debuggers: import openocd-0.7.0
Initial check-in of openocd-0.7.0 as it can be downloaded from http://sourceforge.net/projects/openocd/files/openocd/0.7.0/ Any modifications will follow. Change-Id: I6949beaefd589e046395ea0cb80f4e1ab1654d55
This commit is contained in:
Lars Rademacher
21
debuggers/openocd/jimtcl/.gitignore
vendored
Normal file
21
debuggers/openocd/jimtcl/.gitignore
vendored
Normal file
@ -0,0 +1,21 @@
|
||||
config.log
|
||||
tags
|
||||
/Makefile
|
||||
Tcl.html
|
||||
jimautoconf.h
|
||||
jimautoconfext.h
|
||||
jim-config.h
|
||||
_*.c
|
||||
jim-stdlib.c
|
||||
jim-tclcompat.c
|
||||
jim-tree.c
|
||||
jim-oo.c
|
||||
jimsh
|
||||
*.exe
|
||||
libjim.a
|
||||
*.so
|
||||
*.dll
|
||||
*.o
|
||||
configure.gnu
|
||||
jimsh0
|
||||
build-jim-ext
|
||||
34
debuggers/openocd/jimtcl/.indent.pro
vendored
Normal file
34
debuggers/openocd/jimtcl/.indent.pro
vendored
Normal file
@ -0,0 +1,34 @@
|
||||
-ncs
|
||||
-npcs
|
||||
-nut
|
||||
-bad
|
||||
-bap
|
||||
-bbb
|
||||
-nbc
|
||||
-nlp
|
||||
-ci4
|
||||
-br
|
||||
-ncdb
|
||||
-nce
|
||||
-cli4
|
||||
-d0
|
||||
-di1
|
||||
-nfc1
|
||||
-i4
|
||||
-l100
|
||||
-npsl
|
||||
-TJim_Stack
|
||||
-TJim_HashEntry
|
||||
-TJim_HashTableType
|
||||
-TJim_HashTable
|
||||
-TJim_HashTableIterator
|
||||
-TJim_Obj
|
||||
-TJim_ObjType
|
||||
-TJim_CallFrame
|
||||
-TJim_Var
|
||||
-TJim_Cmd
|
||||
-TJim_PrngState
|
||||
-TJim_Interp
|
||||
-TJim_Reference
|
||||
-TParseToken
|
||||
-TParseTokenList
|
||||
11
debuggers/openocd/jimtcl/.project
Normal file
11
debuggers/openocd/jimtcl/.project
Normal file
@ -0,0 +1,11 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<projectDescription>
|
||||
<name>jim</name>
|
||||
<comment></comment>
|
||||
<projects>
|
||||
</projects>
|
||||
<buildSpec>
|
||||
</buildSpec>
|
||||
<natures>
|
||||
</natures>
|
||||
</projectDescription>
|
||||
41
debuggers/openocd/jimtcl/AUTHORS
Normal file
41
debuggers/openocd/jimtcl/AUTHORS
Normal file
@ -0,0 +1,41 @@
|
||||
Salvatore Sanfilippo <antirez@invece.org>
|
||||
|
||||
with the help (patches, bug reports, ideas, extensions) of:
|
||||
|
||||
Pat Thoyts
|
||||
Clemens Hintze
|
||||
|
||||
See also the ChangeLog and README files for other credits.
|
||||
|
||||
DESIGN CREDITS:
|
||||
|
||||
some of the idea inside Jim are the fruit of long discussions
|
||||
inside the Tclers chat room. The feedback of the Tcl
|
||||
comunity in general, and of the members of the Tcl Core Team, was
|
||||
very important to avoid mistakes: I used the great experience of
|
||||
this people as a test for some of the ideas I put into Jim.
|
||||
Bad ideas tend to be demolished in no time by good engineers.
|
||||
|
||||
Also the following ideas are due to the following authors:
|
||||
|
||||
- Jim locals were originally proposed by Miguel Sofer, I (SS) added
|
||||
the feature that make they similar to lexical scoped closures
|
||||
using capturing of the local variables value if no explicit
|
||||
intialization is provided.
|
||||
|
||||
- The [lmap] command is my (SS) design, but I incorporated inside the
|
||||
command an interesting idea of Donal K. Fellows that proposed that
|
||||
the [continue] command may be used to skip the accumulation of the
|
||||
current-iteartion result, providing in one command the power of
|
||||
[map] and [filter] together.
|
||||
|
||||
|
||||
ChangeLog committers to be identified. Tentative list:
|
||||
|
||||
antirez - Salvatore Sanfilippo <antirez@gmail.com>
|
||||
patthoyts - Pat Thoyts <patthoyts@users.sf.net>
|
||||
oharboe - <20>yvind Harboe - soyvind.harboe@zylin.com
|
||||
Andrew Lunn <andrew@lunn.ch>
|
||||
Duane Ellis <openocd@duaneellis.com>
|
||||
Uwe Klein <uklein@klein-messgeraete.de>
|
||||
Clemens Hintze ml-jim@qiao.in-berlin.de aka chi
|
||||
4
debuggers/openocd/jimtcl/BUGS
Normal file
4
debuggers/openocd/jimtcl/BUGS
Normal file
@ -0,0 +1,4 @@
|
||||
Known bugs
|
||||
==========
|
||||
|
||||
None!
|
||||
93
debuggers/openocd/jimtcl/DEVELOPING
Normal file
93
debuggers/openocd/jimtcl/DEVELOPING
Normal file
@ -0,0 +1,93 @@
|
||||
Working on Jim
|
||||
==============
|
||||
|
||||
Jim's sources are kept in Git Version Control System. Global repository of
|
||||
Jim project is placed on this Web site:
|
||||
|
||||
http://repo.or.cz/w/jimtcl.git
|
||||
|
||||
There are two ways of contributing to Jim project. First is suited for
|
||||
one-time fixes and small corrections. The second is more appropriate
|
||||
for long-term contributors interested in Jim internals.
|
||||
|
||||
Small changes
|
||||
=============
|
||||
|
||||
For small modifications, procedure of preparing a traditional 'patch'
|
||||
is enough. In order to prepare a patch, you first have to obtain the
|
||||
most recent copy of Jim Tcl. This can be done with following command:
|
||||
|
||||
git clone http://repo.or.cz/r/jimtcl.git
|
||||
|
||||
After entering newly created directory you can easily correct/fix/modify
|
||||
files. Once finished, patch can be easily generated:
|
||||
|
||||
git diff > my_patch_fixing_x_y.patch
|
||||
|
||||
If working without Git system, you'll have to backup files first, modify
|
||||
the original files and obtain a patch manually:
|
||||
|
||||
cp jim.c jim.c.ORIGINAL
|
||||
|
||||
[...] <- modifications go here
|
||||
|
||||
diff -u jim.c.ORIGINAL jim.c > my_patch_fixing_z.patch
|
||||
|
||||
Bigger changes
|
||||
==============
|
||||
|
||||
In order to help extending and correcting Jim in a long term basis, one
|
||||
needs to create separate fork of Jim project and maintain his changes in a
|
||||
separate copy of a repository.
|
||||
|
||||
By visiting this site, you'll have a chance to fork a project. This can
|
||||
be easily done with "fork" link. Form that will show up next refers to
|
||||
the project that is about to be started. The only thing that has to be
|
||||
taken care of is the project mode -- it should be "push mode".
|
||||
|
||||
Once the project is created one must add a user that will actually
|
||||
start commiting new files to the repo. It can also be done through the
|
||||
WWW interface, so nothing more is necessary.
|
||||
|
||||
Once finished with setting up a project on the WWW panel, one can
|
||||
start playing with actual import of the files. In order to obtain copy
|
||||
of Jim sources, we have to clone the repository:
|
||||
|
||||
git clone http://repo.or.cz/r/jimtcl.git
|
||||
|
||||
Now, we must push fresh copy of Jim to your project URL:
|
||||
|
||||
git push <URL> master
|
||||
|
||||
So for example for me it was:
|
||||
|
||||
git push ssh://repo.or.cz/srv/git/jimtcl/wkoszek.git master
|
||||
|
||||
In order to add file we type "git add <file>". For remove, we do "git rm
|
||||
<file>". To remove all local changes that aren't in a repository you do "git
|
||||
reset --hard HEAD". Once inserted, files have to be commited with "git commit
|
||||
-a". Once done with commits for today, "git push" can be used to propagate
|
||||
changes from your local disk to the remote repository.
|
||||
|
||||
Right now you can verify whether this works by trying to clone your
|
||||
project's repository somewhere else, this time using anonymount HTTP
|
||||
access:
|
||||
|
||||
git clone http://repo.or.cz/r/jimtcl/wkoszek.git
|
||||
|
||||
Review, testing and publishing
|
||||
==============================
|
||||
|
||||
Notification of work that can be considered finished is more than welcome on
|
||||
Jim-devel mailing list:
|
||||
|
||||
https://lists.berlios.de/mailman/listinfo/jim-devel
|
||||
|
||||
Patches prepared with the procedures presented abore are welcome. Before
|
||||
submitting patches, you can verify that your changes didn't bring any
|
||||
regressions to the Jim. In order to do so, sample regression tests have
|
||||
been implemented. You can execute them by typing:
|
||||
|
||||
make test
|
||||
|
||||
All tests should succeed.
|
||||
45
debuggers/openocd/jimtcl/LICENSE
Normal file
45
debuggers/openocd/jimtcl/LICENSE
Normal file
@ -0,0 +1,45 @@
|
||||
Unless explicitly stated, all files within Jim repository are released
|
||||
under following license:
|
||||
|
||||
/* Jim - A small embeddable Tcl interpreter
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
* Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
|
||||
* Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
|
||||
* Copyright 2008 oharboe - <20>yvind Harboe - oyvind.harboe@zylin.com
|
||||
* Copyright 2008 Andrew Lunn <andrew@lunn.ch>
|
||||
* Copyright 2008 Duane Ellis <openocd@duaneellis.com>
|
||||
* Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
|
||||
* Copyright 2008 Steve Bennett <steveb@workware.net.au>
|
||||
* Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
|
||||
* Copyright 2009 Zachary T Welch zw@superlucidity.net
|
||||
* Copyright 2009 David Brownell
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*/
|
||||
204
debuggers/openocd/jimtcl/Makefile.in
Normal file
204
debuggers/openocd/jimtcl/Makefile.in
Normal file
@ -0,0 +1,204 @@
|
||||
# Tools
|
||||
CC = @CCACHE@ @CC@
|
||||
CXX = @CCACHE@ @CXX@
|
||||
RANLIB = @RANLIB@
|
||||
AR = @AR@
|
||||
STRIP = @STRIP@
|
||||
|
||||
# Configuration
|
||||
|
||||
SH_CFLAGS ?= @SH_CFLAGS@
|
||||
SH_LDFLAGS ?= @SH_LDFLAGS@
|
||||
SHOBJ_CFLAGS ?= @SHOBJ_CFLAGS@
|
||||
@if JIM_STATICLIB
|
||||
SHOBJ_LDFLAGS ?= @SHOBJ_LDFLAGS@
|
||||
@else
|
||||
SHOBJ_LDFLAGS ?= @SHOBJ_LDFLAGS_R@
|
||||
@endif
|
||||
CFLAGS = @CFLAGS@
|
||||
CXXFLAGS = @CXXFLAGS@
|
||||
LDFLAGS = @LDFLAGS@
|
||||
LDLIBS += @LDLIBS@
|
||||
exec_prefix ?= @exec_prefix@
|
||||
prefix ?= @prefix@
|
||||
|
||||
CC += -D_GNU_SOURCE -Wall $(OPTIM) -I.
|
||||
CXX += -D_GNU_SOURCE -Wall $(OPTIM) -I.
|
||||
@if srcdir != .
|
||||
CFLAGS += -I@srcdir@
|
||||
CXXFLAGS += -I@srcdir@
|
||||
VPATH := @srcdir@
|
||||
@endif
|
||||
|
||||
@if JIM_STATICLIB
|
||||
LIBJIM := libjim.a
|
||||
@else
|
||||
LIBJIM := libjim.@LIBSOEXT@
|
||||
SH_LIBJIM := $(LIBJIM)
|
||||
CC += $(SH_CFLAGS)
|
||||
CXX += $(SH_CFLAGS)
|
||||
DEF_LD_PATH := @LD_LIBRARY_PATH@=@builddir@
|
||||
@endif
|
||||
|
||||
@if HAVE_CXX_EXTENSIONS
|
||||
JIMSH_CC := $(CXX) $(CXXFLAGS)
|
||||
@else
|
||||
JIMSH_CC := $(CC) $(CFLAGS)
|
||||
@endif
|
||||
|
||||
OBJS := _load-static-exts.o jim-subcmd.o jim-interactive.o jim-format.o jim.o utf8.o jimregexp.o \
|
||||
@EXTRA_OBJS@ @C_EXT_OBJS@ @TCL_EXT_OBJS@
|
||||
|
||||
JIMSH := jimsh@EXEEXT@
|
||||
|
||||
all: $(JIMSH) @C_EXT_SHOBJS@
|
||||
|
||||
# Create C extensions from pure Tcl extensions
|
||||
.SUFFIXES: .tcl
|
||||
.tcl.o:
|
||||
@tclsh@ @srcdir@/make-c-ext.tcl $< >_$*.c || ( rm _$*.c; exit 1)
|
||||
$(CC) $(CFLAGS) -c -o $@ _$*.c || ( rm _$*.c; exit 1)
|
||||
@rm -f _$*.c
|
||||
|
||||
docs: Tcl.html
|
||||
|
||||
$(JIMSH): $(LIBJIM) jimsh.o initjimsh.o
|
||||
$(JIMSH_CC) @SH_LINKFLAGS@ $(LDFLAGS) -o $@ jimsh.o initjimsh.o $(LIBJIM) $(LDLIBS)
|
||||
|
||||
@if JIM_INSTALL
|
||||
install: all docs @TCL_EXTS@ install-exec
|
||||
mkdir -p $(DESTDIR)$(prefix)/lib/jim
|
||||
cp $(LIBJIM) $(DESTDIR)$(prefix)/lib
|
||||
cp @srcdir@/README.extensions @C_EXT_SHOBJS@ @TCL_EXTS@ $(DESTDIR)$(prefix)/lib/jim
|
||||
mkdir -p $(DESTDIR)$(prefix)/include
|
||||
cp @srcdir@/jim.h @srcdir@/jim-eventloop.h @srcdir@/jim-signal.h \
|
||||
@srcdir@/jim-subcmd.h @srcdir@/jim-win32compat.h $(DESTDIR)$(prefix)/include
|
||||
cp jim-config.h $(DESTDIR)$(prefix)/include
|
||||
mkdir -p $(DESTDIR)$(prefix)/doc/jim
|
||||
cp Tcl.html $(DESTDIR)$(prefix)/doc/jim
|
||||
mkdir -p $(DESTDIR)$(prefix)/bin
|
||||
cp build-jim-ext $(DESTDIR)$(prefix)/bin
|
||||
|
||||
install-exec: all
|
||||
mkdir -p $(DESTDIR)$(prefix)/bin
|
||||
cp $(JIMSH) $(DESTDIR)$(prefix)/bin
|
||||
|
||||
uninstall:
|
||||
rm -f $(DESTDIR)$(prefix)/bin/$(JIMSH)
|
||||
rm -f $(DESTDIR)$(prefix)/bin/build-jim-ext
|
||||
rm -f $(DESTDIR)$(prefix)/lib/$(LIBJIM)
|
||||
for i in README.extensions @C_EXT_SHOBJS@ @TCL_EXTS@; do rm -f $(DESTDIR)$(prefix)/lib/jim/$$i; done
|
||||
rm -f $(DESTDIR)$(prefix)/include/jim*.h
|
||||
rm -f $(DESTDIR)$(prefix)/doc/jim/Tcl.html
|
||||
@else
|
||||
install install-exec: all
|
||||
uninstall:
|
||||
@endif
|
||||
|
||||
test: $(JIMSH)
|
||||
cd @srcdir@/tests; $(DEF_LD_PATH) $(MAKE) jimsh=@builddir@/jimsh
|
||||
|
||||
$(OBJS): Makefile
|
||||
|
||||
@if JIM_UTF8
|
||||
# Generate the unicode case mapping
|
||||
utf8.o: _unicode_mapping.c
|
||||
|
||||
_unicode_mapping.c: @srcdir@/UnicodeData.txt @srcdir@/parse-unidata.tcl
|
||||
@tclsh@ @srcdir@/parse-unidata.tcl @srcdir@/UnicodeData.txt >$@ || ( rm $@; exit 1)
|
||||
@endif
|
||||
|
||||
_load-static-exts.c: @srcdir@/make-load-static-exts.tcl Makefile
|
||||
@tclsh@ @srcdir@/make-load-static-exts.tcl @STATIC_EXTS@ >$@ || ( rm $@; exit 1)
|
||||
|
||||
@if JIM_STATICLIB
|
||||
$(LIBJIM): $(OBJS)
|
||||
$(AR) cr $@ $(OBJS)
|
||||
$(RANLIB) $@
|
||||
@else
|
||||
$(LIBJIM): $(OBJS)
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SH_LDFLAGS) -o $@ $(OBJS) $(LDLIBS)
|
||||
@endif
|
||||
|
||||
# Note that $> $^ is for compatibility with both GNU make and BSD make
|
||||
readdir.so: jim-readdir.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-readdir.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-readdir.o $(SH_LIBJIM)
|
||||
|
||||
array.so: jim-array.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-array.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-array.o $(SH_LIBJIM)
|
||||
|
||||
clock.so: jim-clock.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-clock.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-clock.o $(SH_LIBJIM)
|
||||
|
||||
file.so: jim-file.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-file.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-file.o $(SH_LIBJIM)
|
||||
|
||||
posix.so: jim-posix.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-posix.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-posix.o $(SH_LIBJIM)
|
||||
|
||||
regexp.so: jim-regexp.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-regexp.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-regexp.o $(SH_LIBJIM)
|
||||
|
||||
syslog.so: jim-syslog.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-syslog.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-syslog.o $(SH_LIBJIM)
|
||||
|
||||
readline.so: jim-readline.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-readline.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-readline.o $(SH_LIBJIM) @LDLIBS_readline@
|
||||
|
||||
pack.so: jim-pack.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-pack.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-pack.o $(SH_LIBJIM) @LDLIBS_pack@
|
||||
|
||||
tclprefix.so: jim-tclprefix.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-tclprefix.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-tclprefix.o $(SH_LIBJIM) @LDLIBS_tclprefix@
|
||||
|
||||
sqlite3.so: jim-sqlite3.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-sqlite3.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-sqlite3.o $(SH_LIBJIM) @LDLIBS_sqlite3@
|
||||
|
||||
win32.so: jim-win32.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-win32.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-win32.o $(SH_LIBJIM) @LDLIBS_win32@
|
||||
|
||||
mk.so: jim-mk.cpp
|
||||
$(CXX) $(CXXFLAGS) $(SHOBJ_CFLAGS) -c -o jim-mk.o $> $^
|
||||
$(CXX) $(CXXFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-mk.o $(SH_LIBJIM) @LDLIBS_mk@
|
||||
|
||||
sdl.so: jim-sdl.c
|
||||
$(CC) $(CFLAGS) $(SHOBJ_CFLAGS) -c -o jim-sdl.o $> $^
|
||||
$(CC) $(CFLAGS) $(LDFLAGS) $(SHOBJ_LDFLAGS) -o $@ jim-sdl.o $(SH_LIBJIM) @LDLIBS_sdl@
|
||||
|
||||
Tcl.html: jim_tcl.txt
|
||||
@tclsh@ @srcdir@/make-index $> $^ | asciidoc -o $@ -d manpage - || cp @srcdir@/Tcl_shipped.html Tcl.html
|
||||
|
||||
clean:
|
||||
rm -f *.o *.so *.dll *.exe lib*.a $(JIMSH) Tcl.html _*.c
|
||||
|
||||
distclean: clean
|
||||
rm -f jimautoconf.h jim-config.h Makefile config.log autosetup/jimsh0@EXEEXT@ build-jim-ext
|
||||
|
||||
ship: Tcl.html
|
||||
cp $< Tcl_shipped.html
|
||||
|
||||
# automake compatibility. do nothing for all these targets
|
||||
EMPTY_AUTOMAKE_TARGETS := dvi pdf ps info html tags ctags mostlyclean maintainer-clean check installcheck installdirs \
|
||||
install-pdf install-ps install-info install-html -install-dvi uninstall install-data
|
||||
.PHONY: $(EMPTY_AUTOMAKE_TARGETS)
|
||||
$(EMPTY_AUTOMAKE_TARGETS):
|
||||
|
||||
# automake compatibility - install sources from the current dir to $(distdir)
|
||||
distdir_full := $(shell cd $(distdir); pwd)
|
||||
distdir:
|
||||
cd "@srcdir@"; git ls-files | cpio -pdmu $(distdir_full)
|
||||
|
||||
reconfig:
|
||||
CC='@CC@' @AUTOREMAKE@
|
||||
235
debuggers/openocd/jimtcl/README
Normal file
235
debuggers/openocd/jimtcl/README
Normal file
@ -0,0 +1,235 @@
|
||||
The Jim Interpreter
|
||||
|
||||
A small-footprint implementation of the Tcl programming language.
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
WHAT IS JIM?
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Jim is a small footprint implementation of the Tcl programming language
|
||||
written from scratch. Currently Jim Tcl is very feature complete with
|
||||
an extensive test suite (see the tests directory).
|
||||
There are some Tcl commands and features which are not implemented
|
||||
(and likely never will be), including namespaces, traces and Tk. However
|
||||
Jim Tcl offers a number of both Tcl8.5 and Tcl8.6 features ({*}, dict, lassign,
|
||||
tailcall and optional UTF-8 support) and some unique features.
|
||||
These unique features include [lambda] with garbage collection, a general GC/references
|
||||
system, arrays as syntax sugar for [dict]tionaries, object-based I/O and more.
|
||||
|
||||
Other common features of the Tcl programming language are present, like
|
||||
the "everything is a string" behaviour, implemented internally as
|
||||
dual ported objects to ensure that the execution time does not reflect
|
||||
the semantic of the language :)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
WHEN JIM CAN BE USEFUL?
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
1) If you are writing an application, and want to make it scriptable, with
|
||||
Jim you have a way to do it that does not require to link your application
|
||||
with a big system. You can include the Jim source directly in your project
|
||||
and use the Jim API to write the glue code that makes your application
|
||||
scriptable in Jim, with the following advantages:
|
||||
|
||||
- Jim is not the next "little language", but it's a Tcl implementation.
|
||||
You can reuse your knowledge if you already Tcl skills, or enjoy
|
||||
the availability of documentation, books, web resources, ...
|
||||
(for example check my online Tcl book at http://www.invece.org/tclwise)
|
||||
|
||||
- Jim is simple, 14k lines of core code. If you want to adapt it you can hack
|
||||
the source code to meet the needs of your application. It makes you
|
||||
able to have scripting for default, and avoid external dependences.
|
||||
|
||||
Having scripting support *inside*, and in a way that a given version
|
||||
of your program always gets shipped a given version of Jim, you can
|
||||
write part of your application in Jim itself. Like it happens for
|
||||
Emacs/Elisp, or Gimp/Scheme, both this applications have the interpreter
|
||||
inside.
|
||||
|
||||
- Jim is Tcl, and Tcl looks like a configuration file if you want. So
|
||||
if you use Jim you have also a flexible syntax for your config file.
|
||||
This is a valid Tcl script:
|
||||
|
||||
set MyFeature on
|
||||
ifssl {
|
||||
set SslPort 45000
|
||||
use compression
|
||||
}
|
||||
|
||||
It looks like a configuration file, but if you implement the [ifssl]
|
||||
and [use] commands, it's a valid Tcl script.
|
||||
|
||||
- Tcl scales with the user. Not all know it, but Tcl is so powerful that
|
||||
you can reprogram the language in itself. Jim support this features
|
||||
of the Tcl programming language. You can write new control structures,
|
||||
use the flexible data types it offers (Lists are a central data structure,
|
||||
with Dictionaries that are also lists). Still Tcl is simpler for the
|
||||
casual programmer, especially if compared to other languages offering
|
||||
small footprint implementations (like Scheme and FORTH).
|
||||
|
||||
- Because of the Tcl semantic (pass by value, everything is a command
|
||||
since there are no reserved words), there is a nice API to glue
|
||||
your application with Jim. See under the Jim Tcl manual for more detail.
|
||||
|
||||
- Jim is supported. If you need commercial software, contact the original author
|
||||
at 'antirez@gmail.com' or the current maintainer at 'steveb@workware.net.au'.
|
||||
|
||||
2) The other "field" where Jim can be useful is obviously embedded systems.
|
||||
|
||||
3) We are working to make Jim as feature-complete as possible, thanks to
|
||||
dynamically loaded extensions it may stay as little as it is today
|
||||
but able to do interesting things for you. So it's not excluded that
|
||||
in the future Jim will be an option as general purpose language.
|
||||
But don't mind, for this there is already the mainstream Tcl
|
||||
implementation ;).
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
HOW BIG IS IT?
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Jim with the default extensions configured and compiled with -Os is about 130k.
|
||||
Without any extensions, it is about 85k.
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
HOW FAST IS IT?
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Jim is in most code faster than Tcl7.6p2 (latest 7.x version),
|
||||
and slower than Tcl 8.4.x. You can expect pretty decent performance
|
||||
for such a little interpreter.
|
||||
|
||||
If you want a more precise measure, there is 'bench.tcl' inside this
|
||||
distribution that will run both under Jim and Tcl, so just execute
|
||||
it with both the interpreters and see what you get :)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
HOW TO COMPILE
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Jim was tested under Linux, FreeBSD, MacosX, eCos, QNX, Windows XP (mingw, MVC).
|
||||
|
||||
To compile jim itself try:
|
||||
|
||||
./configure
|
||||
make
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
EXTENSIONS
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Many optional extensions are included. Some are C extensions and others are pure Tcl.
|
||||
Form more information, try:
|
||||
|
||||
./configure --help
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
HOW TO EMBED JIM INTO APPLICATIONS
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
See the "examples.api" directory
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
HOW TO WRITE EXTENSIONS FOR JIM
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
See the extensions shipped with Jim, jim-readline.c, jim-clock.c, glob.tcl and oo.tcl
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
COPYRIGHT and LICENSE
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
Unless explicitly stated, all files within Jim repository are released
|
||||
under following license:
|
||||
|
||||
/* Jim - A small embeddable Tcl interpreter
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
* Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
|
||||
* Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
|
||||
* Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
|
||||
* Copyright 2008 Andrew Lunn <andrew@lunn.ch>
|
||||
* Copyright 2008 Duane Ellis <openocd@duaneellis.com>
|
||||
* Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
|
||||
* Copyright 2008 Steve Bennett <steveb@workware.net.au>
|
||||
* Copyright 2009 Nico Coesel <ncoesel@dealogic.nl>
|
||||
* Copyright 2009 Zachary T Welch zw@superlucidity.net
|
||||
* Copyright 2009 David Brownell
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*/
|
||||
--------------------------------------------------------------------------------
|
||||
HISTORY
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
"first Jim goal: to vent my need to hack on Tcl."
|
||||
|
||||
And actually this is exactly why I started Jim, in the first days
|
||||
of Jenuary 2005. After a month of hacking Jim was able to run
|
||||
simple scripts, now, after two months it started to be clear to
|
||||
me that it was not just the next toy to throw away but something
|
||||
that may evolve into a real interpreter. In the same time
|
||||
Pat Thoyts and Clemens Hintze started to contribute code, so that
|
||||
the development of new core commands was faster, and also more
|
||||
people hacking on the same code had as result fixes in the API,
|
||||
C macros, and so on.
|
||||
|
||||
Currently we are at the point that the core interpreter is almost finished
|
||||
and it is entering the Beta stage. There is to add some other core command,
|
||||
to do a code review to ensure quality of all the parts and to write
|
||||
documentation.
|
||||
|
||||
We already started to work on extensions like OOP, event loop,
|
||||
I/O, networking, regexp. Some extensions are already ready for
|
||||
prime time, like the Sqlite extension and the ANSI I/O.
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
Thanks to...
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
- First of all, thanks to every guy that are listed in the AUTHORS file,
|
||||
that directly helped with code and ideas. Also check the ChangeLog
|
||||
file for additional credits about patches or bug reports.
|
||||
- Elisa Manara that helped me to select this ill conceived name for
|
||||
an interpreter.
|
||||
- Many people on the Tclers Chat that helped me to explore issues
|
||||
about the use and the implementation of the Tcl programming language.
|
||||
- David Welton for the tech info sharing and our chats about
|
||||
programming languages design and the ability of software to "scale down".
|
||||
- Martin S. Weber for the great help with Solaris issues, debugging of
|
||||
problems with [load] on this arch, 64bit tests.
|
||||
- The authors of "valgrind", for this wonderful tool, that helped me a
|
||||
lot to fix bugs in minutes instead of hours.
|
||||
|
||||
|
||||
----
|
||||
Enjoy!
|
||||
Salvatore Sanfilippo
|
||||
10 Mar 2005
|
||||
|
||||
|
||||
15
debuggers/openocd/jimtcl/README.extensions
Normal file
15
debuggers/openocd/jimtcl/README.extensions
Normal file
@ -0,0 +1,15 @@
|
||||
The /lib/jim directory contains both dynamically loadable extensions
|
||||
and pure-Tcl extensions.
|
||||
|
||||
Dynamically loadable extensions must have a .so file extension
|
||||
Tcl extensions must have a .tcl file extension
|
||||
|
||||
As long as /lib/jim is in $::auto_path (it is by default), extension
|
||||
abc can be loaded with:
|
||||
|
||||
package require abc
|
||||
|
||||
First abc.so will be tried, and then abc.tcl
|
||||
|
||||
Note that this directory may be something like /lib/jim, /usr/lib/jim or
|
||||
/usr/local/lib/jim, depending upon where jim was installed.
|
||||
316
debuggers/openocd/jimtcl/README.metakit
Normal file
316
debuggers/openocd/jimtcl/README.metakit
Normal file
@ -0,0 +1,316 @@
|
||||
---
|
||||
title: Metakit
|
||||
---
|
||||
|
||||
Metakit Extension for Jim Tcl
|
||||
=============================
|
||||
|
||||
OVERVIEW
|
||||
--------
|
||||
The mk extension provides an interface to the Metakit small-footprint
|
||||
embeddable database library (<http://equi4.com/metakit/>). The underlying
|
||||
library is efficient at manipulating not-so-large amounts of data and takes a
|
||||
different approach to composing database operations than common SQL-based
|
||||
relational databases.
|
||||
|
||||
Both the Metakit core library and the mk package can be linked either
|
||||
statically or dynamically and loaded using
|
||||
|
||||
package require mk
|
||||
|
||||
CREATING A DATABASE
|
||||
-------------------
|
||||
A database (called a "storage" in Metakit terms) may either reside totally in
|
||||
memory or be backed by a file. To open or create a database, call the
|
||||
`storage` command with an optional filename parameter:
|
||||
|
||||
set db [storage test.mk]
|
||||
|
||||
The returned handle can be used as a command name to access the database. When
|
||||
you are done, execute the `close` method, that is, run
|
||||
|
||||
$db close
|
||||
|
||||
A lost handle won't be found by GC but will be closed when the interpreter
|
||||
exits. Note that by default Metakit will only record changes to the database
|
||||
when you close the handle. Use the `commit` method to record the current
|
||||
state of the database to disk.
|
||||
|
||||
CREATING VIEWS
|
||||
--------------
|
||||
*Views* in Metakit are what is called "tables" in conventional databases. A view
|
||||
may several typed *properties*, or columns, and contains homogenous *rows*, or
|
||||
records. New properties may be added to a view as needed; however, new properties
|
||||
are not stored in the database file by default. The structure method specifies
|
||||
the stored properties of a view, creating a new view or restructuring an old one
|
||||
as needed:
|
||||
|
||||
$db structure viewName description
|
||||
|
||||
The view description must be a list of form `{propName type propName type ...}`.
|
||||
The supported property types include:
|
||||
|
||||
`string`
|
||||
: A NULL-terminated string, stored as an array of bytes (without any encoding
|
||||
assumptions).
|
||||
|
||||
`binary`
|
||||
: **Not yet supported by the `mk` extension.**
|
||||
Blob of binary data that may contain embedded NULLs (zero bytes). Stored
|
||||
as-is. This is more efficient than `string` when storing large blocks of
|
||||
data (e.g. images) and will adjust the storage strategy as needed.
|
||||
|
||||
`integer`
|
||||
: An signed integer value occupying a maximum of 32 bits. If all values
|
||||
stored in a column can fit in a smaller range (16, 8, or even 4 or 2 bits),
|
||||
they are packed automatically.
|
||||
|
||||
`long`
|
||||
: Like `integer`, but is required to fit into 64 bits.
|
||||
|
||||
`float` and `double`
|
||||
: 32-bit and 64-bit IEEE floating-point values respectively.
|
||||
|
||||
`subview`
|
||||
: This type is not usually specified directly; instead, a structure
|
||||
description of a nested view is given. `subview` properties store complete
|
||||
views as their value, creating hierarchical data structures. When retreived
|
||||
from a view, a value of a subview property is a normal view handle.
|
||||
|
||||
Without a `description` parameter, the `structure` method returns the current
|
||||
structure of the named view; without any parameters, it returns a dictionary
|
||||
containing structure descriptions of all views stored in the database.
|
||||
|
||||
After specifying the properties you expect to see in the view, call
|
||||
|
||||
[$db view $viewName] as viewHandle
|
||||
|
||||
to obtain a view handle. These handles are also commands, but are
|
||||
garbage-collected and also destroy themselves after a single method call; the
|
||||
`as viewHandle` call assigns the view handle to the specified variable and also
|
||||
tells the view not to destroy itself until all the references to it are gone.
|
||||
|
||||
View handles may also be made permanent by giving them a global command name,
|
||||
e.g.
|
||||
|
||||
rename [$db view data] .db.data
|
||||
|
||||
However, such view handles are not managed automatically at all and must be
|
||||
destroyed using the `destroy` method, or by renaming them to `""`.
|
||||
|
||||
MANIPULATING DATA
|
||||
-----------------
|
||||
The value of a particular property is obtained using
|
||||
|
||||
cursor get $cur propName
|
||||
|
||||
where `$cur` is a string of form `viewHandle!index`. Row indices are zero-based
|
||||
and may also be specified relative to the last row of the view using the
|
||||
`end[+-]integer` notation.
|
||||
|
||||
A dictionary containing all property name and value pairs can be retreived by
|
||||
omitting the `propName` argument:
|
||||
|
||||
cursor get $cur
|
||||
|
||||
Setting property values is also performed either individually, using
|
||||
|
||||
cursor set $cur propName value ?propName value ...?
|
||||
|
||||
or via a dictionary with
|
||||
|
||||
cursor set $cur dictValue
|
||||
|
||||
In the first form of the command, property names may also be preceded by a
|
||||
-_typeName_ option. In this case, a new property of the specified type will be
|
||||
created if it doesn't already exist; note that this will cause *all* the rows
|
||||
in the view to have the property (but see **A NOTE ON NULL** below).
|
||||
|
||||
If the row index points after the end of the view, an appropriate number of
|
||||
fresh rows will be inserted first. So, for example, you can use `end+1`
|
||||
to append a new row. (Note that you then have to set it all at once, though.)
|
||||
|
||||
The total number of rows can be obtained using
|
||||
|
||||
$viewHandle size
|
||||
|
||||
and set manually with
|
||||
|
||||
$viewHandle resize newSize
|
||||
|
||||
For example, you can use `$viewHandle resize 0` to clear a view.
|
||||
|
||||
INSERT AND REMOVE
|
||||
-----------------
|
||||
New rows may also be inserted at an arbitrary position in a view with
|
||||
|
||||
cursor insert $cur ?count?
|
||||
|
||||
This will insert _count_ fresh rows into the view so that _$cur_ points to
|
||||
the first one. The inverse of this operation is
|
||||
|
||||
cursor remove $cur ?count?
|
||||
|
||||
COMPOSING VIEWS
|
||||
---------------
|
||||
The real power of Metakit lies in the way existing views are combined to create
|
||||
new ones to obtain a particular perspective on the stored data. A single
|
||||
operation takes one or more views and possibly additional options and produces a
|
||||
new view, usually tracking notifications to the underlying views and sometimes
|
||||
even supporting modification.
|
||||
|
||||
Binary operations are left-biased when there are conflicting property values;
|
||||
that is, they always prefer the values from the left view.
|
||||
|
||||
### Unary operations ###
|
||||
|
||||
*view* `unique`
|
||||
: Derived view with duplicate rows removed.
|
||||
|
||||
*view* `sort` *crit ?crit ...?*
|
||||
: Derived view sorted on the specified criteria, in order. A single _crit_
|
||||
is either a property name or a property name preceded by a dash; the latter
|
||||
specifies that the sorting is to be performed in reverse order.
|
||||
|
||||
### Binary operations ###
|
||||
|
||||
The operations taking _set_ arguments require that the given views have no
|
||||
duplicate rows. The `unique` method can be used to ensure this.
|
||||
|
||||
*view1* `concat` *view2*
|
||||
: Vertical concatenation; that is, all the rows of _view1_ and then all rows
|
||||
of _view2_.
|
||||
|
||||
*view1* `pair` *view2*
|
||||
: Pairing, or horizontal concatenation: every row in _view1_ is matched with
|
||||
a row with the same index in _view2_; the result has all the properties of
|
||||
_view1_ and all the properties of _view2_.
|
||||
|
||||
*view1* `product` *view2*
|
||||
: Cartesian product: each row in _view1_ horizontally concatenated with every
|
||||
row in _view2_.
|
||||
|
||||
*set1* `union` *set2*
|
||||
: Set union. Unlike `concat`, this operation removes duplicates from the
|
||||
result. A row is in the result if it is in _set1_ **or** in _set2_.
|
||||
|
||||
*set1* `intersect` *set2*
|
||||
: Set intersection. A row is in the result if it is in _set1_ **and** in
|
||||
_set2_.
|
||||
|
||||
*set1* `different` *set2*
|
||||
: Symmetric difference. A row is in the result if it is in _set1_ **xor** in
|
||||
_set2_, that is, in _set1_ or in _set2_, but not in both.
|
||||
|
||||
*set1* `minus` *set2*
|
||||
: Set minus. A row is in the result if it is in _set1_ **and not** in _set2_.
|
||||
|
||||
### Relational operations ###
|
||||
|
||||
*view1* `join` *view2* ?`-outer`? *prop ?prop ...?*
|
||||
: Relational join on the specified properties: the rows from _view1_ and
|
||||
_view2_ with all the specified properties equal are concatenated to form a
|
||||
new row. If the `-outer` option is specified, the rows from _view1_ that do
|
||||
not have a corresponding one in _view2_ are also left in the view, with the
|
||||
properties existing only in _view2_ filled with default values.
|
||||
|
||||
*view* `group` *subviewName prop ?prop ...?*
|
||||
: Groups the rows with all the specified properties equal; moves all the
|
||||
remaining properties into a newly created subview property called
|
||||
_subviewName_.
|
||||
|
||||
*view* `flatten` *subviewProp*
|
||||
: The inverse of `group`.
|
||||
|
||||
### Projections and selections ###
|
||||
|
||||
*view* `project` *prop ?prop ...?*
|
||||
: Projection: a derived view with only the specified properties left.
|
||||
|
||||
*view* `without` *prop ?prop ...?*
|
||||
: The opposite of `project`: a derived view with the specified properties
|
||||
removed.
|
||||
|
||||
*view* `range` *start end ?step?*
|
||||
A slice or a segment of _view_: rows at _start_, _start+step_, and so on,
|
||||
until the row number becomes larger than _end_. The usual `end[+-]integer`
|
||||
notation is supported, but the indices don't change if the underlying view
|
||||
is resized.
|
||||
|
||||
**(!) select etc. should go here**
|
||||
|
||||
### Search and storage optimization ###
|
||||
|
||||
*view* `blocked`
|
||||
: Invokes an optimization designed for storing large amounts of data. _view_
|
||||
must have a single subview property called `_B` with the desired structure
|
||||
inside. This additional level of indirection is used by `blocked` to create
|
||||
a view that looks like a usual one, but can store much more data
|
||||
efficiently. As a result, indexing into the view becomes a bit slower. Once
|
||||
this method is invoked, all access to _view_ must go through the returned
|
||||
view.
|
||||
|
||||
*view* `ordered` *prop ?prop ...?*
|
||||
: Does not transform the structure of the view in any way, but signals that
|
||||
the view should be considered ordered on a unique key consisting of the
|
||||
specified properties, enabling some optimizations. Note that duplicate keys
|
||||
are not allowed in an ordered view.
|
||||
|
||||
**(!) TODO: hash, indexed(?) -- these make no sense until searches are implemented**
|
||||
|
||||
### Pipelines ###
|
||||
|
||||
Because constructs like `[[view op1 ...] op2 ...] op3 ...` tend to be common in
|
||||
programs using Metakit, a shorthand syntax is introduced: such expressions may
|
||||
also be written as `view op1 ... | op2 ... | op3 ...`.
|
||||
|
||||
Note though that this syntax is not in any way magically wired into the
|
||||
interpreter: it is understood only by the view handles and the two commands that
|
||||
can possibly return a view: `$db view` and `cursor get`. If you want to support
|
||||
this syntax in Tcl procedures, you'll need to do this yourself, or you may want
|
||||
to create a custom view method and have the view handle work out the syntax for
|
||||
you (see **USER-DEFINED METHODS** below).
|
||||
|
||||
OTHER VIEW METHODS
|
||||
------------------
|
||||
|
||||
*view* `copy`
|
||||
: Creates a copy of view with the same data.
|
||||
|
||||
*view* `clone`
|
||||
: Creates a view with the same structure, but no data.
|
||||
|
||||
*view* `pin`
|
||||
: Specifies that the view should not be destroyed after a single method call.
|
||||
Returns _view_.
|
||||
|
||||
*view* `as` *varName*
|
||||
: In addition to the actions performed by `pin`, assigns the view handle to
|
||||
the variable named varName in the caller's scope.
|
||||
|
||||
*view* `properties`
|
||||
: Returns the names of all properties in the view.
|
||||
|
||||
*view* `type` *prop*
|
||||
: Returns the type of the specified property.
|
||||
|
||||
A NOTE ON NULL
|
||||
--------------
|
||||
Note that Metakit does not have a special `NULL` value like conventional
|
||||
relational databases do. Instead, it defines _default_ property values: `""` for
|
||||
`string` and `binary` types, `0` for all numeric types and a view with no rows
|
||||
for subviews. These defaults are used when a fresh row is inserted and when
|
||||
a new property is added to the view to fill in the missing values.
|
||||
|
||||
USER-DEFINED METHODS
|
||||
--------------------
|
||||
The storage and view handles support custom methods defined in Tcl: to define
|
||||
_methodName_ on every storage or view handle, create a procedure called
|
||||
{`mk.storage` *methodName*} or {`mk.view` *methodName*} respectively. These
|
||||
procedures will receive the handle as the first argument and all the remaining
|
||||
arguments. Remember to `pin` the view handle in view methods if you call more
|
||||
than one method of it!
|
||||
|
||||
Custom `cursor` subcommands may also be defined by creating a procedure called
|
||||
{`cursor` *methodName*}. These receive all the arguments without any
|
||||
modifications.
|
||||
191
debuggers/openocd/jimtcl/README.namespaces
Normal file
191
debuggers/openocd/jimtcl/README.namespaces
Normal file
@ -0,0 +1,191 @@
|
||||
Lightweight Namespaces for Jim Tcl
|
||||
==================================
|
||||
|
||||
There are two broad requirements for namespace support in Jim Tcl.
|
||||
|
||||
1. To allow code from multiple sources while reducing the chance of name clashes
|
||||
2. To simplify porting existing Tcl code which uses namespaces
|
||||
|
||||
This proposal addresses both of these requirements, with the following
|
||||
additional requirements imposed by Jim Tcl.
|
||||
|
||||
3. Support for namespaces should be optional, with the space and time overhead
|
||||
when namespaces are disabled as close to zero as possible.
|
||||
4. The implementation should be small and reasonably efficient.
|
||||
|
||||
To further expand on requirement (2), the goal is not to be able to run
|
||||
any Tcl scripts using namespaces with no changes. Rather, scripts
|
||||
which use namespaces in a straightforward manner, should be easily
|
||||
ported with changes which are compatible with Tcl.
|
||||
|
||||
Implicit namespaces
|
||||
-------------------
|
||||
Rather than supporting explicit namespaces as Tcl does, Jim Tcl
|
||||
supports implicit namespaces. Any procedure or variable which
|
||||
is defined with a name containing ::, is implicitly scoped within
|
||||
a namespace.
|
||||
|
||||
For example, the following procedure and variable are created
|
||||
in the namespace 'test'
|
||||
|
||||
proc ::test::myproc {} {
|
||||
puts "I am in namespace [namespace current]"
|
||||
}
|
||||
set ::test::myvar 3
|
||||
|
||||
This approach allows much of the existing variable and command
|
||||
resolution machinery to be used with little change. It also means
|
||||
that it is possible to simply define a namespace-scoped variable
|
||||
or procedure without first creating the namespace, and similarly,
|
||||
namespaces "disappear" when all variables and procedures defined
|
||||
with the namespace scope are deleted.
|
||||
|
||||
Namespaces, procedures and call frames
|
||||
--------------------------------------
|
||||
When namespace support is enabled (at build time), each procedure has an associated
|
||||
namespace (based on the procedure name). When the procedure is evaluated,
|
||||
the namespace for the created call frame is set to the namespace associated
|
||||
with the procedure.
|
||||
|
||||
Command resolution is based on the namespace of the current call frame.
|
||||
An unscoped command name will first be looked up in the current namespace,
|
||||
and then in the global namespace.
|
||||
|
||||
This also means that commands which do not create a call frame (such as commands
|
||||
implemented in C) do not have an associated namespace.
|
||||
|
||||
Similarly to Tcl, namespace eval introduces a temporary, anonymous
|
||||
call frame with the associated namespace. For example, the following
|
||||
will return "::test,1".
|
||||
|
||||
namespace eval test {
|
||||
puts [namespace current],[info level]
|
||||
}
|
||||
|
||||
Variable resolution
|
||||
-------------------
|
||||
The variable command in Jim Tcl has the same syntax as Tcl, but is closer in behaviour to the global command.
|
||||
The variable command creates a link from a local variable to a namespace variable, possibly initialising it.
|
||||
|
||||
For example, the following procedure uses 'variable' to initialse and access myvar.
|
||||
|
||||
proc ::test::myproc {} {
|
||||
variable myvar 4
|
||||
incr myvar
|
||||
}
|
||||
|
||||
Note that there is no automatic resolution of namespace variables.
|
||||
For example, the following will *not* work.
|
||||
|
||||
namespace eval ::test {
|
||||
variable myvar 4
|
||||
}
|
||||
namespace eval ::test {
|
||||
# This will increment a local variable, not ::test::myvar
|
||||
incr myvar
|
||||
}
|
||||
|
||||
And similarly, the following will only access local variables
|
||||
|
||||
set x 3
|
||||
namespace eval ::test {
|
||||
# This will incremement a local variable, not ::x
|
||||
incr x
|
||||
# This will also increment a local variable
|
||||
incr abc::def
|
||||
}
|
||||
|
||||
In the same way that variable resolution does not "fall back" to
|
||||
global variables, it also does not "fall back" to namespace variables.
|
||||
|
||||
This approach allows name resolution to be simpler and more efficient
|
||||
since it uses the same variable linking mechanism as upvar/global
|
||||
and it allows namespaces to be implicit. It also solves the "creative
|
||||
writing" problem where a variable may be created in an unintentional
|
||||
scope.
|
||||
|
||||
The namespace command
|
||||
---------------------
|
||||
Currently, the following namespace commands are supported.
|
||||
|
||||
* current - returns the current, fully-qualified namespace
|
||||
* eval - evaluates a script in a namespace (introduces a call frame)
|
||||
* qualifiers, tail, parent - note that these do not check for existence
|
||||
* code, inscope - implemented
|
||||
* delete - deletes all variables and commands with the namespace prefix
|
||||
* which - implemented
|
||||
* upvar - implemented
|
||||
|
||||
namespace children, exists, path
|
||||
--------------------------------
|
||||
With implicit namespaces, the namespace exists and namespace children commands
|
||||
are expensive to implement and are of limited use. Checking the existence
|
||||
of a namespace can be better done by checking for the existence of a known procedure
|
||||
or variable in the namespace.
|
||||
|
||||
Command resolution is always done by first looking in the namespace and then
|
||||
at the global scope, so namespace path is not required.
|
||||
|
||||
namespace ensemble
|
||||
------------------
|
||||
The namespace ensemble command is not currently supported. A future version
|
||||
of Jim Tcl will have a general-purpose ensemble creation and manipulation
|
||||
mechanism and namespace ensemble will be implemented in terms of that mechanism.
|
||||
|
||||
namespace import, export, forget, origin
|
||||
----------------------------------------
|
||||
Since Jim Tcl namespaces are implicit, there is no location to store export patterns.
|
||||
Therefore the namespace export command is a dummy command which does nothing.
|
||||
All procedures in a namespace are considered to be exported.
|
||||
|
||||
The namespace import command works by creating aliases to the target namespace
|
||||
procedures.
|
||||
|
||||
namespace forget is not implemented.
|
||||
|
||||
namespace origin understands aliases created by namespace import
|
||||
and can return the original command.
|
||||
|
||||
namespace unknown
|
||||
-----------------
|
||||
If an undefined command is invoked, the "unknown" command is invoked.
|
||||
The same namespace resolution rules apply for the unknown command.
|
||||
This means that in the following example, test::unknown will be invoked
|
||||
for the missing command rather than the global ::unknown.
|
||||
|
||||
proc unknown {args} {
|
||||
puts "global unknown"
|
||||
}
|
||||
|
||||
proc test::unknown {args} {
|
||||
puts "test unknown"
|
||||
}
|
||||
|
||||
namespace eval test {
|
||||
bogus
|
||||
}
|
||||
|
||||
This approach requires no special support and provides enough flexibility that
|
||||
the namespace unknown command is not implemented.
|
||||
|
||||
Porting namespace code from Tcl to Jim Tcl
|
||||
------------------------------------------
|
||||
For most code, the following changes will be sufficient to port code.
|
||||
|
||||
1. Canonicalise namespace names. For example, ::ns:: should be written
|
||||
as ::ns or ns as appropriate, and excess colons should be removed.
|
||||
For example ::ns:::blah should be written as ::ns::blah
|
||||
(Note that the only "excess colon" case supported is ::::abc
|
||||
in order to support [namespace current]::abc in the global namespace)
|
||||
|
||||
2. The variable command should be used within namespace eval to link
|
||||
to namespace variables, and access to variables in other namespaces
|
||||
should be fully qualified
|
||||
|
||||
Changes in the core Jim Tcl
|
||||
---------------------------
|
||||
Previously Jim Tcl performed no scoping of command names. i.e. The
|
||||
::format command was considered different from the format command.
|
||||
|
||||
Even if namespace support is disabled, the command resolution will
|
||||
recognised global scoping of commands and treat these as identical.
|
||||
253
debuggers/openocd/jimtcl/README.oo
Normal file
253
debuggers/openocd/jimtcl/README.oo
Normal file
@ -0,0 +1,253 @@
|
||||
OO Package for Jim Tcl
|
||||
======================
|
||||
|
||||
Author: Steve Bennett <steveb@workware.net.au>
|
||||
Date: 1 Nov 2010 09:18:40
|
||||
|
||||
OVERVIEW
|
||||
--------
|
||||
The pure-Tcl oo package leverages Jim's unique strengths
|
||||
to provide support for Object Oriented programming.
|
||||
|
||||
The oo package can be statically linked with Jim or installed
|
||||
as a separate Tcl package and loaded with:
|
||||
|
||||
package require oo
|
||||
|
||||
DECLARING CLASSES
|
||||
-----------------
|
||||
A class is declared with the 'class' proc as follows.
|
||||
|
||||
class myclass ?baseclasses? classvars
|
||||
|
||||
This declares a class named 'myclass' with the given dictionary,
|
||||
'classvars', providing the initial state of all new objects.
|
||||
It is important to list all class variables in 'classvars', even
|
||||
if initialised only to the empty string, since the class makes
|
||||
these variables available in methods and via [myclass vars].
|
||||
|
||||
A list of zero or more base classes may also be specified from
|
||||
which methods and class variables are imported. See INHERITANCE
|
||||
below for more details.
|
||||
|
||||
Declaring a class creates a procedure with the class name along
|
||||
with some related procedures. For example:
|
||||
|
||||
. class Account {balance 0}
|
||||
Account
|
||||
. info procs Account*
|
||||
{Account get} {Account methods} {Account eval} Account {Account new} {Account destroy}
|
||||
{Account vars} {Account classname} {Account classvars} {Account method}
|
||||
|
||||
Notice that apart from the main 'Account' procedure, all the remaining procedures (methods)
|
||||
are prefixed with 'Account' and a space.
|
||||
|
||||
PREDEFINED CLASS METHODS
|
||||
------------------------
|
||||
Decaring a class pre-defines a number of "class" methods. i.e. those which don't
|
||||
require an object and simply return or manipulate properties of the class. These are:
|
||||
|
||||
new ?instancevars?::
|
||||
Creates and returns new object, optionally overriding the default class variable values.
|
||||
Note that the class name is an alias for 'classname new {}' and can be used as a shorthand
|
||||
for creating new objects with default values.
|
||||
|
||||
method name arglist body::
|
||||
Creates or redefines a method for the class with the given name, argument list and body.
|
||||
|
||||
methods::
|
||||
Returns a list of the methods supported by this class, including both class methods
|
||||
and instance methods. Also includes base class methods.
|
||||
|
||||
vars::
|
||||
Returns a list of the class variables for this class (names
|
||||
only). Also includes base class variables.
|
||||
|
||||
classvars::
|
||||
Returns a dictionary the class variables, including initial values, for this class.
|
||||
Also includes base class variables.
|
||||
|
||||
classname::
|
||||
Returns the classname. This can be useful as [$self classname].
|
||||
|
||||
Class methods may be invoked either via the class name or via an object of the class.
|
||||
For example:
|
||||
|
||||
. class Account {balance 0}
|
||||
Account
|
||||
. Account methods
|
||||
classname classvars destroy eval get method methods new vars
|
||||
. set a [Account]
|
||||
<reference.<Account>.00000000000000000001>
|
||||
. $a methods
|
||||
classname classvars destroy eval get method methods new vars
|
||||
|
||||
PREDEFINED OBJECT METHODS
|
||||
-------------------------
|
||||
Decaring a class pre-defines a number of "object" methods. i.e. those which operate
|
||||
on a specific object.
|
||||
|
||||
destroy::
|
||||
Destroys the object. This method may be overridden, but note that it should
|
||||
delete the object with {rename $self ""}. This method will also be called
|
||||
if the object is reaped during garbage collection.
|
||||
|
||||
get varname::
|
||||
Returns the value of the given instance variable.
|
||||
|
||||
eval ?locals? body::
|
||||
Makes any given local variables available to the body, along with
|
||||
the instance variables, and evaluate the body in that context.
|
||||
This can be used for one-off evaluation to avoid declaring a method.
|
||||
|
||||
CREATING OBJECTS
|
||||
----------------
|
||||
An object is created with the 'new' method, or simply by using the classname shortcut.
|
||||
If the 'new' method is used, the variables for the newly created object (instance variables)
|
||||
may be initialised. Otherwise they are set to the default values specified when the
|
||||
class was declared.
|
||||
|
||||
For example:
|
||||
|
||||
. class Account {balance 0}
|
||||
Account
|
||||
. set a [Account]
|
||||
<reference.<Account>.00000000000000000001>
|
||||
. set b [Account new {balance 1000}]
|
||||
<reference.<Account>.00000000000000000002>
|
||||
. $a get balance
|
||||
0
|
||||
. $b get balance
|
||||
1000
|
||||
|
||||
DECLARING METHODS
|
||||
-----------------
|
||||
In addition to the predefined methods, new methods may be decared, or existing
|
||||
methods redefined with the class method, method.
|
||||
|
||||
Declaring a method is very similar to defining a proc, and the arglist
|
||||
has identical syntax. For example:
|
||||
|
||||
. Account method show {{channel stdout}} { $channel puts "Balance of account is $balance" }
|
||||
. $b show
|
||||
Balance of account is 1000
|
||||
|
||||
All instance variables are available within the method and any
|
||||
changes to these variables are maintained by the object.
|
||||
|
||||
In addition, the $self variables is defined and refers to the current object.
|
||||
This may be used to invoke further methods on the object. For example:
|
||||
|
||||
. Account method show {} { puts "Balance of account is [$self get balance]" }
|
||||
. $b show
|
||||
Balance of account is 1000
|
||||
|
||||
Notes:
|
||||
* It is a bad idea to unset an instance variable.
|
||||
* In general, you should avoid redefining any of the pre-defined methods, except for 'destroy'.
|
||||
* When accessing the caller's scope with upvar or uplevel, note that there
|
||||
are two frame levels between the caller and the method. Thus it is necessary
|
||||
to use 'upvar 2' or 'uplevel 2'
|
||||
|
||||
INHERITANCE
|
||||
-----------
|
||||
For each base class given in a new class declaration, the methods
|
||||
and variables of those classes are imported into the new class being
|
||||
defined. Base classes are imported in left to right order, so that if a
|
||||
method is defined in more than one base class, the later definition
|
||||
is selected. This applies similarly to class variables.
|
||||
|
||||
Within a method, 'super' may be used to explicitly invoke a
|
||||
base class method on the object. This applies only to the *last*
|
||||
base class given. For example:
|
||||
|
||||
# Assumes the existence of classes Account and Client
|
||||
. Account method debit {amount} { incr balance -$amount }
|
||||
. class CreditAccount {Client Account} {type visa}
|
||||
CreditAccount
|
||||
. CreditAccount method debit {amount} {
|
||||
puts "Debit $type card"
|
||||
super debit $amount
|
||||
}
|
||||
. set a [CreditAccount]
|
||||
<reference.<Account>.00000000000000000001>
|
||||
. $a debit 20
|
||||
Debit visa card
|
||||
. $a balance
|
||||
-20
|
||||
|
||||
In the CreditAccount debit method, the call to 'super debit' invokes
|
||||
the method 'Account debit' since Account is the last base class listed.
|
||||
|
||||
OBJECT LIFETIME/GARBAGE COLLECTION
|
||||
----------------------------------
|
||||
Objects are implemented as lambdas. That is, they are procedures with state
|
||||
and are named as references. This means that when an object is no longer
|
||||
reachable by any name and garbage collection runs, the object will be
|
||||
discarded and the destructor will be invoked. Note that the garbage collector
|
||||
can be invoked manually with 'collect' if required.
|
||||
|
||||
. class Account {}
|
||||
Account
|
||||
. Account method destroy {} { puts dying...; rename $self "" }
|
||||
Account destroy
|
||||
. proc a {} { set b [Account]; return "" }
|
||||
a
|
||||
. a
|
||||
. collect
|
||||
dying...
|
||||
1
|
||||
|
||||
CLASS METHODS/CLASS STATIC VARIABLES
|
||||
------------------------------------
|
||||
All methods defined with 'method' operate on objects (instances).
|
||||
If a class method is required, it is possible to simply declare one with 'proc'.
|
||||
The method dispatcher will automatically be able to dispatch to this method.
|
||||
Using this approach, it is also possible to add class static variables by
|
||||
defining static variables to the proc. Although strictly these variables
|
||||
are accessible only to that proc, not the class as a whole.
|
||||
|
||||
For example:
|
||||
|
||||
. class Account {}
|
||||
Account
|
||||
. proc {Account nextid} {} {{id 0}} { incr id }
|
||||
Account nextid
|
||||
. Account nextid
|
||||
1
|
||||
. Account nextid
|
||||
2
|
||||
. set a [Account]
|
||||
<reference.<Account>.00000000000000000001>
|
||||
. $a nextid
|
||||
3
|
||||
. $a eval { $self nextid }
|
||||
4
|
||||
|
||||
HOW METHOD DISPATCH WORKS
|
||||
-------------------------
|
||||
All class and object methods are name "classname methodname".
|
||||
|
||||
The class method dispatcher is named "classname". When invoked with a methodname,
|
||||
it simply invokes the method "classname methodname".
|
||||
|
||||
The method dispatch is via a two step process. Firstly the object procedure is invoked
|
||||
with the method name. This procedure then invokes "classname method" which sets up
|
||||
the appropriate access to the object variables, and then invokes the method body.
|
||||
|
||||
EXAMPLES
|
||||
--------
|
||||
tree.tcl
|
||||
~~~~~~~~
|
||||
The 'tree' package is implemented using the 'oo' package.
|
||||
See the source code in tree.tcl and a usage example in tests/tree.test
|
||||
|
||||
Of particular note is how callbacks and recursive invocation is used in the 'walk' method.
|
||||
|
||||
examples/ootest.tcl
|
||||
~~~~~~~~~~~~~~~~~~~
|
||||
A comprehensive OO example is provided in examples/ootest.tcl.
|
||||
|
||||
It can be run simply as:
|
||||
|
||||
./jimsh examples/ootest.tcl
|
||||
177
debuggers/openocd/jimtcl/README.sqlite
Normal file
177
debuggers/openocd/jimtcl/README.sqlite
Normal file
@ -0,0 +1,177 @@
|
||||
Jim Sqlite extension documentation.
|
||||
Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
|
||||
|
||||
Overview
|
||||
~~~~~~~~
|
||||
|
||||
The Sqlite extension makes possible to work with sqlite (http://www.sqlite.org)
|
||||
databases from Jim. SQLite is a small C library that implements a
|
||||
self-contained, embeddable, zero-configuration SQL database engine. This
|
||||
means it is perfect for embedded systems, and for stand-alone applications
|
||||
that need the power of SQL without to use an external server like Mysql.
|
||||
|
||||
Basic usage
|
||||
~~~~~~~~~~~
|
||||
|
||||
The Sqlite extension exports an Object Based interface for databases. In order
|
||||
to open a database use:
|
||||
|
||||
set f [sqlite3.open dbname]
|
||||
|
||||
The [sqlite3.open] command returns a db handle, that is a command name that
|
||||
can be used to perform operations on the database. A real example:
|
||||
|
||||
. set db [sqlite3.open test.db]
|
||||
sqlite.handle0
|
||||
. $db query "SELECT * from tbl1"
|
||||
{one hello! two 10} {one goodbye two 20}
|
||||
|
||||
In the second line the handle is used as a command name, followed
|
||||
by the 'method' or 'subcommand' ("query" in the example), and the arguments.
|
||||
|
||||
The query method
|
||||
~~~~~~~~~~~~~~~~
|
||||
|
||||
The query method has the following signature:
|
||||
|
||||
$db query SqlQuery ?args?
|
||||
|
||||
The sql query may contain occurrences of "%s" that are substituted
|
||||
in the actual query with the following arguments, quoted in order
|
||||
to make sure that the query is correct even if this arguments contain
|
||||
"'" characters. So for example it is possible to write:
|
||||
|
||||
. $db query "SELECT * from tbl1 WHERE one='%s'" hello!
|
||||
{one hello! two 10}
|
||||
|
||||
Instead of hello! it is possible to use a string with embedded "'":
|
||||
|
||||
. $db query "SELECT * from tbl1 WHERE one='%s'" a'b
|
||||
(no matches - the empty list is returned)
|
||||
|
||||
This does not work instead using the Tcl variable expansion in the string:
|
||||
|
||||
. $db query "SELECT * from tbl1 WHERE one='$foo'"
|
||||
Runtime error, file "?", line 1:
|
||||
near "b": syntax error
|
||||
|
||||
In order to obtain an actual '%' character in the query, there is just
|
||||
to use two, like in "foo %% bar". This is the same as the [format] argument.
|
||||
|
||||
Specification of query results
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
In one of the above examples, the following query was used:
|
||||
|
||||
. $db query "SELECT * from tbl1"
|
||||
{one hello! two 10} {one goodbye two 20}
|
||||
|
||||
As you can see the result of a query is a list of lists. Every
|
||||
element of the list represents a row, as a list of key/value pairs,
|
||||
so actually every row is a Jim dictionary.
|
||||
|
||||
The following example and generated output show how to take advantage
|
||||
of this representation:
|
||||
|
||||
. set res [$db query "SELECT * from tbl1"]
|
||||
{one hello! two 10} {one goodbye two 20}
|
||||
. foreach row $res {puts "One: $row(one), Two: $row(two)"}
|
||||
One: hello!, Two: 10
|
||||
One: goodbye, Two: 20
|
||||
|
||||
To access every row sequentially is very simple, and field of a row
|
||||
can be accessed using the $row(field) syntax.
|
||||
|
||||
The close method
|
||||
~~~~~~~~~~~~~~~~
|
||||
|
||||
In order to close the db, use the 'close' method that will have as side effect
|
||||
to close the db and to remove the command associated with the db.
|
||||
Just use:
|
||||
|
||||
$db close
|
||||
|
||||
Handling NULL values
|
||||
~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
In the SQL language there is a special value NULL that is not the empty
|
||||
string, so how to represent it in a typeless language like Tcl?
|
||||
For default this extension will use the empty string, but it is possible
|
||||
to specify a different string for the NULL value.
|
||||
|
||||
In the above example there were two rows in the 'tbl1' table. Now
|
||||
we can add using the "sqlite" command line client another one with
|
||||
a NULL value:
|
||||
|
||||
sqlite> INSERT INTO tbl1 VALUES(NULL,30);
|
||||
sqlite> .exit
|
||||
|
||||
That's what the sqlite extension will return for default:
|
||||
|
||||
. $db query "SELECT * from tbl1"
|
||||
{one hello! two 10} {one goodbye two 20} {one {} two 30}
|
||||
|
||||
As you can see in the last row, the NULL is represented as {}, that's
|
||||
the empty string. Using the -null option of the 'query' command we
|
||||
can change this default, and tell the sqlite extension to represent
|
||||
the NULL value as a different string:
|
||||
|
||||
. $db query -null <<NULL>> "SELECT * from tbl1"
|
||||
{one hello! two 10} {one goodbye two 20} {one <<NULL>> two 30}
|
||||
|
||||
This way if the emtpy string has some semantical value for your
|
||||
dataset you can change it.
|
||||
|
||||
Finding the ID of the last inserted row
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
This is as simple as:
|
||||
|
||||
. $db lastid
|
||||
10
|
||||
|
||||
Number of rows changed by the most recent query
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
This is also very simple, there is just to use the 'changes' method
|
||||
without arugments.
|
||||
|
||||
. $db changes
|
||||
5
|
||||
|
||||
Note that if you drop an entire table the number of changes will
|
||||
be reported as zero, because of details of the sqlite implementation.
|
||||
|
||||
That's all,
|
||||
Enjoy!
|
||||
Salvatore Sanfilippo
|
||||
|
||||
p.s. this extension is just the work of some hour thanks to the cool
|
||||
clean C API that sqlite exports. Thanks to the author of sqlite for this
|
||||
great work.
|
||||
|
||||
In memory databases
|
||||
~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
SQLite is able to create in-memory databases instead to use files.
|
||||
This is of course faster and does not need the ability to write
|
||||
to the filesystem. Of course this databases are only useful for
|
||||
temp data.
|
||||
|
||||
In-memory DBs are used just like regular databases, just the name used to
|
||||
open the database is :memory:. That's an example that does not use the
|
||||
filesystem at all to create and work with the db.
|
||||
|
||||
package require sqlite3
|
||||
set db [sqlite3.open :memory:]
|
||||
$db query {CREATE TABLE plays (id, author, title)}
|
||||
$db query {INSERT INTO plays (id, author, title) VALUES (1, 'Goethe', 'Faust');}
|
||||
$db query {INSERT INTO plays (id, author, title) VALUES (2, 'Shakespeare', 'Hamlet');}
|
||||
$db query {INSERT INTO plays (id, author, title) VALUES (3, 'Sophocles', 'Oedipus Rex');}
|
||||
set res [$db query "SELECT * FROM plays"]
|
||||
$db close
|
||||
foreach r $res {puts $r(author)}
|
||||
|
||||
Of course once the Jim process is destroyed the database will no longer
|
||||
exists.
|
||||
123
debuggers/openocd/jimtcl/README.utf-8
Normal file
123
debuggers/openocd/jimtcl/README.utf-8
Normal file
@ -0,0 +1,123 @@
|
||||
UTF-8 Support for Jim Tcl
|
||||
=========================
|
||||
|
||||
Author: Steve Bennett <steveb@workware.net.au>
|
||||
Date: 2 Nov 2010 10:55:52 EST
|
||||
|
||||
OVERVIEW
|
||||
--------
|
||||
Traditionally Jim Tcl has support strings, including binary strings containing
|
||||
nulls, however it has had no support for multi-byte character encodings.
|
||||
|
||||
In some fields, such as when dealing with the web, or other user-generated content,
|
||||
support for multi-byte character encodings is necessary.
|
||||
In these cases it would be very useful for Jim Tcl to be able to process strings
|
||||
as multi-byte character strings rather than simply binary bytes.
|
||||
|
||||
Supporting multiple character encodings and translation between those encodings
|
||||
is beyond the scope of Jim Tcl. Therefore, Jim has been enhanced to add support
|
||||
for UTF-8, as probably the most popular general purpose multi-byte encoding.
|
||||
|
||||
UTF-8 support is optional. It can be enabled at compile time with:
|
||||
|
||||
./configure --enable-utf8
|
||||
|
||||
The Jim Tcl documentation fully documents the UTF-8 support. This README includes
|
||||
additional background information.
|
||||
|
||||
Unicode vs UTF-8
|
||||
----------------
|
||||
It is important to understand that Unicode is an abstract representation
|
||||
of the concept of a "character", while UTF-8 is an encoding of
|
||||
Unicode into bytes. Thus the Unicode codepoint U+00B5 is encoded
|
||||
in UTF-8 with the byte sequence: 0xc2, 0xb5. This is different from
|
||||
ASCII which the same name is used interchangeably between a character
|
||||
set and an encoding.
|
||||
|
||||
Unicode Escapes
|
||||
---------------
|
||||
Even without UTF-8 enabled, it is useful to be able to encode UTF-8 characters
|
||||
in strings. This can be done with the \uNNNN Unicode escape. This syntax
|
||||
is compatible with Tcl and is enabled even if UTF-8 is disabled.
|
||||
|
||||
Like Tcl, currently only 16-bit Unicode characters can be encoded.
|
||||
|
||||
UTF-8 Properties
|
||||
----------------
|
||||
Due to the design of the UTF-8 encoding, many (most) commands continue
|
||||
to work with UTF-8 strings. This is due to the following properties of UTF-8:
|
||||
|
||||
* ASCII characters in strings have the same representation in UTF-8
|
||||
* An ASCII string will never match the middle of a multi-byte UTF-8 sequence
|
||||
* UTF-8 strings can be sorted as bytes and produce the same result as sorting
|
||||
by characters
|
||||
* UTF-8 strings in Jim continue to be null terminated
|
||||
|
||||
Commands Supporting UTF-8
|
||||
-------------------------
|
||||
The following commands have been enhanced to support UTF-8 strings.
|
||||
|
||||
* array {get,names,unset}
|
||||
* case
|
||||
* glob
|
||||
* lsearch -glob, -regexp
|
||||
* switch -glob, -regexp
|
||||
* regexp, regsub
|
||||
* format
|
||||
* scan
|
||||
* split
|
||||
* string index, range, length, compare, equal, first, last, map, match, reverse, tolower, toupper
|
||||
* string bytelength (new)
|
||||
* info procs, commands, vars, globals, locals
|
||||
|
||||
Character Classes
|
||||
-----------------
|
||||
Jim Tcl has no support for UTF-8 character classes. Thus [:alpha:]
|
||||
will match [a-zA-Z], but not non-ASCII alphabetic characters. The
|
||||
same is true for 'string is'.
|
||||
|
||||
Regular Expressions
|
||||
-------------------
|
||||
Normally, Jim Tcl uses the system-supplied POSIX-compatible regex
|
||||
implementation.
|
||||
|
||||
Typically systems do not provide a UTF-8 capable regex implementation,
|
||||
therefore when UTF-8 support is enabled, the built-in regex
|
||||
implementation is used which includes UTF-8 support.
|
||||
|
||||
Case Insensitivity
|
||||
------------------
|
||||
Case folding is much more complex under Unicode than under ASCII.
|
||||
For example it is possible for a character to change the number of
|
||||
bytes required for representation when converting from one case to
|
||||
another. Jim Tcl supports only "simple" case folding, where case
|
||||
is folded only where the number of bytes does not change.
|
||||
|
||||
Case folding tables are automatically generated from the official
|
||||
unicode data table at http://unicode.org/Public/UNIDATA/UnicodeData.txt
|
||||
|
||||
Working with Binary Data and non-UTF-8 encodings
|
||||
------------------------------------------------
|
||||
Almost all Jim commands will work identically with binary data and
|
||||
UTF-8 encoded data, including read, gets, puts and 'string eq'. It
|
||||
is only certain string manipulation commands which will operated
|
||||
differently. For example, 'string index' will return UTF-8 characters,
|
||||
not bytes.
|
||||
|
||||
If it is necessary to manipulate strings containing binary, non-ASCII
|
||||
data (bytes >= 0x80), there are two options.
|
||||
|
||||
1. Build Jim without UTF-8 support
|
||||
2. Arrange to encode and decode binary data or data in other encodings
|
||||
to UTF-8 before manipulation.
|
||||
|
||||
Internal Details
|
||||
----------------
|
||||
Jim_Utf8Length() will calculate the character length of the string and cache
|
||||
it for later access. It uses utf8_strlen() which relies on the string to be null
|
||||
terminated (which it always will be).
|
||||
|
||||
It is possible to tell if a string is ascii-only because length == bytelength
|
||||
|
||||
It is possible to provide optimised versions of various routines for
|
||||
the ascii-only case. Currently this is done only for 'string index' and 'string range'.
|
||||
64
debuggers/openocd/jimtcl/STYLE
Normal file
64
debuggers/openocd/jimtcl/STYLE
Normal file
@ -0,0 +1,64 @@
|
||||
This file summarizes the C style used for Jim.
|
||||
Copyright (C) 2005 Salvatore Sanfilippo.
|
||||
|
||||
-----------
|
||||
INDENTATION
|
||||
-----------
|
||||
|
||||
Indentation is 4 spaces, no smart-tabs are used (i.e.
|
||||
two indentation steps of 4 spaces will not be converted
|
||||
into a real tab, but 8 spaces).
|
||||
|
||||
---------------
|
||||
FUNCTIONS NAMES
|
||||
---------------
|
||||
|
||||
Functions names of exported functions are in the form:
|
||||
|
||||
Jim_ExportedFunctionName()
|
||||
|
||||
The prefix is "Jim_", every word composing the function name
|
||||
is capitalized.
|
||||
|
||||
Not exported functions that are of general interest for the Jim
|
||||
core, like JimFreeInterp() are capitalized the same way, but the
|
||||
prefix used for this functions is "Jim" instead of "Jim_".
|
||||
Another example is:
|
||||
|
||||
JimNotExportedFunction()
|
||||
|
||||
Not exported functions that are not general, like functions
|
||||
implementing hashtables or Jim objects methods can be named
|
||||
in any prefix as long as capitalization rules are followed,
|
||||
like in:
|
||||
|
||||
ListSetIndex()
|
||||
|
||||
---------------
|
||||
VARIABLES NAMES
|
||||
---------------
|
||||
|
||||
Global variables follow the same names convention of functions.
|
||||
|
||||
Local variables have usually short names. A counter is just 'i', or 'j',
|
||||
or something like this. When a longer name is required, composed of
|
||||
more words, capitalization is used, but the first word starts in
|
||||
lowcase:
|
||||
|
||||
thisIsALogVarName
|
||||
|
||||
----
|
||||
GOTO
|
||||
----
|
||||
|
||||
Goto is allowed every time it makes the code cleaner, like in complex
|
||||
functions that need to handle exceptions, there is often an "err" label
|
||||
at the end of the function where allocated resources are freed before to exit
|
||||
with an error. Goto is also used in order to escape multiple nested loops.
|
||||
|
||||
----------
|
||||
C FEATURES
|
||||
----------
|
||||
|
||||
Only C89 ANSI C is allowed. C99 features can't be used currently.
|
||||
GCC extensions are not allowed.
|
||||
26
debuggers/openocd/jimtcl/TODO
Normal file
26
debuggers/openocd/jimtcl/TODO
Normal file
@ -0,0 +1,26 @@
|
||||
CORE LANGUAGE FEATURES
|
||||
|
||||
CORE COMMANDS
|
||||
|
||||
- [onleave] command, executing something as soon as the current procedure
|
||||
returns. With no arguments it returns the script set, with one appends
|
||||
the onleave script. There should be a way to reset.
|
||||
|
||||
Currently we have [local] which can be used to delete procs on proc exit.
|
||||
Also try/on/finally. Is [onleave] really needed?
|
||||
|
||||
OTHER COMMANDS NOT IN TCL BUT THAT SHOULD BE IN JIM
|
||||
|
||||
- Set commands: [lunion], [lintersect], and [ldifference]
|
||||
|
||||
EXTENSIONS
|
||||
|
||||
- Cryptography: hash functions, block ciphers, strim ciphers, PRNGs.
|
||||
- Tuplespace extension (http://wiki.tcl.tk/3947) (using sqlite as backend)
|
||||
- Zlib
|
||||
- Gdlib
|
||||
- CGI (interface compatible with ncgi, but possibly written in C for speed)
|
||||
|
||||
REFERENCES SYSTEM
|
||||
|
||||
- Unify ref/getref/setref/collect/finalize under an unique [ref] command.
|
||||
8078
debuggers/openocd/jimtcl/Tcl_shipped.html
Normal file
8078
debuggers/openocd/jimtcl/Tcl_shipped.html
Normal file
File diff suppressed because it is too large
Load Diff
21829
debuggers/openocd/jimtcl/UnicodeData.txt
Normal file
21829
debuggers/openocd/jimtcl/UnicodeData.txt
Normal file
File diff suppressed because it is too large
Load Diff
339
debuggers/openocd/jimtcl/auto.def
Normal file
339
debuggers/openocd/jimtcl/auto.def
Normal file
@ -0,0 +1,339 @@
|
||||
# vim:se syn=tcl:
|
||||
#
|
||||
|
||||
# Note: modules which support options *must* be included before 'options'
|
||||
use cc cc-shared cc-db cc-lib
|
||||
use local
|
||||
|
||||
options {
|
||||
utf8 => "include support for utf8-encoded strings"
|
||||
lineedit=1 => "disable line editing"
|
||||
references=1 => "disable support for references"
|
||||
math => "include support for math functions"
|
||||
ipv6 => "include ipv6 support in the aio extension"
|
||||
maintainer => {enable the [debug] command and JimPanic}
|
||||
full => "Enable some optional features: ipv6, math, utf8, binary, oo, tree"
|
||||
with-jim-shared shared => "build a shared library instead of a static library"
|
||||
jim-regexp=1 => "prefer POSIX regex if over the the built-in (Tcl-compatible) regex"
|
||||
with-jim-ext: {with-ext:"ext1 ext2 ..."} => {
|
||||
Specify additional jim extensions to include.
|
||||
These are enabled by default:
|
||||
|
||||
aio - ANSI I/O, including open and socket
|
||||
eventloop - after, vwait, update
|
||||
array - Tcl-compatible array command
|
||||
clock - Tcl-compatible clock command
|
||||
exec - Tcl-compatible exec command
|
||||
file - Tcl-compatible file command
|
||||
glob - Tcl-compatible glob command
|
||||
history - Tcl access to interactive history
|
||||
readdir - Required for glob
|
||||
package - Package management with the package command
|
||||
load - Load binary extensions at runtime with load or package
|
||||
posix - Posix APIs including os.fork, os.wait, pid
|
||||
regexp - Tcl-compatible regexp, regsub commands
|
||||
signal - Signal handling
|
||||
stdlib - Built-in commands including lassign, lambda, alias
|
||||
syslog - System logging with syslog
|
||||
tclcompat - Tcl compatible read, gets, puts, parray, case, ...
|
||||
namespace - Tcl compatible namespace support
|
||||
|
||||
These are disabled by default:
|
||||
|
||||
oo - Jim OO extension
|
||||
tree - OO tree structure, similar to tcllib ::struct::tree
|
||||
binary - Tcl-compatible 'binary' command
|
||||
readline - Interface to libreadline
|
||||
rlprompt - Tcl wrapper around the readline extension
|
||||
mk - Interface to Metakit
|
||||
tclprefix - Support for the tcl::prefix command
|
||||
sqlite3 - Interface to sqlite3
|
||||
win32 - Interface to win32
|
||||
}
|
||||
with-out-jim-ext: {without-ext:"default|ext1 ext2 ..."} => {
|
||||
Specify jim extensions to exclude.
|
||||
If 'default' is given, the default extensions will not be added.
|
||||
}
|
||||
with-jim-extmod: {with-mod:"ext1 ext2 ..."} => {
|
||||
Specify jim extensions to build as separate modules (either C or Tcl).
|
||||
Note that not all extensions can be built as loadable modules.
|
||||
}
|
||||
# To help out openocd with automake
|
||||
install-jim=1
|
||||
}
|
||||
|
||||
cc-check-types "long long"
|
||||
|
||||
cc-check-includes sys/time.h sys/socket.h netinet/in.h arpa/inet.h netdb.h
|
||||
cc-check-includes sys/un.h dlfcn.h unistd.h dirent.h crt_externs.h
|
||||
|
||||
define LDLIBS ""
|
||||
|
||||
# Haiku needs -lnetwork, Solaris needs -lnsl
|
||||
if {[cc-check-function-in-lib inet_ntop {nsl network}]} {
|
||||
# This does nothing if no libs are needed
|
||||
cc-with [list -libs [get-define lib_inet_ntop]]
|
||||
define-append LDLIBS [get-define lib_inet_ntop]
|
||||
}
|
||||
# Solaris needs -lsocket, Windows needs -lwsock32
|
||||
if {[cc-check-function-in-lib socket socket]} {
|
||||
define-append LDLIBS [get-define lib_socket]
|
||||
}
|
||||
|
||||
cc-check-functions ualarm lstat fork vfork system select execvpe
|
||||
cc-check-functions backtrace geteuid mkstemp realpath strptime isatty
|
||||
cc-check-functions regcomp waitpid sigaction sys_signame sys_siglist
|
||||
cc-check-functions syslog opendir readlink sleep usleep pipe getaddrinfo utimes
|
||||
if {[cc-check-functions sysinfo]} {
|
||||
cc-with {-includes sys/sysinfo.h} {
|
||||
cc-check-members "struct sysinfo.uptime"
|
||||
}
|
||||
}
|
||||
|
||||
cc-check-lfs
|
||||
cc-check-functions fseeko ftello
|
||||
|
||||
define TCL_LIBRARY [get-define prefix]/lib/jim
|
||||
|
||||
lassign [split [get-define host] -] host_cpu host_vendor host_os
|
||||
# Scrub revision from the host_os
|
||||
regsub -all {[0-9.]} $host_os {} host_os
|
||||
|
||||
switch -glob -- $host_os {
|
||||
mingw* {
|
||||
# We provide our own implementation of dlopen for mingw32
|
||||
define-feature dlopen-compat
|
||||
define-feature winconsole
|
||||
define TCL_PLATFORM_OS $host_os
|
||||
define TCL_PLATFORM_PLATFORM windows
|
||||
define TCL_PLATFORM_PATH_SEPARATOR {;}
|
||||
}
|
||||
default {
|
||||
# Note that cygwin is considered a unix platform
|
||||
define TCL_PLATFORM_OS $host_os
|
||||
define TCL_PLATFORM_PLATFORM unix
|
||||
define TCL_PLATFORM_PATH_SEPARATOR :
|
||||
}
|
||||
}
|
||||
|
||||
if {[have-feature windows]} {
|
||||
define LIBSOEXT dll
|
||||
} else {
|
||||
define LIBSOEXT so
|
||||
}
|
||||
|
||||
# Find some tools
|
||||
cc-check-tools ar ranlib strip
|
||||
define tclsh [info nameofexecutable]
|
||||
|
||||
if {![cc-check-functions _NSGetEnviron]} {
|
||||
msg-checking "Checking environ declared in unistd.h..."
|
||||
if {[cctest -cflags -D_GNU_SOURCE -includes unistd.h -code {char **ep = environ;}]} {
|
||||
define NO_ENVIRON_EXTERN
|
||||
msg-result "yes"
|
||||
} else {
|
||||
msg-result "no"
|
||||
}
|
||||
}
|
||||
|
||||
# Windows has a mkdir with no permission arg
|
||||
cc-check-includes sys/types.h sys/stat.h
|
||||
msg-checking "Checking for mkdir with one arg..."
|
||||
if {[cctest -includes {sys/types.h sys/stat.h} -code {mkdir("/dummy");}]} {
|
||||
define HAVE_MKDIR_ONE_ARG
|
||||
msg-result yes
|
||||
} else {
|
||||
msg-result no
|
||||
}
|
||||
|
||||
set extra_objs {}
|
||||
set jimregexp 0
|
||||
|
||||
if {[opt-bool utf8 full]} {
|
||||
msg-result "Enabling UTF-8"
|
||||
define JIM_UTF8
|
||||
incr jimregexp
|
||||
} else {
|
||||
define JIM_UTF8 0
|
||||
}
|
||||
if {[opt-bool maintainer]} {
|
||||
msg-result "Enabling maintainer settings"
|
||||
define JIM_MAINTAINER
|
||||
}
|
||||
if {[opt-bool math full]} {
|
||||
msg-result "Enabling math functions"
|
||||
define JIM_MATH_FUNCTIONS
|
||||
cc-check-function-in-lib sin m
|
||||
define-append LDLIBS [get-define lib_sin]
|
||||
}
|
||||
if {[opt-bool ipv6 full]} {
|
||||
msg-result "Enabling IPv6"
|
||||
define JIM_IPV6
|
||||
}
|
||||
if {[opt-bool lineedit full]} {
|
||||
if {([cc-check-includes termios.h] && [have-feature isatty]) || [have-feature winconsole]} {
|
||||
msg-result "Enabling line editing"
|
||||
define USE_LINENOISE
|
||||
lappend extra_objs linenoise.o
|
||||
}
|
||||
}
|
||||
if {[opt-bool references]} {
|
||||
msg-result "Enabling references"
|
||||
define JIM_REFERENCES
|
||||
}
|
||||
if {[opt-bool shared with-jim-shared]} {
|
||||
msg-result "Building shared library"
|
||||
} else {
|
||||
msg-result "Building static library"
|
||||
define JIM_STATICLIB
|
||||
}
|
||||
define JIM_INSTALL [opt-bool install-jim]
|
||||
|
||||
# Attributes of the extensions
|
||||
# tcl=Pure Tcl extension
|
||||
# static=Can't be built as a module
|
||||
# optional=Not selected by default
|
||||
# cpp=Is a C++ extension
|
||||
global extdb
|
||||
dict set extdb attrs {
|
||||
aio { static }
|
||||
array {}
|
||||
binary { tcl }
|
||||
clock {}
|
||||
eventloop { static }
|
||||
exec { static }
|
||||
file {}
|
||||
glob { tcl }
|
||||
history {}
|
||||
load { static }
|
||||
mk { cpp optional }
|
||||
namespace { static }
|
||||
nshelper { tcl optional }
|
||||
oo { tcl }
|
||||
pack {}
|
||||
package { static }
|
||||
posix {}
|
||||
readdir {}
|
||||
readline { optional }
|
||||
regexp {}
|
||||
rlprompt { tcl optional }
|
||||
sdl { optional }
|
||||
signal { static }
|
||||
sqlite3 { optional }
|
||||
stdlib { tcl static }
|
||||
syslog {}
|
||||
tclcompat { tcl static }
|
||||
tclprefix {}
|
||||
tree { tcl }
|
||||
win32 { optional }
|
||||
}
|
||||
|
||||
# Additional information about certain extensions
|
||||
# dep=list of extensions which are required for this extension
|
||||
# check=[expr] expression to evaluate to determine if the extension can be used
|
||||
# libdep=list of 'define' symbols for dependent libraries
|
||||
dict set extdb info {
|
||||
binary { dep pack }
|
||||
exec { check {([have-feature vfork] && [have-feature waitpid]) || [have-feature system]} }
|
||||
glob { dep readdir }
|
||||
load { check {[have-feature dlopen-compat] || [cc-check-function-in-lib dlopen dl]} libdep lib_dlopen }
|
||||
mk { check {[check-metakit]} libdep lib_mk }
|
||||
namespace { dep nshelper }
|
||||
posix { check {[have-feature waitpid]} }
|
||||
readdir { check {[have-feature opendir]} }
|
||||
readline { check {[cc-check-function-in-lib readline readline]} libdep lib_readline}
|
||||
rlprompt { dep readline }
|
||||
tree { dep oo }
|
||||
sdl { check {[cc-check-function-in-lib SDL_SetVideoMode SDL] && [cc-check-function-in-lib rectangleRGBA SDL_gfx]}
|
||||
libdep {lib_SDL_SetVideoMode lib_rectangleRGBA}
|
||||
}
|
||||
signal { check {[have-feature sigaction] && [have-feature vfork]} }
|
||||
sqlite3 { check {[cc-check-function-in-lib sqlite3_prepare_v2 sqlite3]} libdep lib_sqlite3_prepare_v2 }
|
||||
syslog { check {[have-feature syslog]} }
|
||||
tree { dep oo }
|
||||
win32 { check {[have-feature windows]} }
|
||||
}
|
||||
|
||||
# autosetup cc-check-function-in-library can't handle C++ libraries
|
||||
proc check-metakit {} {
|
||||
set found 0
|
||||
msg-checking "Checking for Metakit..."
|
||||
cc-with {-lang c++} {
|
||||
if {[cctest -includes mk4.h -libs -lmk4 -code {c4_Storage dummy();}]} {
|
||||
msg-result ok
|
||||
define lib_mk -lmk4
|
||||
incr found
|
||||
} else {
|
||||
msg-result "not found"
|
||||
}
|
||||
}
|
||||
return $found
|
||||
}
|
||||
|
||||
# Set up the withinfo array based on what the user selected
|
||||
global withinfo
|
||||
set withinfo(without) [join [opt-val {without-ext with-out-jim-ext}]]
|
||||
set withinfo(ext) [join [opt-val {with-ext with-jim-ext}]]
|
||||
set withinfo(mod) [join [opt-val {with-mod with-jim-extmod}]]
|
||||
set withinfo(nodefault) 0
|
||||
if {$withinfo(without) eq "default"} {
|
||||
set withinfo(without) {}
|
||||
set withinfo(nodefault) 1
|
||||
}
|
||||
|
||||
# Now go check everything - see autosetup/local.tcl
|
||||
array set extinfo [check-extensions]
|
||||
|
||||
# Now special checks
|
||||
if {[have-feature windows]} {
|
||||
lappend extra_objs jim-win32compat.o
|
||||
|
||||
if {[llength $extinfo(module-c)] && [get-define JIM_STATICLIB]} {
|
||||
user-error "cygwin/mingw require --shared for dynamic modules"
|
||||
}
|
||||
}
|
||||
|
||||
if {[ext-get-status regexp] in {y m}} {
|
||||
if {![have-feature regcomp]} {
|
||||
# No regcomp means we need to use the built-in version
|
||||
incr jimregexp
|
||||
}
|
||||
}
|
||||
|
||||
if {$jimregexp || [opt-bool jim-regexp]} {
|
||||
msg-result "Using built-in regexp"
|
||||
define JIM_REGEXP
|
||||
|
||||
# If the built-in regexp overrides the system regcomp, etc.
|
||||
# jim must be built shared so that the correct symbols are found
|
||||
if {[ext-get-status regexp] eq "m" && [get-define JIM_STATICLIB] && [have-feature regcomp]} {
|
||||
user-error "Must use --shared with regexp module and built-in regexp"
|
||||
}
|
||||
}
|
||||
|
||||
if {[ext-get-status load] eq "n"} {
|
||||
# If we don't have load, no need to support shared objects
|
||||
define SH_LINKFLAGS ""
|
||||
}
|
||||
|
||||
msg-result "Jim static extensions: [lsort [concat $extinfo(static-tcl) $extinfo(static-c)]]"
|
||||
if {[llength $extinfo(module-tcl)]} {
|
||||
msg-result "Jim Tcl extensions: [lsort $extinfo(module-tcl)]"
|
||||
}
|
||||
if {[llength $extinfo(module-c)]} {
|
||||
msg-result "Jim dynamic extensions: [lsort $extinfo(module-c)]"
|
||||
}
|
||||
|
||||
define STATIC_EXTS [concat $extinfo(static-c) $extinfo(static-tcl)]
|
||||
define C_EXT_OBJS [prefix jim- [suffix .o $extinfo(static-c)]]
|
||||
define TCL_EXT_OBJS [suffix .o $extinfo(static-tcl)]
|
||||
define C_EXT_SHOBJS [suffix .so $extinfo(module-c)]
|
||||
define TCL_EXTS [suffix .tcl $extinfo(module-tcl)]
|
||||
define EXTRA_OBJS $extra_objs
|
||||
|
||||
make-config-header jim-config.h -auto {HAVE_LONG_LONG* JIM_UTF8} -none *
|
||||
make-config-header jimautoconf.h -auto {jim_ext_* TCL_PLATFORM_* TCL_LIBRARY USE_* JIM_* _FILE_OFFSET*}
|
||||
make-template Makefile.in
|
||||
make-template build-jim-ext.in
|
||||
|
||||
catch {exec chmod +x build-jim-ext}
|
||||
35
debuggers/openocd/jimtcl/autosetup/LICENSE
Normal file
35
debuggers/openocd/jimtcl/autosetup/LICENSE
Normal file
@ -0,0 +1,35 @@
|
||||
Unless explicitly stated, all files which form part of autosetup
|
||||
are released under the following license:
|
||||
|
||||
---------------------------------------------------------------------
|
||||
autosetup - A build environment "autoconfigurator"
|
||||
|
||||
Copyright (c) 2010-2011, WorkWare Systems <http://workware.net.au/>
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above
|
||||
copyright notice, this list of conditions and the following
|
||||
disclaimer in the documentation and/or other materials
|
||||
provided with the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE WORKWARE SYSTEMS ``AS IS'' AND ANY
|
||||
EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL WORKWARE
|
||||
SYSTEMS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
The views and conclusions contained in the software and documentation
|
||||
are those of the authors and should not be interpreted as representing
|
||||
official policies, either expressed or implied, of WorkWare Systems.
|
||||
1
debuggers/openocd/jimtcl/autosetup/README.autosetup
Normal file
1
debuggers/openocd/jimtcl/autosetup/README.autosetup
Normal file
@ -0,0 +1 @@
|
||||
This is autosetup v0.6.5. See http://msteveb.github.com/autosetup/
|
||||
1898
debuggers/openocd/jimtcl/autosetup/autosetup
Executable file
1898
debuggers/openocd/jimtcl/autosetup/autosetup
Executable file
File diff suppressed because it is too large
Load Diff
15
debuggers/openocd/jimtcl/autosetup/cc-db.tcl
Normal file
15
debuggers/openocd/jimtcl/autosetup/cc-db.tcl
Normal file
@ -0,0 +1,15 @@
|
||||
# Copyright (c) 2011 WorkWare Systems http://www.workware.net.au/
|
||||
# All rights reserved
|
||||
|
||||
# @synopsis:
|
||||
#
|
||||
# The 'cc-db' module provides a knowledge based of system idiosyncracies
|
||||
# In general, this module can always be included
|
||||
|
||||
use cc
|
||||
|
||||
module-options {}
|
||||
|
||||
# openbsd needs sys/types.h to detect some system headers
|
||||
cc-include-needs sys/socket.h sys/types.h
|
||||
cc-include-needs netinet/in.h sys/types.h
|
||||
161
debuggers/openocd/jimtcl/autosetup/cc-lib.tcl
Normal file
161
debuggers/openocd/jimtcl/autosetup/cc-lib.tcl
Normal file
@ -0,0 +1,161 @@
|
||||
# Copyright (c) 2011 WorkWare Systems http://www.workware.net.au/
|
||||
# All rights reserved
|
||||
|
||||
# @synopsis:
|
||||
#
|
||||
# Provides a library of common tests on top of the 'cc' module.
|
||||
|
||||
use cc
|
||||
|
||||
module-options {}
|
||||
|
||||
# @cc-check-lfs
|
||||
#
|
||||
# The equivalent of the AC_SYS_LARGEFILE macro
|
||||
#
|
||||
# defines 'HAVE_LFS' if LFS is available,
|
||||
# and defines '_FILE_OFFSET_BITS=64' if necessary
|
||||
#
|
||||
# Returns 1 if 'LFS' is available or 0 otherwise
|
||||
#
|
||||
proc cc-check-lfs {} {
|
||||
cc-check-includes sys/types.h
|
||||
msg-checking "Checking if -D_FILE_OFFSET_BITS=64 is needed..."
|
||||
set lfs 1
|
||||
if {[msg-quiet cc-with {-includes sys/types.h} {cc-check-sizeof off_t}] == 8} {
|
||||
msg-result no
|
||||
} elseif {[msg-quiet cc-with {-includes sys/types.h -cflags -D_FILE_OFFSET_BITS=64} {cc-check-sizeof off_t}] == 8} {
|
||||
define _FILE_OFFSET_BITS 64
|
||||
msg-result yes
|
||||
} else {
|
||||
set lfs 0
|
||||
msg-result none
|
||||
}
|
||||
define-feature lfs $lfs
|
||||
return $lfs
|
||||
}
|
||||
|
||||
# @cc-check-endian
|
||||
#
|
||||
# The equivalent of the AC_C_BIGENDIAN macro
|
||||
#
|
||||
# defines 'HAVE_BIG_ENDIAN' if endian is known to be big,
|
||||
# or 'HAVE_LITTLE_ENDIAN' if endian is known to be little.
|
||||
#
|
||||
# Returns 1 if determined, or 0 if not.
|
||||
#
|
||||
proc cc-check-endian {} {
|
||||
cc-check-includes sys/types.h sys/param.h
|
||||
set rc 0
|
||||
msg-checking "Checking endian..."
|
||||
cc-with {-includes {sys/types.h sys/param.h}} {
|
||||
if {[cctest -code {
|
||||
#if !defined(BIG_ENDIAN) || !defined(BYTE_ORDER)
|
||||
#error unknown
|
||||
#elif BYTE_ORDER != BIG_ENDIAN
|
||||
#error little
|
||||
#endif
|
||||
}]} {
|
||||
define-feature big-endian
|
||||
msg-result "big"
|
||||
set rc 1
|
||||
} elseif {[cctest -code {
|
||||
#if !defined(LITTLE_ENDIAN) || !defined(BYTE_ORDER)
|
||||
#error unknown
|
||||
#elif BYTE_ORDER != LITTLE_ENDIAN
|
||||
#error big
|
||||
#endif
|
||||
}]} {
|
||||
define-feature little-endian
|
||||
msg-result "little"
|
||||
set rc 1
|
||||
} else {
|
||||
msg-result "unknown"
|
||||
}
|
||||
}
|
||||
return $rc
|
||||
}
|
||||
|
||||
# @cc-check-flags flag ?...?
|
||||
#
|
||||
# Checks whether the given C/C++ compiler flags can be used. Defines feature
|
||||
# names prefixed with 'HAVE_CFLAG' and 'HAVE_CXXFLAG' respectively, and
|
||||
# appends working flags to '-cflags' and 'CFLAGS' or 'CXXFLAGS'.
|
||||
proc cc-check-flags {args} {
|
||||
set result 1
|
||||
array set opts [cc-get-settings]
|
||||
switch -exact -- $opts(-lang) {
|
||||
c++ {
|
||||
set lang C++
|
||||
set prefix CXXFLAG
|
||||
}
|
||||
c {
|
||||
set lang C
|
||||
set prefix CFLAG
|
||||
}
|
||||
default {
|
||||
autosetup-error "cc-check-flags failed with unknown language: $opts(-lang)"
|
||||
}
|
||||
}
|
||||
foreach flag $args {
|
||||
msg-checking "Checking whether the $lang compiler accepts $flag..."
|
||||
if {[cctest -cflags $flag]} {
|
||||
msg-result yes
|
||||
define-feature $prefix$flag
|
||||
cc-with [list -cflags [list $flag]]
|
||||
define-append ${prefix}S $flag
|
||||
} else {
|
||||
msg-result no
|
||||
set result 0
|
||||
}
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
# @cc-check-standards ver ?...?
|
||||
#
|
||||
# Checks whether the C/C++ compiler accepts one of the specified '-std=$ver'
|
||||
# options, and appends the first working one to '-cflags' and 'CFLAGS' or
|
||||
# 'CXXFLAGS'.
|
||||
proc cc-check-standards {args} {
|
||||
array set opts [cc-get-settings]
|
||||
foreach std $args {
|
||||
if {[cc-check-flags -std=$std]} {
|
||||
return $std
|
||||
}
|
||||
}
|
||||
return ""
|
||||
}
|
||||
|
||||
# Checks whether $keyword is usable as alignof
|
||||
proc cctest_alignof {keyword} {
|
||||
msg-checking "Checking for $keyword..."
|
||||
if {[cctest -code [subst -nobackslashes {
|
||||
printf("minimum alignment is %d == %d\n", ${keyword}(char), ${keyword}('x'));
|
||||
}]]} then {
|
||||
msg-result ok
|
||||
define-feature $keyword
|
||||
} else {
|
||||
msg-result "not found"
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-c11
|
||||
#
|
||||
# Checks for several C11/C++11 extensions and their alternatives. Currently
|
||||
# checks for '_Static_assert', '_Alignof', '__alignof__', '__alignof'.
|
||||
proc cc-check-c11 {} {
|
||||
msg-checking "Checking for _Static_assert..."
|
||||
if {[cctest -code {
|
||||
_Static_assert(1, "static assertions are available");
|
||||
}]} then {
|
||||
msg-result ok
|
||||
define-feature _Static_assert
|
||||
} else {
|
||||
msg-result "not found"
|
||||
}
|
||||
|
||||
cctest_alignof _Alignof
|
||||
cctest_alignof __alignof__
|
||||
cctest_alignof __alignof
|
||||
}
|
||||
103
debuggers/openocd/jimtcl/autosetup/cc-shared.tcl
Normal file
103
debuggers/openocd/jimtcl/autosetup/cc-shared.tcl
Normal file
@ -0,0 +1,103 @@
|
||||
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
|
||||
# All rights reserved
|
||||
|
||||
# @synopsis:
|
||||
#
|
||||
# The 'cc-shared' module provides support for shared libraries and shared objects.
|
||||
# It defines the following variables:
|
||||
#
|
||||
## SH_CFLAGS Flags to use compiling sources destined for a shared library
|
||||
## SH_LDFLAGS Flags to use linking (creating) a shared library
|
||||
## SH_SOPREFIX Prefix to use to set the soname when creating a shared library
|
||||
## SH_SOEXT Extension for shared libs
|
||||
## SH_SOEXTVER Format for versioned shared libs - %s = version
|
||||
## SHOBJ_CFLAGS Flags to use compiling sources destined for a shared object
|
||||
## SHOBJ_LDFLAGS Flags to use linking a shared object, undefined symbols allowed
|
||||
## SHOBJ_LDFLAGS_R - as above, but all symbols must be resolved
|
||||
## SH_LINKFLAGS Flags to use linking an executable which will load shared objects
|
||||
## LD_LIBRARY_PATH Environment variable which specifies path to shared libraries
|
||||
## STRIPLIBFLAGS Arguments to strip to strip a dynamic library
|
||||
|
||||
module-options {}
|
||||
|
||||
# Defaults: gcc on unix
|
||||
define SHOBJ_CFLAGS -fpic
|
||||
define SHOBJ_LDFLAGS -shared
|
||||
define SH_CFLAGS -fpic
|
||||
define SH_LDFLAGS -shared
|
||||
define SH_LINKFLAGS -rdynamic
|
||||
define SH_SOEXT .so
|
||||
define SH_SOEXTVER .so.%s
|
||||
define SH_SOPREFIX -Wl,-soname,
|
||||
define LD_LIBRARY_PATH LD_LIBRARY_PATH
|
||||
define STRIPLIBFLAGS --strip-unneeded
|
||||
|
||||
# Note: This is a helpful reference for identifying the toolchain
|
||||
# http://sourceforge.net/apps/mediawiki/predef/index.php?title=Compilers
|
||||
|
||||
switch -glob -- [get-define host] {
|
||||
*-*-darwin* {
|
||||
define SHOBJ_CFLAGS "-dynamic -fno-common"
|
||||
define SHOBJ_LDFLAGS "-bundle -undefined dynamic_lookup"
|
||||
define SHOBJ_LDFLAGS_R -bundle
|
||||
define SH_CFLAGS -dynamic
|
||||
define SH_LDFLAGS -dynamiclib
|
||||
define SH_LINKFLAGS ""
|
||||
define SH_SOEXT .dylib
|
||||
define SH_SOEXTVER .%s.dylib
|
||||
define SH_SOPREFIX -Wl,-install_name,
|
||||
define LD_LIBRARY_PATH DYLD_LIBRARY_PATH
|
||||
define STRIPLIBFLAGS -x
|
||||
}
|
||||
*-*-ming* - *-*-cygwin - *-*-msys {
|
||||
define SHOBJ_CFLAGS ""
|
||||
define SHOBJ_LDFLAGS -shared
|
||||
define SH_CFLAGS ""
|
||||
define SH_LDFLAGS -shared
|
||||
define SH_LINKFLAGS ""
|
||||
define SH_SOEXT .dll
|
||||
define SH_SOEXTVER .dll
|
||||
define SH_SOPREFIX ""
|
||||
define LD_LIBRARY_PATH PATH
|
||||
}
|
||||
sparc* {
|
||||
if {[msg-quiet cc-check-decls __SUNPRO_C]} {
|
||||
msg-result "Found sun stdio compiler"
|
||||
# sun stdio compiler
|
||||
# XXX: These haven't been fully tested.
|
||||
define SHOBJ_CFLAGS -KPIC
|
||||
define SHOBJ_LDFLAGS "-G"
|
||||
define SH_CFLAGS -KPIC
|
||||
define SH_LINKFLAGS -Wl,-export-dynamic
|
||||
define SH_SOPREFIX -Wl,-h,
|
||||
} else {
|
||||
# sparc has a very small GOT table limit, so use -fPIC
|
||||
define SH_CFLAGS -fPIC
|
||||
define SHOBJ_CFLAGS -fPIC
|
||||
}
|
||||
}
|
||||
*-*-solaris* {
|
||||
if {[msg-quiet cc-check-decls __SUNPRO_C]} {
|
||||
msg-result "Found sun stdio compiler"
|
||||
# sun stdio compiler
|
||||
# XXX: These haven't been fully tested.
|
||||
define SHOBJ_CFLAGS -KPIC
|
||||
define SHOBJ_LDFLAGS "-G"
|
||||
define SH_CFLAGS -KPIC
|
||||
define SH_LINKFLAGS -Wl,-export-dynamic
|
||||
define SH_SOPREFIX -Wl,-h,
|
||||
}
|
||||
}
|
||||
*-*-hpux {
|
||||
# XXX: These haven't been tested
|
||||
define SHOBJ_CFLAGS "+O3 +z"
|
||||
define SHOBJ_LDFLAGS -b
|
||||
define SH_CFLAGS +z
|
||||
define SH_LINKFLAGS -Wl,+s
|
||||
define LD_LIBRARY_PATH SHLIB_PATH
|
||||
}
|
||||
}
|
||||
|
||||
if {![is-defined SHOBJ_LDFLAGS_R]} {
|
||||
define SHOBJ_LDFLAGS_R [get-define SHOBJ_LDFLAGS]
|
||||
}
|
||||
697
debuggers/openocd/jimtcl/autosetup/cc.tcl
Normal file
697
debuggers/openocd/jimtcl/autosetup/cc.tcl
Normal file
@ -0,0 +1,697 @@
|
||||
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
|
||||
# All rights reserved
|
||||
|
||||
# @synopsis:
|
||||
#
|
||||
# The 'cc' module supports checking various 'features' of the C or C++
|
||||
# compiler/linker environment. Common commands are cc-check-includes,
|
||||
# cc-check-types, cc-check-functions, cc-with, make-autoconf-h and make-template.
|
||||
#
|
||||
# The following environment variables are used if set:
|
||||
#
|
||||
## CC - C compiler
|
||||
## CXX - C++ compiler
|
||||
## CCACHE - Set to "none" to disable automatic use of ccache
|
||||
## CFLAGS - Additional C compiler flags
|
||||
## CXXFLAGS - Additional C++ compiler flags
|
||||
## LDFLAGS - Additional compiler flags during linking
|
||||
## LIBS - Additional libraries to use (for all tests)
|
||||
## CROSS - Tool prefix for cross compilation
|
||||
#
|
||||
# The following variables are defined from the corresponding
|
||||
# environment variables if set.
|
||||
#
|
||||
## CPPFLAGS
|
||||
## LINKFLAGS
|
||||
## CC_FOR_BUILD
|
||||
## LD
|
||||
|
||||
use system
|
||||
|
||||
module-options {}
|
||||
|
||||
# Note that the return code is not meaningful
|
||||
proc cc-check-something {name code} {
|
||||
uplevel 1 $code
|
||||
}
|
||||
|
||||
# Checks for the existence of the given function by linking
|
||||
#
|
||||
proc cctest_function {function} {
|
||||
cctest -link 1 -declare "extern void $function\(void);" -code "$function\();"
|
||||
}
|
||||
|
||||
# Checks for the existence of the given type by compiling
|
||||
proc cctest_type {type} {
|
||||
cctest -code "$type _x;"
|
||||
}
|
||||
|
||||
# Checks for the existence of the given type/structure member.
|
||||
# e.g. "struct stat.st_mtime"
|
||||
proc cctest_member {struct_member} {
|
||||
lassign [split $struct_member .] struct member
|
||||
cctest -code "static $struct _s; return sizeof(_s.$member);"
|
||||
}
|
||||
|
||||
# Checks for the existence of the given define by compiling
|
||||
#
|
||||
proc cctest_define {name} {
|
||||
cctest -code "#ifndef $name\n#error not defined\n#endif"
|
||||
}
|
||||
|
||||
# Checks for the existence of the given name either as
|
||||
# a macro (#define) or an rvalue (such as an enum)
|
||||
#
|
||||
proc cctest_decl {name} {
|
||||
cctest -code "#ifndef $name\n(void)$name;\n#endif"
|
||||
}
|
||||
|
||||
# @cc-check-sizeof type ...
|
||||
#
|
||||
# Checks the size of the given types (between 1 and 32, inclusive).
|
||||
# Defines a variable with the size determined, or "unknown" otherwise.
|
||||
# e.g. for type 'long long', defines SIZEOF_LONG_LONG.
|
||||
# Returns the size of the last type.
|
||||
#
|
||||
proc cc-check-sizeof {args} {
|
||||
foreach type $args {
|
||||
msg-checking "Checking for sizeof $type..."
|
||||
set size unknown
|
||||
# Try the most common sizes first
|
||||
foreach i {4 8 1 2 16 32} {
|
||||
if {[cctest -code "static int _x\[sizeof($type) == $i ? 1 : -1\] = { 1 };"]} {
|
||||
set size $i
|
||||
break
|
||||
}
|
||||
}
|
||||
msg-result $size
|
||||
set define [feature-define-name $type SIZEOF_]
|
||||
define $define $size
|
||||
}
|
||||
# Return the last result
|
||||
get-define $define
|
||||
}
|
||||
|
||||
# Checks for each feature in $list by using the given script.
|
||||
#
|
||||
# When the script is evaluated, $each is set to the feature
|
||||
# being checked, and $extra is set to any additional cctest args.
|
||||
#
|
||||
# Returns 1 if all features were found, or 0 otherwise.
|
||||
proc cc-check-some-feature {list script} {
|
||||
set ret 1
|
||||
foreach each $list {
|
||||
if {![check-feature $each $script]} {
|
||||
set ret 0
|
||||
}
|
||||
}
|
||||
return $ret
|
||||
}
|
||||
|
||||
# @cc-check-includes includes ...
|
||||
#
|
||||
# Checks that the given include files can be used
|
||||
proc cc-check-includes {args} {
|
||||
cc-check-some-feature $args {
|
||||
set with {}
|
||||
if {[dict exists $::autosetup(cc-include-deps) $each]} {
|
||||
set deps [dict keys [dict get $::autosetup(cc-include-deps) $each]]
|
||||
msg-quiet cc-check-includes {*}$deps
|
||||
foreach i $deps {
|
||||
if {[have-feature $i]} {
|
||||
lappend with $i
|
||||
}
|
||||
}
|
||||
}
|
||||
if {[llength $with]} {
|
||||
cc-with [list -includes $with] {
|
||||
cctest -includes $each
|
||||
}
|
||||
} else {
|
||||
cctest -includes $each
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-include-needs include required ...
|
||||
#
|
||||
# Ensures that when checking for 'include', a check is first
|
||||
# made for each 'required' file, and if found, it is #included
|
||||
proc cc-include-needs {file args} {
|
||||
foreach depfile $args {
|
||||
dict set ::autosetup(cc-include-deps) $file $depfile 1
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-types type ...
|
||||
#
|
||||
# Checks that the types exist.
|
||||
proc cc-check-types {args} {
|
||||
cc-check-some-feature $args {
|
||||
cctest_type $each
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-defines define ...
|
||||
#
|
||||
# Checks that the given preprocessor symbol is defined
|
||||
proc cc-check-defines {args} {
|
||||
cc-check-some-feature $args {
|
||||
cctest_define $each
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-decls name ...
|
||||
#
|
||||
# Checks that each given name is either a preprocessor symbol or rvalue
|
||||
# such as an enum. Note that the define used for a decl is HAVE_DECL_xxx
|
||||
# rather than HAVE_xxx
|
||||
proc cc-check-decls {args} {
|
||||
set ret 1
|
||||
foreach name $args {
|
||||
msg-checking "Checking for $name..."
|
||||
set r [cctest_decl $name]
|
||||
define-feature "decl $name" $r
|
||||
if {$r} {
|
||||
msg-result "ok"
|
||||
} else {
|
||||
msg-result "not found"
|
||||
set ret 0
|
||||
}
|
||||
}
|
||||
return $ret
|
||||
}
|
||||
|
||||
# @cc-check-functions function ...
|
||||
#
|
||||
# Checks that the given functions exist (can be linked)
|
||||
proc cc-check-functions {args} {
|
||||
cc-check-some-feature $args {
|
||||
cctest_function $each
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-members type.member ...
|
||||
#
|
||||
# Checks that the given type/structure members exist.
|
||||
# A structure member is of the form "struct stat.st_mtime"
|
||||
proc cc-check-members {args} {
|
||||
cc-check-some-feature $args {
|
||||
cctest_member $each
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-function-in-lib function libs ?otherlibs?
|
||||
#
|
||||
# Checks that the given given function can be found in one of the libs.
|
||||
#
|
||||
# First checks for no library required, then checks each of the libraries
|
||||
# in turn.
|
||||
#
|
||||
# If the function is found, the feature is defined and lib_$function is defined
|
||||
# to -l$lib where the function was found, or "" if no library required.
|
||||
# In addition, -l$lib is added to the LIBS define.
|
||||
#
|
||||
# If additional libraries may be needed for linking, they should be specified
|
||||
# as $extralibs as "-lotherlib1 -lotherlib2".
|
||||
# These libraries are not automatically added to LIBS.
|
||||
#
|
||||
# Returns 1 if found or 0 if not.
|
||||
#
|
||||
proc cc-check-function-in-lib {function libs {otherlibs {}}} {
|
||||
msg-checking "Checking libs for $function..."
|
||||
set found 0
|
||||
cc-with [list -libs $otherlibs] {
|
||||
if {[cctest_function $function]} {
|
||||
msg-result "none needed"
|
||||
define lib_$function ""
|
||||
incr found
|
||||
} else {
|
||||
foreach lib $libs {
|
||||
cc-with [list -libs -l$lib] {
|
||||
if {[cctest_function $function]} {
|
||||
msg-result -l$lib
|
||||
define lib_$function -l$lib
|
||||
define-append LIBS -l$lib
|
||||
incr found
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
if {$found} {
|
||||
define [feature-define-name $function]
|
||||
} else {
|
||||
msg-result "no"
|
||||
}
|
||||
return $found
|
||||
}
|
||||
|
||||
# @cc-check-tools tool ...
|
||||
#
|
||||
# Checks for existence of the given compiler tools, taking
|
||||
# into account any cross compilation prefix.
|
||||
#
|
||||
# For example, when checking for "ar", first AR is checked on the command
|
||||
# line and then in the environment. If not found, "${host}-ar" or
|
||||
# simply "ar" is assumed depending upon whether cross compiling.
|
||||
# The path is searched for this executable, and if found AR is defined
|
||||
# to the executable name.
|
||||
# Note that even when cross compiling, the simple "ar" is used as a fallback,
|
||||
# but a warning is generated. This is necessary for some toolchains.
|
||||
#
|
||||
# It is an error if the executable is not found.
|
||||
#
|
||||
proc cc-check-tools {args} {
|
||||
foreach tool $args {
|
||||
set TOOL [string toupper $tool]
|
||||
set exe [get-env $TOOL [get-define cross]$tool]
|
||||
if {[find-executable {*}$exe]} {
|
||||
define $TOOL $exe
|
||||
continue
|
||||
}
|
||||
if {[find-executable {*}$tool]} {
|
||||
msg-result "Warning: Failed to find $exe, falling back to $tool which may be incorrect"
|
||||
define $TOOL $tool
|
||||
continue
|
||||
}
|
||||
user-error "Failed to find $exe"
|
||||
}
|
||||
}
|
||||
|
||||
# @cc-check-progs prog ...
|
||||
#
|
||||
# Checks for existence of the given executables on the path.
|
||||
#
|
||||
# For example, when checking for "grep", the path is searched for
|
||||
# the executable, 'grep', and if found GREP is defined as "grep".
|
||||
#
|
||||
# It the executable is not found, the variable is defined as false.
|
||||
# Returns 1 if all programs were found, or 0 otherwise.
|
||||
#
|
||||
proc cc-check-progs {args} {
|
||||
set failed 0
|
||||
foreach prog $args {
|
||||
set PROG [string toupper $prog]
|
||||
msg-checking "Checking for $prog..."
|
||||
if {![find-executable $prog]} {
|
||||
msg-result no
|
||||
define $PROG false
|
||||
incr failed
|
||||
} else {
|
||||
msg-result ok
|
||||
define $PROG $prog
|
||||
}
|
||||
}
|
||||
expr {!$failed}
|
||||
}
|
||||
|
||||
# Adds the given settings to $::autosetup(ccsettings) and
|
||||
# returns the old settings.
|
||||
#
|
||||
proc cc-add-settings {settings} {
|
||||
if {[llength $settings] % 2} {
|
||||
autosetup-error "settings list is missing a value: $settings"
|
||||
}
|
||||
|
||||
set prev [cc-get-settings]
|
||||
# workaround a bug in some versions of jimsh by forcing
|
||||
# conversion of $prev to a list
|
||||
llength $prev
|
||||
|
||||
array set new $prev
|
||||
|
||||
foreach {name value} $settings {
|
||||
switch -exact -- $name {
|
||||
-cflags - -includes {
|
||||
# These are given as lists
|
||||
lappend new($name) {*}$value
|
||||
}
|
||||
-declare {
|
||||
lappend new($name) $value
|
||||
}
|
||||
-libs {
|
||||
# Note that new libraries are added before previous libraries
|
||||
set new($name) [list {*}$value {*}$new($name)]
|
||||
}
|
||||
-link - -lang {
|
||||
set new($name) $value
|
||||
}
|
||||
-source - -sourcefile - -code {
|
||||
# XXX: These probably are only valid directly from cctest
|
||||
set new($name) $value
|
||||
}
|
||||
default {
|
||||
autosetup-error "unknown cctest setting: $name"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
cc-store-settings [array get new]
|
||||
|
||||
return $prev
|
||||
}
|
||||
|
||||
proc cc-store-settings {new} {
|
||||
set ::autosetup(ccsettings) $new
|
||||
}
|
||||
|
||||
proc cc-get-settings {} {
|
||||
return $::autosetup(ccsettings)
|
||||
}
|
||||
|
||||
# Similar to cc-add-settings, but each given setting
|
||||
# simply replaces the existing value.
|
||||
#
|
||||
# Returns the previous settings
|
||||
proc cc-update-settings {args} {
|
||||
set prev [cc-get-settings]
|
||||
cc-store-settings [dict merge $prev $args]
|
||||
return $prev
|
||||
}
|
||||
|
||||
# @cc-with settings ?{ script }?
|
||||
#
|
||||
# Sets the given 'cctest' settings and then runs the tests in 'script'.
|
||||
# Note that settings such as -lang replace the current setting, while
|
||||
# those such as -includes are appended to the existing setting.
|
||||
#
|
||||
# If no script is given, the settings become the default for the remainder
|
||||
# of the auto.def file.
|
||||
#
|
||||
## cc-with {-lang c++} {
|
||||
## # This will check with the C++ compiler
|
||||
## cc-check-types bool
|
||||
## cc-with {-includes signal.h} {
|
||||
## # This will check with the C++ compiler, signal.h and any existing includes.
|
||||
## ...
|
||||
## }
|
||||
## # back to just the C++ compiler
|
||||
## }
|
||||
#
|
||||
# The -libs setting is special in that newer values are added *before* earlier ones.
|
||||
#
|
||||
## cc-with {-libs {-lc -lm}} {
|
||||
## cc-with {-libs -ldl} {
|
||||
## cctest -libs -lsocket ...
|
||||
## # libs will be in this order: -lsocket -ldl -lc -lm
|
||||
## }
|
||||
## }
|
||||
proc cc-with {settings args} {
|
||||
if {[llength $args] == 0} {
|
||||
cc-add-settings $settings
|
||||
} elseif {[llength $args] > 1} {
|
||||
autosetup-error "usage: cc-with settings ?script?"
|
||||
} else {
|
||||
set save [cc-add-settings $settings]
|
||||
set rc [catch {uplevel 1 [lindex $args 0]} result info]
|
||||
cc-store-settings $save
|
||||
if {$rc != 0} {
|
||||
return -code [dict get $info -code] $result
|
||||
}
|
||||
return $result
|
||||
}
|
||||
}
|
||||
|
||||
# @cctest ?settings?
|
||||
#
|
||||
# Low level C compiler checker. Compiles and or links a small C program
|
||||
# according to the arguments and returns 1 if OK, or 0 if not.
|
||||
#
|
||||
# Supported settings are:
|
||||
#
|
||||
## -cflags cflags A list of flags to pass to the compiler
|
||||
## -includes list A list of includes, e.g. {stdlib.h stdio.h}
|
||||
## -declare code Code to declare before main()
|
||||
## -link 1 Don't just compile, link too
|
||||
## -lang c|c++ Use the C (default) or C++ compiler
|
||||
## -libs liblist List of libraries to link, e.g. {-ldl -lm}
|
||||
## -code code Code to compile in the body of main()
|
||||
## -source code Compile a complete program. Ignore -includes, -declare and -code
|
||||
## -sourcefile file Shorthand for -source [readfile [get-define srcdir]/$file]
|
||||
#
|
||||
# Unless -source or -sourcefile is specified, the C program looks like:
|
||||
#
|
||||
## #include <firstinclude> /* same for remaining includes in the list */
|
||||
##
|
||||
## declare-code /* any code in -declare, verbatim */
|
||||
##
|
||||
## int main(void) {
|
||||
## code /* any code in -code, verbatim */
|
||||
## return 0;
|
||||
## }
|
||||
#
|
||||
# Any failures are recorded in 'config.log'
|
||||
#
|
||||
proc cctest {args} {
|
||||
set src conftest__.c
|
||||
set tmp conftest__
|
||||
|
||||
# Easiest way to merge in the settings
|
||||
cc-with $args {
|
||||
array set opts [cc-get-settings]
|
||||
}
|
||||
|
||||
if {[info exists opts(-sourcefile)]} {
|
||||
set opts(-source) [readfile [get-define srcdir]/$opts(-sourcefile) "#error can't find $opts(-sourcefile)"]
|
||||
}
|
||||
if {[info exists opts(-source)]} {
|
||||
set lines $opts(-source)
|
||||
} else {
|
||||
foreach i $opts(-includes) {
|
||||
if {$opts(-code) ne "" && ![feature-checked $i]} {
|
||||
# Compiling real code with an unchecked header file
|
||||
# Quickly (and silently) check for it now
|
||||
|
||||
# Remove all -includes from settings before checking
|
||||
set saveopts [cc-update-settings -includes {}]
|
||||
msg-quiet cc-check-includes $i
|
||||
cc-store-settings $saveopts
|
||||
}
|
||||
if {$opts(-code) eq "" || [have-feature $i]} {
|
||||
lappend source "#include <$i>"
|
||||
}
|
||||
}
|
||||
lappend source {*}$opts(-declare)
|
||||
lappend source "int main(void) {"
|
||||
lappend source $opts(-code)
|
||||
lappend source "return 0;"
|
||||
lappend source "}"
|
||||
|
||||
set lines [join $source \n]
|
||||
}
|
||||
|
||||
# Build the command line
|
||||
set cmdline {}
|
||||
lappend cmdline {*}[get-define CCACHE]
|
||||
switch -exact -- $opts(-lang) {
|
||||
c++ {
|
||||
lappend cmdline {*}[get-define CXX] {*}[get-define CXXFLAGS]
|
||||
}
|
||||
c {
|
||||
lappend cmdline {*}[get-define CC] {*}[get-define CFLAGS]
|
||||
}
|
||||
default {
|
||||
autosetup-error "cctest called with unknown language: $opts(-lang)"
|
||||
}
|
||||
}
|
||||
|
||||
if {!$opts(-link)} {
|
||||
set tmp conftest__.o
|
||||
lappend cmdline -c
|
||||
}
|
||||
lappend cmdline {*}$opts(-cflags) {*}[get-define cc-default-debug ""]
|
||||
|
||||
lappend cmdline $src -o $tmp {*}$opts(-libs)
|
||||
|
||||
# At this point we have the complete command line and the
|
||||
# complete source to be compiled. Get the result from cache if
|
||||
# we can
|
||||
if {[info exists ::cc_cache($cmdline,$lines)]} {
|
||||
msg-checking "(cached) "
|
||||
set ok $::cc_cache($cmdline,$lines)
|
||||
if {$::autosetup(debug)} {
|
||||
configlog "From cache (ok=$ok): [join $cmdline]"
|
||||
configlog "============"
|
||||
configlog $lines
|
||||
configlog "============"
|
||||
}
|
||||
return $ok
|
||||
}
|
||||
|
||||
writefile $src $lines\n
|
||||
|
||||
set ok 1
|
||||
if {[catch {exec-with-stderr {*}$cmdline} result errinfo]} {
|
||||
configlog "Failed: [join $cmdline]"
|
||||
configlog $result
|
||||
configlog "============"
|
||||
configlog "The failed code was:"
|
||||
configlog $lines
|
||||
configlog "============"
|
||||
set ok 0
|
||||
} elseif {$::autosetup(debug)} {
|
||||
configlog "Compiled OK: [join $cmdline]"
|
||||
configlog "============"
|
||||
configlog $lines
|
||||
configlog "============"
|
||||
}
|
||||
file delete $src
|
||||
file delete $tmp
|
||||
|
||||
# cache it
|
||||
set ::cc_cache($cmdline,$lines) $ok
|
||||
|
||||
return $ok
|
||||
}
|
||||
|
||||
# @make-autoconf-h outfile ?auto-patterns=HAVE_*? ?bare-patterns=SIZEOF_*?
|
||||
#
|
||||
# Deprecated - see make-config-header
|
||||
proc make-autoconf-h {file {autopatterns {HAVE_*}} {barepatterns {SIZEOF_* HAVE_DECL_*}}} {
|
||||
user-notice "*** make-autoconf-h is deprecated -- use make-config-header instead"
|
||||
make-config-header $file -auto $autopatterns -bare $barepatterns
|
||||
}
|
||||
|
||||
# @make-config-header outfile ?-auto patternlist? ?-bare patternlist? ?-none patternlist? ?-str patternlist? ...
|
||||
#
|
||||
# Examines all defined variables which match the given patterns
|
||||
# and writes an include file, $file, which defines each of these.
|
||||
# Variables which match '-auto' are output as follows:
|
||||
# - defines which have the value "0" are ignored.
|
||||
# - defines which have integer values are defined as the integer value.
|
||||
# - any other value is defined as a string, e.g. "value"
|
||||
# Variables which match '-bare' are defined as-is.
|
||||
# Variables which match '-str' are defined as a string, e.g. "value"
|
||||
# Variables which match '-none' are omitted.
|
||||
#
|
||||
# Note that order is important. The first pattern which matches is selected
|
||||
# Default behaviour is:
|
||||
#
|
||||
# -bare {SIZEOF_* HAVE_DECL_*} -auto HAVE_* -none *
|
||||
#
|
||||
# If the file would be unchanged, it is not written.
|
||||
proc make-config-header {file args} {
|
||||
set guard _[string toupper [regsub -all {[^a-zA-Z0-9]} [file tail $file] _]]
|
||||
file mkdir [file dirname $file]
|
||||
set lines {}
|
||||
lappend lines "#ifndef $guard"
|
||||
lappend lines "#define $guard"
|
||||
|
||||
# Add some defaults
|
||||
lappend args -bare {SIZEOF_* HAVE_DECL_*} -auto HAVE_*
|
||||
|
||||
foreach n [lsort [dict keys [all-defines]]] {
|
||||
set value [get-define $n]
|
||||
set type [calc-define-output-type $n $args]
|
||||
switch -exact -- $type {
|
||||
-bare {
|
||||
# Just output the value unchanged
|
||||
}
|
||||
-none {
|
||||
continue
|
||||
}
|
||||
-str {
|
||||
set value \"[string map [list \\ \\\\ \" \\\"] $value]\"
|
||||
}
|
||||
-auto {
|
||||
# Automatically determine the type
|
||||
if {$value eq "0"} {
|
||||
lappend lines "/* #undef $n */"
|
||||
continue
|
||||
}
|
||||
if {![string is integer -strict $value]} {
|
||||
set value \"[string map [list \\ \\\\ \" \\\"] $value]\"
|
||||
}
|
||||
}
|
||||
"" {
|
||||
continue
|
||||
}
|
||||
default {
|
||||
autosetup-error "Unknown type in make-config-header: $type"
|
||||
}
|
||||
}
|
||||
lappend lines "#define $n $value"
|
||||
}
|
||||
lappend lines "#endif"
|
||||
set buf [join $lines \n]
|
||||
write-if-changed $file $buf {
|
||||
msg-result "Created $file"
|
||||
}
|
||||
}
|
||||
|
||||
proc calc-define-output-type {name spec} {
|
||||
foreach {type patterns} $spec {
|
||||
foreach pattern $patterns {
|
||||
if {[string match $pattern $name]} {
|
||||
return $type
|
||||
}
|
||||
}
|
||||
}
|
||||
return ""
|
||||
}
|
||||
|
||||
# Initialise some values from the environment or commandline or default settings
|
||||
foreach i {LDFLAGS LIBS CPPFLAGS LINKFLAGS {CFLAGS "-g -O2"}} {
|
||||
lassign $i var default
|
||||
define $var [get-env $var $default]
|
||||
}
|
||||
|
||||
if {[env-is-set CC]} {
|
||||
# Set by the user, so don't try anything else
|
||||
set try [list [get-env CC ""]]
|
||||
} else {
|
||||
# Try some reasonable options
|
||||
set try [list [get-define cross]cc [get-define cross]gcc]
|
||||
}
|
||||
define CC [find-an-executable {*}$try]
|
||||
if {[get-define CC] eq ""} {
|
||||
user-error "Could not find a C compiler. Tried: [join $try ", "]"
|
||||
}
|
||||
|
||||
define CPP [get-env CPP "[get-define CC] -E"]
|
||||
|
||||
# XXX: Could avoid looking for a C++ compiler until requested
|
||||
# Note that if CXX isn't found, we just set it to "false". It might not be needed.
|
||||
if {[env-is-set CXX]} {
|
||||
define CXX [find-an-executable -required [get-env CXX ""]]
|
||||
} else {
|
||||
define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++ false]
|
||||
}
|
||||
|
||||
# CXXFLAGS default to CFLAGS if not specified
|
||||
define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]]
|
||||
|
||||
# May need a CC_FOR_BUILD, so look for one
|
||||
define CC_FOR_BUILD [find-an-executable [get-env CC_FOR_BUILD ""] cc gcc false]
|
||||
|
||||
if {[get-define CC] eq ""} {
|
||||
user-error "Could not find a C compiler. Tried: [join $try ", "]"
|
||||
}
|
||||
|
||||
define CCACHE [find-an-executable [get-env CCACHE ccache]]
|
||||
|
||||
# Initial cctest settings
|
||||
cc-store-settings {-cflags {} -includes {} -declare {} -link 0 -lang c -libs {} -code {}}
|
||||
set autosetup(cc-include-deps) {}
|
||||
|
||||
msg-result "C compiler...[get-define CCACHE] [get-define CC] [get-define CFLAGS]"
|
||||
if {[get-define CXX] ne "false"} {
|
||||
msg-result "C++ compiler...[get-define CCACHE] [get-define CXX] [get-define CXXFLAGS]"
|
||||
}
|
||||
msg-result "Build C compiler...[get-define CC_FOR_BUILD]"
|
||||
|
||||
# On Darwin, we prefer to use -gstabs to avoid creating .dSYM directories
|
||||
# but some compilers don't support -gstabs, so test for it here.
|
||||
switch -glob -- [get-define host] {
|
||||
*-*-darwin* {
|
||||
if {[cctest -cflags {-gstabs}]} {
|
||||
define cc-default-debug -gstabs
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {![cc-check-includes stdlib.h]} {
|
||||
user-error "Compiler does not work. See config.log"
|
||||
}
|
||||
1511
debuggers/openocd/jimtcl/autosetup/config.guess
vendored
Executable file
1511
debuggers/openocd/jimtcl/autosetup/config.guess
vendored
Executable file
File diff suppressed because it is too large
Load Diff
1743
debuggers/openocd/jimtcl/autosetup/config.sub
vendored
Executable file
1743
debuggers/openocd/jimtcl/autosetup/config.sub
vendored
Executable file
File diff suppressed because it is too large
Load Diff
25
debuggers/openocd/jimtcl/autosetup/default.auto
Normal file
25
debuggers/openocd/jimtcl/autosetup/default.auto
Normal file
@ -0,0 +1,25 @@
|
||||
# Copyright (c) 2012 WorkWare Systems http://www.workware.net.au/
|
||||
# All rights reserved
|
||||
|
||||
# Auto-load module for 'make' build system integration
|
||||
|
||||
use init
|
||||
|
||||
autosetup_add_init_type make {Simple "make" build system} {
|
||||
autosetup_check_create auto.def \
|
||||
{# Initial auto.def created by 'autosetup --init=make'
|
||||
|
||||
use cc
|
||||
|
||||
# Add any user options here
|
||||
options {
|
||||
}
|
||||
|
||||
make-config-header config.h
|
||||
make-template Makefile.in
|
||||
}
|
||||
|
||||
if {![file exists Makefile.in]} {
|
||||
puts "Note: I don't see Makefile.in. You will probably need to create one."
|
||||
}
|
||||
}
|
||||
16
debuggers/openocd/jimtcl/autosetup/find-tclsh
Executable file
16
debuggers/openocd/jimtcl/autosetup/find-tclsh
Executable file
@ -0,0 +1,16 @@
|
||||
#!/bin/sh
|
||||
# Looks for a suitable tclsh or jimsh in the PATH
|
||||
# If not found, builds a bootstrap jimsh from source
|
||||
d=`dirname "$0"`
|
||||
{ "$d/jimsh0" "$d/test-tclsh"; } 2>/dev/null && exit 0
|
||||
PATH="$PATH:$d"; export PATH
|
||||
for tclsh in jimsh tclsh tclsh8.5 tclsh8.6; do
|
||||
{ $tclsh "$d/test-tclsh"; } 2>/dev/null && exit 0
|
||||
done
|
||||
echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0"
|
||||
for cc in ${CC_FOR_BUILD:-cc} gcc; do
|
||||
{ $cc -o "$d/jimsh0" "$d/jimsh0.c"; } 2>/dev/null || continue
|
||||
"$d/jimsh0" "$d/test-tclsh" && exit 0
|
||||
done
|
||||
echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc."
|
||||
echo false
|
||||
21555
debuggers/openocd/jimtcl/autosetup/jimsh0.c
Normal file
21555
debuggers/openocd/jimtcl/autosetup/jimsh0.c
Normal file
File diff suppressed because it is too large
Load Diff
194
debuggers/openocd/jimtcl/autosetup/local.tcl
Normal file
194
debuggers/openocd/jimtcl/autosetup/local.tcl
Normal file
@ -0,0 +1,194 @@
|
||||
# The complex extension checking is done here.
|
||||
|
||||
global withinfo
|
||||
global extdb
|
||||
|
||||
# Final determination of module status
|
||||
dict set extdb status {}
|
||||
|
||||
# Returns 1 if the extension has the attribute
|
||||
proc ext-has {ext attr} {
|
||||
expr {$attr in [dict get $::extdb attrs $ext]}
|
||||
}
|
||||
|
||||
# Returns an entry from the extension 'info' table, or $default otherwise
|
||||
proc ext-get {ext key {default {}}} {
|
||||
if {[dict exists $::extdb info $ext $key]} {
|
||||
return [dict get $::extdb info $ext $key]
|
||||
} else {
|
||||
return $default
|
||||
}
|
||||
}
|
||||
|
||||
# Set the status of the extension to the given value, and returns the value
|
||||
proc ext-set-status {ext value} {
|
||||
dict set ::extdb status $ext $value
|
||||
return $value
|
||||
}
|
||||
|
||||
# Returns the status of the extension, or ? if unknown
|
||||
proc ext-get-status {ext} {
|
||||
if {[dict exists $::extdb status $ext]} {
|
||||
return [dict get $::extdb status $ext]
|
||||
}
|
||||
return ?
|
||||
}
|
||||
|
||||
proc check-extension-status {ext required} {
|
||||
global withinfo
|
||||
|
||||
set status [ext-get-status $ext]
|
||||
|
||||
if {$ext in $withinfo(without)} {
|
||||
# Disabled without further ado
|
||||
msg-result "Extension $ext...disabled"
|
||||
return [ext-set-status $ext n]
|
||||
}
|
||||
|
||||
if {$status in {m y n}} {
|
||||
return $status
|
||||
}
|
||||
|
||||
# required is "required" if this extension *must* be enabled
|
||||
# required is "wanted" if it is not fatal for this extension
|
||||
# not to be enabled
|
||||
|
||||
array set depinfo {m 0 y 0 n 0}
|
||||
|
||||
# Check direct dependencies
|
||||
if [ext-get $ext check 1] {
|
||||
# "check" conditions are met
|
||||
} else {
|
||||
# not met
|
||||
incr depinfo(n)
|
||||
}
|
||||
|
||||
if {$depinfo(n) == 0} {
|
||||
# Now extension dependencies
|
||||
foreach i [ext-get $ext dep] {
|
||||
set status [check-extension-status $i $required]
|
||||
#puts "$ext: dep $i $required => $status"
|
||||
incr depinfo($status)
|
||||
if {$depinfo(n)} {
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#parray depinfo
|
||||
|
||||
if {$depinfo(n)} {
|
||||
msg-checking "Extension $ext..."
|
||||
if {$required eq "required"} {
|
||||
user-error "dependencies not met"
|
||||
}
|
||||
msg-result "disabled (dependencies)"
|
||||
return [ext-set-status $ext n]
|
||||
}
|
||||
|
||||
# Selected as a module?
|
||||
if {$ext in $withinfo(mod)} {
|
||||
if {[ext-has $ext tcl]} {
|
||||
# Easy, a Tcl module
|
||||
msg-result "Extension $ext...tcl"
|
||||
} elseif {[ext-has $ext static]} {
|
||||
user-error "Extension $ext can't be a module"
|
||||
} else {
|
||||
msg-result "Extension $ext...module"
|
||||
foreach i [ext-get $ext libdep] {
|
||||
define-append LDLIBS_$ext [get-define $i ""]
|
||||
}
|
||||
}
|
||||
return [ext-set-status $ext m]
|
||||
}
|
||||
|
||||
# Selected as a static extension?
|
||||
if {[ext-has $ext shared]} {
|
||||
user-error "Extension $ext can only be selected as a module"
|
||||
} elseif {$ext in $withinfo(ext) || $required eq "$required"} {
|
||||
msg-result "Extension $ext...enabled"
|
||||
} elseif {$ext in $withinfo(maybe)} {
|
||||
msg-result "Extension $ext...enabled (default)"
|
||||
} else {
|
||||
# Could be selected, but isn't (yet)
|
||||
return [ext-set-status $ext x]
|
||||
}
|
||||
foreach i [ext-get $ext libdep] {
|
||||
define-append LDLIBS [get-define $i ""]
|
||||
}
|
||||
return [ext-set-status $ext y]
|
||||
}
|
||||
|
||||
# Examines the user options (the $withinfo array)
|
||||
# and the extension database ($extdb) to determine
|
||||
# what is selected, and in what way.
|
||||
#
|
||||
# The results are available via ext-get-status
|
||||
# And a dictionary is returned containing four keys:
|
||||
# static-c extensions which are static C
|
||||
# static-tcl extensions which are static Tcl
|
||||
# module-c extensions which are C modules
|
||||
# module-tcl extensions which are Tcl modules
|
||||
proc check-extensions {} {
|
||||
global extdb withinfo
|
||||
|
||||
# Check valid extension names
|
||||
foreach i [concat $withinfo(ext) $withinfo(mod)] {
|
||||
if {![dict exists $extdb attrs $i]} {
|
||||
user-error "Unknown extension: $i"
|
||||
}
|
||||
}
|
||||
|
||||
set extlist [lsort [dict keys [dict get $extdb attrs]]]
|
||||
|
||||
set withinfo(maybe) {}
|
||||
|
||||
# Now work out the default status. We have.
|
||||
# normal case, include !optional if possible
|
||||
# --without=default, don't include optional
|
||||
if {$withinfo(nodefault)} {
|
||||
lappend withinfo(maybe) stdlib
|
||||
} else {
|
||||
foreach i $extlist {
|
||||
if {![ext-has $i optional]} {
|
||||
lappend withinfo(maybe) $i
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
foreach i $extlist {
|
||||
define LDLIBS_$i ""
|
||||
}
|
||||
|
||||
foreach i [concat $withinfo(ext) $withinfo(mod)] {
|
||||
check-extension-status $i required
|
||||
}
|
||||
foreach i $withinfo(maybe) {
|
||||
check-extension-status $i wanted
|
||||
}
|
||||
|
||||
array set extinfo {static-c {} static-tcl {} module-c {} module-tcl {}}
|
||||
|
||||
foreach i $extlist {
|
||||
set status [ext-get-status $i]
|
||||
set tcl [ext-has $i tcl]
|
||||
switch $status,$tcl {
|
||||
y,1 {
|
||||
define jim_ext_$i
|
||||
lappend extinfo(static-tcl) $i
|
||||
}
|
||||
y,0 {
|
||||
define jim_ext_$i
|
||||
lappend extinfo(static-c) $i
|
||||
# If there are any static C++ extensions, jimsh must be linked using
|
||||
# the C++ compiler
|
||||
if {[ext-has $i cpp]} {
|
||||
define HAVE_CXX_EXTENSIONS
|
||||
}
|
||||
}
|
||||
m,1 { lappend extinfo(module-tcl) $i }
|
||||
m,0 { lappend extinfo(module-c) $i }
|
||||
}
|
||||
}
|
||||
return [array get extinfo]
|
||||
}
|
||||
269
debuggers/openocd/jimtcl/autosetup/system.tcl
Normal file
269
debuggers/openocd/jimtcl/autosetup/system.tcl
Normal file
@ -0,0 +1,269 @@
|
||||
# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/
|
||||
# All rights reserved
|
||||
|
||||
# @synopsis:
|
||||
#
|
||||
# This module supports common system interrogation and options
|
||||
# such as --host, --build, --prefix, and setting srcdir, builddir, and EXEXT.
|
||||
#
|
||||
# It also support the 'feature' naming convention, where searching
|
||||
# for a feature such as sys/type.h defines HAVE_SYS_TYPES_H
|
||||
#
|
||||
module-options {
|
||||
host:host-alias => {a complete or partial cpu-vendor-opsys for the system where
|
||||
the application will run (defaults to the same value as --build)}
|
||||
build:build-alias => {a complete or partial cpu-vendor-opsys for the system
|
||||
where the application will be built (defaults to the
|
||||
result of running config.guess)}
|
||||
prefix:dir => {the target directory for the build (defaults to /usr/local)}
|
||||
|
||||
# These (hidden) options are supported for autoconf/automake compatibility
|
||||
exec-prefix:
|
||||
bindir:
|
||||
sbindir:
|
||||
includedir:
|
||||
mandir:
|
||||
infodir:
|
||||
libexecdir:
|
||||
datadir:
|
||||
libdir:
|
||||
sysconfdir:
|
||||
sharedstatedir:
|
||||
localstatedir:
|
||||
maintainer-mode=0
|
||||
dependency-tracking=0
|
||||
}
|
||||
|
||||
# Returns 1 if exists, or 0 if not
|
||||
#
|
||||
proc check-feature {name code} {
|
||||
msg-checking "Checking for $name..."
|
||||
set r [uplevel 1 $code]
|
||||
define-feature $name $r
|
||||
if {$r} {
|
||||
msg-result "ok"
|
||||
} else {
|
||||
msg-result "not found"
|
||||
}
|
||||
return $r
|
||||
}
|
||||
|
||||
# @have-feature name ?default=0?
|
||||
#
|
||||
# Returns the value of the feature if defined, or $default if not.
|
||||
# See 'feature-define-name' for how the feature name
|
||||
# is translated into the define name.
|
||||
#
|
||||
proc have-feature {name {default 0}} {
|
||||
get-define [feature-define-name $name] $default
|
||||
}
|
||||
|
||||
# @define-feature name ?value=1?
|
||||
#
|
||||
# Sets the feature 'define' to the given value.
|
||||
# See 'feature-define-name' for how the feature name
|
||||
# is translated into the define name.
|
||||
#
|
||||
proc define-feature {name {value 1}} {
|
||||
define [feature-define-name $name] $value
|
||||
}
|
||||
|
||||
# @feature-checked name
|
||||
#
|
||||
# Returns 1 if the feature has been checked, whether true or not
|
||||
#
|
||||
proc feature-checked {name} {
|
||||
is-defined [feature-define-name $name]
|
||||
}
|
||||
|
||||
# @feature-define-name name ?prefix=HAVE_?
|
||||
#
|
||||
# Converts a name to the corresponding define,
|
||||
# e.g. sys/stat.h becomes HAVE_SYS_STAT_H.
|
||||
#
|
||||
# Converts * to P and all non-alphanumeric to underscore.
|
||||
#
|
||||
proc feature-define-name {name {prefix HAVE_}} {
|
||||
string toupper $prefix[regsub -all {[^a-zA-Z0-9]} [regsub -all {[*]} $name p] _]
|
||||
}
|
||||
|
||||
# If $file doesn't exist, or it's contents are different than $buf,
|
||||
# the file is written and $script is executed.
|
||||
# Otherwise a "file is unchanged" message is displayed.
|
||||
proc write-if-changed {file buf {script {}}} {
|
||||
set old [readfile $file ""]
|
||||
if {$old eq $buf && [file exists $file]} {
|
||||
msg-result "$file is unchanged"
|
||||
} else {
|
||||
writefile $file $buf\n
|
||||
uplevel 1 $script
|
||||
}
|
||||
}
|
||||
|
||||
# @make-template template ?outfile?
|
||||
#
|
||||
# Reads the input file <srcdir>/$template and writes the output file $outfile.
|
||||
# If $outfile is blank/omitted, $template should end with ".in" which
|
||||
# is removed to create the output file name.
|
||||
#
|
||||
# Each pattern of the form @define@ is replaced the the corresponding
|
||||
# define, if it exists, or left unchanged if not.
|
||||
#
|
||||
# The special value @srcdir@ is subsituted with the relative
|
||||
# path to the source directory from the directory where the output
|
||||
# file is created. Use @top_srcdir@ for the absolute path.
|
||||
#
|
||||
# Conditional sections may be specified as follows:
|
||||
## @if name == value
|
||||
## lines
|
||||
## @else
|
||||
## lines
|
||||
## @endif
|
||||
#
|
||||
# Where 'name' is a defined variable name and @else is optional.
|
||||
# If the expression does not match, all lines through '@endif' are ignored.
|
||||
#
|
||||
# The alternative forms may also be used:
|
||||
## @if name
|
||||
## @if name != value
|
||||
#
|
||||
# Where the first form is true if the variable is defined, but not empty or 0
|
||||
#
|
||||
# Currently these expressions can't be nested.
|
||||
#
|
||||
proc make-template {template {out {}}} {
|
||||
set infile [file join $::autosetup(srcdir) $template]
|
||||
|
||||
if {![file exists $infile]} {
|
||||
user-error "Template $template is missing"
|
||||
}
|
||||
|
||||
# Define this as late as possible
|
||||
define AUTODEPS $::autosetup(deps)
|
||||
|
||||
if {$out eq ""} {
|
||||
if {[file ext $template] ne ".in"} {
|
||||
autosetup-error "make_template $template has no target file and can't guess"
|
||||
}
|
||||
set out [file rootname $template]
|
||||
}
|
||||
|
||||
set outdir [file dirname $out]
|
||||
|
||||
# Make sure the directory exists
|
||||
file mkdir $outdir
|
||||
|
||||
# Set up srcdir to be relative to the target dir
|
||||
define srcdir [relative-path [file join $::autosetup(srcdir) $outdir] $outdir]
|
||||
|
||||
set mapping {}
|
||||
foreach {n v} [array get ::define] {
|
||||
lappend mapping @$n@ $v
|
||||
}
|
||||
set result {}
|
||||
foreach line [split [readfile $infile] \n] {
|
||||
if {[info exists cond]} {
|
||||
set l [string trimright $line]
|
||||
if {$l eq "@endif"} {
|
||||
unset cond
|
||||
continue
|
||||
}
|
||||
if {$l eq "@else"} {
|
||||
set cond [expr {!$cond}]
|
||||
continue
|
||||
}
|
||||
if {$cond} {
|
||||
lappend result $line
|
||||
}
|
||||
continue
|
||||
}
|
||||
if {[regexp {^@if\s+(\w+)(.*)} $line -> name expression]} {
|
||||
lassign $expression equal value
|
||||
set varval [get-define $name ""]
|
||||
if {$equal eq ""} {
|
||||
set cond [expr {$varval ni {"" 0}}]
|
||||
} else {
|
||||
set cond [expr {$varval eq $value}]
|
||||
if {$equal ne "=="} {
|
||||
set cond [expr {!$cond}]
|
||||
}
|
||||
}
|
||||
continue
|
||||
}
|
||||
lappend result $line
|
||||
}
|
||||
writefile $out [string map $mapping [join $result \n]]\n
|
||||
|
||||
msg-result "Created [relative-path $out] from [relative-path $template]"
|
||||
}
|
||||
|
||||
# build/host tuples and cross-compilation prefix
|
||||
set build [opt-val build]
|
||||
define build_alias $build
|
||||
if {$build eq ""} {
|
||||
define build [config_guess]
|
||||
} else {
|
||||
define build [config_sub $build]
|
||||
}
|
||||
|
||||
set host [opt-val host]
|
||||
define host_alias $host
|
||||
if {$host eq ""} {
|
||||
define host [get-define build]
|
||||
set cross ""
|
||||
} else {
|
||||
define host [config_sub $host]
|
||||
set cross $host-
|
||||
}
|
||||
define cross [get-env CROSS $cross]
|
||||
|
||||
# Do "define defaultprefix myvalue" to set the default prefix *before* the first "use"
|
||||
set prefix [opt-val prefix [get-define defaultprefix /usr/local]]
|
||||
|
||||
# These are for compatibility with autoconf
|
||||
define target [get-define host]
|
||||
define prefix $prefix
|
||||
define builddir $autosetup(builddir)
|
||||
define srcdir $autosetup(srcdir)
|
||||
# Allow this to come from the environment
|
||||
define top_srcdir [get-env top_srcdir [get-define srcdir]]
|
||||
|
||||
# autoconf supports all of these
|
||||
set exec_prefix [opt-val exec-prefix $prefix]
|
||||
define exec_prefix $exec_prefix
|
||||
foreach {name defpath} {
|
||||
bindir /bin
|
||||
sbindir /sbin
|
||||
libexecdir /libexec
|
||||
libdir /lib
|
||||
} {
|
||||
define $name [opt-val $name $exec_prefix$defpath]
|
||||
}
|
||||
foreach {name defpath} {
|
||||
datadir /share
|
||||
sysconfdir /etc
|
||||
sharedstatedir /com
|
||||
localstatedir /var
|
||||
infodir /share/info
|
||||
mandir /share/man
|
||||
includedir /include
|
||||
} {
|
||||
define $name [opt-val $name $prefix$defpath]
|
||||
}
|
||||
|
||||
define SHELL [get-env SHELL [find-an-executable sh bash ksh]]
|
||||
|
||||
# Windows vs. non-Windows
|
||||
switch -glob -- [get-define host] {
|
||||
*-*-ming* - *-*-cygwin - *-*-msys {
|
||||
define-feature windows
|
||||
define EXEEXT .exe
|
||||
}
|
||||
default {
|
||||
define EXEEXT ""
|
||||
}
|
||||
}
|
||||
|
||||
# Display
|
||||
msg-result "Host System...[get-define host]"
|
||||
msg-result "Build System...[get-define build]"
|
||||
20
debuggers/openocd/jimtcl/autosetup/test-tclsh
Normal file
20
debuggers/openocd/jimtcl/autosetup/test-tclsh
Normal file
@ -0,0 +1,20 @@
|
||||
# A small Tcl script to verify that the chosen
|
||||
# interpreter works. Sometimes we might e.g. pick up
|
||||
# an interpreter for a different arch.
|
||||
# Outputs the full path to the interpreter
|
||||
|
||||
if {[catch {info version} version] == 0} {
|
||||
# This is Jim Tcl
|
||||
if {$version >= 0.72} {
|
||||
# Ensure that regexp works
|
||||
regexp (a.*?) a
|
||||
puts [info nameofexecutable]
|
||||
exit 0
|
||||
}
|
||||
} elseif {[catch {info tclversion} version] == 0} {
|
||||
if {$version >= 8.5 && ![string match 8.5a* [info patchlevel]]} {
|
||||
puts [info nameofexecutable]
|
||||
exit 0
|
||||
}
|
||||
}
|
||||
exit 1
|
||||
586
debuggers/openocd/jimtcl/bench.tcl
Normal file
586
debuggers/openocd/jimtcl/bench.tcl
Normal file
@ -0,0 +1,586 @@
|
||||
set batchmode 0
|
||||
set benchmarks {}
|
||||
|
||||
proc bench {title script} {
|
||||
global benchmarks batchmode
|
||||
|
||||
set Title [string range "$title " 0 20]
|
||||
|
||||
set failed [catch {time $script} res]
|
||||
if {$failed} {
|
||||
if {!$batchmode} {puts "$Title - This test can't run on this interpreter"}
|
||||
lappend benchmarks $title F
|
||||
} else {
|
||||
set t [expr [lindex $res 0] / 1000]
|
||||
lappend benchmarks $title $t
|
||||
set ts " $t"
|
||||
set ts [string range $ts [expr {[string length $ts]-10}] end]
|
||||
if {!$batchmode} {puts "$Title -$ts ms per iteration"}
|
||||
}
|
||||
catch { collect }
|
||||
}
|
||||
|
||||
### BUSY LOOP ##################################################################
|
||||
|
||||
proc whilebusyloop {} {
|
||||
set i 0
|
||||
while {$i < 1850000} {
|
||||
set a 2
|
||||
incr i
|
||||
}
|
||||
}
|
||||
|
||||
proc forbusyloop {} {
|
||||
for {set i 0} {$i < 1850000} {incr i} {
|
||||
set a 2
|
||||
}
|
||||
}
|
||||
|
||||
### FIBONACCI ##################################################################
|
||||
|
||||
proc fibonacci {x} {
|
||||
if {$x <= 1} {
|
||||
expr 1
|
||||
} else {
|
||||
expr {[fibonacci [expr {$x-1}]] + [fibonacci [expr {$x-2}]]}
|
||||
}
|
||||
}
|
||||
|
||||
### HEAPSORT ###################################################################
|
||||
|
||||
set IM 139968
|
||||
set IA 3877
|
||||
set IC 29573
|
||||
|
||||
set last 42
|
||||
|
||||
proc make_gen_random {} {
|
||||
global IM IA IC
|
||||
set params [list IM $IM IA $IA IC $IC]
|
||||
set body [string map $params {
|
||||
global last
|
||||
expr {($max * [set last [expr {($last * IA + IC) % IM}]]) / IM}
|
||||
}]
|
||||
proc gen_random {max} $body
|
||||
}
|
||||
|
||||
proc heapsort {ra_name} {
|
||||
upvar 1 $ra_name ra
|
||||
set n [llength $ra]
|
||||
set l [expr {$n / 2}]
|
||||
set ir [expr {$n - 1}]
|
||||
while 1 {
|
||||
if {$l} {
|
||||
set rra [lindex $ra [incr l -1]]
|
||||
} else {
|
||||
set rra [lindex $ra $ir]
|
||||
lset ra $ir [lindex $ra 0]
|
||||
if {[incr ir -1] == 0} {
|
||||
lset ra 0 $rra
|
||||
break
|
||||
}
|
||||
}
|
||||
set i $l
|
||||
set j [expr {(2 * $l) + 1}]
|
||||
while {$j <= $ir} {
|
||||
set tmp [lindex $ra $j]
|
||||
if {$j < $ir} {
|
||||
if {$tmp < [lindex $ra [expr {$j + 1}]]} {
|
||||
set tmp [lindex $ra [incr j]]
|
||||
}
|
||||
}
|
||||
if {$rra >= $tmp} {
|
||||
break
|
||||
}
|
||||
lset ra $i $tmp
|
||||
incr j [set i $j]
|
||||
}
|
||||
lset ra $i $rra
|
||||
}
|
||||
}
|
||||
|
||||
proc heapsort_main {} {
|
||||
set n 6100
|
||||
make_gen_random
|
||||
|
||||
set data {}
|
||||
for {set i 1} {$i <= $n} {incr i} {
|
||||
lappend data [gen_random 1.0]
|
||||
}
|
||||
heapsort data
|
||||
}
|
||||
|
||||
### SIEVE ######################################################################
|
||||
|
||||
proc sieve {num} {
|
||||
while {$num > 0} {
|
||||
incr num -1
|
||||
set count 0
|
||||
for {set i 2} {$i <= 8192} {incr i} {
|
||||
set flags($i) 1
|
||||
}
|
||||
for {set i 2} {$i <= 8192} {incr i} {
|
||||
if {$flags($i) == 1} {
|
||||
# remove all multiples of prime: i
|
||||
for {set k [expr {$i+$i}]} {$k <= 8192} {incr k $i} {
|
||||
set flags($k) 0
|
||||
}
|
||||
incr count
|
||||
}
|
||||
}
|
||||
}
|
||||
return $count
|
||||
}
|
||||
|
||||
proc sieve_dict {num} {
|
||||
while {$num > 0} {
|
||||
incr num -1
|
||||
set count 0
|
||||
for {set i 2} {$i <= 8192} {incr i} {
|
||||
dict set flags $i 1
|
||||
}
|
||||
for {set i 2} {$i <= 8192} {incr i} {
|
||||
if {[dict get $flags $i] == 1} {
|
||||
# remove all multiples of prime: i
|
||||
for {set k [expr {$i+$i}]} {$k <= 8192} {incr k $i} {
|
||||
dict set flags $k 0
|
||||
}
|
||||
incr count
|
||||
}
|
||||
}
|
||||
}
|
||||
return $count
|
||||
}
|
||||
|
||||
### ARY ########################################################################
|
||||
|
||||
proc ary n {
|
||||
for {set i 0} {$i < $n} {incr i} {
|
||||
set x($i) $i
|
||||
}
|
||||
set last [expr {$n - 1}]
|
||||
for {set j $last} {$j >= 0} {incr j -1} {
|
||||
set y($j) $x($j)
|
||||
}
|
||||
}
|
||||
|
||||
proc ary_dict n {
|
||||
for {set i 0} {$i < $n} {incr i} {
|
||||
dict set x $i $i
|
||||
}
|
||||
set last [expr {$n - 1}]
|
||||
for {set j $last} {$j >= 0} {incr j -1} {
|
||||
dict set y $j $x($j)
|
||||
}
|
||||
}
|
||||
|
||||
### REPEAT #####################################################################
|
||||
|
||||
proc repeat {n body} {
|
||||
for {set i 0} {$i < $n} {incr i} {
|
||||
uplevel 1 $body
|
||||
}
|
||||
}
|
||||
|
||||
proc use_repeat {} {
|
||||
set x 0
|
||||
repeat {1000000} {incr x}
|
||||
}
|
||||
|
||||
### UPVAR ######################################################################
|
||||
|
||||
proc myincr varname {
|
||||
upvar 1 $varname x
|
||||
incr x
|
||||
}
|
||||
|
||||
proc upvartest {} {
|
||||
set y 0
|
||||
for {set x 0} {$x < 100000} {myincr x} {
|
||||
myincr y
|
||||
}
|
||||
}
|
||||
|
||||
### NESTED LOOPS ###############################################################
|
||||
|
||||
proc nestedloops {} {
|
||||
set n 10
|
||||
set x 0
|
||||
incr n 1
|
||||
set a $n
|
||||
while {[incr a -1]} {
|
||||
set b $n
|
||||
while {[incr b -1]} {
|
||||
set c $n
|
||||
while {[incr c -1]} {
|
||||
set d $n
|
||||
while {[incr d -1]} {
|
||||
set e $n
|
||||
while {[incr e -1]} {
|
||||
set f $n
|
||||
while {[incr f -1]} {
|
||||
incr x
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
### ROTATE #####################################################################
|
||||
|
||||
proc rotate {count} {
|
||||
set v 1
|
||||
for {set n 0} {$n < $count} {incr n} {
|
||||
set v [expr {$v <<< 1}]
|
||||
}
|
||||
}
|
||||
|
||||
### DYNAMICALLY GENERATED CODE #################################################
|
||||
|
||||
proc dyncode {} {
|
||||
for {set i 0} {$i < 100000} {incr i} {
|
||||
set script "lappend foo $i"
|
||||
eval $script
|
||||
}
|
||||
}
|
||||
|
||||
proc dyncode_list {} {
|
||||
for {set i 0} {$i < 100000} {incr i} {
|
||||
set script [list lappend foo $i]
|
||||
eval $script
|
||||
}
|
||||
}
|
||||
|
||||
### PI DIGITS ##################################################################
|
||||
|
||||
proc pi_digits {} {
|
||||
set N 300
|
||||
set LEN [expr {10*$N/3}]
|
||||
set result ""
|
||||
|
||||
set a [string repeat " 2" $LEN]
|
||||
set nines 0
|
||||
set predigit 0
|
||||
set nines {}
|
||||
|
||||
set i0 [expr {$LEN+1}]
|
||||
set quot0 [expr {2*$LEN+1}]
|
||||
for {set j 0} {$j<$N} {incr j} {
|
||||
set q 0
|
||||
set i $i0
|
||||
set quot $quot0
|
||||
set pos -1
|
||||
foreach apos $a {
|
||||
set x [expr {10*$apos + $q * [incr i -1]}]
|
||||
lset a [incr pos] [expr {$x % [incr quot -2]}]
|
||||
set q [expr {$x / $quot}]
|
||||
}
|
||||
lset a end [expr {$q % 10}]
|
||||
set q [expr {$q / 10}]
|
||||
if {$q < 8} {
|
||||
append result $predigit $nines
|
||||
set nines {}
|
||||
set predigit $q
|
||||
} elseif {$q == 9} {
|
||||
append nines 9
|
||||
} else {
|
||||
append result [expr {$predigit+1}][string map {9 0} $nines]
|
||||
set nines {}
|
||||
set predigit 0
|
||||
}
|
||||
}
|
||||
#puts $result$predigit
|
||||
}
|
||||
|
||||
### EXPAND #####################################################################
|
||||
|
||||
proc expand {} {
|
||||
for {set i 0} {$i < 100000} {incr i} {
|
||||
set a [list a b c d e f]
|
||||
lappend b {*}$a
|
||||
}
|
||||
}
|
||||
|
||||
### MINLOOPS ###################################################################
|
||||
|
||||
proc miniloops {} {
|
||||
for {set i 0} {$i < 100000} {incr i} {
|
||||
set sum 0
|
||||
for {set j 0} {$j < 10} {incr j} {
|
||||
# something of more or less real
|
||||
incr sum $j
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
### wiki.tcl.tk/8566 ###########################################################
|
||||
|
||||
# Internal procedure that indexes into the 2-dimensional array t,
|
||||
# which corresponds to the sequence y, looking for the (i,j)th element.
|
||||
|
||||
proc Index { t y i j } {
|
||||
set indx [expr { ([llength $y] + 1) * ($i + 1) + ($j + 1) }]
|
||||
return [lindex $t $indx]
|
||||
}
|
||||
|
||||
# Internal procedure that implements Levenshtein to derive the longest
|
||||
# common subsequence of two lists x and y.
|
||||
|
||||
proc ComputeLCS { x y } {
|
||||
set t [list]
|
||||
for { set i -1 } { $i < [llength $y] } { incr i } {
|
||||
lappend t 0
|
||||
}
|
||||
for { set i 0 } { $i < [llength $x] } { incr i } {
|
||||
lappend t 0
|
||||
for { set j 0 } { $j < [llength $y] } { incr j } {
|
||||
if { [string equal [lindex $x $i] [lindex $y $j]] } {
|
||||
set lastT [Index $t $y [expr { $i - 1 }] [expr {$j - 1}]]
|
||||
set nextT [expr {$lastT + 1}]
|
||||
} else {
|
||||
set lastT1 [Index $t $y $i [expr { $j - 1 }]]
|
||||
set lastT2 [Index $t $y [expr { $i - 1 }] $j]
|
||||
if { $lastT1 > $lastT2 } {
|
||||
set nextT $lastT1
|
||||
} else {
|
||||
set nextT $lastT2
|
||||
}
|
||||
}
|
||||
lappend t $nextT
|
||||
}
|
||||
}
|
||||
return $t
|
||||
}
|
||||
|
||||
# Internal procedure that traces through the array built by ComputeLCS
|
||||
# and finds a longest common subsequence -- specifically, the one that
|
||||
# is lexicographically first.
|
||||
|
||||
proc TraceLCS { t x y } {
|
||||
set trace {}
|
||||
set i [expr { [llength $x] - 1 }]
|
||||
set j [expr { [llength $y] - 1 }]
|
||||
set k [expr { [Index $t $y $i $j] - 1 }]
|
||||
while { $i >= 0 && $j >= 0 } {
|
||||
set im1 [expr { $i - 1 }]
|
||||
set jm1 [expr { $j - 1 }]
|
||||
if { [Index $t $y $i $j] == [Index $t $y $im1 $jm1] + 1
|
||||
&& [string equal [lindex $x $i] [lindex $y $j]] } {
|
||||
lappend trace xy [list $i $j]
|
||||
set i $im1
|
||||
set j $jm1
|
||||
} elseif { [Index $t $y $im1 $j] > [Index $t $y $i $jm1] } {
|
||||
lappend trace x $i
|
||||
set i $im1
|
||||
} else {
|
||||
lappend trace y $j
|
||||
set j $jm1
|
||||
}
|
||||
}
|
||||
while { $i >= 0 } {
|
||||
lappend trace x $i
|
||||
incr i -1
|
||||
}
|
||||
while { $j >= 0 } {
|
||||
lappend trace y $j
|
||||
incr j -1
|
||||
}
|
||||
return $trace
|
||||
}
|
||||
|
||||
# list::longestCommonSubsequence::compare --
|
||||
#
|
||||
# Compare two lists for the longest common subsequence
|
||||
#
|
||||
# Arguments:
|
||||
# x, y - Two lists of strings to compare
|
||||
# matched - Callback to execute on matched elements, see below
|
||||
# unmatchedX - Callback to execute on unmatched elements from the
|
||||
# first list, see below.
|
||||
# unmatchedY - Callback to execute on unmatched elements from the
|
||||
# second list, see below.
|
||||
#
|
||||
# Results:
|
||||
# None.
|
||||
#
|
||||
# Side effects:
|
||||
# Whatever the callbacks do.
|
||||
#
|
||||
# The 'compare' procedure compares the two lists of strings, x and y.
|
||||
# It finds a longest common subsequence between the two. It then walks
|
||||
# the lists in order and makes the following callbacks:
|
||||
#
|
||||
# For an element that is common to both lists, it appends the index in
|
||||
# the first list, the index in the second list, and the string value of
|
||||
# the element as three parameters to the 'matched' callback, and executes
|
||||
# the result.
|
||||
#
|
||||
# For an element that is in the first list but not the second, it appends
|
||||
# the index in the first list and the string value of the element as two
|
||||
# parameters to the 'unmatchedX' callback and executes the result.
|
||||
#
|
||||
# For an element that is in the second list but not the first, it appends
|
||||
# the index in the second list and the string value of the element as two
|
||||
# parameters to the 'unmatchedY' callback and executes the result.
|
||||
|
||||
proc compare { x y
|
||||
matched
|
||||
unmatchedX unmatchedY } {
|
||||
set t [ComputeLCS $x $y]
|
||||
set trace [TraceLCS $t $x $y]
|
||||
set i [llength $trace]
|
||||
while { $i > 0 } {
|
||||
set indices [lindex $trace [incr i -1]]
|
||||
set type [lindex $trace [incr i -1]]
|
||||
switch -exact -- $type {
|
||||
xy {
|
||||
set c $matched
|
||||
eval lappend c $indices
|
||||
lappend c [lindex $x [lindex $indices 0]]
|
||||
uplevel 1 $c
|
||||
}
|
||||
x {
|
||||
set c $unmatchedX
|
||||
lappend c $indices
|
||||
lappend c [lindex $x $indices]
|
||||
uplevel 1 $c
|
||||
}
|
||||
y {
|
||||
set c $unmatchedY
|
||||
lappend c $indices
|
||||
lappend c [lindex $y $indices]
|
||||
uplevel 1 $c
|
||||
}
|
||||
}
|
||||
}
|
||||
return
|
||||
}
|
||||
|
||||
proc umx { index value } {
|
||||
global lastx
|
||||
global xlines
|
||||
append xlines "< " $value \n
|
||||
set lastx $index
|
||||
}
|
||||
|
||||
proc umy { index value } {
|
||||
global lasty
|
||||
global ylines
|
||||
append ylines "> " $value \n
|
||||
set lasty $index
|
||||
}
|
||||
|
||||
proc matched { index1 index2 value } {
|
||||
global lastx
|
||||
global lasty
|
||||
global xlines
|
||||
global ylines
|
||||
if { [info exists lastx] && [info exists lasty] } {
|
||||
#puts "[expr { $lastx + 1 }],${index1}c[expr {$lasty + 1 }],${index2}"
|
||||
#puts -nonewline $xlines
|
||||
#puts "----"
|
||||
#puts -nonewline $ylines
|
||||
} elseif { [info exists lastx] } {
|
||||
#puts "[expr { $lastx + 1 }],${index1}d${index2}"
|
||||
#puts -nonewline $xlines
|
||||
} elseif { [info exists lasty] } {
|
||||
#puts "${index1}a[expr {$lasty + 1 }],${index2}"
|
||||
#puts -nonewline $ylines
|
||||
}
|
||||
catch { unset lastx }
|
||||
catch { unset xlines }
|
||||
catch { unset lasty }
|
||||
catch { unset ylines }
|
||||
}
|
||||
|
||||
# Really, we should read the first file in like this:
|
||||
# set f0 [open [lindex $argv 0] r]
|
||||
# set x [split [read $f0] \n]
|
||||
# close $f0
|
||||
# But I'll just provide some sample lines:
|
||||
|
||||
proc commonsub_test {} {
|
||||
set x {}
|
||||
for { set i 0 } { $i < 20 } { incr i } {
|
||||
lappend x a r a d e d a b r a x
|
||||
}
|
||||
|
||||
# The second file, too, should be read in like this:
|
||||
# set f1 [open [lindex $argv 1] r]
|
||||
# set y [split [read $f1] \n]
|
||||
# close $f1
|
||||
# Once again, I'll just do some sample lines.
|
||||
|
||||
set y {}
|
||||
for { set i 0 } { $i < 20 } { incr i } {
|
||||
lappend y a b r a c a d a b r a
|
||||
}
|
||||
|
||||
compare $x $y matched umx umy
|
||||
matched [llength $x] [llength $y] {}
|
||||
}
|
||||
|
||||
### MANDEL #####################################################################
|
||||
|
||||
proc mandel {xres yres infx infy supx supy} {
|
||||
set incremx [expr {double($supx-$infx)/$xres}]
|
||||
set incremy [expr {double($supy-$infy)/$yres}]
|
||||
|
||||
for {set j 0} {$j < $yres} {incr j} {
|
||||
set cim [expr {$infy+$incremy*$j}]
|
||||
set line {}
|
||||
for {set i 0} {$i < $xres} {incr i} {
|
||||
set counter 0
|
||||
set zim 0
|
||||
set zre 0
|
||||
set cre [expr {$infx+$incremx*$i}]
|
||||
while {$counter < 255} {
|
||||
set dam [expr {$zre*$zre-$zim*$zim+$cre}]
|
||||
set zim [expr {2*$zim*$zre+$cim}]
|
||||
set zre $dam
|
||||
if {$zre*$zre+$zim*$zim > 4} break
|
||||
incr counter
|
||||
}
|
||||
# output pixel $i $j
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
### RUN ALL ####################################################################
|
||||
|
||||
if {[string compare [lindex $argv 0] "-batch"] == 0} {
|
||||
set batchmode 1
|
||||
set argv [lrange $argv 1 end]
|
||||
}
|
||||
set ver [lindex $argv 0]
|
||||
|
||||
bench {[while] busy loop} {whilebusyloop}
|
||||
bench {[for] busy loop} {forbusyloop}
|
||||
bench {mini loops} {miniloops}
|
||||
bench {fibonacci(25)} {fibonacci 25}
|
||||
bench {heapsort} {heapsort_main}
|
||||
bench {sieve} {sieve 10}
|
||||
bench {sieve [dict]} {sieve_dict 10}
|
||||
bench {ary} {ary 100000}
|
||||
bench {ary [dict]} {ary_dict 100000}
|
||||
bench {repeat} {use_repeat}
|
||||
bench {upvar} {upvartest}
|
||||
bench {nested loops} {nestedloops}
|
||||
bench {rotate} {rotate 100000}
|
||||
bench {dynamic code} {dyncode}
|
||||
bench {dynamic code (list)} {dyncode_list}
|
||||
bench {PI digits} {pi_digits}
|
||||
bench {expand} {expand}
|
||||
bench {wiki.tcl.tk/8566} {commonsub_test}
|
||||
bench {mandel} {mandel 60 60 -2 -1.5 1 1.5}
|
||||
|
||||
if {$batchmode} {
|
||||
if {$ver == ""} {
|
||||
if {[catch {info patchlevel} ver]} {
|
||||
set ver Jim[info version]
|
||||
}
|
||||
}
|
||||
puts [list $ver $benchmarks]
|
||||
}
|
||||
254
debuggers/openocd/jimtcl/binary.tcl
Normal file
254
debuggers/openocd/jimtcl/binary.tcl
Normal file
@ -0,0 +1,254 @@
|
||||
# Implements the 'binary scan' and 'binary format' commands.
|
||||
#
|
||||
# (c) 2010 Steve Bennett <steveb@workware.net.au>
|
||||
#
|
||||
# See LICENCE in this directory for licensing.
|
||||
|
||||
package require pack
|
||||
package require regexp
|
||||
|
||||
proc binary {cmd args} {
|
||||
tailcall "binary $cmd" {*}$args
|
||||
}
|
||||
|
||||
proc "binary format" {formatString args} {
|
||||
set bitoffset 0
|
||||
set result {}
|
||||
foreach {conv t u n} [regexp -all -inline {([a-zA-Z@])(u)?([*0-9]*)} $formatString] {
|
||||
if {$t in {a A}} {
|
||||
set value [binary.nextarg args]
|
||||
set sn [string bytelength $value]
|
||||
if {$n ne "*"} {
|
||||
if {$n eq ""} {
|
||||
set n 1
|
||||
}
|
||||
if {$n > $sn} {
|
||||
# Need to pad the string with spaces or nulls
|
||||
append value [string repeat [dict get {A " " a \x00} $t] $($n - $sn)]
|
||||
}
|
||||
} else {
|
||||
set n $sn
|
||||
}
|
||||
if {$n} {
|
||||
set bitoffset [pack result $value -str $(8 * $n) $bitoffset]
|
||||
}
|
||||
} elseif {[binary.intinfo $t] ne ""} {
|
||||
# An integer type
|
||||
lassign [binary.intinfo $t] type endian size prefix
|
||||
set value [binary.nextarg args]
|
||||
|
||||
if {$type ne "int"} {
|
||||
set value [split $value {}]
|
||||
}
|
||||
set vn [llength $value]
|
||||
if {$n eq "*"} {
|
||||
set n $vn
|
||||
} elseif {$n eq ""} {
|
||||
set n 1
|
||||
set value [list $value]
|
||||
} elseif {$vn < $n} {
|
||||
if {$type eq "int"} {
|
||||
return -code error "number of elements in list does not match count"
|
||||
} else {
|
||||
# Need to pad the list with zeros
|
||||
lappend value {*}[lrepeat $($n - $vn) 0]
|
||||
}
|
||||
} elseif {$vn > $n} {
|
||||
# Need to truncate the list
|
||||
set value [lrange $value 0 $n-1]
|
||||
}
|
||||
|
||||
if {$endian eq "host"} {
|
||||
set endian $($::tcl_platform(byteOrder) eq "bigEndian" ? "be" : "le")
|
||||
}
|
||||
foreach v $value {
|
||||
set bitoffset [pack result $prefix$v -int$endian $size $bitoffset]
|
||||
}
|
||||
# Now pad out with zeros to the end of the current byte
|
||||
if {$bitoffset % 8} {
|
||||
set bitoffset [pack result 0 -int$endian $(8 - $bitoffset % 8) $bitoffset]
|
||||
}
|
||||
} elseif {$t eq "x"} {
|
||||
if {$n eq "*"} {
|
||||
return -code error {cannot use "*" in format string with "x"}
|
||||
}
|
||||
if {$n eq ""} {
|
||||
set n 1
|
||||
}
|
||||
loop i 0 $n {
|
||||
set bitoffset [pack result 0 -intbe 8 $bitoffset]
|
||||
}
|
||||
} elseif {$t eq "@"} {
|
||||
if {$n eq ""} {
|
||||
return -code error {missing count for "@" field specifier}
|
||||
}
|
||||
if {$n eq "*"} {
|
||||
set bitoffset $(8 * [string bytelength $result])
|
||||
} else {
|
||||
# May need to pad it out
|
||||
set max [string bytelength $result]
|
||||
while {$n > $max} {
|
||||
append result \x00
|
||||
incr max
|
||||
}
|
||||
set bitoffset $(8 * $n)
|
||||
}
|
||||
} elseif {$t eq "X"} {
|
||||
if {$n eq "*"} {
|
||||
set bitoffset 0
|
||||
} elseif {$n eq ""} {
|
||||
incr bitoffset -8
|
||||
} else {
|
||||
incr bitoffset $($n * -8)
|
||||
}
|
||||
if {$bitoffset < 0} {
|
||||
set bitoffset 0
|
||||
}
|
||||
} else {
|
||||
return -code error "bad field specifier \"$t\""
|
||||
}
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
proc "binary scan" {value formatString {args varName}} {
|
||||
# Pops the next arg from the front of the list and returns it.
|
||||
# Throws an error if no more args
|
||||
set bitoffset 0
|
||||
set count 0
|
||||
foreach {conv t u n} [regexp -all -inline {([a-zA-Z@])(u)?([*0-9]*)} $formatString] {
|
||||
set rembytes $([string bytelength $value] - $bitoffset / 8)
|
||||
if {$t in {a A}} {
|
||||
if {$n eq "*"} {
|
||||
set n $rembytes
|
||||
} elseif {$n eq ""} {
|
||||
set n 1
|
||||
}
|
||||
if {$n > $rembytes} {
|
||||
break
|
||||
}
|
||||
|
||||
set var [binary.nextarg varName]
|
||||
|
||||
set result [unpack $value -str $bitoffset $($n * 8)]
|
||||
incr bitoffset $([string bytelength $result] * 8)
|
||||
if {$t eq "A"} {
|
||||
set result [string trimright $result]
|
||||
}
|
||||
} elseif {[binary.intinfo $t] ne ""} {
|
||||
# An integer type
|
||||
lassign [binary.intinfo $t] type endian size prefix
|
||||
set var [binary.nextarg varName]
|
||||
|
||||
if {$n eq "*"} {
|
||||
set n $($rembytes * 8 / $size)
|
||||
} else {
|
||||
if {$n eq ""} {
|
||||
set n 1
|
||||
}
|
||||
}
|
||||
if {$n * $size > $rembytes * 8} {
|
||||
break
|
||||
}
|
||||
|
||||
if {$type ne "int"} {
|
||||
set u u
|
||||
}
|
||||
if {$endian eq "host"} {
|
||||
set endian $($::tcl_platform(byteOrder) eq "bigEndian" ? "be" : "le")
|
||||
}
|
||||
|
||||
set result {}
|
||||
loop i 0 $n {
|
||||
set v [unpack $value -${u}int$endian $bitoffset $size]
|
||||
if {$type eq "int"} {
|
||||
lappend result $v
|
||||
} else {
|
||||
append result [lindex {0 1 2 3 4 5 6 7 8 9 a b c d e f} $v]
|
||||
}
|
||||
incr bitoffset $size
|
||||
}
|
||||
# Now skip to the end of the current byte
|
||||
if {$bitoffset % 8} {
|
||||
incr bitoffset $(8 - ($bitoffset % 8))
|
||||
}
|
||||
} elseif {$t eq "x"} {
|
||||
# Skip bytes
|
||||
if {$n eq "*"} {
|
||||
set n $rembytes
|
||||
} elseif {$n eq ""} {
|
||||
set n 1
|
||||
}
|
||||
if {$n > $rembytes} {
|
||||
set n $rembytes
|
||||
}
|
||||
incr bitoffset $($n * 8)
|
||||
continue
|
||||
} elseif {$t eq "X"} {
|
||||
# Back up bytes
|
||||
if {$n eq "*"} {
|
||||
set bitoffset 0
|
||||
continue
|
||||
}
|
||||
if {$n eq ""} {
|
||||
set n 1
|
||||
}
|
||||
if {$n * 8 > $bitoffset} {
|
||||
set bitoffset 0
|
||||
continue
|
||||
}
|
||||
incr bitoffset -$($n * 8)
|
||||
continue
|
||||
} elseif {$t eq "@"} {
|
||||
if {$n eq ""} {
|
||||
return -code error {missing count for "@" field specifier}
|
||||
}
|
||||
if {$n eq "*" || $n > $rembytes + $bitoffset / 8} {
|
||||
incr bitoffset $($rembytes * 8)
|
||||
} elseif {$n < 0} {
|
||||
set bitoffset 0
|
||||
} else {
|
||||
set bitoffset $($n * 8)
|
||||
}
|
||||
continue
|
||||
} else {
|
||||
return -code error "bad field specifier \"$t\""
|
||||
}
|
||||
uplevel 1 [list set $var $result]
|
||||
incr count
|
||||
}
|
||||
return $count
|
||||
}
|
||||
|
||||
# Pops the next arg from the front of the list and returns it.
|
||||
# Throws an error if no more args
|
||||
proc binary.nextarg {&arglist} {
|
||||
if {[llength $arglist] == 0} {
|
||||
return -level 2 -code error "not enough arguments for all format specifiers"
|
||||
}
|
||||
set arglist [lassign $arglist arg]
|
||||
return $arg
|
||||
}
|
||||
|
||||
proc binary.intinfo {type} {
|
||||
set info {
|
||||
c {int be 8}
|
||||
s {int le 16}
|
||||
t {int host 16}
|
||||
S {int be 16}
|
||||
i {int le 32}
|
||||
I {int be 32}
|
||||
n {int host 32}
|
||||
w {int le 64}
|
||||
W {int be 64}
|
||||
m {int host 64}
|
||||
h {hex le 4 0x}
|
||||
H {hex be 4 0x}
|
||||
b {bin le 1}
|
||||
B {bin be 1}
|
||||
}
|
||||
if {[exists info($type)]} {
|
||||
return $info($type)
|
||||
}
|
||||
return ""
|
||||
}
|
||||
3
debuggers/openocd/jimtcl/bootstrap.tcl
Normal file
3
debuggers/openocd/jimtcl/bootstrap.tcl
Normal file
@ -0,0 +1,3 @@
|
||||
# No need for package support in the bootstrap jimsh, but
|
||||
# Tcl extensions call package require
|
||||
proc package {args} {}
|
||||
255
debuggers/openocd/jimtcl/build-jim-ext.in
Normal file
255
debuggers/openocd/jimtcl/build-jim-ext.in
Normal file
@ -0,0 +1,255 @@
|
||||
#!/usr/bin/env jimsh
|
||||
|
||||
# Separate command line arguments into options and source files
|
||||
set opts {}
|
||||
set sources {}
|
||||
|
||||
proc usage {{msg {}}} {
|
||||
puts stderr "Usage: build-jim-ext ?--notest? ?--install? ?--static? ?cc-options? ?-o modname? sources..."
|
||||
if {$msg ne ""} {
|
||||
puts stderr \n$msg
|
||||
}
|
||||
exit 1
|
||||
}
|
||||
|
||||
proc readfile {filename {default_value ""}} {
|
||||
set result $default_value
|
||||
catch {
|
||||
set f [open $filename]
|
||||
set result [$f read -nonewline]
|
||||
$f close
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
set linker "@CC@"
|
||||
set testmod 1
|
||||
set install 0
|
||||
set static 0
|
||||
set verbose 0
|
||||
set keep 0
|
||||
set includepaths {}
|
||||
set libpaths {}
|
||||
set libs {}
|
||||
for {set i 0} {$i < [llength $argv]} {incr i} {
|
||||
set arg [lindex $argv $i]
|
||||
switch -glob -- $arg {
|
||||
*.c {
|
||||
lappend sources $arg
|
||||
}
|
||||
*.cpp {
|
||||
lappend sources $arg
|
||||
set linker "@CXX@"
|
||||
}
|
||||
--notest {
|
||||
set testmod 0
|
||||
}
|
||||
--install {
|
||||
set install 1
|
||||
}
|
||||
--static {
|
||||
set static 1
|
||||
}
|
||||
--verbose {
|
||||
set verbose 1
|
||||
}
|
||||
--keep {
|
||||
set keep 1
|
||||
}
|
||||
--help {
|
||||
usage "Easily builds dynamic (loadable) modules for jim"
|
||||
}
|
||||
-o {
|
||||
incr i
|
||||
set modname [file rootname [lindex $argv $i]]
|
||||
if {$modname eq ""} {
|
||||
usage "Option -o requires an argument"
|
||||
}
|
||||
}
|
||||
-I* {
|
||||
lappend includepaths $arg
|
||||
if {$arg eq "-I"} {
|
||||
lappend includepaths [lindex $argv $i]
|
||||
}
|
||||
}
|
||||
-L* {
|
||||
lappend libpaths $arg
|
||||
if {$arg eq "-L"} {
|
||||
lappend libpaths [lindex $argv $i]
|
||||
}
|
||||
}
|
||||
-l* {
|
||||
lappend libs $arg
|
||||
}
|
||||
-* {
|
||||
lappend opts $arg
|
||||
}
|
||||
default {
|
||||
usage "Unexpected '$arg'"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {$sources eq ""} {
|
||||
usage "No sources provided"
|
||||
}
|
||||
if {![info exists modname]} {
|
||||
set modname [file rootname [file tail [lindex $sources 0]]]
|
||||
# Remove jim- prefix if one exists
|
||||
regsub "^jim-" $modname "" modname
|
||||
}
|
||||
|
||||
if {$static} {
|
||||
set target libjim-$modname.a
|
||||
} else {
|
||||
set target $modname.so
|
||||
}
|
||||
puts "Building $target from $sources\n"
|
||||
|
||||
# Now add the standard location after any user include paths
|
||||
lappend includepaths -I@prefix@/include
|
||||
|
||||
set CPPFLAGS "-D_GNU_SOURCE"
|
||||
|
||||
set ljim ""
|
||||
set shobj_cflags ""
|
||||
set shobj_ldflags ""
|
||||
if {!$static} {
|
||||
set shobj_cflags "@SHOBJ_CFLAGS@"
|
||||
if {"@JIM_STATICLIB@" eq "1"} {
|
||||
puts stderr "Warning: libjim is static. Dynamic module may not work on some platforms.\n"
|
||||
set shobj_ldflags "@SHOBJ_LDFLAGS@"
|
||||
} else {
|
||||
# If shared, link against the shared libjim to resolve symbols
|
||||
set ljim -ljim
|
||||
set shobj_ldflags "@SHOBJ_LDFLAGS_R@"
|
||||
}
|
||||
}
|
||||
|
||||
set objs {}
|
||||
foreach source $sources {
|
||||
set obj [file rootname [file tail $source]].o
|
||||
if {[string match *.c $source]} {
|
||||
set compiler "@CC@"
|
||||
} else {
|
||||
set compiler "@CXX@"
|
||||
}
|
||||
set compile "$compiler @CFLAGS@ $CPPFLAGS $shobj_cflags $includepaths $opts -c -o $obj $source"
|
||||
puts "Compile: $obj"
|
||||
lappend objs $obj
|
||||
flush stdout
|
||||
set rc [catch {
|
||||
if {$verbose} {
|
||||
puts $compile
|
||||
}
|
||||
exec 2>jimerr.out {*}$compile
|
||||
} msg]
|
||||
|
||||
set errmsg [readfile jimerr.out]
|
||||
file delete jimerr.out
|
||||
|
||||
if {$rc} {
|
||||
if {!$verbose} {
|
||||
puts stderr $compile
|
||||
}
|
||||
puts stderr $msg
|
||||
if {$errmsg ne ""} {
|
||||
puts stderr $errmsg
|
||||
}
|
||||
file delete {*}$objs
|
||||
exit 1
|
||||
} else {
|
||||
if {$errmsg ne ""} {
|
||||
puts $errmsg
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {$static} {
|
||||
set ar "@AR@ cq $target $objs"
|
||||
set ranlib "@RANLIB@ $target"
|
||||
|
||||
puts "Ar: $target"
|
||||
set rc [catch {
|
||||
file delete $target
|
||||
exec {*}$ar
|
||||
exec {*}$ranlib
|
||||
if {$verbose} {
|
||||
puts stderr $ar
|
||||
}
|
||||
} msg]
|
||||
|
||||
file delete {*}$objs
|
||||
|
||||
if {$rc} {
|
||||
puts stderr $ar
|
||||
puts stderr $ranlib
|
||||
puts stderr $msg
|
||||
file delete $target
|
||||
exit 1
|
||||
}
|
||||
} else {
|
||||
# Add the standard location after any user lib paths
|
||||
lappend libpaths -L@prefix@/lib
|
||||
|
||||
set link "$linker @CFLAGS@ @LDFLAGS@ $shobj_ldflags $libpaths $opts -o $target $objs $ljim @LIBS@ $libs"
|
||||
|
||||
puts "Link: $target"
|
||||
set rc [catch {
|
||||
if {$verbose} {
|
||||
puts stderr $link
|
||||
}
|
||||
exec 2>jimerr.out {*}$link
|
||||
} msg]
|
||||
|
||||
set errmsg [readfile jimerr.out]
|
||||
file delete jimerr.out
|
||||
|
||||
if {!$keep} {
|
||||
file delete {*}$objs
|
||||
}
|
||||
|
||||
if {$rc} {
|
||||
file delete $target
|
||||
puts stderr $link
|
||||
puts stderr $msg
|
||||
if {$errmsg ne ""} {
|
||||
puts stderr $errmsg
|
||||
}
|
||||
exit 1
|
||||
}
|
||||
if {$errmsg ne ""} {
|
||||
puts $errmsg
|
||||
}
|
||||
|
||||
if {$testmod} {
|
||||
# Now, is testing even possible?
|
||||
# We must be running a compatible jimsh with the load command at least
|
||||
set testmod 0
|
||||
set rc [catch {
|
||||
# This will avoid attempting on Tcl and on jimsh without load
|
||||
# How to tell if we are cross compiling?
|
||||
if {[info version] > 0.73 && [exists -command load]} {
|
||||
set testmod 1
|
||||
}
|
||||
} msg]
|
||||
}
|
||||
|
||||
set rc [catch {
|
||||
if {$testmod} {
|
||||
puts "Test: load $target"
|
||||
load $target
|
||||
}
|
||||
if {$install} {
|
||||
set dest [env DESTDIR ""]@prefix@/lib/jim
|
||||
puts "Install: $target => $dest"
|
||||
file mkdir $dest
|
||||
file copy $target $dest/$target
|
||||
}
|
||||
puts "\nSuccess!"
|
||||
} msg]
|
||||
if {$rc} {
|
||||
puts stderr $msg
|
||||
exit 1
|
||||
}
|
||||
}
|
||||
3
debuggers/openocd/jimtcl/configure
vendored
Executable file
3
debuggers/openocd/jimtcl/configure
vendored
Executable file
@ -0,0 +1,3 @@
|
||||
#!/bin/sh
|
||||
dir="`dirname "$0"`/autosetup"
|
||||
WRAPPER="$0"; export WRAPPER; exec "`$dir/find-tclsh`" "$dir/autosetup" "$@"
|
||||
1
debuggers/openocd/jimtcl/configure.ac
Normal file
1
debuggers/openocd/jimtcl/configure.ac
Normal file
@ -0,0 +1 @@
|
||||
# Dummy configure.ac to make automake happy
|
||||
36
debuggers/openocd/jimtcl/examples.api/README
Normal file
36
debuggers/openocd/jimtcl/examples.api/README
Normal file
@ -0,0 +1,36 @@
|
||||
Jim examples
|
||||
============
|
||||
BSD 2-clause license, (c) 2010 Wojciech A. Koszek <wkoszek@FreeBSD.org>
|
||||
|
||||
|
||||
This directory contains examples of Jim interpreter API. In order to start
|
||||
working with Jim API one may just want to copy existing example .c file
|
||||
into new file, modify Makefile and start working on a new program.
|
||||
|
||||
Existing examples
|
||||
=================
|
||||
|
||||
jim_command
|
||||
Simple command implementation in Jim's API. Command is then executed
|
||||
in a script encoded within a program.
|
||||
|
||||
jim_hello
|
||||
Standard "Hello world!" program.
|
||||
|
||||
jim_inline
|
||||
Similar "Hello world!" program, but the result comes from a Tcl
|
||||
script interpreted in Jim. Result is printed back on a terminal.
|
||||
|
||||
jim_list
|
||||
Will teach you how to create a list in Jim's API. Once created,
|
||||
will show how to name and export it, so that variable is visible in
|
||||
the script's source code. Once done, interpretation of separate
|
||||
print.tcl file is presented. As a result, the script can print a
|
||||
list members created from within ANSI C program.
|
||||
|
||||
jim_obj
|
||||
Basic object creation in Jim.
|
||||
|
||||
jim_return
|
||||
Similar to jim_command example, but implemented command actually
|
||||
returns a value.
|
||||
96
debuggers/openocd/jimtcl/examples.api/jim_command.c
Normal file
96
debuggers/openocd/jimtcl/examples.api/jim_command.c
Normal file
@ -0,0 +1,96 @@
|
||||
/*-
|
||||
* Copyright (c) 2010 Wojciech A. Koszek <wkoszek@FreeBSD.org>
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above copyright
|
||||
* notice, this list of conditions and the following disclaimer in the
|
||||
* documentation and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||||
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
* SUCH DAMAGE.
|
||||
*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define JIM_EMBEDDED
|
||||
#include <jim.h>
|
||||
|
||||
/*
|
||||
* Program which we want to get executed.
|
||||
*/
|
||||
#define JIM_PROGRAM "if {1 < 2} { MySampleCommand sample }"
|
||||
|
||||
static int
|
||||
MySampleCommandFunc(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *str;
|
||||
int len;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "string");
|
||||
return (JIM_ERR);
|
||||
}
|
||||
|
||||
str = Jim_GetString(argv[1], &len);
|
||||
assert(str != NULL);
|
||||
printf("%s\n", str);
|
||||
|
||||
return (JIM_OK);
|
||||
}
|
||||
|
||||
/*
|
||||
* Now we try to write big enough code to duplication our array in Jim's
|
||||
* list implementation. Later, we try to load a sample script in Tcl that
|
||||
* could print our list.
|
||||
*/
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Jim_Interp *interp;
|
||||
int error;
|
||||
|
||||
/* Create an interpreter. */
|
||||
interp = Jim_CreateInterp();
|
||||
assert(interp != NULL && "couldn't create interpreter");
|
||||
|
||||
/* We register base commands, so that we actually implement Tcl. */
|
||||
Jim_RegisterCoreCommands(interp);
|
||||
|
||||
/* And initialise any static extensions */
|
||||
Jim_InitStaticExtensions(interp);
|
||||
|
||||
/* Register our Jim commands. */
|
||||
Jim_CreateCommand(interp, "MySampleCommand", MySampleCommandFunc,
|
||||
NULL, NULL);
|
||||
|
||||
/* Run a script. */
|
||||
error = Jim_Eval(interp, JIM_PROGRAM);
|
||||
if (error == JIM_ERR) {
|
||||
Jim_MakeErrorMessage(interp);
|
||||
fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
|
||||
Jim_FreeInterp(interp);
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
Jim_FreeInterp(interp);
|
||||
return (EXIT_SUCCESS);
|
||||
}
|
||||
58
debuggers/openocd/jimtcl/examples.api/jim_hello.c
Normal file
58
debuggers/openocd/jimtcl/examples.api/jim_hello.c
Normal file
@ -0,0 +1,58 @@
|
||||
/*-
|
||||
* Copyright (c) 2010 Wojciech A. Koszek <wkoszek@FreeBSD.org>
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above copyright
|
||||
* notice, this list of conditions and the following disclaimer in the
|
||||
* documentation and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||||
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
* SUCH DAMAGE.
|
||||
*
|
||||
* $Id$
|
||||
*/
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
#include <jim.h>
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Jim_Interp *interp;
|
||||
|
||||
interp = NULL;
|
||||
|
||||
/* Create Jim instance */
|
||||
interp = Jim_CreateInterp();
|
||||
assert(interp != NULL && "couldn't create interpreter!");
|
||||
|
||||
/* We register base commands, so that we actually implement Tcl. */
|
||||
Jim_RegisterCoreCommands(interp);
|
||||
|
||||
/* And initialise any static extensions */
|
||||
Jim_InitStaticExtensions(interp);
|
||||
|
||||
|
||||
/* Print a string to standard output */
|
||||
Jim_Eval(interp, "puts {Hello world!}");
|
||||
|
||||
/* Free the interpreter */
|
||||
Jim_FreeInterp(interp);
|
||||
return (EXIT_SUCCESS);
|
||||
}
|
||||
112
debuggers/openocd/jimtcl/examples.api/jim_list.c
Normal file
112
debuggers/openocd/jimtcl/examples.api/jim_list.c
Normal file
@ -0,0 +1,112 @@
|
||||
/*-
|
||||
* Copyright (c) 2010 Wojciech A. Koszek <wkoszek@FreeBSD.org>
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above copyright
|
||||
* notice, this list of conditions and the following disclaimer in the
|
||||
* documentation and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||||
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
* SUCH DAMAGE.
|
||||
*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define JIM_EMBEDDED
|
||||
#include <jim.h>
|
||||
|
||||
/*
|
||||
* We have a list of sample words in 'C'..
|
||||
*/
|
||||
const char *strings[] = {
|
||||
"simple",
|
||||
"strings",
|
||||
"which",
|
||||
"should",
|
||||
"get",
|
||||
"interpreted",
|
||||
"by",
|
||||
"Jim",
|
||||
};
|
||||
|
||||
/*
|
||||
* We have macros which let us to easily obtain of array presented above
|
||||
*/
|
||||
#define ARRAY_SIZE(a) (sizeof((a)) / sizeof((a)[0]))
|
||||
#define SAMPLE_OBJS ARRAY_SIZE(strings)
|
||||
|
||||
/*
|
||||
* Now we try to write big enough code to duplication our array in Jim's
|
||||
* list implementation. Later, we try to load a sample script in Tcl that
|
||||
* could print our list.
|
||||
*/
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Jim_Interp *interp;
|
||||
Jim_Obj *obj[SAMPLE_OBJS];
|
||||
Jim_Obj *list;
|
||||
int i;
|
||||
int error;
|
||||
|
||||
/* Create an interpreter */
|
||||
interp = Jim_CreateInterp();
|
||||
|
||||
/* We register base commands, so that we actually implement Tcl. */
|
||||
Jim_RegisterCoreCommands(interp);
|
||||
|
||||
/* And initialise any static extensions */
|
||||
Jim_InitStaticExtensions(interp);
|
||||
|
||||
/* Create an empty list */
|
||||
list = Jim_NewListObj(interp, NULL, 0);
|
||||
assert(list != NULL);
|
||||
|
||||
/*
|
||||
* For each string..
|
||||
*/
|
||||
for (i = 0; i < SAMPLE_OBJS; i++) {
|
||||
/* Duplicate it as an array member. */
|
||||
obj[i] = Jim_NewStringObj(interp, strings[i], -1);
|
||||
assert(obj[i] != NULL);
|
||||
|
||||
/* We append newly created object to the list */
|
||||
Jim_ListAppendElement(interp, list, obj[i]);
|
||||
}
|
||||
|
||||
/*
|
||||
* We bind a Tcl's name with our list, so that Tcl script can
|
||||
* identify the variable.
|
||||
*/
|
||||
Jim_SetVariableStr(interp, "MYLIST", list);
|
||||
|
||||
/*
|
||||
* Parse a script
|
||||
*/
|
||||
error = Jim_EvalFile(interp, "./print.tcl");
|
||||
if (error == JIM_ERR) {
|
||||
Jim_MakeErrorMessage(interp);
|
||||
fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
|
||||
}
|
||||
Jim_FreeInterp(interp);
|
||||
return (EXIT_SUCCESS);
|
||||
}
|
||||
76
debuggers/openocd/jimtcl/examples.api/jim_obj.c
Normal file
76
debuggers/openocd/jimtcl/examples.api/jim_obj.c
Normal file
@ -0,0 +1,76 @@
|
||||
/*-
|
||||
* Copyright (c) 2010 Wojciech A. Koszek <wkoszek@FreeBSD.org>
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above copyright
|
||||
* notice, this list of conditions and the following disclaimer in the
|
||||
* documentation and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||||
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
* SUCH DAMAGE.
|
||||
*
|
||||
* $Id$
|
||||
*/
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define JIM_EMBEDDED
|
||||
#include <jim.h>
|
||||
|
||||
#define OBJ_DESC "hello world"
|
||||
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Jim_Interp *interp;
|
||||
Jim_Obj *obj;
|
||||
const char *obj_desc;
|
||||
int obj_size;
|
||||
|
||||
obj = NULL;
|
||||
obj_desc = NULL;
|
||||
obj_size = -1;
|
||||
|
||||
/* Create an interpreter */
|
||||
interp = Jim_CreateInterp();
|
||||
|
||||
/* We register base commands, so that we actually implement Tcl. */
|
||||
Jim_RegisterCoreCommands(interp);
|
||||
|
||||
/* And initialise any static extensions */
|
||||
Jim_InitStaticExtensions(interp);
|
||||
|
||||
|
||||
/* Create some empty object */
|
||||
obj = Jim_NewObj(interp);
|
||||
|
||||
/* Name the object */
|
||||
Jim_InitStringRep(obj, OBJ_DESC, strlen(OBJ_DESC)) ;
|
||||
|
||||
/* Obtain internal representation of an object */
|
||||
obj_desc = Jim_GetString(obj, &obj_size);
|
||||
assert(obj_desc != NULL && "Jim should return NULL as a description");
|
||||
printf("Object described as '%s'; object size is %d\n", obj_desc,
|
||||
obj_size);
|
||||
|
||||
Jim_FreeObj(interp, obj);
|
||||
Jim_FreeInterp(interp);
|
||||
|
||||
return (EXIT_SUCCESS);
|
||||
}
|
||||
97
debuggers/openocd/jimtcl/examples.api/jim_return.c
Normal file
97
debuggers/openocd/jimtcl/examples.api/jim_return.c
Normal file
@ -0,0 +1,97 @@
|
||||
/*-
|
||||
* Copyright (c) 2010 Wojciech A. Koszek <wkoszek@FreeBSD.org>
|
||||
* All rights reserved.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above copyright
|
||||
* notice, this list of conditions and the following disclaimer in the
|
||||
* documentation and/or other materials provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
|
||||
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
|
||||
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
||||
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
||||
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
||||
* SUCH DAMAGE.
|
||||
*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define JIM_EMBEDDED
|
||||
#include <jim.h>
|
||||
|
||||
/*
|
||||
* Program which we want to get executed.
|
||||
*/
|
||||
#define JIM_PROGRAM "set l [CountChars Sample]; puts $l"
|
||||
|
||||
/*
|
||||
* Our function.
|
||||
*/
|
||||
static int
|
||||
CountCharsFunc(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *str;
|
||||
int len;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "string");
|
||||
return (JIM_ERR);
|
||||
}
|
||||
str = Jim_GetString(argv[1], &len);
|
||||
Jim_SetResult(interp, Jim_NewIntObj(interp, (jim_wide)len));
|
||||
return (JIM_OK);
|
||||
}
|
||||
|
||||
/*
|
||||
* Now we try to write big enough code to duplication our array in Jim's
|
||||
* list implementation. Later, we try to load a sample script in Tcl that
|
||||
* could print our list.
|
||||
*/
|
||||
int
|
||||
main(int argc, char **argv)
|
||||
{
|
||||
Jim_Interp *interp;
|
||||
int error;
|
||||
|
||||
/* Create an interpreter. */
|
||||
interp = Jim_CreateInterp();
|
||||
assert(interp != NULL && "couldn't create interpreter");
|
||||
|
||||
/* We register base commands, so that we actually implement Tcl. */
|
||||
Jim_RegisterCoreCommands(interp);
|
||||
|
||||
/* And initialise any static extensions */
|
||||
Jim_InitStaticExtensions(interp);
|
||||
|
||||
|
||||
/* Register our Jim command. */
|
||||
Jim_CreateCommand(interp, "CountChars", CountCharsFunc,
|
||||
NULL, NULL);
|
||||
|
||||
/* Run a script. */
|
||||
error = Jim_Eval(interp, JIM_PROGRAM);
|
||||
if (error == JIM_ERR) {
|
||||
Jim_MakeErrorMessage(interp);
|
||||
fprintf(stderr, "%s\n", Jim_GetString(Jim_GetResult(interp), NULL));
|
||||
Jim_FreeInterp(interp);
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
|
||||
Jim_FreeInterp(interp);
|
||||
return (EXIT_SUCCESS);
|
||||
}
|
||||
5
debuggers/openocd/jimtcl/examples.api/print.tcl
Normal file
5
debuggers/openocd/jimtcl/examples.api/print.tcl
Normal file
@ -0,0 +1,5 @@
|
||||
puts "-- List present in an array constructed from C program --"
|
||||
foreach {str} $MYLIST {
|
||||
puts $str
|
||||
}
|
||||
puts "---------------------------------------------------------"
|
||||
7
debuggers/openocd/jimtcl/examples.ext/README
Normal file
7
debuggers/openocd/jimtcl/examples.ext/README
Normal file
@ -0,0 +1,7 @@
|
||||
This directory contains examples of C extensions for Jim.
|
||||
|
||||
In general, do:
|
||||
|
||||
build-jim-ext extsource.c
|
||||
|
||||
See the Makefile
|
||||
24
debuggers/openocd/jimtcl/examples.ext/helloworld.c
Normal file
24
debuggers/openocd/jimtcl/examples.ext/helloworld.c
Normal file
@ -0,0 +1,24 @@
|
||||
/*
|
||||
* hello.c -- A minimal Jim C extension.
|
||||
*/
|
||||
#include <jim.h>
|
||||
|
||||
static int
|
||||
Hello_Cmd(Jim_Interp *interp, int objc, Jim_Obj *const objv[])
|
||||
{
|
||||
Jim_SetResultString(interp, "Hello, World!", -1);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
* Jim_helloworldInit -- Called when Jim loads your extension.
|
||||
*
|
||||
* Note that the name *must* correspond exactly to the name of the extension:
|
||||
* Jim_<extname>Init
|
||||
*/
|
||||
int
|
||||
Jim_helloworldInit(Jim_Interp *interp)
|
||||
{
|
||||
Jim_CreateCommand(interp, "hello", Hello_Cmd, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
83
debuggers/openocd/jimtcl/examples/client-server.tcl
Normal file
83
debuggers/openocd/jimtcl/examples/client-server.tcl
Normal file
@ -0,0 +1,83 @@
|
||||
proc bgerror {msg} {
|
||||
puts "bgerror: $msg"
|
||||
#exit 0
|
||||
}
|
||||
|
||||
proc verbose {msg} {
|
||||
puts $msg
|
||||
}
|
||||
|
||||
if {[os.fork] == 0} {
|
||||
verbose "child: waiting a bit"
|
||||
|
||||
# This will be our client
|
||||
|
||||
sleep .1
|
||||
|
||||
set f [socket stream localhost:9876]
|
||||
fconfigure $f -buffering line
|
||||
|
||||
set done 0
|
||||
|
||||
proc onread {f} {
|
||||
if {[$f gets buf] > 0} {
|
||||
verbose "child: read response '$buf'"
|
||||
} else {
|
||||
verbose "child: read got eof"
|
||||
set ::done 1
|
||||
}
|
||||
}
|
||||
|
||||
proc onwrite {f} {
|
||||
verbose "child: sending request"
|
||||
$f puts -nonewline "GET / HTTP/1.0\r\n\r\n"
|
||||
$f writable {}
|
||||
}
|
||||
|
||||
$f readable [list onread $f]
|
||||
$f writable [list onwrite $f]
|
||||
|
||||
alarm 10
|
||||
catch -signal {
|
||||
verbose "child: in event loop"
|
||||
vwait done
|
||||
verbose "child: done event loop"
|
||||
}
|
||||
alarm 0
|
||||
$f close
|
||||
exit 0
|
||||
}
|
||||
|
||||
verbose "parent: opening socket"
|
||||
set done 0
|
||||
|
||||
# This will be our server
|
||||
set f [socket stream.server 0.0.0.0:9876]
|
||||
|
||||
proc server_onread {f} {
|
||||
verbose "parent: onread (server) got connection on $f"
|
||||
set cfd [$f accept]
|
||||
verbose "parent: onread accepted $cfd"
|
||||
|
||||
verbose "parent: read request '[string trim [$cfd gets]]'"
|
||||
|
||||
$cfd puts "Thanks for the request"
|
||||
$cfd close
|
||||
|
||||
verbose "parent: sent response"
|
||||
|
||||
incr ::done
|
||||
}
|
||||
|
||||
$f readable [list server_onread $f]
|
||||
|
||||
alarm 10
|
||||
catch -signal {
|
||||
vwait done
|
||||
}
|
||||
alarm 0
|
||||
$f close
|
||||
|
||||
sleep .5
|
||||
|
||||
return "ok"
|
||||
1226
debuggers/openocd/jimtcl/examples/dns.tcl
Normal file
1226
debuggers/openocd/jimtcl/examples/dns.tcl
Normal file
File diff suppressed because it is too large
Load Diff
22
debuggers/openocd/jimtcl/examples/dnstest.tcl
Normal file
22
debuggers/openocd/jimtcl/examples/dnstest.tcl
Normal file
@ -0,0 +1,22 @@
|
||||
lappend auto_path [pwd]
|
||||
package require dns
|
||||
|
||||
# Use google's DNS
|
||||
dns::configure -nameserver 8.8.8.8
|
||||
|
||||
puts "Resolve with udp"
|
||||
set tok [dns::resolve www.tcl.tk]
|
||||
puts status=[dns::status $tok]
|
||||
puts address=[dns::address $tok]
|
||||
puts names=[dns::name $tok]
|
||||
dns::cleanup $tok
|
||||
|
||||
# Now with tcp
|
||||
dns::configure -protocol tcp
|
||||
|
||||
puts "Resolve with tcp"
|
||||
set tok [dns::resolve www.google.com]
|
||||
puts status=[dns::status $tok]
|
||||
puts address=[dns::address $tok]
|
||||
puts names=[dns::name $tok]
|
||||
dns::cleanup $tok
|
||||
36
debuggers/openocd/jimtcl/examples/jtclsh.tcl
Normal file
36
debuggers/openocd/jimtcl/examples/jtclsh.tcl
Normal file
@ -0,0 +1,36 @@
|
||||
# Simple example of how the history extension
|
||||
# can be used to provide line editing and history
|
||||
|
||||
# Build jimsh with the history extension and enable line editing (the default)
|
||||
# ./configure --with-ext=history
|
||||
|
||||
package require history
|
||||
|
||||
set histfile [env HOME]/.jtclsh
|
||||
history load $histfile
|
||||
while 1 {
|
||||
if {[history getline "jim> " cmd] < 0} {
|
||||
break
|
||||
}
|
||||
if {$cmd eq "h"} {
|
||||
history show
|
||||
continue
|
||||
}
|
||||
# Don't bother adding single char commands to the history
|
||||
if {[string length $cmd] > 1} {
|
||||
history add $cmd
|
||||
history save $histfile
|
||||
}
|
||||
# jimsh also does:
|
||||
# - check for a complete command: [info complete]
|
||||
# - handle other non-error return codes and changes the prompt: [info returncodes]
|
||||
# - displays the complete error message: [errorInfo]
|
||||
try {
|
||||
set result [eval $cmd]
|
||||
if {$result ne {}} {
|
||||
puts $result
|
||||
}
|
||||
} on error msg {
|
||||
puts $msg
|
||||
}
|
||||
}
|
||||
112
debuggers/openocd/jimtcl/examples/metakit.tcl
Normal file
112
debuggers/openocd/jimtcl/examples/metakit.tcl
Normal file
@ -0,0 +1,112 @@
|
||||
package require mk
|
||||
|
||||
# These will become subcommands of every view handle
|
||||
|
||||
# Looping using cursors
|
||||
proc {mk.view each} {view arrayVar script} {
|
||||
upvar 1 $arrayVar array
|
||||
for {set cur $view!0} {[cursor valid $cur]} {cursor incr cur} {
|
||||
set array [cursor get $cur]
|
||||
uplevel 1 $script
|
||||
}
|
||||
}
|
||||
|
||||
# Shortcuts to avoid cursors for one-time operations
|
||||
proc {mk.view set} {view pos args} {
|
||||
tailcall cursor set $view!$pos {*}$args
|
||||
}
|
||||
proc {mk.view append} {view args} {
|
||||
tailcall cursor set $view!end+1 {*}$args
|
||||
}
|
||||
proc {mk.view insert} {view pos args} {
|
||||
# Note that this only inserts fresh rows and doesn't set any data
|
||||
tailcall cursor insert $view!$pos {*}$args
|
||||
}
|
||||
|
||||
# Dump a view to stdout
|
||||
proc {mk.view dump} {view} {
|
||||
$view each row {puts " $row"}
|
||||
}
|
||||
|
||||
# -----------------------------------------------------------------------------
|
||||
|
||||
# Open an in-memory database
|
||||
set db [storage]
|
||||
|
||||
# Specify the view structure, creating new views and restructuring existing
|
||||
# ones as necessary
|
||||
$db structure firstview {key string first string}
|
||||
$db structure secondview {key string second string}
|
||||
|
||||
# Open them.
|
||||
[$db view firstview] as fstview
|
||||
# Or equivalently (using pipeline notation)
|
||||
$db view secondview | as sndview
|
||||
|
||||
# Use the helpers defined above to populate the first view
|
||||
$fstview set 0 key foo first bar
|
||||
$fstview append key hello first world
|
||||
$fstview insert 0
|
||||
$fstview set 0 key metakit first example
|
||||
|
||||
# Or use cursors directly. A end-X/end+X cursor moves automatically when
|
||||
# the view size changes.
|
||||
set cur $sndview!end+1
|
||||
cursor set $cur key foo second baz
|
||||
cursor set $cur key hello second goodbye
|
||||
cursor set $cur key silly second examples
|
||||
|
||||
puts "First view:"
|
||||
$fstview dump
|
||||
puts "Second view:"
|
||||
$sndview dump
|
||||
|
||||
puts "\nNow trying view operations. Note that all the binary operations"
|
||||
puts "are left-biased when it comes to conflicting property values.\n"
|
||||
|
||||
puts "Join on key:" ;# Common subset of the two outer joins below
|
||||
$fstview join $sndview key | dump
|
||||
puts "Outer join on key:" ;# Will yield more rows than an inner join
|
||||
$fstview join $sndview -outer key | dump
|
||||
puts "Outer join on key, in reverse order:"
|
||||
$sndview join $fstview -outer key | dump
|
||||
|
||||
puts "Cartesian product:"
|
||||
$fstview product $sndview | dump
|
||||
|
||||
puts "Pairing:"
|
||||
$fstview pair $sndview | dump
|
||||
puts "Pairing, in reverse order:"
|
||||
$sndview pair $fstview | dump
|
||||
|
||||
puts "Complex pipeline (fetch rows 3,5,.. from the cartesian product and sort"
|
||||
puts "them on the 'first' property):"
|
||||
$fstview product $sndview | range 3 end 2 | sort first | dump
|
||||
# Slice step defaults to 1. Sorting may be performed on several properties at
|
||||
# a time, prepending a "-" (minus sign) will cause the sort order to be reversed.
|
||||
|
||||
puts "Another one (fetch the unique key values from the cartesian product):"
|
||||
$fstview product $sndview | project key | unique | dump
|
||||
# Use "without" to remove certain properties.
|
||||
|
||||
puts "Keys in the cartesian product not in the reverse pairing:"
|
||||
[$fstview product $sndview | project key | unique] minus [$sndview pair $fstview | unique] | dump
|
||||
# Union "union", intersection "intersect" and symmetric difference "different"
|
||||
# are also available. They all work only if the rows are unique.
|
||||
|
||||
puts "Create a subview:"
|
||||
$fstview product $sndview | group subv key | as complexview | dump
|
||||
# Not so informative as subviews are not displayed properly. Several grouping
|
||||
# properties may be specified.
|
||||
puts "Get its values for row #0:"
|
||||
cursor get $complexview!0 subv | dump
|
||||
puts "And flatten it back:"
|
||||
$complexview flatten subv | dump
|
||||
|
||||
puts "Remove a row:"
|
||||
cursor remove $sndview!1
|
||||
$sndview dump
|
||||
# Several rows may be removed at once by specifying a row count
|
||||
puts "Clear the view:"
|
||||
$sndview resize 0
|
||||
$sndview dump
|
||||
139
debuggers/openocd/jimtcl/examples/ootest.tcl
Normal file
139
debuggers/openocd/jimtcl/examples/ootest.tcl
Normal file
@ -0,0 +1,139 @@
|
||||
package require oo
|
||||
|
||||
# Create a class, the usual bank account, with two instance variables:
|
||||
class Account {
|
||||
balance 0
|
||||
name "Unknown"
|
||||
}
|
||||
|
||||
# We have some class methods predefined
|
||||
# Note we can call (e.g.) either Account.methods or 'Account methods'
|
||||
puts "---- class Account ----"
|
||||
puts "Account vars=[Account vars]"
|
||||
puts "Account methods=[Account methods]"
|
||||
puts ""
|
||||
|
||||
# Now flesh out the class with some methods
|
||||
# Could use 'Account method' here instead
|
||||
Account method deposit {amount} {
|
||||
set balance [+ $balance $amount]
|
||||
}
|
||||
Account method see {} {
|
||||
set balance
|
||||
}
|
||||
Account method withdraw {amount} {
|
||||
if {$amount > $balance} {error "Sorry $name, can only withdraw $balance"}
|
||||
set balance [- $balance $amount]
|
||||
}
|
||||
Account method describe {} {
|
||||
puts "I am object $self of class [$self classname]"
|
||||
puts "My 'see' method returns [$self see]"
|
||||
puts "My variables are:"
|
||||
foreach i [$self vars] {
|
||||
puts " $i=[set $i]"
|
||||
}
|
||||
}
|
||||
|
||||
# Now an instance, initialisition some fields
|
||||
set a [Account new {name "Bob Smith"}]
|
||||
|
||||
puts "---- object Account ----"
|
||||
# We can use class methods on the instance too
|
||||
puts a.vars=[$a vars]
|
||||
puts a.classname=[$a classname]
|
||||
|
||||
# Now object methods
|
||||
$a deposit 100
|
||||
puts "deposit 100 -> [$a see]"
|
||||
|
||||
$a withdraw 40
|
||||
puts "withdraw 40 -> [$a see]"
|
||||
|
||||
catch {$a withdraw 1000} res
|
||||
puts "withdraw 1000 -> $res\n"
|
||||
|
||||
# Tell me something about the object
|
||||
$a describe
|
||||
puts ""
|
||||
|
||||
# Now create a new subclass
|
||||
class CreditAccount Account {
|
||||
limit -1000
|
||||
balance -20
|
||||
}
|
||||
# Override the 'withdraw' method to allow overdrawing
|
||||
CreditAccount method withdraw {amount} {
|
||||
if {$balance - $amount < $limit} {error "Sorry $name, that would exceed your credit limit of [expr -$limit]"}
|
||||
set balance [- $balance $amount]
|
||||
}
|
||||
# Override the 'describe' method, but invoke the baseclass method first
|
||||
CreditAccount method describe {} {
|
||||
# First invoke the base class 'describe'
|
||||
super describe
|
||||
if {$balance < 0} {
|
||||
puts "*** Account is in debit"
|
||||
}
|
||||
}
|
||||
|
||||
puts "---- class CreditAccount ----"
|
||||
puts "CreditAccount vars=[CreditAccount vars]"
|
||||
puts "CreditAccount methods=[CreditAccount methods]"
|
||||
puts ""
|
||||
|
||||
puts "---- object CreditAccount ----"
|
||||
set b [CreditAccount new {name "John White"}]
|
||||
|
||||
puts b.vars=[$b vars]
|
||||
puts b.classname=[$b classname]
|
||||
|
||||
puts "initial balance -> [$b see]"
|
||||
$b deposit 100
|
||||
puts "deposit 100 -> [$b see]"
|
||||
|
||||
$b withdraw 40
|
||||
puts "withdraw 40 -> [$b see]"
|
||||
|
||||
$b withdraw 1000
|
||||
puts "withdraw 1000 -> [$b see]"
|
||||
puts ""
|
||||
|
||||
# Tell me something about the object
|
||||
$b describe
|
||||
puts ""
|
||||
|
||||
# 'eval' is similar to 'dict with' for an object, except it operates
|
||||
# in it's own scope. A list of variables can be imported into the object scope.
|
||||
# It is useful for ad-hoc operations for which it is not worth defining a method.
|
||||
set total 0
|
||||
$a eval total { incr total $balance }
|
||||
incr total [$b get balance]
|
||||
puts "Total of accounts [$a get name] and [$b eval {return "$name (Credit Limit: $limit)"}] is: $total"
|
||||
|
||||
# Can we find all objects in the system?
|
||||
# Almost. We can't really distinguish those which aren't real classes.
|
||||
# This will get all references which aren't simple lambdas.
|
||||
puts "---- All objects ----"
|
||||
Account new {name "Terry Green" balance 20}
|
||||
set x [Account]
|
||||
lambda {} {dummy}
|
||||
ref blah blah
|
||||
|
||||
foreach r [info references] {
|
||||
if {[getref $r] ne {}} {
|
||||
try {
|
||||
$r eval {
|
||||
puts [format "Found %14s: Owner: %14s, Balance: %+5d, in object %s" [$self classname] $name $balance $self]
|
||||
}
|
||||
} on error msg {
|
||||
puts "Not an object: $r"
|
||||
}
|
||||
}
|
||||
}
|
||||
unset r
|
||||
|
||||
# And goodbye
|
||||
$a destroy
|
||||
|
||||
# Let the garbage collection take care of this one
|
||||
unset b
|
||||
collect
|
||||
17
debuggers/openocd/jimtcl/examples/parray.tcl
Normal file
17
debuggers/openocd/jimtcl/examples/parray.tcl
Normal file
@ -0,0 +1,17 @@
|
||||
# Example of using the 'putter' function to redirect parray output
|
||||
|
||||
set a {1 one 2 two 3 three}
|
||||
|
||||
# Use 'curry' to create a single command from two words
|
||||
stderr puts "curry"
|
||||
parray a * [curry stderr puts]
|
||||
|
||||
# Same thing, but an alias instead
|
||||
stderr puts "\nalias"
|
||||
alias stderr_puts stderr puts
|
||||
parray a * stderr_puts
|
||||
|
||||
# Now use a lambda to accumulate the results in a buffer
|
||||
stderr puts "\nlamba"
|
||||
parray a * [lambda {msg} {lappend ::lines $msg}]
|
||||
stderr puts [join $lines \n]
|
||||
16
debuggers/openocd/jimtcl/examples/pipe.tcl
Normal file
16
debuggers/openocd/jimtcl/examples/pipe.tcl
Normal file
@ -0,0 +1,16 @@
|
||||
lassign [socket pipe] r w
|
||||
|
||||
# Note, once the exec has the fh (via dup), close it
|
||||
# so that the pipe data is accessible
|
||||
exec ps aux >@$w &
|
||||
$w close
|
||||
|
||||
$r readable {
|
||||
puts [$r gets]
|
||||
if {[eof $r]} {
|
||||
$r close
|
||||
set done 1
|
||||
}
|
||||
}
|
||||
|
||||
vwait done
|
||||
20
debuggers/openocd/jimtcl/examples/popen.tcl
Normal file
20
debuggers/openocd/jimtcl/examples/popen.tcl
Normal file
@ -0,0 +1,20 @@
|
||||
# Internally, open "|..." calls out to popen from tclcompat.tcl
|
||||
#
|
||||
# This code is compatible with Tcl
|
||||
|
||||
# Write to a pipe
|
||||
set f [open |[list cat | sed -e "s/line/This is line/" >temp.out] w]
|
||||
puts "Creating temp.out with pids: [pid $f]"
|
||||
foreach n {1 2 3 4 5} {
|
||||
puts $f "line $n"
|
||||
}
|
||||
close $f
|
||||
|
||||
# Read from a pipe
|
||||
set f [open "|cat temp.out"]
|
||||
puts "Reading temp.out with pids: [pid $f]"
|
||||
while {[gets $f buf] >= 0} {
|
||||
puts $buf
|
||||
}
|
||||
close $f
|
||||
file delete temp.out
|
||||
10
debuggers/openocd/jimtcl/examples/sqlite3test.tcl
Normal file
10
debuggers/openocd/jimtcl/examples/sqlite3test.tcl
Normal file
@ -0,0 +1,10 @@
|
||||
package require sqlite3
|
||||
|
||||
set db [sqlite3.open :memory:]
|
||||
$db query {CREATE TABLE plays (id, author, title)}
|
||||
$db query {INSERT INTO plays (id, author, title) VALUES (1, 'Goethe', 'Faust');}
|
||||
$db query {INSERT INTO plays (id, author, title) VALUES (2, 'Shakespeare', 'Hamlet');}
|
||||
$db query {INSERT INTO plays (id, author, title) VALUES (3, 'Sophocles', 'Oedipus Rex');}
|
||||
set res [$db query "SELECT * FROM plays"]
|
||||
$db close
|
||||
foreach r $res {puts $r(author)}
|
||||
9
debuggers/openocd/jimtcl/examples/tcp.client
Normal file
9
debuggers/openocd/jimtcl/examples/tcp.client
Normal file
@ -0,0 +1,9 @@
|
||||
# Example of sending via a connected tcp socket
|
||||
|
||||
set s [socket stream 127.0.0.1:20000]
|
||||
|
||||
foreach i [range 1 20] {
|
||||
$s puts "1 << $i"
|
||||
|
||||
puts [$s gets]
|
||||
}
|
||||
39
debuggers/openocd/jimtcl/examples/tcp.server
Normal file
39
debuggers/openocd/jimtcl/examples/tcp.server
Normal file
@ -0,0 +1,39 @@
|
||||
# Example of a udp server which sends a response
|
||||
|
||||
# Listen on port 20000. No host specified means 0.0.0.0
|
||||
set s [socket stream.server 20000]
|
||||
|
||||
$s readable {
|
||||
# Clean up children
|
||||
os.wait -nohang 0
|
||||
set sock [$s accept]
|
||||
|
||||
# Make this server forking so we can accept multiple
|
||||
# simultaneous connections
|
||||
if {[os.fork] == 0} {
|
||||
$s close
|
||||
|
||||
$sock buffering line
|
||||
|
||||
# Get the request (max 80 chars) - need the source address
|
||||
while {[$sock gets buf] >= 0} {
|
||||
set buf [string trim $buf]
|
||||
puts -nonewline "read '$buf'"
|
||||
|
||||
try {
|
||||
set result "$buf = [expr $buf]"
|
||||
} on error {msg} {
|
||||
set result "Error: $buf => $msg"
|
||||
}
|
||||
|
||||
puts ", sending '$result'"
|
||||
|
||||
# Send the result back to where it came from
|
||||
$sock puts $result
|
||||
}
|
||||
}
|
||||
|
||||
$sock close
|
||||
}
|
||||
|
||||
vwait done
|
||||
19
debuggers/openocd/jimtcl/examples/timedread.tcl
Normal file
19
debuggers/openocd/jimtcl/examples/timedread.tcl
Normal file
@ -0,0 +1,19 @@
|
||||
# Tests that SIGALRM can interrupt read
|
||||
set f [open "/dev/urandom" r]
|
||||
|
||||
set count 0
|
||||
set error NONE
|
||||
|
||||
signal handle SIGALRM
|
||||
catch -signal {
|
||||
alarm 0.5
|
||||
while {1} {
|
||||
incr count [string bytelength [read $f 100]]
|
||||
}
|
||||
alarm 0
|
||||
signal default SIGALRM
|
||||
} error
|
||||
|
||||
puts "Read $count bytes in 0.5 seconds: Got $error"
|
||||
|
||||
$f close
|
||||
28
debuggers/openocd/jimtcl/examples/udp.client
Normal file
28
debuggers/openocd/jimtcl/examples/udp.client
Normal file
@ -0,0 +1,28 @@
|
||||
# Example of sending from an unconnected socket
|
||||
|
||||
set s [socket dgram]
|
||||
|
||||
foreach i [range 1 5] {
|
||||
# Specify the address and port with sendto
|
||||
$s sendto "$i + $i + 10" 127.0.0.1:20000
|
||||
|
||||
# Receive the response - max length of 100
|
||||
puts [$s recvfrom 100]
|
||||
}
|
||||
|
||||
$s close
|
||||
|
||||
# Now sending via a connected udp socket
|
||||
|
||||
set s [socket dgram 127.0.0.1:20000]
|
||||
$s buffering none
|
||||
|
||||
foreach i [range 5 10] {
|
||||
# Socket is connected, so can just use puts here
|
||||
# No need to flush because we set 'buffering none' above.
|
||||
$s puts -nonewline "$i * $i"
|
||||
#$s flush
|
||||
|
||||
# Receive the response - max length of 100
|
||||
puts [$s recvfrom 100]
|
||||
}
|
||||
25
debuggers/openocd/jimtcl/examples/udp.server
Normal file
25
debuggers/openocd/jimtcl/examples/udp.server
Normal file
@ -0,0 +1,25 @@
|
||||
# Example of a udp server which sends a response
|
||||
|
||||
# Listen on port 20000. No host specified means 0.0.0.0
|
||||
set s [socket dgram.server 20000]
|
||||
|
||||
# For each request...
|
||||
$s readable {
|
||||
# Get the request (max 80 chars) - need the source address
|
||||
set buf [$s recvfrom 80 addr]
|
||||
|
||||
puts -nonewline "read '$buf' from $addr"
|
||||
|
||||
try {
|
||||
set result "$buf = [expr $buf]"
|
||||
} on error {msg} {
|
||||
set result "Error: $buf => $msg"
|
||||
}
|
||||
|
||||
puts ", sending '$result' to $addr"
|
||||
|
||||
# Send the result back to where it came from
|
||||
$s sendto $result $addr
|
||||
}
|
||||
|
||||
vwait done
|
||||
13
debuggers/openocd/jimtcl/examples/udp2.client
Normal file
13
debuggers/openocd/jimtcl/examples/udp2.client
Normal file
@ -0,0 +1,13 @@
|
||||
# Example of sending via a connected udp socket
|
||||
|
||||
set s [socket dgram 127.0.0.1:20000]
|
||||
|
||||
foreach i [range 1 20] {
|
||||
# Socket is connected, so can just use puts here
|
||||
# But remember to flush to ensure that each message is separate
|
||||
$s puts -nonewline "$i * $i"
|
||||
$s flush
|
||||
|
||||
# Receive the response - max length of 100
|
||||
puts [$s recvfrom 100]
|
||||
}
|
||||
27
debuggers/openocd/jimtcl/examples/udp6.client
Normal file
27
debuggers/openocd/jimtcl/examples/udp6.client
Normal file
@ -0,0 +1,27 @@
|
||||
# Example of sending from an unconnected ipv6 socket
|
||||
|
||||
set s [socket -ipv6 dgram]
|
||||
|
||||
foreach i [range 1 5] {
|
||||
# Specify the address and port with sendto
|
||||
$s sendto "$i + $i + 10" {[::1]:20000}
|
||||
|
||||
# Receive the response - max length of 100
|
||||
puts [$s recvfrom 100]
|
||||
}
|
||||
|
||||
$s close
|
||||
|
||||
# Now sending via a connected udp socket
|
||||
|
||||
set s [socket -ipv6 dgram {[::1]:20000}]
|
||||
|
||||
foreach i [range 5 10] {
|
||||
# Socket is connected, so can just use puts here
|
||||
# But remember to flush to ensure that each message is separate
|
||||
$s puts -nonewline "$i * $i"
|
||||
$s flush
|
||||
|
||||
# Receive the response - max length of 100
|
||||
puts [$s recvfrom 100]
|
||||
}
|
||||
26
debuggers/openocd/jimtcl/examples/udp6.server
Normal file
26
debuggers/openocd/jimtcl/examples/udp6.server
Normal file
@ -0,0 +1,26 @@
|
||||
# Example of a udp server listening on ipv6 which sends a response
|
||||
# Note that on many hosts, this will also respond to ipv4 requests too
|
||||
|
||||
# Listen on port 20000.
|
||||
set s [socket -ipv6 dgram.server {[::]:20000}]
|
||||
|
||||
# For each request...
|
||||
$s readable {
|
||||
# Get the request (max 80 chars) - need the source address
|
||||
set buf [$s recvfrom 80 addr]
|
||||
|
||||
puts -nonewline "read '$buf' from $addr"
|
||||
|
||||
try {
|
||||
set result "$buf = [expr $buf]"
|
||||
} on error {msg} {
|
||||
set result "Error: $buf => $msg"
|
||||
}
|
||||
|
||||
puts ", sending '$result'"
|
||||
|
||||
# Send the result back to where it came from
|
||||
$s sendto $result $addr
|
||||
}
|
||||
|
||||
vwait done
|
||||
65
debuggers/openocd/jimtcl/freebsd/andrew.txt
Normal file
65
debuggers/openocd/jimtcl/freebsd/andrew.txt
Normal file
@ -0,0 +1,65 @@
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
Received: by 10.100.7.20 with SMTP id 20cs86142ang;
|
||||
Wed, 16 Jul 2008 00:45:59 -0700 (PDT)
|
||||
Received: by 10.142.238.12 with SMTP id l12mr5009290wfh.204.1216194359186;
|
||||
Wed, 16 Jul 2008 00:45:59 -0700 (PDT)
|
||||
Return-Path: <andrew@lunn.ch>
|
||||
Received: from cpanel5.proisp.no (cpanel5.proisp.no [209.85.100.29])
|
||||
by mx.google.com with ESMTP id 31si6762736wff.16.2008.07.16.00.45.57;
|
||||
Wed, 16 Jul 2008 00:45:59 -0700 (PDT)
|
||||
Received-SPF: fail (google.com: domain of andrew@lunn.ch does not designate 209.85.100.29 as permitted sender) client-ip=209.85.100.29;
|
||||
Authentication-Results: mx.google.com; spf=hardfail (google.com: domain of andrew@lunn.ch does not designate 209.85.100.29 as permitted sender) smtp.mail=andrew@lunn.ch
|
||||
Received: from londo.lunn.ch ([80.238.139.98]:48839 ident=mail)
|
||||
by cpanel5.proisp.no with esmtp (Exim 4.69)
|
||||
(envelope-from <andrew@lunn.ch>)
|
||||
id 1KJ1ht-00085G-Ng
|
||||
for oyvind.harboe@zylin.com; Wed, 16 Jul 2008 09:45:52 +0200
|
||||
Received: from lunn by londo.lunn.ch with local (Exim 3.36 #1 (Debian))
|
||||
id 1KJ1hq-0005ss-00; Wed, 16 Jul 2008 09:45:46 +0200
|
||||
Date: Wed, 16 Jul 2008 09:45:46 +0200
|
||||
From: Andrew Lunn <andrew@lunn.ch>
|
||||
To: ?yvind Harboe <oyvind.harboe@zylin.com>
|
||||
Cc: jim-devel@lists.berlios.de, antirez@gmail.com, patthoyts@users.sf.net,
|
||||
andrew@lunn.ch, openocd@duaneellis.com, uklein@klein-messgeraete.de,
|
||||
ml-jim@qiao.in-berlin.de
|
||||
Subject: Re: Change Jim Tcl license
|
||||
Message-ID: <20080716074546.GC24771@lunn.ch>
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=us-ascii
|
||||
Content-Disposition: inline
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
User-Agent: Mutt/1.5.18 (2008-05-17)
|
||||
X-Spam-Status: No, score=-2.6
|
||||
X-Spam-Score: -25
|
||||
X-Spam-Bar: --
|
||||
X-Spam-Flag: NO
|
||||
X-AntiAbuse: This header was added to track abuse, please include it with any abuse report
|
||||
X-AntiAbuse: Primary Hostname - cpanel5.proisp.no
|
||||
X-AntiAbuse: Original Domain - zylin.com
|
||||
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
|
||||
X-AntiAbuse: Sender Address Domain - lunn.ch
|
||||
X-Source:
|
||||
X-Source-Args:
|
||||
X-Source-Dir:
|
||||
|
||||
On Wed, Jul 16, 2008 at 09:34:14AM +0200, ?yvind Harboe wrote:
|
||||
> Hi all,
|
||||
>
|
||||
> I'm currently the maintainer of Jim Tcl trying as best as I can
|
||||
> to fill Salvatore's shoes.
|
||||
>
|
||||
> Short story:
|
||||
>
|
||||
> If you have contributed to Jim Tcl, please reply to this email
|
||||
> that you agree that we can switch Jim Tcl to a FreeBSD license.
|
||||
|
||||
I've no problems with this, but my contributions are very minimal.
|
||||
|
||||
Do you want this written down, in blood, to keep the lawyers happy?
|
||||
|
||||
At a minimum i think everybody's agreement needs to be posted to a
|
||||
public email list which is publicly archived etc so there is a
|
||||
record of the agreement...
|
||||
|
||||
Andrew
|
||||
87
debuggers/openocd/jimtcl/freebsd/clemens.txt
Normal file
87
debuggers/openocd/jimtcl/freebsd/clemens.txt
Normal file
@ -0,0 +1,87 @@
|
||||
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
Received: by 10.100.7.20 with SMTP id 20cs114742ang;
|
||||
Wed, 16 Jul 2008 08:58:18 -0700 (PDT)
|
||||
Received: by 10.114.137.2 with SMTP id k2mr325372wad.95.1216223896673;
|
||||
Wed, 16 Jul 2008 08:58:16 -0700 (PDT)
|
||||
Return-Path: <ml-jim@qiao.in-berlin.de>
|
||||
Received: from cpanel5.proisp.no (cpanel5.proisp.no [209.85.100.29])
|
||||
by mx.google.com with ESMTP id m28si10145125waf.16.2008.07.16.08.58.15;
|
||||
Wed, 16 Jul 2008 08:58:16 -0700 (PDT)
|
||||
Received-SPF: neutral (google.com: 209.85.100.29 is neither permitted nor denied by best guess record for domain of ml-jim@qiao.in-berlin.de) client-ip=209.85.100.29;
|
||||
Authentication-Results: mx.google.com; spf=neutral (google.com: 209.85.100.29 is neither permitted nor denied by best guess record for domain of ml-jim@qiao.in-berlin.de) smtp.mail=ml-jim@qiao.in-berlin.de
|
||||
Received: from gnu.in-berlin.de ([192.109.42.4]:58401)
|
||||
by cpanel5.proisp.no with esmtps (TLSv1:AES256-SHA:256)
|
||||
(Exim 4.69)
|
||||
(envelope-from <ml-jim@qiao.in-berlin.de>)
|
||||
id 1KJ9OG-0006Hf-8y
|
||||
for oyvind.harboe@zylin.com; Wed, 16 Jul 2008 17:58:07 +0200
|
||||
X-Envelope-From: ml-jim@qiao.in-berlin.de
|
||||
X-Envelope-To: <oyvind.harboe@zylin.com>
|
||||
Received: from qiao.in-berlin.de (qiao.in-berlin.de [217.197.85.72])
|
||||
by gnu.in-berlin.de (8.13.8/8.13.8/Debian-2) with ESMTP id m6GFvxio009504
|
||||
for <oyvind.harboe@zylin.com>; Wed, 16 Jul 2008 17:58:02 +0200
|
||||
Received: from [192.168.0.10] ([::ffff:192.168.0.10])
|
||||
by qiao.in-berlin.de with esmtp; Wed, 16 Jul 2008 18:00:04 +0200
|
||||
id 0001D68D.487E1B04.000042E7
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
Mime-Version: 1.0 (Apple Message framework v753.1)
|
||||
Content-Type: text/plain; charset=ISO-8859-1; delsp=yes; format=flowed
|
||||
Message-Id: <E112D7A6-89D1-40C8-913C-7DAF7303E7EC@qiao.in-berlin.de>
|
||||
Cc: jim-devel@lists.berlios.de, antirez@gmail.com, patthoyts@users.sf.net,
|
||||
andrew@lunn.ch, openocd@duaneellis.com, uklein@klein-messgeraete.de
|
||||
Content-Transfer-Encoding: quoted-printable
|
||||
From: Clemens Hintze <ml-jim@qiao.in-berlin.de>
|
||||
Subject: Re: Change Jim Tcl license
|
||||
Date: Wed, 16 Jul 2008 17:58:14 +0200
|
||||
To: "=?ISO-8859-1?Q?\"=D8yvind_Harboe\"?=" <oyvind.harboe@zylin.com>
|
||||
X-Mailer: Apple Mail (2.753.1)
|
||||
X-Spam-Score: (0.101) BAYES_50,RDNS_NONE
|
||||
X-Scanned-By: MIMEDefang_at_IN-Berlin_e.V. on 192.109.42.4
|
||||
X-Spam-Status: No, score=-2.6
|
||||
X-Spam-Score: -25
|
||||
X-Spam-Bar: --
|
||||
X-Spam-Flag: NO
|
||||
X-AntiAbuse: This header was added to track abuse, please include it with any abuse report
|
||||
X-AntiAbuse: Primary Hostname - cpanel5.proisp.no
|
||||
X-AntiAbuse: Original Domain - zylin.com
|
||||
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
|
||||
X-AntiAbuse: Sender Address Domain - qiao.in-berlin.de
|
||||
X-Source:
|
||||
X-Source-Args:
|
||||
X-Source-Dir:
|
||||
|
||||
|
||||
Am 16.07.2008 um 09:34 schrieb =D8yvind Harboe:
|
||||
|
||||
> Hi all,
|
||||
|
||||
Hi =D8yvind,
|
||||
|
||||
(...)
|
||||
|
||||
> If you have contributed to Jim Tcl, please reply to this email
|
||||
> that you agree that we can switch Jim Tcl to a FreeBSD license.
|
||||
>
|
||||
> Once I have a record of all contributors agreeing to switch
|
||||
> to a FreeBSD license, I'll update CVS.
|
||||
|
||||
No problem with me: I agree to permit my contributions to the Jim =20
|
||||
project to be
|
||||
re-licensed under a BSD compatible license.
|
||||
|
||||
(...)
|
||||
|
||||
> Please let me know if any of the emails below are wrong(chi is
|
||||
> missing) or the list is not complete.
|
||||
|
||||
After consultation with the voices in my head, I can ensure you, =20
|
||||
'chi' is also agreeing with the re-licensing, because its me too ;-)
|
||||
|
||||
Thank you very much to revive Jim! :-)
|
||||
|
||||
Best regards,
|
||||
Clemens Hintze.
|
||||
|
||||
(...)=
|
||||
65
debuggers/openocd/jimtcl/freebsd/duane.txt
Normal file
65
debuggers/openocd/jimtcl/freebsd/duane.txt
Normal file
@ -0,0 +1,65 @@
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
Received: by 10.100.7.20 with SMTP id 20cs93801ang;
|
||||
Wed, 16 Jul 2008 03:40:02 -0700 (PDT)
|
||||
Received: by 10.142.148.10 with SMTP id v10mr5070849wfd.317.1216204801306;
|
||||
Wed, 16 Jul 2008 03:40:01 -0700 (PDT)
|
||||
Return-Path: <openocd@duaneellis.com>
|
||||
Received: from cpanel5.proisp.no (cpanel5.proisp.no [209.85.100.29])
|
||||
by mx.google.com with ESMTP id 27si9313433wff.3.2008.07.16.03.40.00;
|
||||
Wed, 16 Jul 2008 03:40:01 -0700 (PDT)
|
||||
Received-SPF: neutral (google.com: 209.85.100.29 is neither permitted nor denied by best guess record for domain of openocd@duaneellis.com) client-ip=209.85.100.29;
|
||||
Authentication-Results: mx.google.com; spf=neutral (google.com: 209.85.100.29 is neither permitted nor denied by best guess record for domain of openocd@duaneellis.com) smtp.mail=openocd@duaneellis.com
|
||||
Received: from smtpout10-04.prod.mesa1.secureserver.net ([64.202.165.238]:48803 helo=smtpout10.prod.mesa1.secureserver.net)
|
||||
by cpanel5.proisp.no with smtp (Exim 4.69)
|
||||
(envelope-from <openocd@duaneellis.com>)
|
||||
id 1KJ4QL-0005cq-GB
|
||||
for oyvind.harboe@zylin.com; Wed, 16 Jul 2008 12:39:54 +0200
|
||||
Received: (qmail 2305 invoked from network); 16 Jul 2008 10:39:56 -0000
|
||||
Received: from unknown (68.37.53.103)
|
||||
by smtpout10-04.prod.mesa1.secureserver.net (64.202.165.238) with ESMTP; 16 Jul 2008 10:39:55 -0000
|
||||
Message-ID: <487DCFEC.4010104@duaneellis.com>
|
||||
Date: Wed, 16 Jul 2008 06:39:40 -0400
|
||||
From: Duane Ellis <openocd@duaneellis.com>
|
||||
Reply-To: openocd@duaneellis.com
|
||||
User-Agent: Thunderbird 2.0.0.14 (Windows/20080421)
|
||||
MIME-Version: 1.0
|
||||
To: =?ISO-8859-1?Q?=D8yvind_Harboe?= <oyvind.harboe@zylin.com>
|
||||
CC: jim-devel@lists.berlios.de, antirez@gmail.com,
|
||||
patthoyts@users.sf.net, andrew@lunn.ch, uklein@klein-messgeraete.de,
|
||||
ml-jim@qiao.in-berlin.de
|
||||
Subject: Re: Change Jim Tcl license
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
Content-Type: text/plain; charset=ISO-8859-1; format=flowed
|
||||
Content-Transfer-Encoding: 8bit
|
||||
X-Spam-Status: No, score=-2.6
|
||||
X-Spam-Score: -25
|
||||
X-Spam-Bar: --
|
||||
X-Spam-Flag: NO
|
||||
X-AntiAbuse: This header was added to track abuse, please include it with any abuse report
|
||||
X-AntiAbuse: Primary Hostname - cpanel5.proisp.no
|
||||
X-AntiAbuse: Original Domain - zylin.com
|
||||
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
|
||||
X-AntiAbuse: Sender Address Domain - duaneellis.com
|
||||
X-Source:
|
||||
X-Source-Args:
|
||||
X-Source-Dir:
|
||||
|
||||
Oyvind Harboe wrote:
|
||||
> Short story:
|
||||
>
|
||||
> If you have contributed to Jim Tcl, please reply to this email
|
||||
> that you agree that we can switch Jim Tcl to a FreeBSD license.
|
||||
>
|
||||
> Once I have a record of all contributors agreeing to switch
|
||||
> to a FreeBSD license, I'll update CVS.
|
||||
>
|
||||
>
|
||||
OK - from me
|
||||
|
||||
--Duane.
|
||||
|
||||
-Duane.
|
||||
|
||||
|
||||
|
||||
85
debuggers/openocd/jimtcl/freebsd/oharboe.txt
Normal file
85
debuggers/openocd/jimtcl/freebsd/oharboe.txt
Normal file
@ -0,0 +1,85 @@
|
||||
|
||||
Received: by 10.100.7.20 with HTTP; Wed, 16 Jul 2008 10:12:05 -0700 (PDT)
|
||||
Message-ID: <c09652430807161012m178c5fbesef9a3f831e4d1dac@mail.gmail.com>
|
||||
Date: Wed, 16 Jul 2008 19:12:05 +0200
|
||||
From: "=?ISO-8859-1?Q?=D8yvind_Harboe?=" <oyvind.harboe@zylin.com>
|
||||
Sender: oyvindharboe@gmail.com
|
||||
To: jim-devel@lists.berlios.de
|
||||
Subject: Re: Change Jim Tcl license
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=ISO-8859-1
|
||||
Content-Transfer-Encoding: quoted-printable
|
||||
Content-Disposition: inline
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
X-Google-Sender-Auth: fc18e85532eee8f2
|
||||
|
||||
For the record:
|
||||
|
||||
I would like my contributions to Jim Tcl to be under a FreeBSD license too=
|
||||
.
|
||||
|
||||
On Wed, Jul 16, 2008 at 9:34 AM, =D8yvind Harboe <oyvind.harboe@zylin.com> =
|
||||
wrote:
|
||||
> Hi all,
|
||||
>
|
||||
> I'm currently the maintainer of Jim Tcl trying as best as I can
|
||||
> to fill Salvatore's shoes.
|
||||
>
|
||||
> Short story:
|
||||
>
|
||||
> If you have contributed to Jim Tcl, please reply to this email
|
||||
> that you agree that we can switch Jim Tcl to a FreeBSD license.
|
||||
>
|
||||
> Once I have a record of all contributors agreeing to switch
|
||||
> to a FreeBSD license, I'll update CVS.
|
||||
>
|
||||
> Long story:
|
||||
>
|
||||
> The current Jim Tcl license has a problem with GPL. If you
|
||||
> link GPL code and Jim Tcl, the result is no license at all.
|
||||
>
|
||||
> This prevents Jim Tcl from being used in GPL projects.
|
||||
>
|
||||
> Lately Jim Tcl has been used with OpenOCD, a GPL project,
|
||||
> and the license issue must be resolved one way or another.
|
||||
>
|
||||
> Upon conferring with Jonathan Larmour <jifl@ecoscentric.com>, who
|
||||
> has kindly helped out with his knowledge on the topic, I have
|
||||
> concluded that the best way to rectify this is to change the
|
||||
> Jim Tcl license to a FreeBSD license. See OpenOCD mailing
|
||||
> list for a discussion on this if you want details.
|
||||
>
|
||||
> http://www.fsf.org/licensing/licenses/index_html#FreeBSD
|
||||
>
|
||||
> As far as I can determine, below is the complete list of contributors.
|
||||
>
|
||||
>
|
||||
> antirez - Salvatore Sanfilippo <antirez@gmail.com>
|
||||
> patthoyts - ?? Pat Thoyts <patthoyts@users.sf.net>
|
||||
> oharboe - =D8yvind Harboe - soyvind.harboe@zylin.com
|
||||
> chi - ??
|
||||
> Andrew Lunn <andrew@lunn.ch>
|
||||
> Duane Ellis <openocd@duaneellis.com>
|
||||
> Uwe Klein <uklein@klein-messgeraete.de>
|
||||
> Clemens Hintze ml-jim@qiao.in-berlin.de
|
||||
>
|
||||
> Please let me know if any of the emails below are wrong(chi is
|
||||
> missing) or the list is not complete.
|
||||
>
|
||||
>
|
||||
> --
|
||||
> =D8yvind Harboe
|
||||
> http://www.zylin.com/zy1000.html
|
||||
> ARM7 ARM9 XScale Cortex
|
||||
> JTAG debugger and flash programmer
|
||||
>
|
||||
|
||||
|
||||
|
||||
--=20
|
||||
=D8yvind Harboe
|
||||
http://www.zylin.com/zy1000.html
|
||||
ARM7 ARM9 XScale Cortex
|
||||
JTAG debugger and flash programmer
|
||||
84
debuggers/openocd/jimtcl/freebsd/pat.txt
Normal file
84
debuggers/openocd/jimtcl/freebsd/pat.txt
Normal file
@ -0,0 +1,84 @@
|
||||
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
Received: by 10.100.7.20 with SMTP id 20cs108097ang;
|
||||
Wed, 16 Jul 2008 07:49:02 -0700 (PDT)
|
||||
Received: by 10.142.232.20 with SMTP id e20mr80874wfh.138.1216219741865;
|
||||
Wed, 16 Jul 2008 07:49:01 -0700 (PDT)
|
||||
Return-Path: <patthoyts@users.sourceforge.net>
|
||||
Received: from cpanel5.proisp.no (cpanel5.proisp.no [209.85.100.29])
|
||||
by mx.google.com with ESMTP id 30si10551683wff.18.2008.07.16.07.49.01;
|
||||
Wed, 16 Jul 2008 07:49:01 -0700 (PDT)
|
||||
Received-SPF: neutral (google.com: 209.85.100.29 is neither permitted nor denied by best guess record for domain of patthoyts@users.sourceforge.net) client-ip=209.85.100.29;
|
||||
Authentication-Results: mx.google.com; spf=neutral (google.com: 209.85.100.29 is neither permitted nor denied by best guess record for domain of patthoyts@users.sourceforge.net) smtp.mail=patthoyts@users.sourceforge.net
|
||||
Received: from smtp-out4.blueyonder.co.uk ([195.188.213.7]:38596)
|
||||
by cpanel5.proisp.no with esmtp (Exim 4.69)
|
||||
(envelope-from <patthoyts@users.sourceforge.net>)
|
||||
id 1KJ8JH-0000Vd-OT
|
||||
for oyvind.harboe@zylin.com; Wed, 16 Jul 2008 16:48:52 +0200
|
||||
Received: from [172.23.170.141] (helo=anti-virus02-08)
|
||||
by smtp-out4.blueyonder.co.uk with smtp (Exim 4.52)
|
||||
id 1KJ8JO-0007r0-Cy; Wed, 16 Jul 2008 15:48:58 +0100
|
||||
Received: from [77.102.249.21] (helo=badger.patthoyts.tk)
|
||||
by asmtp-out4.blueyonder.co.uk with esmtp (Exim 4.52)
|
||||
id 1KJ8J6-0000gY-VY; Wed, 16 Jul 2008 15:48:41 +0100
|
||||
Received: by badger.patthoyts.tk (Postfix, from userid 1000)
|
||||
id 810535184F; Wed, 16 Jul 2008 15:48:40 +0100 (BST)
|
||||
Sender: pat@badger.patthoyts.tk
|
||||
To: =?iso-8859-1?q?=D8yvind_Harboe?= <oyvind.harboe@zylin.com>
|
||||
Cc: jim-devel@lists.berlios.de
|
||||
Subject: Re: Change Jim Tcl license
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
X-Face: .`d#euqz@6H{";Ysmx2IVe_7M3vA+2w1X[QLk?ZO&QRauXQL{*L'$3getx}9+zK.-KWDx3.
|
||||
qrlR)76MFb`6bgoGvLpLtcQKB=X~;*<JKLtwLBM(IA'?rVjs1*tq\VHn?WMNsB,3XXWF@5.)4SRFa+
|
||||
'?a?.s#@hl7CiTo'F"O!fvbL0
|
||||
X-Url: http://www.patthoyts.tk/
|
||||
From: Pat Thoyts <patthoyts@users.sourceforge.net>
|
||||
Date: 16 Jul 2008 15:48:39 +0100
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
Message-ID: <87fxq97um0.fsf@badger.patthoyts.tk>
|
||||
Lines: 27
|
||||
User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.3
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=iso-8859-1
|
||||
Content-Transfer-Encoding: quoted-printable
|
||||
X-Spam-Status: No, score=-2.6
|
||||
X-Spam-Score: -25
|
||||
X-Spam-Bar: --
|
||||
X-Spam-Flag: NO
|
||||
X-AntiAbuse: This header was added to track abuse, please include it with any abuse report
|
||||
X-AntiAbuse: Primary Hostname - cpanel5.proisp.no
|
||||
X-AntiAbuse: Original Domain - zylin.com
|
||||
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
|
||||
X-AntiAbuse: Sender Address Domain - users.sourceforge.net
|
||||
X-Source:
|
||||
X-Source-Args:
|
||||
X-Source-Dir:
|
||||
|
||||
-----BEGIN PGP SIGNED MESSAGE-----
|
||||
Hash: SHA1
|
||||
|
||||
"=D8yvind Harboe" <oyvind.harboe@zylin.com> writes:
|
||||
|
||||
>If you have contributed to Jim Tcl, please reply to this email
|
||||
>that you agree that we can switch Jim Tcl to a FreeBSD license.
|
||||
>
|
||||
>Once I have a record of all contributors agreeing to switch
|
||||
>to a FreeBSD license, I'll update CVS.
|
||||
|
||||
I hereby agree to permit my contributions to the Jim project to be
|
||||
re-licensed under a BSD compatible license.
|
||||
|
||||
- --=20
|
||||
Pat Thoyts http://www.patthoyts.tk/
|
||||
PGP fingerprint 2C 6E 98 07 2C 59 C8 97 10 CE 11 E6 04 E0 B9 DD
|
||||
-----BEGIN PGP SIGNATURE-----
|
||||
Version: GnuPG v1.4.8 (SunOS)
|
||||
Comment: Processed by Mailcrypt 3.5.8 <http://mailcrypt.sourceforge.net/>
|
||||
|
||||
iQCVAwUBSH4KO2B90JXwhOSJAQKtqQP9ERwSXpbP69l4JSrunG29Rhu2F3r83zu3
|
||||
GAKpFu4HwkVnIStLQ4o3tsqG9uKrVDbRMa187eSwHmlXXIMwDlkCKNsDFxvdLDZz
|
||||
kbTYDibspYSw6CjwOUSTXifK9P7ho4Q7PtsRnJ8T1IMlGJlwg39Rxd+mpEO/if3q
|
||||
ExIwM1aBbAs=3D
|
||||
=3Du8si
|
||||
-----END PGP SIGNATURE-----
|
||||
|
||||
88
debuggers/openocd/jimtcl/freebsd/salvatore.txt
Normal file
88
debuggers/openocd/jimtcl/freebsd/salvatore.txt
Normal file
@ -0,0 +1,88 @@
|
||||
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
Received: by 10.100.7.20 with SMTP id 20cs113143ang;
|
||||
Wed, 16 Jul 2008 08:41:11 -0700 (PDT)
|
||||
Received: by 10.142.140.15 with SMTP id n15mr127048wfd.84.1216222870242;
|
||||
Wed, 16 Jul 2008 08:41:10 -0700 (PDT)
|
||||
Return-Path: <antirez@gmail.com>
|
||||
Received: from cpanel5.proisp.no (cpanel5.proisp.no [209.85.100.29])
|
||||
by mx.google.com with ESMTP id 29si7397124wfg.0.2008.07.16.08.41.08;
|
||||
Wed, 16 Jul 2008 08:41:10 -0700 (PDT)
|
||||
Received-SPF: neutral (google.com: 209.85.100.29 is neither permitted nor denied by domain of antirez@gmail.com) client-ip=209.85.100.29;
|
||||
Authentication-Results: mx.google.com; spf=neutral (google.com: 209.85.100.29 is neither permitted nor denied by domain of antirez@gmail.com) smtp.mail=antirez@gmail.com; dkim=pass (test mode) header.i=@gmail.com
|
||||
Received: from fg-out-1718.google.com ([72.14.220.155]:16058)
|
||||
by cpanel5.proisp.no with esmtp (Exim 4.69)
|
||||
(envelope-from <antirez@gmail.com>)
|
||||
id 1KJ97g-0004yX-1W
|
||||
for oyvind.harboe@zylin.com; Wed, 16 Jul 2008 17:40:59 +0200
|
||||
Received: by fg-out-1718.google.com with SMTP id l27so3985052fgb.19
|
||||
for <oyvind.harboe@zylin.com>; Wed, 16 Jul 2008 08:40:59 -0700 (PDT)
|
||||
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
|
||||
d=gmail.com; s=gamma;
|
||||
h=domainkey-signature:received:received:message-id:date:from:to
|
||||
:subject:cc:in-reply-to:mime-version:content-type
|
||||
:content-transfer-encoding:content-disposition:references;
|
||||
bh=/aWDZQfgMBPqomYWZ2AUKOhhGMju+bwnSBbKL8MBonA=;
|
||||
b=i0P3OKDopn/vHfa5ZrUvBjuPBnj43GMw8FOXKjxM/IfvywJParYqBS2Vmlw8RTndFg
|
||||
J5wwxXf5056cZu/GbKbj8xLfylFfSInVaO7OnDutA3CeX1iU35my1DU6l9W6ILkLiT1P
|
||||
Azi3L27rFQrzau/s53VU/UVELc3WckWdu1a1k=
|
||||
DomainKey-Signature: a=rsa-sha1; c=nofws;
|
||||
d=gmail.com; s=gamma;
|
||||
h=message-id:date:from:to:subject:cc:in-reply-to:mime-version
|
||||
:content-type:content-transfer-encoding:content-disposition
|
||||
:references;
|
||||
b=ww2MIz9svJttgS8mTRBhEX8Isveugn2hl3sMcgh0hZ1+ln8YbiysxYxZkdddewWm02
|
||||
WXsWgSgwy7MIPAUK1tNjzgkZ2l789SdrAtBCmqmRWJJI+ESTqbHMz8cqW+QRVP/A9Dfm
|
||||
8+AR85DHi7SOB0mdHtq9fsavZReUdaSIgy6F4=
|
||||
Received: by 10.86.80.5 with SMTP id d5mr2284433fgb.19.1216222858224;
|
||||
Wed, 16 Jul 2008 08:40:58 -0700 (PDT)
|
||||
Received: by 10.86.50.18 with HTTP; Wed, 16 Jul 2008 08:40:58 -0700 (PDT)
|
||||
Message-ID: <c6114db60807160840n62186f46w7cdc1bbec91186ca@mail.gmail.com>
|
||||
Date: Wed, 16 Jul 2008 17:40:58 +0200
|
||||
From: "Salvatore Sanfilippo" <antirez@gmail.com>
|
||||
To: "=?ISO-8859-1?Q?=D8yvind_Harboe?=" <oyvind.harboe@zylin.com>
|
||||
Subject: Re: Change Jim Tcl license
|
||||
Cc: jim-devel@lists.berlios.de, patthoyts@users.sf.net, andrew@lunn.ch,
|
||||
openocd@duaneellis.com, uklein@klein-messgeraete.de,
|
||||
ml-jim@qiao.in-berlin.de
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=ISO-8859-1
|
||||
Content-Transfer-Encoding: 7bit
|
||||
Content-Disposition: inline
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
X-Spam-Status: No, score=-2.6
|
||||
X-Spam-Score: -25
|
||||
X-Spam-Bar: --
|
||||
X-Spam-Flag: NO
|
||||
X-AntiAbuse: This header was added to track abuse, please include it with any abuse report
|
||||
X-AntiAbuse: Primary Hostname - cpanel5.proisp.no
|
||||
X-AntiAbuse: Original Domain - zylin.com
|
||||
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
|
||||
X-AntiAbuse: Sender Address Domain - gmail.com
|
||||
X-Source:
|
||||
X-Source-Args:
|
||||
X-Source-Dir:
|
||||
|
||||
I agree to permit my contributions to the Jim project to be
|
||||
re-licensed under a BSD compatible license.
|
||||
|
||||
Since I'm currently the top contributor if it's safer from
|
||||
the legal point of view I can also put a tar.gz of the current
|
||||
Jim source code with a BSD "LICENSE" file on my website.
|
||||
|
||||
Otherwise I can sign by hand a letter and send a digitalized
|
||||
image here.
|
||||
|
||||
Ciao,
|
||||
Salvatore
|
||||
|
||||
--
|
||||
Salvatore 'antirez' Sanfilippo
|
||||
http://antirez.com
|
||||
|
||||
Organizations which design systems are constrained to produce designs
|
||||
which are copies of the communication structures of these
|
||||
organizations.
|
||||
|
||||
Conway's Law
|
||||
73
debuggers/openocd/jimtcl/freebsd/uwe.txt
Normal file
73
debuggers/openocd/jimtcl/freebsd/uwe.txt
Normal file
@ -0,0 +1,73 @@
|
||||
Delivered-To: oyvindharboe@gmail.com
|
||||
Received: by 10.100.7.20 with SMTP id 20cs89014ang;
|
||||
Wed, 16 Jul 2008 01:58:32 -0700 (PDT)
|
||||
Received: by 10.142.125.9 with SMTP id x9mr5028534wfc.123.1216198711465;
|
||||
Wed, 16 Jul 2008 01:58:31 -0700 (PDT)
|
||||
Return-Path: <wiederling@googlemail.com>
|
||||
Received: from cpanel5.proisp.no (cpanel5.proisp.no [209.85.100.29])
|
||||
by mx.google.com with ESMTP id 30si6756166wfa.10.2008.07.16.01.58.29;
|
||||
Wed, 16 Jul 2008 01:58:31 -0700 (PDT)
|
||||
Received-SPF: neutral (google.com: 209.85.100.29 is neither permitted nor denied by domain of wiederling@googlemail.com) client-ip=209.85.100.29;
|
||||
Authentication-Results: mx.google.com; spf=neutral (google.com: 209.85.100.29 is neither permitted nor denied by domain of wiederling@googlemail.com) smtp.mail=wiederling@googlemail.com; dkim=pass (test mode) header.i=@googlemail.com
|
||||
Received: from wr-out-0506.google.com ([64.233.184.233]:51225)
|
||||
by cpanel5.proisp.no with esmtp (Exim 4.69)
|
||||
(envelope-from <wiederling@googlemail.com>)
|
||||
id 1KJ2q7-00057b-IR
|
||||
for oyvind.harboe@zylin.com; Wed, 16 Jul 2008 10:58:24 +0200
|
||||
Received: by wr-out-0506.google.com with SMTP id c8so2209154wra.27
|
||||
for <oyvind.harboe@zylin.com>; Wed, 16 Jul 2008 01:58:25 -0700 (PDT)
|
||||
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed;
|
||||
d=googlemail.com; s=gamma;
|
||||
h=domainkey-signature:received:received:message-id:date:from:to
|
||||
:subject:cc:in-reply-to:mime-version:content-type
|
||||
:content-transfer-encoding:content-disposition:references;
|
||||
bh=VxcH0g2H5iLUo27gqJiqrlY4uVbN1NFE4skyMKqysPM=;
|
||||
b=JPK53r6LQ6GqBCG1kfVYyTPuPuVhlBrbzQ8oSBwpwuwwB7t3CSv+c75jRjb/n3y8mi
|
||||
gN1r6noZucK9ZpRZiHxYZpHVhYFcWbZ+ZXM75H2qIFfl4YDzfgg/Ub7CzoR2LskuBsRk
|
||||
DMH2LnyAYf+Om2YAKJdkoMnGbPMDMFSrNHeIc=
|
||||
DomainKey-Signature: a=rsa-sha1; c=nofws;
|
||||
d=googlemail.com; s=gamma;
|
||||
h=message-id:date:from:to:subject:cc:in-reply-to:mime-version
|
||||
:content-type:content-transfer-encoding:content-disposition
|
||||
:references;
|
||||
b=VAGlxpb1YGbex/eaS0tQgWvH/lWHzgD5R/rxjshVSwZJOStwqMA1F5jNQgybQFIn1F
|
||||
zWoiAV81uWMzBEGYab7SGsStWLxovcBSgi9NL+XqwAkhBdrWjgFPvpBHn5PvgOOXEhGH
|
||||
EGhjrY8qp2LSxhFcW3/DvgObhBBKtY1J+qzvA=
|
||||
Received: by 10.90.115.17 with SMTP id n17mr1231758agc.90.1216198705850;
|
||||
Wed, 16 Jul 2008 01:58:25 -0700 (PDT)
|
||||
Received: by 10.90.105.18 with HTTP; Wed, 16 Jul 2008 01:58:25 -0700 (PDT)
|
||||
Message-ID: <1af31b6f0807160158o295303adh43abdd34fbe8ec99@mail.gmail.com>
|
||||
Date: Wed, 16 Jul 2008 10:58:25 +0200
|
||||
From: "Uwe Klein" <wiederling@googlemail.com>
|
||||
To: "=?ISO-8859-1?Q?=D8yvind_Harboe?=" <oyvind.harboe@zylin.com>
|
||||
Subject: Re: [Jim-devel] Change Jim Tcl license
|
||||
Cc: jim-devel@lists.berlios.de, patthoyts@users.sf.net, andrew@lunn.ch,
|
||||
uklein@klein-messgeraete.de, antirez@gmail.com,
|
||||
openocd@duaneellis.com, ml-jim@qiao.in-berlin.de
|
||||
In-Reply-To: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=ISO-8859-1
|
||||
Content-Transfer-Encoding: 7bit
|
||||
Content-Disposition: inline
|
||||
References: <c09652430807160034pd4a5b0q18f69a219827e111@mail.gmail.com>
|
||||
X-Spam-Status: No, score=-2.6
|
||||
X-Spam-Score: -25
|
||||
X-Spam-Bar: --
|
||||
X-Spam-Flag: NO
|
||||
X-AntiAbuse: This header was added to track abuse, please include it with any abuse report
|
||||
X-AntiAbuse: Primary Hostname - cpanel5.proisp.no
|
||||
X-AntiAbuse: Original Domain - zylin.com
|
||||
X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12]
|
||||
X-AntiAbuse: Sender Address Domain - googlemail.com
|
||||
X-Source:
|
||||
X-Source-Args:
|
||||
X-Source-Dir:
|
||||
|
||||
> If you have contributed to Jim Tcl, please reply to this email
|
||||
> that you agree that we can switch Jim Tcl to a FreeBSD license.
|
||||
|
||||
For Uwe Klein <uklein@klein-messgeraete.de>
|
||||
|
||||
This is OK with me.
|
||||
|
||||
uwe
|
||||
185
debuggers/openocd/jimtcl/glob.tcl
Normal file
185
debuggers/openocd/jimtcl/glob.tcl
Normal file
@ -0,0 +1,185 @@
|
||||
# Implements a mostly Tcl-compatible glob command based on readdir
|
||||
#
|
||||
# (c) 2008 Steve Bennett <steveb@workware.net.au>
|
||||
# (c) 2012 Alexander Shpilkin <ashpilkin@gmail.com>
|
||||
#
|
||||
# See LICENCE in this directory for licensing.
|
||||
|
||||
package require readdir
|
||||
|
||||
# Return a list of all entries in $dir that match the pattern.
|
||||
proc glob.globdir {dir pattern} {
|
||||
set result {}
|
||||
set files [readdir $dir]
|
||||
lappend files . ..
|
||||
|
||||
foreach name $files {
|
||||
if {[string match $pattern $name]} {
|
||||
# Starting dots match only explicitly
|
||||
if {[string index $name 0] eq "." && [string index $pattern 0] ne "."} {
|
||||
continue
|
||||
}
|
||||
lappend result $name
|
||||
}
|
||||
}
|
||||
|
||||
return $result
|
||||
}
|
||||
|
||||
# Return the list of patterns resulting from expanding any braced
|
||||
# alternatives inside the given pattern, prepending the unprocessed
|
||||
# part of the pattern. Does _not_ handle escaped braces or commas.
|
||||
proc glob.explode {pattern} {
|
||||
set oldexp {}
|
||||
set newexp {""}
|
||||
|
||||
while 1 {
|
||||
set oldexp $newexp
|
||||
set newexp {}
|
||||
set ob [string first \{ $pattern]
|
||||
set cb [string first \} $pattern]
|
||||
|
||||
if {$ob < $cb && $ob != -1} {
|
||||
set mid [string range $pattern 0 $ob-1]
|
||||
set subexp [lassign [glob.explode [string range $pattern $ob+1 end]] pattern]
|
||||
if {$pattern eq ""} {
|
||||
error "unmatched open brace in glob pattern"
|
||||
}
|
||||
set pattern [string range $pattern 1 end]
|
||||
|
||||
foreach subs $subexp {
|
||||
foreach sub [split $subs ,] {
|
||||
foreach old $oldexp {
|
||||
lappend newexp $old$mid$sub
|
||||
}
|
||||
}
|
||||
}
|
||||
} elseif {$cb != -1} {
|
||||
set suf [string range $pattern 0 $cb-1]
|
||||
set rest [string range $pattern $cb end]
|
||||
break
|
||||
} else {
|
||||
set suf $pattern
|
||||
set rest ""
|
||||
break
|
||||
}
|
||||
}
|
||||
|
||||
foreach old $oldexp {
|
||||
lappend newexp $old$suf
|
||||
}
|
||||
linsert $newexp 0 $rest
|
||||
}
|
||||
|
||||
# Core glob implementation. Returns a list of files/directories inside
|
||||
# base matching pattern, in {realname name} pairs.
|
||||
proc glob.glob {base pattern} {
|
||||
set dir [file dirname $pattern]
|
||||
if {$pattern eq $dir || $pattern eq ""} {
|
||||
return [list [file join $base $dir] $pattern]
|
||||
} elseif {$pattern eq [file tail $pattern]} {
|
||||
set dir ""
|
||||
}
|
||||
|
||||
# Recursively expand the parent directory
|
||||
set dirlist [glob.glob $base $dir]
|
||||
set pattern [file tail $pattern]
|
||||
|
||||
# Collect the files/directories
|
||||
set result {}
|
||||
foreach {realdir dir} $dirlist {
|
||||
if {![file isdir $realdir]} {
|
||||
continue
|
||||
}
|
||||
if {[string index $dir end] ne "/" && $dir ne ""} {
|
||||
append dir /
|
||||
}
|
||||
foreach name [glob.globdir $realdir $pattern] {
|
||||
lappend result [file join $realdir $name] $dir$name
|
||||
}
|
||||
}
|
||||
return $result
|
||||
}
|
||||
|
||||
# Implements the Tcl glob command
|
||||
#
|
||||
# Usage: glob ?-nocomplain? ?-directory dir? ?--? pattern ...
|
||||
#
|
||||
# Patterns use 'string match' (glob) pattern matching for each
|
||||
# directory level, plus support for braced alternations.
|
||||
#
|
||||
# e.g. glob {te[a-e]*/*.{c,tcl}}
|
||||
#
|
||||
# Note: files starting with . will only be returned if matching component
|
||||
# of the pattern starts with .
|
||||
proc glob {args} {
|
||||
set nocomplain 0
|
||||
set base ""
|
||||
|
||||
set n 0
|
||||
foreach arg $args {
|
||||
if {[info exists param]} {
|
||||
set $param $arg
|
||||
unset param
|
||||
incr n
|
||||
continue
|
||||
}
|
||||
switch -glob -- $arg {
|
||||
-d* {
|
||||
set switch $arg
|
||||
set param base
|
||||
}
|
||||
-n* {
|
||||
set nocomplain 1
|
||||
}
|
||||
-t* {
|
||||
# Ignored for Tcl compatibility
|
||||
}
|
||||
|
||||
-* {
|
||||
return -code error "bad option \"$switch\": must be -directory, -nocomplain, -tails, or --"
|
||||
}
|
||||
-- {
|
||||
incr n
|
||||
break
|
||||
}
|
||||
* {
|
||||
break
|
||||
}
|
||||
}
|
||||
incr n
|
||||
}
|
||||
if {[info exists param]} {
|
||||
return -code error "missing argument to \"$switch\""
|
||||
}
|
||||
if {[llength $args] <= $n} {
|
||||
return -code error "wrong # args: should be \"glob ?options? pattern ?pattern ...?\""
|
||||
}
|
||||
|
||||
set args [lrange $args $n end]
|
||||
|
||||
set result {}
|
||||
foreach pattern $args {
|
||||
set pattern [string map {
|
||||
\\\\ \x01 \\\{ \x02 \\\} \x03 \\, \x04
|
||||
} $pattern]
|
||||
set patexps [lassign [glob.explode $pattern] rest]
|
||||
if {$rest ne ""} {
|
||||
return -code error "unmatched close brace in glob pattern"
|
||||
}
|
||||
foreach patexp $patexps {
|
||||
set patexp [string map {
|
||||
\x01 \\\\ \x02 \{ \x03 \} \x04 ,
|
||||
} $patexp]
|
||||
foreach {realname name} [glob.glob $base $patexp] {
|
||||
lappend result $name
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {!$nocomplain && [llength $result] == 0} {
|
||||
return -code error "no files matched glob patterns"
|
||||
}
|
||||
|
||||
return $result
|
||||
}
|
||||
27
debuggers/openocd/jimtcl/initjimsh.tcl
Normal file
27
debuggers/openocd/jimtcl/initjimsh.tcl
Normal file
@ -0,0 +1,27 @@
|
||||
# This pseudo-package is loaded from jimsh to add additional
|
||||
# paths to $auto_path and to source ~/.jimrc
|
||||
|
||||
proc _jimsh_init {} {
|
||||
rename _jimsh_init {}
|
||||
|
||||
# Add to the standard auto_path
|
||||
lappend p {*}[split [env JIMLIB {}] $::tcl_platform(pathSeparator)]
|
||||
lappend p {*}$::auto_path
|
||||
lappend p [file dirname [info nameofexecutable]]
|
||||
set ::auto_path $p
|
||||
|
||||
if {$::tcl_interactive && [env HOME {}] ne ""} {
|
||||
foreach src {.jimrc jimrc.tcl} {
|
||||
if {[file exists [env HOME]/$src]} {
|
||||
uplevel #0 source [env HOME]/$src
|
||||
break
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
if {$tcl_platform(platform) eq "windows"} {
|
||||
set jim_argv0 [string map {\\ /} $jim_argv0]
|
||||
}
|
||||
|
||||
_jimsh_init
|
||||
1404
debuggers/openocd/jimtcl/jim-aio.c
Normal file
1404
debuggers/openocd/jimtcl/jim-aio.c
Normal file
File diff suppressed because it is too large
Load Diff
243
debuggers/openocd/jimtcl/jim-array.c
Normal file
243
debuggers/openocd/jimtcl/jim-array.c
Normal file
@ -0,0 +1,243 @@
|
||||
|
||||
/*
|
||||
* Implements the array command for jim
|
||||
*
|
||||
* (c) 2008 Steve Bennett <steveb@workware.net.au>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*
|
||||
* Based on code originally from Tcl 6.7:
|
||||
*
|
||||
* Copyright 1987-1991 Regents of the University of California
|
||||
* Permission to use, copy, modify, and distribute this
|
||||
* software and its documentation for any purpose and without
|
||||
* fee is hereby granted, provided that the above copyright
|
||||
* notice appear in all copies. The University of California
|
||||
* makes no representations about the suitability of this
|
||||
* software for any purpose. It is provided "as is" without
|
||||
* express or implied warranty.
|
||||
*/
|
||||
|
||||
#include <limits.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#include <jim-subcmd.h>
|
||||
|
||||
static int array_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
/* Just a regular [info exists] */
|
||||
Jim_SetResultInt(interp, Jim_GetVariable(interp, argv[0], 0) != 0);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE);
|
||||
|
||||
if (!objPtr) {
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) {
|
||||
/* Optimise the "all" case */
|
||||
if (Jim_IsList(objPtr)) {
|
||||
if (Jim_ListLength(interp, objPtr) % 2 != 0) {
|
||||
/* A list with an odd number of elements */
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
else if (Jim_DictSize(interp, objPtr) < 0) {
|
||||
/* Can't be converted to a dictionary */
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResult(interp, objPtr);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
/* Return a list of keys and values where the keys match the pattern */
|
||||
return Jim_DictValues(interp, objPtr, argv[1]);
|
||||
}
|
||||
|
||||
static int array_cmd_names(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE);
|
||||
|
||||
if (!objPtr) {
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
return Jim_DictKeys(interp, objPtr, argc == 1 ? NULL : argv[1]);
|
||||
}
|
||||
|
||||
static int array_cmd_unset(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int i;
|
||||
int len;
|
||||
Jim_Obj *resultObj;
|
||||
Jim_Obj *objPtr;
|
||||
Jim_Obj **dictValuesObj;
|
||||
|
||||
if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) {
|
||||
/* Unset the whole array */
|
||||
Jim_UnsetVariable(interp, argv[0], JIM_NONE);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE);
|
||||
|
||||
if (Jim_DictPairs(interp, objPtr, &dictValuesObj, &len) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
/* Create a new object with the values which don't match */
|
||||
resultObj = Jim_NewDictObj(interp, NULL, 0);
|
||||
|
||||
for (i = 0; i < len; i += 2) {
|
||||
if (!Jim_StringMatchObj(interp, argv[1], dictValuesObj[i], 0)) {
|
||||
Jim_DictAddElement(interp, resultObj, dictValuesObj[i], dictValuesObj[i + 1]);
|
||||
}
|
||||
}
|
||||
Jim_Free(dictValuesObj);
|
||||
|
||||
Jim_SetVariable(interp, argv[0], resultObj);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int array_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *objPtr;
|
||||
int len = 0;
|
||||
|
||||
/* Not found means zero length */
|
||||
objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE);
|
||||
if (objPtr) {
|
||||
len = Jim_DictSize(interp, objPtr);
|
||||
if (len < 0) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
|
||||
Jim_SetResultInt(interp, len);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int array_cmd_set(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int i;
|
||||
int len;
|
||||
Jim_Obj *listObj = argv[1];
|
||||
Jim_Obj *dictObj;
|
||||
|
||||
len = Jim_ListLength(interp, listObj);
|
||||
if (len % 2) {
|
||||
Jim_SetResultString(interp, "list must have an even number of elements", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
dictObj = Jim_GetVariable(interp, argv[0], JIM_UNSHARED);
|
||||
if (!dictObj) {
|
||||
/* Doesn't exist, so just set the list directly */
|
||||
return Jim_SetVariable(interp, argv[0], listObj);
|
||||
}
|
||||
|
||||
if (Jim_IsShared(dictObj)) {
|
||||
dictObj = Jim_DuplicateObj(interp, dictObj);
|
||||
}
|
||||
|
||||
for (i = 0; i < len; i += 2) {
|
||||
Jim_Obj *nameObj;
|
||||
Jim_Obj *valueObj;
|
||||
|
||||
Jim_ListIndex(interp, listObj, i, &nameObj, JIM_NONE);
|
||||
Jim_ListIndex(interp, listObj, i + 1, &valueObj, JIM_NONE);
|
||||
|
||||
Jim_DictAddElement(interp, dictObj, nameObj, valueObj);
|
||||
}
|
||||
return Jim_SetVariable(interp, argv[0], dictObj);
|
||||
}
|
||||
|
||||
static const jim_subcmd_type array_command_table[] = {
|
||||
{ "exists",
|
||||
"arrayName",
|
||||
array_cmd_exists,
|
||||
1,
|
||||
1,
|
||||
/* Description: Does array exist? */
|
||||
},
|
||||
{ "get",
|
||||
"arrayName ?pattern?",
|
||||
array_cmd_get,
|
||||
1,
|
||||
2,
|
||||
/* Description: Array contents as name value list */
|
||||
},
|
||||
{ "names",
|
||||
"arrayName ?pattern?",
|
||||
array_cmd_names,
|
||||
1,
|
||||
2,
|
||||
/* Description: Array keys as a list */
|
||||
},
|
||||
{ "set",
|
||||
"arrayName list",
|
||||
array_cmd_set,
|
||||
2,
|
||||
2,
|
||||
/* Description: Set array from list */
|
||||
},
|
||||
{ "size",
|
||||
"arrayName",
|
||||
array_cmd_size,
|
||||
1,
|
||||
1,
|
||||
/* Description: Number of elements in array */
|
||||
},
|
||||
{ "unset",
|
||||
"arrayName ?pattern?",
|
||||
array_cmd_unset,
|
||||
1,
|
||||
2,
|
||||
/* Description: Unset elements of an array */
|
||||
},
|
||||
{ NULL
|
||||
}
|
||||
};
|
||||
|
||||
int Jim_arrayInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "array", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
165
debuggers/openocd/jimtcl/jim-clock.c
Normal file
165
debuggers/openocd/jimtcl/jim-clock.c
Normal file
@ -0,0 +1,165 @@
|
||||
|
||||
/*
|
||||
* tcl_clock.c
|
||||
*
|
||||
* Implements the clock command
|
||||
*/
|
||||
|
||||
/* For strptime() */
|
||||
#ifndef _XOPEN_SOURCE
|
||||
#define _XOPEN_SOURCE 500
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <time.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim-subcmd.h>
|
||||
|
||||
#ifdef HAVE_SYS_TIME_H
|
||||
#include <sys/time.h>
|
||||
#endif
|
||||
|
||||
static int clock_cmd_format(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
/* How big is big enough? */
|
||||
char buf[100];
|
||||
time_t t;
|
||||
long seconds;
|
||||
|
||||
const char *format = "%a %b %d %H:%M:%S %Z %Y";
|
||||
|
||||
if (argc == 2 || (argc == 3 && !Jim_CompareStringImmediate(interp, argv[1], "-format"))) {
|
||||
return -1;
|
||||
}
|
||||
|
||||
if (argc == 3) {
|
||||
format = Jim_String(argv[2]);
|
||||
}
|
||||
|
||||
if (Jim_GetLong(interp, argv[0], &seconds) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
t = seconds;
|
||||
|
||||
strftime(buf, sizeof(buf), format, localtime(&t));
|
||||
|
||||
Jim_SetResultString(interp, buf, -1);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
#ifdef HAVE_STRPTIME
|
||||
static int clock_cmd_scan(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
char *pt;
|
||||
struct tm tm;
|
||||
time_t now = time(0);
|
||||
|
||||
if (!Jim_CompareStringImmediate(interp, argv[1], "-format")) {
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Initialise with the current date/time */
|
||||
localtime_r(&now, &tm);
|
||||
|
||||
pt = strptime(Jim_String(argv[0]), Jim_String(argv[2]), &tm);
|
||||
if (pt == 0 || *pt != 0) {
|
||||
Jim_SetResultString(interp, "Failed to parse time according to format", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
/* Now convert into a time_t */
|
||||
Jim_SetResultInt(interp, mktime(&tm));
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
static int clock_cmd_seconds(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_SetResultInt(interp, time(NULL));
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int clock_cmd_micros(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct timeval tv;
|
||||
|
||||
gettimeofday(&tv, NULL);
|
||||
|
||||
Jim_SetResultInt(interp, (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int clock_cmd_millis(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct timeval tv;
|
||||
|
||||
gettimeofday(&tv, NULL);
|
||||
|
||||
Jim_SetResultInt(interp, (jim_wide) tv.tv_sec * 1000 + tv.tv_usec / 1000);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static const jim_subcmd_type clock_command_table[] = {
|
||||
{ "seconds",
|
||||
NULL,
|
||||
clock_cmd_seconds,
|
||||
0,
|
||||
0,
|
||||
/* Description: Returns the current time as seconds since the epoch */
|
||||
},
|
||||
{ "clicks",
|
||||
NULL,
|
||||
clock_cmd_micros,
|
||||
0,
|
||||
0,
|
||||
/* Description: Returns the current time in 'clicks' */
|
||||
},
|
||||
{ "microseconds",
|
||||
NULL,
|
||||
clock_cmd_micros,
|
||||
0,
|
||||
0,
|
||||
/* Description: Returns the current time in microseconds */
|
||||
},
|
||||
{ "milliseconds",
|
||||
NULL,
|
||||
clock_cmd_millis,
|
||||
0,
|
||||
0,
|
||||
/* Description: Returns the current time in milliseconds */
|
||||
},
|
||||
{ "format",
|
||||
"seconds ?-format format?",
|
||||
clock_cmd_format,
|
||||
1,
|
||||
3,
|
||||
/* Description: Format the given time */
|
||||
},
|
||||
#ifdef HAVE_STRPTIME
|
||||
{ "scan",
|
||||
"str -format format",
|
||||
clock_cmd_scan,
|
||||
3,
|
||||
3,
|
||||
/* Description: Determine the time according to the given format */
|
||||
},
|
||||
#endif
|
||||
{ NULL }
|
||||
};
|
||||
|
||||
int Jim_clockInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "clock", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "clock", Jim_SubCmdProc, (void *)clock_command_table, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
2
debuggers/openocd/jimtcl/jim-config.h.in
Normal file
2
debuggers/openocd/jimtcl/jim-config.h.in
Normal file
@ -0,0 +1,2 @@
|
||||
/* Public autoconf settings */
|
||||
@DEFINE_HAVE_LONG_LONG@
|
||||
760
debuggers/openocd/jimtcl/jim-eventloop.c
Normal file
760
debuggers/openocd/jimtcl/jim-eventloop.c
Normal file
@ -0,0 +1,760 @@
|
||||
|
||||
/* Jim - A small embeddable Tcl interpreter
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
* Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
|
||||
* Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
|
||||
* Copyright 2008 oharboe - Øyvind Harboe - oyvind.harboe@zylin.com
|
||||
* Copyright 2008 Andrew Lunn <andrew@lunn.ch>
|
||||
* Copyright 2008 Duane Ellis <openocd@duaneellis.com>
|
||||
* Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
**/
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim.h>
|
||||
#include <jim-eventloop.h>
|
||||
|
||||
/* POSIX includes */
|
||||
#include <sys/time.h>
|
||||
#include <sys/types.h>
|
||||
#include <string.h>
|
||||
#include <unistd.h>
|
||||
#include <errno.h>
|
||||
|
||||
#if defined(__MINGW32__)
|
||||
#include <windows.h>
|
||||
#include <winsock.h>
|
||||
#define msleep Sleep
|
||||
#ifndef HAVE_USLEEP
|
||||
#define usleep(US) msleep((US) / 1000)
|
||||
#endif
|
||||
#else
|
||||
#include <sys/select.h>
|
||||
|
||||
#ifndef HAVE_USLEEP
|
||||
/* XXX: Implement this in terms of select() or nanosleep() */
|
||||
#define usleep(US)
|
||||
#endif
|
||||
#define msleep(MS) sleep((MS) / 1000); usleep(((MS) % 1000) * 1000);
|
||||
#endif
|
||||
|
||||
/* --- */
|
||||
|
||||
/* File event structure */
|
||||
typedef struct Jim_FileEvent
|
||||
{
|
||||
FILE *handle;
|
||||
int mask; /* one of JIM_EVENT_(READABLE|WRITABLE|EXCEPTION) */
|
||||
Jim_FileProc *fileProc;
|
||||
Jim_EventFinalizerProc *finalizerProc;
|
||||
void *clientData;
|
||||
struct Jim_FileEvent *next;
|
||||
} Jim_FileEvent;
|
||||
|
||||
/* Time event structure */
|
||||
typedef struct Jim_TimeEvent
|
||||
{
|
||||
jim_wide id; /* time event identifier. */
|
||||
int mode; /* restart, repetitive .. UK */
|
||||
long initialms; /* initial relativ timer value UK */
|
||||
long when_sec; /* seconds */
|
||||
long when_ms; /* milliseconds */
|
||||
Jim_TimeProc *timeProc;
|
||||
Jim_EventFinalizerProc *finalizerProc;
|
||||
void *clientData;
|
||||
struct Jim_TimeEvent *next;
|
||||
} Jim_TimeEvent;
|
||||
|
||||
/* Per-interp stucture containing the state of the event loop */
|
||||
typedef struct Jim_EventLoop
|
||||
{
|
||||
jim_wide timeEventNextId;
|
||||
Jim_FileEvent *fileEventHead;
|
||||
Jim_TimeEvent *timeEventHead;
|
||||
int suppress_bgerror; /* bgerror returned break, so don't call it again */
|
||||
} Jim_EventLoop;
|
||||
|
||||
static void JimAfterTimeHandler(Jim_Interp *interp, void *clientData);
|
||||
static void JimAfterTimeEventFinalizer(Jim_Interp *interp, void *clientData);
|
||||
|
||||
int Jim_EvalObjBackground(Jim_Interp *interp, Jim_Obj *scriptObjPtr)
|
||||
{
|
||||
Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
|
||||
Jim_CallFrame *savedFramePtr;
|
||||
int retval;
|
||||
|
||||
savedFramePtr = interp->framePtr;
|
||||
interp->framePtr = interp->topFramePtr;
|
||||
retval = Jim_EvalObj(interp, scriptObjPtr);
|
||||
interp->framePtr = savedFramePtr;
|
||||
/* Try to report the error (if any) via the bgerror proc */
|
||||
if (retval != JIM_OK && !eventLoop->suppress_bgerror) {
|
||||
Jim_Obj *objv[2];
|
||||
int rc = JIM_ERR;
|
||||
|
||||
objv[0] = Jim_NewStringObj(interp, "bgerror", -1);
|
||||
objv[1] = Jim_GetResult(interp);
|
||||
Jim_IncrRefCount(objv[0]);
|
||||
Jim_IncrRefCount(objv[1]);
|
||||
if (Jim_GetCommand(interp, objv[0], JIM_NONE) == NULL || (rc = Jim_EvalObjVector(interp, 2, objv)) != JIM_OK) {
|
||||
if (rc == JIM_BREAK) {
|
||||
/* No more bgerror calls */
|
||||
eventLoop->suppress_bgerror++;
|
||||
}
|
||||
else {
|
||||
/* Report the error to stderr. */
|
||||
Jim_MakeErrorMessage(interp);
|
||||
fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp)));
|
||||
/* And reset the result */
|
||||
Jim_SetResultString(interp, "", -1);
|
||||
}
|
||||
}
|
||||
Jim_DecrRefCount(interp, objv[0]);
|
||||
Jim_DecrRefCount(interp, objv[1]);
|
||||
}
|
||||
return retval;
|
||||
}
|
||||
|
||||
|
||||
void Jim_CreateFileHandler(Jim_Interp *interp, FILE * handle, int mask,
|
||||
Jim_FileProc * proc, void *clientData, Jim_EventFinalizerProc * finalizerProc)
|
||||
{
|
||||
Jim_FileEvent *fe;
|
||||
Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
|
||||
|
||||
fe = Jim_Alloc(sizeof(*fe));
|
||||
fe->handle = handle;
|
||||
fe->mask = mask;
|
||||
fe->fileProc = proc;
|
||||
fe->finalizerProc = finalizerProc;
|
||||
fe->clientData = clientData;
|
||||
fe->next = eventLoop->fileEventHead;
|
||||
eventLoop->fileEventHead = fe;
|
||||
}
|
||||
|
||||
void Jim_DeleteFileHandler(Jim_Interp *interp, FILE * handle)
|
||||
{
|
||||
Jim_FileEvent *fe, *prev = NULL;
|
||||
Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
|
||||
|
||||
fe = eventLoop->fileEventHead;
|
||||
while (fe) {
|
||||
if (fe->handle == handle) {
|
||||
if (prev == NULL)
|
||||
eventLoop->fileEventHead = fe->next;
|
||||
else
|
||||
prev->next = fe->next;
|
||||
if (fe->finalizerProc)
|
||||
fe->finalizerProc(interp, fe->clientData);
|
||||
Jim_Free(fe);
|
||||
return;
|
||||
}
|
||||
prev = fe;
|
||||
fe = fe->next;
|
||||
}
|
||||
}
|
||||
|
||||
static void JimGetTime(long *seconds, long *milliseconds)
|
||||
{
|
||||
struct timeval tv;
|
||||
|
||||
gettimeofday(&tv, NULL);
|
||||
*seconds = tv.tv_sec;
|
||||
*milliseconds = tv.tv_usec / 1000;
|
||||
}
|
||||
|
||||
jim_wide Jim_CreateTimeHandler(Jim_Interp *interp, jim_wide milliseconds,
|
||||
Jim_TimeProc * proc, void *clientData, Jim_EventFinalizerProc * finalizerProc)
|
||||
{
|
||||
Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
|
||||
jim_wide id = eventLoop->timeEventNextId++;
|
||||
Jim_TimeEvent *te, *e, *prev;
|
||||
long cur_sec, cur_ms;
|
||||
|
||||
JimGetTime(&cur_sec, &cur_ms);
|
||||
|
||||
te = Jim_Alloc(sizeof(*te));
|
||||
te->id = id;
|
||||
te->mode = 0;
|
||||
te->initialms = milliseconds;
|
||||
te->when_sec = cur_sec + milliseconds / 1000;
|
||||
te->when_ms = cur_ms + milliseconds % 1000;
|
||||
if (te->when_ms >= 1000) {
|
||||
te->when_sec++;
|
||||
te->when_ms -= 1000;
|
||||
}
|
||||
te->timeProc = proc;
|
||||
te->finalizerProc = finalizerProc;
|
||||
te->clientData = clientData;
|
||||
|
||||
/* Add to the appropriate place in the list */
|
||||
if (eventLoop->timeEventHead) {
|
||||
prev = NULL;
|
||||
for (e = eventLoop->timeEventHead; e; e = e->next) {
|
||||
if (te->when_sec < e->when_sec || (te->when_sec == e->when_sec && te->when_ms < e->when_ms)) {
|
||||
break;
|
||||
}
|
||||
prev = e;
|
||||
}
|
||||
if (prev) {
|
||||
te->next = prev->next;
|
||||
prev->next = te;
|
||||
return id;
|
||||
}
|
||||
}
|
||||
|
||||
te->next = eventLoop->timeEventHead;
|
||||
eventLoop->timeEventHead = te;
|
||||
|
||||
return id;
|
||||
}
|
||||
|
||||
static jim_wide JimParseAfterId(Jim_Obj *idObj)
|
||||
{
|
||||
int len;
|
||||
const char *tok = Jim_GetString(idObj, &len);
|
||||
jim_wide id;
|
||||
|
||||
if (strncmp(tok, "after#", 6) == 0 && Jim_StringToWide(tok + 6, &id, 10) == JIM_OK) {
|
||||
/* Got an event by id */
|
||||
return id;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static jim_wide JimFindAfterByScript(Jim_EventLoop *eventLoop, Jim_Obj *scriptObj)
|
||||
{
|
||||
Jim_TimeEvent *te;
|
||||
|
||||
for (te = eventLoop->timeEventHead; te; te = te->next) {
|
||||
/* Is this an 'after' event? */
|
||||
if (te->timeProc == JimAfterTimeHandler) {
|
||||
if (Jim_StringEqObj(scriptObj, te->clientData)) {
|
||||
return te->id;
|
||||
}
|
||||
}
|
||||
}
|
||||
return -1; /* NO event with the specified ID found */
|
||||
}
|
||||
|
||||
static Jim_TimeEvent *JimFindTimeHandlerById(Jim_EventLoop *eventLoop, jim_wide id)
|
||||
{
|
||||
Jim_TimeEvent *te;
|
||||
|
||||
for (te = eventLoop->timeEventHead; te; te = te->next) {
|
||||
if (te->id == id) {
|
||||
return te;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static Jim_TimeEvent *Jim_RemoveTimeHandler(Jim_EventLoop *eventLoop, jim_wide id)
|
||||
{
|
||||
Jim_TimeEvent *te, *prev = NULL;
|
||||
|
||||
for (te = eventLoop->timeEventHead; te; te = te->next) {
|
||||
if (te->id == id) {
|
||||
if (prev == NULL)
|
||||
eventLoop->timeEventHead = te->next;
|
||||
else
|
||||
prev->next = te->next;
|
||||
return te;
|
||||
}
|
||||
prev = te;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static void Jim_FreeTimeHandler(Jim_Interp *interp, Jim_TimeEvent *te)
|
||||
{
|
||||
if (te->finalizerProc)
|
||||
te->finalizerProc(interp, te->clientData);
|
||||
Jim_Free(te);
|
||||
}
|
||||
|
||||
jim_wide Jim_DeleteTimeHandler(Jim_Interp *interp, jim_wide id)
|
||||
{
|
||||
Jim_TimeEvent *te;
|
||||
Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
|
||||
|
||||
if (id >= eventLoop->timeEventNextId) {
|
||||
return -2; /* wrong event ID */
|
||||
}
|
||||
|
||||
te = Jim_RemoveTimeHandler(eventLoop, id);
|
||||
if (te) {
|
||||
jim_wide remain;
|
||||
long cur_sec, cur_ms;
|
||||
|
||||
JimGetTime(&cur_sec, &cur_ms);
|
||||
|
||||
remain = (te->when_sec - cur_sec) * 1000;
|
||||
remain += (te->when_ms - cur_ms);
|
||||
remain = (remain < 0) ? 0 : remain;
|
||||
|
||||
Jim_FreeTimeHandler(interp, te);
|
||||
return remain;
|
||||
}
|
||||
return -1; /* NO event with the specified ID found */
|
||||
}
|
||||
|
||||
/* --- POSIX version of Jim_ProcessEvents, for now the only available --- */
|
||||
|
||||
/* Process every pending time event, then every pending file event
|
||||
* (that may be registered by time event callbacks just processed).
|
||||
* Without special flags the function sleeps until some file event
|
||||
* fires, or when the next time event occurrs (if any).
|
||||
*
|
||||
* If flags is 0, the function does nothing and returns.
|
||||
* if flags has JIM_ALL_EVENTS set, all the kind of events are processed.
|
||||
* if flags has JIM_FILE_EVENTS set, file events are processed.
|
||||
* if flags has JIM_TIME_EVENTS set, time events are processed.
|
||||
* if flags has JIM_DONT_WAIT set the function returns ASAP until all
|
||||
* the events that's possible to process without to wait are processed.
|
||||
*
|
||||
* The function returns the number of events processed or -1 if
|
||||
* there are no matching handlers, or -2 on error.
|
||||
*/
|
||||
int Jim_ProcessEvents(Jim_Interp *interp, int flags)
|
||||
{
|
||||
jim_wide sleep_ms = -1;
|
||||
int processed = 0;
|
||||
Jim_EventLoop *eventLoop = Jim_GetAssocData(interp, "eventloop");
|
||||
Jim_FileEvent *fe = eventLoop->fileEventHead;
|
||||
Jim_TimeEvent *te;
|
||||
jim_wide maxId;
|
||||
|
||||
if ((flags & JIM_FILE_EVENTS) == 0 || fe == NULL) {
|
||||
/* No file events */
|
||||
if ((flags & JIM_TIME_EVENTS) == 0 || eventLoop->timeEventHead == NULL) {
|
||||
/* No time events */
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Note that we want call select() even if there are no
|
||||
* file events to process as long as we want to process time
|
||||
* events, in order to sleep until the next time event is ready
|
||||
* to fire. */
|
||||
|
||||
if (flags & JIM_DONT_WAIT) {
|
||||
/* Wait no time */
|
||||
sleep_ms = 0;
|
||||
}
|
||||
else if (flags & JIM_TIME_EVENTS) {
|
||||
/* The nearest timer is always at the head of the list */
|
||||
if (eventLoop->timeEventHead) {
|
||||
Jim_TimeEvent *shortest = eventLoop->timeEventHead;
|
||||
long now_sec, now_ms;
|
||||
|
||||
/* Calculate the time missing for the nearest
|
||||
* timer to fire. */
|
||||
JimGetTime(&now_sec, &now_ms);
|
||||
sleep_ms = 1000 * (shortest->when_sec - now_sec) + (shortest->when_ms - now_ms);
|
||||
if (sleep_ms < 0) {
|
||||
sleep_ms = 1;
|
||||
}
|
||||
}
|
||||
else {
|
||||
/* Wait forever */
|
||||
sleep_ms = -1;
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef HAVE_SELECT
|
||||
if (flags & JIM_FILE_EVENTS) {
|
||||
int retval;
|
||||
struct timeval tv, *tvp = NULL;
|
||||
fd_set rfds, wfds, efds;
|
||||
int maxfd = -1;
|
||||
|
||||
FD_ZERO(&rfds);
|
||||
FD_ZERO(&wfds);
|
||||
FD_ZERO(&efds);
|
||||
|
||||
/* Check file events */
|
||||
while (fe != NULL) {
|
||||
int fd = fileno(fe->handle);
|
||||
|
||||
if (fe->mask & JIM_EVENT_READABLE)
|
||||
FD_SET(fd, &rfds);
|
||||
if (fe->mask & JIM_EVENT_WRITABLE)
|
||||
FD_SET(fd, &wfds);
|
||||
if (fe->mask & JIM_EVENT_EXCEPTION)
|
||||
FD_SET(fd, &efds);
|
||||
if (maxfd < fd)
|
||||
maxfd = fd;
|
||||
fe = fe->next;
|
||||
}
|
||||
|
||||
if (sleep_ms >= 0) {
|
||||
tvp = &tv;
|
||||
tvp->tv_sec = sleep_ms / 1000;
|
||||
tvp->tv_usec = 1000 * (sleep_ms % 1000);
|
||||
}
|
||||
|
||||
retval = select(maxfd + 1, &rfds, &wfds, &efds, tvp);
|
||||
|
||||
if (retval < 0) {
|
||||
if (errno == EINVAL) {
|
||||
/* This can happen on mingw32 if a non-socket filehandle is passed */
|
||||
Jim_SetResultString(interp, "non-waitable filehandle", -1);
|
||||
return -2;
|
||||
}
|
||||
/* XXX: What about EINTR? */
|
||||
}
|
||||
else if (retval > 0) {
|
||||
fe = eventLoop->fileEventHead;
|
||||
while (fe != NULL) {
|
||||
int fd = fileno(fe->handle);
|
||||
int mask = 0;
|
||||
|
||||
if ((fe->mask & JIM_EVENT_READABLE) && FD_ISSET(fd, &rfds))
|
||||
mask |= JIM_EVENT_READABLE;
|
||||
if (fe->mask & JIM_EVENT_WRITABLE && FD_ISSET(fd, &wfds))
|
||||
mask |= JIM_EVENT_WRITABLE;
|
||||
if (fe->mask & JIM_EVENT_EXCEPTION && FD_ISSET(fd, &efds))
|
||||
mask |= JIM_EVENT_EXCEPTION;
|
||||
|
||||
if (mask) {
|
||||
if (fe->fileProc(interp, fe->clientData, mask) != JIM_OK) {
|
||||
/* Remove the element on handler error */
|
||||
Jim_DeleteFileHandler(interp, fe->handle);
|
||||
}
|
||||
processed++;
|
||||
/* After an event is processed our file event list
|
||||
* may no longer be the same, so what we do
|
||||
* is to clear the bit for this file descriptor and
|
||||
* restart again from the head. */
|
||||
fe = eventLoop->fileEventHead;
|
||||
FD_CLR(fd, &rfds);
|
||||
FD_CLR(fd, &wfds);
|
||||
FD_CLR(fd, &efds);
|
||||
}
|
||||
else {
|
||||
fe = fe->next;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
#else
|
||||
if (sleep_ms > 0) {
|
||||
msleep(sleep_ms);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Check time events */
|
||||
te = eventLoop->timeEventHead;
|
||||
maxId = eventLoop->timeEventNextId - 1;
|
||||
while (te) {
|
||||
long now_sec, now_ms;
|
||||
jim_wide id;
|
||||
|
||||
if (te->id > maxId) {
|
||||
te = te->next;
|
||||
continue;
|
||||
}
|
||||
JimGetTime(&now_sec, &now_ms);
|
||||
if (now_sec > te->when_sec || (now_sec == te->when_sec && now_ms >= te->when_ms)) {
|
||||
id = te->id;
|
||||
/* Remove from the list before executing */
|
||||
Jim_RemoveTimeHandler(eventLoop, id);
|
||||
te->timeProc(interp, te->clientData);
|
||||
/* After an event is processed our time event list may
|
||||
* no longer be the same, so we restart from head.
|
||||
* Still we make sure to don't process events registered
|
||||
* by event handlers itself in order to don't loop forever
|
||||
* even in case an [after 0] that continuously register
|
||||
* itself. To do so we saved the max ID we want to handle. */
|
||||
Jim_FreeTimeHandler(interp, te);
|
||||
|
||||
te = eventLoop->timeEventHead;
|
||||
processed++;
|
||||
}
|
||||
else {
|
||||
te = te->next;
|
||||
}
|
||||
}
|
||||
|
||||
return processed;
|
||||
}
|
||||
|
||||
/* ---------------------------------------------------------------------- */
|
||||
|
||||
static void JimELAssocDataDeleProc(Jim_Interp *interp, void *data)
|
||||
{
|
||||
void *next;
|
||||
Jim_FileEvent *fe;
|
||||
Jim_TimeEvent *te;
|
||||
Jim_EventLoop *eventLoop = data;
|
||||
|
||||
fe = eventLoop->fileEventHead;
|
||||
while (fe) {
|
||||
next = fe->next;
|
||||
if (fe->finalizerProc)
|
||||
fe->finalizerProc(interp, fe->clientData);
|
||||
Jim_Free(fe);
|
||||
fe = next;
|
||||
}
|
||||
|
||||
te = eventLoop->timeEventHead;
|
||||
while (te) {
|
||||
next = te->next;
|
||||
if (te->finalizerProc)
|
||||
te->finalizerProc(interp, te->clientData);
|
||||
Jim_Free(te);
|
||||
te = next;
|
||||
}
|
||||
Jim_Free(data);
|
||||
}
|
||||
|
||||
static int JimELVwaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp);
|
||||
Jim_Obj *oldValue;
|
||||
int rc;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "name");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
oldValue = Jim_GetGlobalVariable(interp, argv[1], JIM_NONE);
|
||||
if (oldValue) {
|
||||
Jim_IncrRefCount(oldValue);
|
||||
}
|
||||
else {
|
||||
/* If a result was left, it is an error */
|
||||
int len;
|
||||
Jim_GetString(interp->result, &len);
|
||||
if (len) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
|
||||
eventLoop->suppress_bgerror = 0;
|
||||
|
||||
while ((rc = Jim_ProcessEvents(interp, JIM_ALL_EVENTS)) >= 0) {
|
||||
Jim_Obj *currValue;
|
||||
currValue = Jim_GetGlobalVariable(interp, argv[1], JIM_NONE);
|
||||
/* Stop the loop if the vwait-ed variable changed value,
|
||||
* or if was unset and now is set (or the contrary). */
|
||||
if ((oldValue && !currValue) ||
|
||||
(!oldValue && currValue) ||
|
||||
(oldValue && currValue && !Jim_StringEqObj(oldValue, currValue)))
|
||||
break;
|
||||
}
|
||||
if (oldValue)
|
||||
Jim_DecrRefCount(interp, oldValue);
|
||||
|
||||
|
||||
if (rc == -2) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
Jim_SetEmptyResult(interp);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int JimELUpdateCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp);
|
||||
static const char * const options[] = {
|
||||
"idletasks", NULL
|
||||
};
|
||||
enum { UPDATE_IDLE, UPDATE_NONE };
|
||||
int option = UPDATE_NONE;
|
||||
int flags = JIM_TIME_EVENTS;
|
||||
|
||||
if (argc == 1) {
|
||||
flags = JIM_ALL_EVENTS;
|
||||
}
|
||||
else if (argc > 2 || Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "?idletasks?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
eventLoop->suppress_bgerror = 0;
|
||||
|
||||
while (Jim_ProcessEvents(interp, flags | JIM_DONT_WAIT) > 0) {
|
||||
}
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static void JimAfterTimeHandler(Jim_Interp *interp, void *clientData)
|
||||
{
|
||||
Jim_Obj *objPtr = clientData;
|
||||
|
||||
Jim_EvalObjBackground(interp, objPtr);
|
||||
}
|
||||
|
||||
static void JimAfterTimeEventFinalizer(Jim_Interp *interp, void *clientData)
|
||||
{
|
||||
Jim_Obj *objPtr = clientData;
|
||||
|
||||
Jim_DecrRefCount(interp, objPtr);
|
||||
}
|
||||
|
||||
static int JimELAfterCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_EventLoop *eventLoop = Jim_CmdPrivData(interp);
|
||||
jim_wide ms = 0, id;
|
||||
Jim_Obj *objPtr, *idObjPtr;
|
||||
static const char * const options[] = {
|
||||
"cancel", "info", "idle", NULL
|
||||
};
|
||||
enum
|
||||
{ AFTER_CANCEL, AFTER_INFO, AFTER_IDLE, AFTER_RESTART, AFTER_EXPIRE, AFTER_CREATE };
|
||||
int option = AFTER_CREATE;
|
||||
|
||||
if (argc < 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "option ?arg ...?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetWide(interp, argv[1], &ms) != JIM_OK) {
|
||||
if (Jim_GetEnum(interp, argv[1], options, &option, "argument", JIM_ERRMSG) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetEmptyResult(interp);
|
||||
}
|
||||
else if (argc == 2) {
|
||||
/* Simply a sleep */
|
||||
msleep(ms);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
switch (option) {
|
||||
case AFTER_IDLE:
|
||||
if (argc < 3) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "script ?script ...?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
/* fall through */
|
||||
case AFTER_CREATE: {
|
||||
Jim_Obj *scriptObj = Jim_ConcatObj(interp, argc - 2, argv + 2);
|
||||
Jim_IncrRefCount(scriptObj);
|
||||
id = Jim_CreateTimeHandler(interp, ms, JimAfterTimeHandler, scriptObj,
|
||||
JimAfterTimeEventFinalizer);
|
||||
objPtr = Jim_NewStringObj(interp, NULL, 0);
|
||||
Jim_AppendString(interp, objPtr, "after#", -1);
|
||||
idObjPtr = Jim_NewIntObj(interp, id);
|
||||
Jim_IncrRefCount(idObjPtr);
|
||||
Jim_AppendObj(interp, objPtr, idObjPtr);
|
||||
Jim_DecrRefCount(interp, idObjPtr);
|
||||
Jim_SetResult(interp, objPtr);
|
||||
return JIM_OK;
|
||||
}
|
||||
case AFTER_CANCEL:
|
||||
if (argc < 3) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "id|command");
|
||||
return JIM_ERR;
|
||||
}
|
||||
else {
|
||||
jim_wide remain = 0;
|
||||
|
||||
id = JimParseAfterId(argv[2]);
|
||||
if (id < 0) {
|
||||
/* Not an event id, so search by script */
|
||||
Jim_Obj *scriptObj = Jim_ConcatObj(interp, argc - 2, argv + 2);
|
||||
id = JimFindAfterByScript(eventLoop, scriptObj);
|
||||
Jim_FreeNewObj(interp, scriptObj);
|
||||
if (id < 0) {
|
||||
/* Not found */
|
||||
break;
|
||||
}
|
||||
}
|
||||
remain = Jim_DeleteTimeHandler(interp, id);
|
||||
if (remain >= 0) {
|
||||
Jim_SetResultInt(interp, remain);
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
||||
case AFTER_INFO:
|
||||
if (argc == 2) {
|
||||
Jim_TimeEvent *te = eventLoop->timeEventHead;
|
||||
Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
|
||||
char buf[30];
|
||||
const char *fmt = "after#%" JIM_WIDE_MODIFIER;
|
||||
|
||||
while (te) {
|
||||
snprintf(buf, sizeof(buf), fmt, te->id);
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, buf, -1));
|
||||
te = te->next;
|
||||
}
|
||||
Jim_SetResult(interp, listObj);
|
||||
}
|
||||
else if (argc == 3) {
|
||||
id = JimParseAfterId(argv[2]);
|
||||
if (id >= 0) {
|
||||
Jim_TimeEvent *e = JimFindTimeHandlerById(eventLoop, id);
|
||||
if (e && e->timeProc == JimAfterTimeHandler) {
|
||||
Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
|
||||
Jim_ListAppendElement(interp, listObj, e->clientData);
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, e->initialms ? "timer" : "idle", -1));
|
||||
Jim_SetResult(interp, listObj);
|
||||
return JIM_OK;
|
||||
}
|
||||
}
|
||||
Jim_SetResultFormatted(interp, "event \"%#s\" doesn't exist", argv[2]);
|
||||
return JIM_ERR;
|
||||
}
|
||||
else {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "?id?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_eventloopInit(Jim_Interp *interp)
|
||||
{
|
||||
Jim_EventLoop *eventLoop;
|
||||
|
||||
if (Jim_PackageProvide(interp, "eventloop", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
eventLoop = Jim_Alloc(sizeof(*eventLoop));
|
||||
eventLoop->fileEventHead = NULL;
|
||||
eventLoop->timeEventHead = NULL;
|
||||
eventLoop->timeEventNextId = 1;
|
||||
eventLoop->suppress_bgerror = 0;
|
||||
Jim_SetAssocData(interp, "eventloop", JimELAssocDataDeleProc, eventLoop);
|
||||
|
||||
Jim_CreateCommand(interp, "vwait", JimELVwaitCommand, eventLoop, NULL);
|
||||
Jim_CreateCommand(interp, "update", JimELUpdateCommand, eventLoop, NULL);
|
||||
Jim_CreateCommand(interp, "after", JimELAfterCommand, eventLoop, NULL);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
87
debuggers/openocd/jimtcl/jim-eventloop.h
Normal file
87
debuggers/openocd/jimtcl/jim-eventloop.h
Normal file
@ -0,0 +1,87 @@
|
||||
/* Jim - A small embeddable Tcl interpreter
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
* Copyright 2005 Clemens Hintze <c.hintze@gmx.net>
|
||||
* Copyright 2005 patthoyts - Pat Thoyts <patthoyts@users.sf.net>
|
||||
* Copyright 2008 oharboe - <20>yvind Harboe - oyvind.harboe@zylin.com
|
||||
* Copyright 2008 Andrew Lunn <andrew@lunn.ch>
|
||||
* Copyright 2008 Duane Ellis <openocd@duaneellis.com>
|
||||
* Copyright 2008 Uwe Klein <uklein@klein-messgeraete.de>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
**/
|
||||
/* ------ USAGE -------
|
||||
*
|
||||
* In order to use this file from other extensions include it in every
|
||||
* file where you need to call the eventloop API, also in the init
|
||||
* function of your extension call Jim_ImportEventloopAPI(interp)
|
||||
* after the Jim_InitExtension() call.
|
||||
*
|
||||
* See the UDP extension as example.
|
||||
*/
|
||||
|
||||
|
||||
#ifndef __JIM_EVENTLOOP_H__
|
||||
#define __JIM_EVENTLOOP_H__
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
typedef int Jim_FileProc(Jim_Interp *interp, void *clientData, int mask);
|
||||
typedef int Jim_SignalProc(Jim_Interp *interp, void *clientData, void *msg);
|
||||
typedef void Jim_TimeProc(Jim_Interp *interp, void *clientData);
|
||||
typedef void Jim_EventFinalizerProc(Jim_Interp *interp, void *clientData);
|
||||
|
||||
/* File event structure */
|
||||
#define JIM_EVENT_READABLE 1
|
||||
#define JIM_EVENT_WRITABLE 2
|
||||
#define JIM_EVENT_EXCEPTION 4
|
||||
|
||||
JIM_EXPORT void Jim_CreateFileHandler (Jim_Interp *interp,
|
||||
FILE *handle, int mask,
|
||||
Jim_FileProc *proc, void *clientData,
|
||||
Jim_EventFinalizerProc *finalizerProc);
|
||||
JIM_EXPORT void Jim_DeleteFileHandler (Jim_Interp *interp,
|
||||
FILE *handle);
|
||||
JIM_EXPORT jim_wide Jim_CreateTimeHandler (Jim_Interp *interp,
|
||||
jim_wide milliseconds,
|
||||
Jim_TimeProc *proc, void *clientData,
|
||||
Jim_EventFinalizerProc *finalizerProc);
|
||||
JIM_EXPORT jim_wide Jim_DeleteTimeHandler (Jim_Interp *interp, jim_wide id);
|
||||
|
||||
#define JIM_FILE_EVENTS 1
|
||||
#define JIM_TIME_EVENTS 2
|
||||
#define JIM_ALL_EVENTS (JIM_FILE_EVENTS|JIM_TIME_EVENTS)
|
||||
#define JIM_DONT_WAIT 4
|
||||
|
||||
JIM_EXPORT int Jim_ProcessEvents (Jim_Interp *interp, int flags);
|
||||
JIM_EXPORT int Jim_EvalObjBackground (Jim_Interp *interp, Jim_Obj *scriptObjPtr);
|
||||
|
||||
int Jim_eventloopInit(Jim_Interp *interp);
|
||||
|
||||
#endif /* __JIM_EVENTLOOP_H__ */
|
||||
1630
debuggers/openocd/jimtcl/jim-exec.c
Normal file
1630
debuggers/openocd/jimtcl/jim-exec.c
Normal file
File diff suppressed because it is too large
Load Diff
958
debuggers/openocd/jimtcl/jim-file.c
Normal file
958
debuggers/openocd/jimtcl/jim-file.c
Normal file
@ -0,0 +1,958 @@
|
||||
/*
|
||||
* Implements the file command for jim
|
||||
*
|
||||
* (c) 2008 Steve Bennett <steveb@workware.net.au>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*
|
||||
* Based on code originally from Tcl 6.7:
|
||||
*
|
||||
* Copyright 1987-1991 Regents of the University of California
|
||||
* Permission to use, copy, modify, and distribute this
|
||||
* software and its documentation for any purpose and without
|
||||
* fee is hereby granted, provided that the above copyright
|
||||
* notice appear in all copies. The University of California
|
||||
* makes no representations about the suitability of this
|
||||
* software for any purpose. It is provided "as is" without
|
||||
* express or implied warranty.
|
||||
*/
|
||||
|
||||
#include <limits.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
#include <sys/stat.h>
|
||||
|
||||
#include <jimautoconf.h>
|
||||
#include <jim-subcmd.h>
|
||||
|
||||
#ifdef HAVE_UTIMES
|
||||
#include <sys/time.h>
|
||||
#endif
|
||||
#ifdef HAVE_UNISTD_H
|
||||
#include <unistd.h>
|
||||
#elif defined(_MSC_VER)
|
||||
#include <direct.h>
|
||||
#define F_OK 0
|
||||
#define W_OK 2
|
||||
#define R_OK 4
|
||||
#define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
|
||||
#define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR)
|
||||
#endif
|
||||
|
||||
# ifndef MAXPATHLEN
|
||||
# define MAXPATHLEN JIM_PATH_LEN
|
||||
# endif
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* JimGetFileType --
|
||||
*
|
||||
* Given a mode word, returns a string identifying the type of a
|
||||
* file.
|
||||
*
|
||||
* Results:
|
||||
* A static text string giving the file type from mode.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static const char *JimGetFileType(int mode)
|
||||
{
|
||||
if (S_ISREG(mode)) {
|
||||
return "file";
|
||||
}
|
||||
else if (S_ISDIR(mode)) {
|
||||
return "directory";
|
||||
}
|
||||
#ifdef S_ISCHR
|
||||
else if (S_ISCHR(mode)) {
|
||||
return "characterSpecial";
|
||||
}
|
||||
#endif
|
||||
#ifdef S_ISBLK
|
||||
else if (S_ISBLK(mode)) {
|
||||
return "blockSpecial";
|
||||
}
|
||||
#endif
|
||||
#ifdef S_ISFIFO
|
||||
else if (S_ISFIFO(mode)) {
|
||||
return "fifo";
|
||||
}
|
||||
#endif
|
||||
#ifdef S_ISLNK
|
||||
else if (S_ISLNK(mode)) {
|
||||
return "link";
|
||||
}
|
||||
#endif
|
||||
#ifdef S_ISSOCK
|
||||
else if (S_ISSOCK(mode)) {
|
||||
return "socket";
|
||||
}
|
||||
#endif
|
||||
return "unknown";
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* StoreStatData --
|
||||
*
|
||||
* This is a utility procedure that breaks out the fields of a
|
||||
* "stat" structure and stores them in textual form into the
|
||||
* elements of an associative array.
|
||||
*
|
||||
* Results:
|
||||
* Returns a standard Tcl return value. If an error occurs then
|
||||
* a message is left in interp->result.
|
||||
*
|
||||
* Side effects:
|
||||
* Elements of the associative array given by "varName" are modified.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
static int set_array_int_value(Jim_Interp *interp, Jim_Obj *container, const char *key,
|
||||
jim_wide value)
|
||||
{
|
||||
Jim_Obj *nameobj = Jim_NewStringObj(interp, key, -1);
|
||||
Jim_Obj *valobj = Jim_NewWideObj(interp, value);
|
||||
|
||||
if (Jim_SetDictKeysVector(interp, container, &nameobj, 1, valobj, JIM_ERRMSG) != JIM_OK) {
|
||||
Jim_FreeObj(interp, nameobj);
|
||||
Jim_FreeObj(interp, valobj);
|
||||
return JIM_ERR;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int set_array_string_value(Jim_Interp *interp, Jim_Obj *container, const char *key,
|
||||
const char *value)
|
||||
{
|
||||
Jim_Obj *nameobj = Jim_NewStringObj(interp, key, -1);
|
||||
Jim_Obj *valobj = Jim_NewStringObj(interp, value, -1);
|
||||
|
||||
if (Jim_SetDictKeysVector(interp, container, &nameobj, 1, valobj, JIM_ERRMSG) != JIM_OK) {
|
||||
Jim_FreeObj(interp, nameobj);
|
||||
Jim_FreeObj(interp, valobj);
|
||||
return JIM_ERR;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int StoreStatData(Jim_Interp *interp, Jim_Obj *varName, const struct stat *sb)
|
||||
{
|
||||
if (set_array_int_value(interp, varName, "dev", sb->st_dev) != JIM_OK) {
|
||||
Jim_SetResultFormatted(interp, "can't set \"%#s(dev)\": variable isn't array", varName);
|
||||
return JIM_ERR;
|
||||
}
|
||||
set_array_int_value(interp, varName, "ino", sb->st_ino);
|
||||
set_array_int_value(interp, varName, "mode", sb->st_mode);
|
||||
set_array_int_value(interp, varName, "nlink", sb->st_nlink);
|
||||
set_array_int_value(interp, varName, "uid", sb->st_uid);
|
||||
set_array_int_value(interp, varName, "gid", sb->st_gid);
|
||||
set_array_int_value(interp, varName, "size", sb->st_size);
|
||||
set_array_int_value(interp, varName, "atime", sb->st_atime);
|
||||
set_array_int_value(interp, varName, "mtime", sb->st_mtime);
|
||||
set_array_int_value(interp, varName, "ctime", sb->st_ctime);
|
||||
set_array_string_value(interp, varName, "type", JimGetFileType((int)sb->st_mode));
|
||||
|
||||
/* And also return the value */
|
||||
Jim_SetResult(interp, Jim_GetVariable(interp, varName, 0));
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *path = Jim_String(argv[0]);
|
||||
const char *p = strrchr(path, '/');
|
||||
|
||||
if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') {
|
||||
Jim_SetResultString(interp, "..", -1);
|
||||
} else if (!p) {
|
||||
Jim_SetResultString(interp, ".", -1);
|
||||
}
|
||||
else if (p == path) {
|
||||
Jim_SetResultString(interp, "/", -1);
|
||||
}
|
||||
#if defined(__MINGW32__) || defined(_MSC_VER)
|
||||
else if (p[-1] == ':') {
|
||||
/* z:/dir => z:/ */
|
||||
Jim_SetResultString(interp, path, p - path + 1);
|
||||
}
|
||||
#endif
|
||||
else {
|
||||
Jim_SetResultString(interp, path, p - path);
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_rootname(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *path = Jim_String(argv[0]);
|
||||
const char *lastSlash = strrchr(path, '/');
|
||||
const char *p = strrchr(path, '.');
|
||||
|
||||
if (p == NULL || (lastSlash != NULL && lastSlash > p)) {
|
||||
Jim_SetResult(interp, argv[0]);
|
||||
}
|
||||
else {
|
||||
Jim_SetResultString(interp, path, p - path);
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_extension(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *path = Jim_String(argv[0]);
|
||||
const char *lastSlash = strrchr(path, '/');
|
||||
const char *p = strrchr(path, '.');
|
||||
|
||||
if (p == NULL || (lastSlash != NULL && lastSlash >= p)) {
|
||||
p = "";
|
||||
}
|
||||
Jim_SetResultString(interp, p, -1);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_tail(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *path = Jim_String(argv[0]);
|
||||
const char *lastSlash = strrchr(path, '/');
|
||||
|
||||
if (lastSlash) {
|
||||
Jim_SetResultString(interp, lastSlash + 1, -1);
|
||||
}
|
||||
else {
|
||||
Jim_SetResult(interp, argv[0]);
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_normalize(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
#ifdef HAVE_REALPATH
|
||||
const char *path = Jim_String(argv[0]);
|
||||
char *newname = Jim_Alloc(MAXPATHLEN + 1);
|
||||
|
||||
if (realpath(path, newname)) {
|
||||
Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, -1));
|
||||
return JIM_OK;
|
||||
}
|
||||
else {
|
||||
Jim_Free(newname);
|
||||
Jim_SetResultFormatted(interp, "can't normalize \"%#s\": %s", argv[0], strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
#else
|
||||
Jim_SetResultString(interp, "Not implemented", -1);
|
||||
return JIM_ERR;
|
||||
#endif
|
||||
}
|
||||
|
||||
static int file_cmd_join(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int i;
|
||||
char *newname = Jim_Alloc(MAXPATHLEN + 1);
|
||||
char *last = newname;
|
||||
|
||||
*newname = 0;
|
||||
|
||||
/* Simple implementation for now */
|
||||
for (i = 0; i < argc; i++) {
|
||||
int len;
|
||||
const char *part = Jim_GetString(argv[i], &len);
|
||||
|
||||
if (*part == '/') {
|
||||
/* Absolute component, so go back to the start */
|
||||
last = newname;
|
||||
}
|
||||
#if defined(__MINGW32__) || defined(_MSC_VER)
|
||||
else if (strchr(part, ':')) {
|
||||
/* Absolute compontent on mingw, so go back to the start */
|
||||
last = newname;
|
||||
}
|
||||
#endif
|
||||
else if (part[0] == '.') {
|
||||
if (part[1] == '/') {
|
||||
part += 2;
|
||||
len -= 2;
|
||||
}
|
||||
else if (part[1] == 0 && last != newname) {
|
||||
/* Adding '.' to an existing path does nothing */
|
||||
continue;
|
||||
}
|
||||
}
|
||||
|
||||
/* Add a slash if needed */
|
||||
if (last != newname && last[-1] != '/') {
|
||||
*last++ = '/';
|
||||
}
|
||||
|
||||
if (len) {
|
||||
if (last + len - newname >= MAXPATHLEN) {
|
||||
Jim_Free(newname);
|
||||
Jim_SetResultString(interp, "Path too long", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
memcpy(last, part, len);
|
||||
last += len;
|
||||
}
|
||||
|
||||
/* Remove a slash if needed */
|
||||
if (last > newname + 1 && last[-1] == '/') {
|
||||
*--last = 0;
|
||||
}
|
||||
}
|
||||
|
||||
*last = 0;
|
||||
|
||||
/* Probably need to handle some special cases ... */
|
||||
|
||||
Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, last - newname));
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_access(Jim_Interp *interp, Jim_Obj *filename, int mode)
|
||||
{
|
||||
const char *path = Jim_String(filename);
|
||||
int rc = access(path, mode);
|
||||
|
||||
Jim_SetResultBool(interp, rc != -1);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_readable(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return file_access(interp, argv[0], R_OK);
|
||||
}
|
||||
|
||||
static int file_cmd_writable(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return file_access(interp, argv[0], W_OK);
|
||||
}
|
||||
|
||||
static int file_cmd_executable(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
#ifdef X_OK
|
||||
return file_access(interp, argv[0], X_OK);
|
||||
#else
|
||||
/* XXX: X_OK doesn't work under Windows.
|
||||
* In any case, may need to add .exe, etc. so just lie!
|
||||
*/
|
||||
Jim_SetResultBool(interp, 1);
|
||||
return JIM_OK;
|
||||
#endif
|
||||
}
|
||||
|
||||
static int file_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return file_access(interp, argv[0], F_OK);
|
||||
}
|
||||
|
||||
static int file_cmd_delete(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int force = Jim_CompareStringImmediate(interp, argv[0], "-force");
|
||||
|
||||
if (force || Jim_CompareStringImmediate(interp, argv[0], "--")) {
|
||||
argc++;
|
||||
argv--;
|
||||
}
|
||||
|
||||
while (argc--) {
|
||||
const char *path = Jim_String(argv[0]);
|
||||
|
||||
if (unlink(path) == -1 && errno != ENOENT) {
|
||||
if (rmdir(path) == -1) {
|
||||
/* Maybe try using the script helper */
|
||||
if (!force || Jim_EvalPrefix(interp, "file delete force", 1, argv) != JIM_OK) {
|
||||
Jim_SetResultFormatted(interp, "couldn't delete file \"%s\": %s", path,
|
||||
strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
}
|
||||
argv++;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
#ifdef HAVE_MKDIR_ONE_ARG
|
||||
#define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME)
|
||||
#else
|
||||
#define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME, 0755)
|
||||
#endif
|
||||
|
||||
/**
|
||||
* Create directory, creating all intermediate paths if necessary.
|
||||
*
|
||||
* Returns 0 if OK or -1 on failure (and sets errno)
|
||||
*
|
||||
* Note: The path may be modified.
|
||||
*/
|
||||
static int mkdir_all(char *path)
|
||||
{
|
||||
int ok = 1;
|
||||
|
||||
/* First time just try to make the dir */
|
||||
goto first;
|
||||
|
||||
while (ok--) {
|
||||
/* Must have failed the first time, so recursively make the parent and try again */
|
||||
{
|
||||
char *slash = strrchr(path, '/');
|
||||
|
||||
if (slash && slash != path) {
|
||||
*slash = 0;
|
||||
if (mkdir_all(path) != 0) {
|
||||
return -1;
|
||||
}
|
||||
*slash = '/';
|
||||
}
|
||||
}
|
||||
first:
|
||||
if (MKDIR_DEFAULT(path) == 0) {
|
||||
return 0;
|
||||
}
|
||||
if (errno == ENOENT) {
|
||||
/* Create the parent and try again */
|
||||
continue;
|
||||
}
|
||||
/* Maybe it already exists as a directory */
|
||||
if (errno == EEXIST) {
|
||||
struct stat sb;
|
||||
|
||||
if (stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) {
|
||||
return 0;
|
||||
}
|
||||
/* Restore errno */
|
||||
errno = EEXIST;
|
||||
}
|
||||
/* Failed */
|
||||
break;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static int file_cmd_mkdir(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
while (argc--) {
|
||||
char *path = Jim_StrDup(Jim_String(argv[0]));
|
||||
int rc = mkdir_all(path);
|
||||
|
||||
Jim_Free(path);
|
||||
if (rc != 0) {
|
||||
Jim_SetResultFormatted(interp, "can't create directory \"%#s\": %s", argv[0],
|
||||
strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
argv++;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
#ifdef HAVE_MKSTEMP
|
||||
static int file_cmd_tempfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int fd;
|
||||
char *filename;
|
||||
const char *template = "/tmp/tcl.tmp.XXXXXX";
|
||||
|
||||
if (argc >= 1) {
|
||||
template = Jim_String(argv[0]);
|
||||
}
|
||||
filename = Jim_StrDup(template);
|
||||
|
||||
fd = mkstemp(filename);
|
||||
if (fd < 0) {
|
||||
Jim_SetResultString(interp, "Failed to create tempfile", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
close(fd);
|
||||
|
||||
Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, filename, -1));
|
||||
return JIM_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
static int file_cmd_rename(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *source;
|
||||
const char *dest;
|
||||
int force = 0;
|
||||
|
||||
if (argc == 3) {
|
||||
if (!Jim_CompareStringImmediate(interp, argv[0], "-force")) {
|
||||
return -1;
|
||||
}
|
||||
force++;
|
||||
argv++;
|
||||
argc--;
|
||||
}
|
||||
|
||||
source = Jim_String(argv[0]);
|
||||
dest = Jim_String(argv[1]);
|
||||
|
||||
if (!force && access(dest, F_OK) == 0) {
|
||||
Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": target exists", argv[0],
|
||||
argv[1]);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (rename(source, dest) != 0) {
|
||||
Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": %s", argv[0], argv[1],
|
||||
strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_stat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb)
|
||||
{
|
||||
const char *path = Jim_String(filename);
|
||||
|
||||
if (stat(path, sb) == -1) {
|
||||
Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
#ifndef HAVE_LSTAT
|
||||
#define lstat stat
|
||||
#endif
|
||||
|
||||
static int file_lstat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb)
|
||||
{
|
||||
const char *path = Jim_String(filename);
|
||||
|
||||
if (lstat(path, sb) == -1) {
|
||||
Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_atime(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
|
||||
if (file_stat(interp, argv[0], &sb) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultInt(interp, sb.st_atime);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_mtime(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
|
||||
if (argc == 2) {
|
||||
#ifdef HAVE_UTIMES
|
||||
jim_wide newtime;
|
||||
struct timeval times[2];
|
||||
|
||||
if (Jim_GetWide(interp, argv[1], &newtime) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
times[1].tv_sec = times[0].tv_sec = newtime;
|
||||
times[1].tv_usec = times[0].tv_usec = 0;
|
||||
|
||||
if (utimes(Jim_String(argv[0]), times) != 0) {
|
||||
Jim_SetResultFormatted(interp, "can't set time on \"%#s\": %s", argv[0], strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
#else
|
||||
Jim_SetResultString(interp, "Not implemented", -1);
|
||||
return JIM_ERR;
|
||||
#endif
|
||||
}
|
||||
if (file_stat(interp, argv[0], &sb) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultInt(interp, sb.st_mtime);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return Jim_EvalPrefix(interp, "file copy", argc, argv);
|
||||
}
|
||||
|
||||
static int file_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
|
||||
if (file_stat(interp, argv[0], &sb) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultInt(interp, sb.st_size);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_isdirectory(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
int ret = 0;
|
||||
|
||||
if (file_stat(interp, argv[0], &sb) == JIM_OK) {
|
||||
ret = S_ISDIR(sb.st_mode);
|
||||
}
|
||||
Jim_SetResultInt(interp, ret);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_isfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
int ret = 0;
|
||||
|
||||
if (file_stat(interp, argv[0], &sb) == JIM_OK) {
|
||||
ret = S_ISREG(sb.st_mode);
|
||||
}
|
||||
Jim_SetResultInt(interp, ret);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
#ifdef HAVE_GETEUID
|
||||
static int file_cmd_owned(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
int ret = 0;
|
||||
|
||||
if (file_stat(interp, argv[0], &sb) == JIM_OK) {
|
||||
ret = (geteuid() == sb.st_uid);
|
||||
}
|
||||
Jim_SetResultInt(interp, ret);
|
||||
return JIM_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
#if defined(HAVE_READLINK)
|
||||
static int file_cmd_readlink(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *path = Jim_String(argv[0]);
|
||||
char *linkValue = Jim_Alloc(MAXPATHLEN + 1);
|
||||
|
||||
int linkLength = readlink(path, linkValue, MAXPATHLEN);
|
||||
|
||||
if (linkLength == -1) {
|
||||
Jim_Free(linkValue);
|
||||
Jim_SetResultFormatted(interp, "couldn't readlink \"%#s\": %s", argv[0], strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
linkValue[linkLength] = 0;
|
||||
Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, linkValue, linkLength));
|
||||
return JIM_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
static int file_cmd_type(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
|
||||
if (file_lstat(interp, argv[0], &sb) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultString(interp, JimGetFileType((int)sb.st_mode), -1);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int file_cmd_lstat(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
|
||||
if (file_lstat(interp, argv[0], &sb) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
return StoreStatData(interp, argv[1], &sb);
|
||||
}
|
||||
|
||||
static int file_cmd_stat(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct stat sb;
|
||||
|
||||
if (file_stat(interp, argv[0], &sb) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
return StoreStatData(interp, argv[1], &sb);
|
||||
}
|
||||
|
||||
static const jim_subcmd_type file_command_table[] = {
|
||||
{ "atime",
|
||||
"name",
|
||||
file_cmd_atime,
|
||||
1,
|
||||
1,
|
||||
/* Description: Last access time */
|
||||
},
|
||||
{ "mtime",
|
||||
"name ?time?",
|
||||
file_cmd_mtime,
|
||||
1,
|
||||
2,
|
||||
/* Description: Get or set last modification time */
|
||||
},
|
||||
{ "copy",
|
||||
"?-force? source dest",
|
||||
file_cmd_copy,
|
||||
2,
|
||||
3,
|
||||
/* Description: Copy source file to destination file */
|
||||
},
|
||||
{ "dirname",
|
||||
"name",
|
||||
file_cmd_dirname,
|
||||
1,
|
||||
1,
|
||||
/* Description: Directory part of the name */
|
||||
},
|
||||
{ "rootname",
|
||||
"name",
|
||||
file_cmd_rootname,
|
||||
1,
|
||||
1,
|
||||
/* Description: Name without any extension */
|
||||
},
|
||||
{ "extension",
|
||||
"name",
|
||||
file_cmd_extension,
|
||||
1,
|
||||
1,
|
||||
/* Description: Last extension including the dot */
|
||||
},
|
||||
{ "tail",
|
||||
"name",
|
||||
file_cmd_tail,
|
||||
1,
|
||||
1,
|
||||
/* Description: Last component of the name */
|
||||
},
|
||||
{ "normalize",
|
||||
"name",
|
||||
file_cmd_normalize,
|
||||
1,
|
||||
1,
|
||||
/* Description: Normalized path of name */
|
||||
},
|
||||
{ "join",
|
||||
"name ?name ...?",
|
||||
file_cmd_join,
|
||||
1,
|
||||
-1,
|
||||
/* Description: Join multiple path components */
|
||||
},
|
||||
{ "readable",
|
||||
"name",
|
||||
file_cmd_readable,
|
||||
1,
|
||||
1,
|
||||
/* Description: Is file readable */
|
||||
},
|
||||
{ "writable",
|
||||
"name",
|
||||
file_cmd_writable,
|
||||
1,
|
||||
1,
|
||||
/* Description: Is file writable */
|
||||
},
|
||||
{ "executable",
|
||||
"name",
|
||||
file_cmd_executable,
|
||||
1,
|
||||
1,
|
||||
/* Description: Is file executable */
|
||||
},
|
||||
{ "exists",
|
||||
"name",
|
||||
file_cmd_exists,
|
||||
1,
|
||||
1,
|
||||
/* Description: Does file exist */
|
||||
},
|
||||
{ "delete",
|
||||
"?-force|--? name ...",
|
||||
file_cmd_delete,
|
||||
1,
|
||||
-1,
|
||||
/* Description: Deletes the files or directories (must be empty unless -force) */
|
||||
},
|
||||
{ "mkdir",
|
||||
"dir ...",
|
||||
file_cmd_mkdir,
|
||||
1,
|
||||
-1,
|
||||
/* Description: Creates the directories */
|
||||
},
|
||||
#ifdef HAVE_MKSTEMP
|
||||
{ "tempfile",
|
||||
"?template?",
|
||||
file_cmd_tempfile,
|
||||
0,
|
||||
1,
|
||||
/* Description: Creates a temporary filename */
|
||||
},
|
||||
#endif
|
||||
{ "rename",
|
||||
"?-force? source dest",
|
||||
file_cmd_rename,
|
||||
2,
|
||||
3,
|
||||
/* Description: Renames a file */
|
||||
},
|
||||
#if defined(HAVE_READLINK)
|
||||
{ "readlink",
|
||||
"name",
|
||||
file_cmd_readlink,
|
||||
1,
|
||||
1,
|
||||
/* Description: Value of the symbolic link */
|
||||
},
|
||||
#endif
|
||||
{ "size",
|
||||
"name",
|
||||
file_cmd_size,
|
||||
1,
|
||||
1,
|
||||
/* Description: Size of file */
|
||||
},
|
||||
{ "stat",
|
||||
"name var",
|
||||
file_cmd_stat,
|
||||
2,
|
||||
2,
|
||||
/* Description: Stores results of stat in var array */
|
||||
},
|
||||
{ "lstat",
|
||||
"name var",
|
||||
file_cmd_lstat,
|
||||
2,
|
||||
2,
|
||||
/* Description: Stores results of lstat in var array */
|
||||
},
|
||||
{ "type",
|
||||
"name",
|
||||
file_cmd_type,
|
||||
1,
|
||||
1,
|
||||
/* Description: Returns type of the file */
|
||||
},
|
||||
#ifdef HAVE_GETEUID
|
||||
{ "owned",
|
||||
"name",
|
||||
file_cmd_owned,
|
||||
1,
|
||||
1,
|
||||
/* Description: Returns 1 if owned by the current owner */
|
||||
},
|
||||
#endif
|
||||
{ "isdirectory",
|
||||
"name",
|
||||
file_cmd_isdirectory,
|
||||
1,
|
||||
1,
|
||||
/* Description: Returns 1 if name is a directory */
|
||||
},
|
||||
{ "isfile",
|
||||
"name",
|
||||
file_cmd_isfile,
|
||||
1,
|
||||
1,
|
||||
/* Description: Returns 1 if name is a file */
|
||||
},
|
||||
{
|
||||
NULL
|
||||
}
|
||||
};
|
||||
|
||||
static int Jim_CdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *path;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "dirname");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
path = Jim_String(argv[1]);
|
||||
|
||||
if (chdir(path) != 0) {
|
||||
Jim_SetResultFormatted(interp, "couldn't change working directory to \"%s\": %s", path,
|
||||
strerror(errno));
|
||||
return JIM_ERR;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int Jim_PwdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const int cwd_len = 2048;
|
||||
char *cwd = malloc(cwd_len);
|
||||
|
||||
if (getcwd(cwd, cwd_len) == NULL) {
|
||||
Jim_SetResultString(interp, "Failed to get pwd", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
#if defined(__MINGW32__) || defined(_MSC_VER)
|
||||
{
|
||||
/* Try to keep backlashes out of paths */
|
||||
char *p = cwd;
|
||||
while ((p = strchr(p, '\\')) != NULL) {
|
||||
*p++ = '/';
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
Jim_SetResultString(interp, cwd, -1);
|
||||
|
||||
free(cwd);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_fileInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "file", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "file", Jim_SubCmdProc, (void *)file_command_table, NULL);
|
||||
Jim_CreateCommand(interp, "pwd", Jim_PwdCmd, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "cd", Jim_CdCmd, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
432
debuggers/openocd/jimtcl/jim-format.c
Normal file
432
debuggers/openocd/jimtcl/jim-format.c
Normal file
@ -0,0 +1,432 @@
|
||||
/*
|
||||
* Implements the internals of the format command for jim
|
||||
*
|
||||
* The FreeBSD license
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*
|
||||
* Based on code originally from Tcl 8.5:
|
||||
*
|
||||
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
|
||||
* Copyright (c) 1999 by Scriptics Corporation.
|
||||
*
|
||||
* See the file "tcl.license.terms" for information on usage and redistribution of
|
||||
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
||||
*/
|
||||
#include <ctype.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <jim.h>
|
||||
#include "utf8.h"
|
||||
|
||||
#define JIM_UTF_MAX 3
|
||||
#define JIM_INTEGER_SPACE 24
|
||||
#define MAX_FLOAT_WIDTH 320
|
||||
|
||||
/**
|
||||
* Apply the printf-like format in fmtObjPtr with the given arguments.
|
||||
*
|
||||
* Returns a new object with zero reference count if OK, or NULL on error.
|
||||
*/
|
||||
Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr, int objc, Jim_Obj *const *objv)
|
||||
{
|
||||
const char *span, *format, *formatEnd, *msg;
|
||||
int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0;
|
||||
static const char * const mixedXPG =
|
||||
"cannot mix \"%\" and \"%n$\" conversion specifiers";
|
||||
static const char * const badIndex[2] = {
|
||||
"not enough arguments for all format specifiers",
|
||||
"\"%n$\" argument index out of range"
|
||||
};
|
||||
int formatLen;
|
||||
Jim_Obj *resultPtr;
|
||||
|
||||
/* A single buffer is used to store numeric fields (with sprintf())
|
||||
* This buffer is allocated/reallocated as necessary
|
||||
*/
|
||||
char *num_buffer = NULL;
|
||||
int num_buffer_size = 0;
|
||||
|
||||
span = format = Jim_GetString(fmtObjPtr, &formatLen);
|
||||
formatEnd = format + formatLen;
|
||||
resultPtr = Jim_NewStringObj(interp, "", 0);
|
||||
|
||||
while (format != formatEnd) {
|
||||
char *end;
|
||||
int gotMinus, sawFlag;
|
||||
int gotPrecision, useShort;
|
||||
long width, precision;
|
||||
int newXpg;
|
||||
int ch;
|
||||
int step;
|
||||
int doubleType;
|
||||
char pad = ' ';
|
||||
char spec[2*JIM_INTEGER_SPACE + 12];
|
||||
char *p;
|
||||
|
||||
int formatted_chars;
|
||||
int formatted_bytes;
|
||||
const char *formatted_buf;
|
||||
|
||||
step = utf8_tounicode(format, &ch);
|
||||
format += step;
|
||||
if (ch != '%') {
|
||||
numBytes += step;
|
||||
continue;
|
||||
}
|
||||
if (numBytes) {
|
||||
Jim_AppendString(interp, resultPtr, span, numBytes);
|
||||
numBytes = 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Saw a % : process the format specifier.
|
||||
*
|
||||
* Step 0. Handle special case of escaped format marker (i.e., %%).
|
||||
*/
|
||||
|
||||
step = utf8_tounicode(format, &ch);
|
||||
if (ch == '%') {
|
||||
span = format;
|
||||
numBytes = step;
|
||||
format += step;
|
||||
continue;
|
||||
}
|
||||
|
||||
/*
|
||||
* Step 1. XPG3 position specifier
|
||||
*/
|
||||
|
||||
newXpg = 0;
|
||||
if (isdigit(ch)) {
|
||||
int position = strtoul(format, &end, 10);
|
||||
if (*end == '$') {
|
||||
newXpg = 1;
|
||||
objIndex = position - 1;
|
||||
format = end + 1;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
}
|
||||
}
|
||||
if (newXpg) {
|
||||
if (gotSequential) {
|
||||
msg = mixedXPG;
|
||||
goto errorMsg;
|
||||
}
|
||||
gotXpg = 1;
|
||||
} else {
|
||||
if (gotXpg) {
|
||||
msg = mixedXPG;
|
||||
goto errorMsg;
|
||||
}
|
||||
gotSequential = 1;
|
||||
}
|
||||
if ((objIndex < 0) || (objIndex >= objc)) {
|
||||
msg = badIndex[gotXpg];
|
||||
goto errorMsg;
|
||||
}
|
||||
|
||||
/*
|
||||
* Step 2. Set of flags. Also build up the sprintf spec.
|
||||
*/
|
||||
p = spec;
|
||||
*p++ = '%';
|
||||
|
||||
gotMinus = 0;
|
||||
sawFlag = 1;
|
||||
do {
|
||||
switch (ch) {
|
||||
case '-':
|
||||
gotMinus = 1;
|
||||
break;
|
||||
case '0':
|
||||
pad = ch;
|
||||
break;
|
||||
case ' ':
|
||||
case '+':
|
||||
case '#':
|
||||
break;
|
||||
default:
|
||||
sawFlag = 0;
|
||||
continue;
|
||||
}
|
||||
*p++ = ch;
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
} while (sawFlag);
|
||||
|
||||
/*
|
||||
* Step 3. Minimum field width.
|
||||
*/
|
||||
|
||||
width = 0;
|
||||
if (isdigit(ch)) {
|
||||
width = strtoul(format, &end, 10);
|
||||
format = end;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
} else if (ch == '*') {
|
||||
if (objIndex >= objc - 1) {
|
||||
msg = badIndex[gotXpg];
|
||||
goto errorMsg;
|
||||
}
|
||||
if (Jim_GetLong(interp, objv[objIndex], &width) != JIM_OK) {
|
||||
goto error;
|
||||
}
|
||||
if (width < 0) {
|
||||
width = -width;
|
||||
if (!gotMinus) {
|
||||
*p++ = '-';
|
||||
gotMinus = 1;
|
||||
}
|
||||
}
|
||||
objIndex++;
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
}
|
||||
|
||||
/*
|
||||
* Step 4. Precision.
|
||||
*/
|
||||
|
||||
gotPrecision = precision = 0;
|
||||
if (ch == '.') {
|
||||
gotPrecision = 1;
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
}
|
||||
if (isdigit(ch)) {
|
||||
precision = strtoul(format, &end, 10);
|
||||
format = end;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
} else if (ch == '*') {
|
||||
if (objIndex >= objc - 1) {
|
||||
msg = badIndex[gotXpg];
|
||||
goto errorMsg;
|
||||
}
|
||||
if (Jim_GetLong(interp, objv[objIndex], &precision) != JIM_OK) {
|
||||
goto error;
|
||||
}
|
||||
|
||||
/*
|
||||
* TODO: Check this truncation logic.
|
||||
*/
|
||||
|
||||
if (precision < 0) {
|
||||
precision = 0;
|
||||
}
|
||||
objIndex++;
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
}
|
||||
|
||||
/*
|
||||
* Step 5. Length modifier.
|
||||
*/
|
||||
|
||||
useShort = 0;
|
||||
if (ch == 'h') {
|
||||
useShort = 1;
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
} else if (ch == 'l') {
|
||||
/* Just for compatibility. All non-short integers are wide. */
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
if (ch == 'l') {
|
||||
format += step;
|
||||
step = utf8_tounicode(format, &ch);
|
||||
}
|
||||
}
|
||||
|
||||
format += step;
|
||||
span = format;
|
||||
|
||||
/*
|
||||
* Step 6. The actual conversion character.
|
||||
*/
|
||||
|
||||
if (ch == 'i') {
|
||||
ch = 'd';
|
||||
}
|
||||
|
||||
doubleType = 0;
|
||||
|
||||
/* Each valid conversion will set:
|
||||
* formatted_buf - the result to be added
|
||||
* formatted_chars - the length of formatted_buf in characters
|
||||
* formatted_bytes - the length of formatted_buf in bytes
|
||||
*/
|
||||
switch (ch) {
|
||||
case '\0':
|
||||
msg = "format string ended in middle of field specifier";
|
||||
goto errorMsg;
|
||||
case 's': {
|
||||
formatted_buf = Jim_GetString(objv[objIndex], &formatted_bytes);
|
||||
formatted_chars = Jim_Utf8Length(interp, objv[objIndex]);
|
||||
if (gotPrecision && (precision < formatted_chars)) {
|
||||
/* Need to build a (null terminated) truncated string */
|
||||
formatted_chars = precision;
|
||||
formatted_bytes = utf8_index(formatted_buf, precision);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case 'c': {
|
||||
jim_wide code;
|
||||
|
||||
if (Jim_GetWide(interp, objv[objIndex], &code) != JIM_OK) {
|
||||
goto error;
|
||||
}
|
||||
/* Just store the value in the 'spec' buffer */
|
||||
formatted_bytes = utf8_fromunicode(spec, code);
|
||||
formatted_buf = spec;
|
||||
formatted_chars = 1;
|
||||
break;
|
||||
}
|
||||
|
||||
case 'e':
|
||||
case 'E':
|
||||
case 'f':
|
||||
case 'g':
|
||||
case 'G':
|
||||
doubleType = 1;
|
||||
/* fall through */
|
||||
case 'd':
|
||||
case 'u':
|
||||
case 'o':
|
||||
case 'x':
|
||||
case 'X': {
|
||||
jim_wide w;
|
||||
double d;
|
||||
int length;
|
||||
|
||||
/* Fill in the width and precision */
|
||||
if (width) {
|
||||
p += sprintf(p, "%ld", width);
|
||||
}
|
||||
if (gotPrecision) {
|
||||
p += sprintf(p, ".%ld", precision);
|
||||
}
|
||||
|
||||
/* Now the modifier, and get the actual value here */
|
||||
if (doubleType) {
|
||||
if (Jim_GetDouble(interp, objv[objIndex], &d) != JIM_OK) {
|
||||
goto error;
|
||||
}
|
||||
length = MAX_FLOAT_WIDTH;
|
||||
}
|
||||
else {
|
||||
if (Jim_GetWide(interp, objv[objIndex], &w) != JIM_OK) {
|
||||
goto error;
|
||||
}
|
||||
length = JIM_INTEGER_SPACE;
|
||||
if (useShort) {
|
||||
*p++ = 'h';
|
||||
if (ch == 'd') {
|
||||
w = (short)w;
|
||||
}
|
||||
else {
|
||||
w = (unsigned short)w;
|
||||
}
|
||||
}
|
||||
else {
|
||||
*p++ = 'l';
|
||||
#ifdef HAVE_LONG_LONG
|
||||
if (sizeof(long long) == sizeof(jim_wide)) {
|
||||
*p++ = 'l';
|
||||
}
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
||||
*p++ = (char) ch;
|
||||
*p = '\0';
|
||||
|
||||
/* Adjust length for width and precision */
|
||||
if (width > length) {
|
||||
length = width;
|
||||
}
|
||||
if (gotPrecision) {
|
||||
length += precision;
|
||||
}
|
||||
|
||||
/* Increase the size of the buffer if needed */
|
||||
if (num_buffer_size < length + 1) {
|
||||
num_buffer_size = length + 1;
|
||||
num_buffer = Jim_Realloc(num_buffer, num_buffer_size);
|
||||
}
|
||||
|
||||
if (doubleType) {
|
||||
snprintf(num_buffer, length + 1, spec, d);
|
||||
}
|
||||
else {
|
||||
formatted_bytes = snprintf(num_buffer, length + 1, spec, w);
|
||||
}
|
||||
formatted_chars = formatted_bytes = strlen(num_buffer);
|
||||
formatted_buf = num_buffer;
|
||||
break;
|
||||
}
|
||||
|
||||
default: {
|
||||
/* Just reuse the 'spec' buffer */
|
||||
spec[0] = ch;
|
||||
spec[1] = '\0';
|
||||
Jim_SetResultFormatted(interp, "bad field specifier \"%s\"", spec);
|
||||
goto error;
|
||||
}
|
||||
}
|
||||
|
||||
if (!gotMinus) {
|
||||
while (formatted_chars < width) {
|
||||
Jim_AppendString(interp, resultPtr, &pad, 1);
|
||||
formatted_chars++;
|
||||
}
|
||||
}
|
||||
|
||||
Jim_AppendString(interp, resultPtr, formatted_buf, formatted_bytes);
|
||||
|
||||
while (formatted_chars < width) {
|
||||
Jim_AppendString(interp, resultPtr, &pad, 1);
|
||||
formatted_chars++;
|
||||
}
|
||||
|
||||
objIndex += gotSequential;
|
||||
}
|
||||
if (numBytes) {
|
||||
Jim_AppendString(interp, resultPtr, span, numBytes);
|
||||
}
|
||||
|
||||
Jim_Free(num_buffer);
|
||||
return resultPtr;
|
||||
|
||||
errorMsg:
|
||||
Jim_SetResultString(interp, msg, -1);
|
||||
error:
|
||||
Jim_FreeNewObj(interp, resultPtr);
|
||||
Jim_Free(num_buffer);
|
||||
return NULL;
|
||||
}
|
||||
122
debuggers/openocd/jimtcl/jim-history.c
Normal file
122
debuggers/openocd/jimtcl/jim-history.c
Normal file
@ -0,0 +1,122 @@
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#include "jim.h"
|
||||
#include "jimautoconf.h"
|
||||
#include "jim-subcmd.h"
|
||||
|
||||
static int history_cmd_getline(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *objPtr;
|
||||
char *line = Jim_HistoryGetline(Jim_String(argv[0]));
|
||||
|
||||
/* On EOF returns -1 if varName was specified, or the empty string. */
|
||||
if (line == NULL) {
|
||||
if (argc == 2) {
|
||||
Jim_SetResultInt(interp, -1);
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
objPtr = Jim_NewStringObjNoAlloc(interp, line, -1);
|
||||
|
||||
/* Returns the length of the string if varName was specified */
|
||||
if (argc == 2) {
|
||||
if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) {
|
||||
Jim_FreeNewObj(interp, objPtr);
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultInt(interp, Jim_Length(objPtr));
|
||||
}
|
||||
else {
|
||||
Jim_SetResult(interp, objPtr);
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int history_cmd_load(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_HistoryLoad(Jim_String(argv[0]));
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int history_cmd_save(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_HistorySave(Jim_String(argv[0]));
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int history_cmd_add(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_HistoryAdd(Jim_String(argv[0]));
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int history_cmd_show(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_HistoryShow();
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static const jim_subcmd_type history_command_table[] = {
|
||||
{ "getline",
|
||||
"prompt ?varname?",
|
||||
history_cmd_getline,
|
||||
1,
|
||||
2,
|
||||
/* Description: Reads one line from the user. Similar to gets. */
|
||||
},
|
||||
{ "load",
|
||||
"filename",
|
||||
history_cmd_load,
|
||||
1,
|
||||
1,
|
||||
/* Description: Loads history from the given file, if possible */
|
||||
},
|
||||
{ "save",
|
||||
"filename",
|
||||
history_cmd_save,
|
||||
1,
|
||||
1,
|
||||
/* Description: Saves history to the given file */
|
||||
},
|
||||
{ "add",
|
||||
"line",
|
||||
history_cmd_add,
|
||||
1,
|
||||
1,
|
||||
/* Description: Adds the line to the history ands saves */
|
||||
},
|
||||
{ "show",
|
||||
NULL,
|
||||
history_cmd_show,
|
||||
0,
|
||||
0,
|
||||
/* Description: Displays the history */
|
||||
},
|
||||
{ NULL }
|
||||
};
|
||||
|
||||
static int JimHistorySubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return Jim_CallSubCmd(interp, Jim_ParseSubCmd(interp, history_command_table, argc, argv), argc, argv);
|
||||
}
|
||||
|
||||
static void JimHistoryDelProc(Jim_Interp *interp, void *privData)
|
||||
{
|
||||
Jim_Free(privData);
|
||||
}
|
||||
|
||||
int Jim_historyInit(Jim_Interp *interp)
|
||||
{
|
||||
void **history;
|
||||
if (Jim_PackageProvide(interp, "history", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
history = Jim_Alloc(sizeof(*history));
|
||||
*history = NULL;
|
||||
|
||||
Jim_CreateCommand(interp, "history", JimHistorySubCmdProc, history, JimHistoryDelProc);
|
||||
return JIM_OK;
|
||||
}
|
||||
172
debuggers/openocd/jimtcl/jim-interactive.c
Normal file
172
debuggers/openocd/jimtcl/jim-interactive.c
Normal file
@ -0,0 +1,172 @@
|
||||
#include <errno.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim.h>
|
||||
|
||||
#ifdef USE_LINENOISE
|
||||
#include <unistd.h>
|
||||
#include "linenoise.h"
|
||||
#else
|
||||
#define MAX_LINE_LEN 512
|
||||
#endif
|
||||
|
||||
/**
|
||||
* Returns an allocated line, or NULL if EOF.
|
||||
*/
|
||||
char *Jim_HistoryGetline(const char *prompt)
|
||||
{
|
||||
#ifdef USE_LINENOISE
|
||||
return linenoise(prompt);
|
||||
#else
|
||||
char *line = malloc(MAX_LINE_LEN);
|
||||
|
||||
fputs(prompt, stdout);
|
||||
fflush(stdout);
|
||||
|
||||
if (fgets(line, MAX_LINE_LEN, stdin) == NULL) {
|
||||
free(line);
|
||||
return NULL;
|
||||
}
|
||||
return line;
|
||||
#endif
|
||||
}
|
||||
|
||||
void Jim_HistoryLoad(const char *filename)
|
||||
{
|
||||
#ifdef USE_LINENOISE
|
||||
linenoiseHistoryLoad(filename);
|
||||
#endif
|
||||
}
|
||||
|
||||
void Jim_HistoryAdd(const char *line)
|
||||
{
|
||||
#ifdef USE_LINENOISE
|
||||
linenoiseHistoryAdd(line);
|
||||
#endif
|
||||
}
|
||||
|
||||
void Jim_HistorySave(const char *filename)
|
||||
{
|
||||
#ifdef USE_LINENOISE
|
||||
linenoiseHistorySave(filename);
|
||||
#endif
|
||||
}
|
||||
|
||||
void Jim_HistoryShow(void)
|
||||
{
|
||||
#ifdef USE_LINENOISE
|
||||
/* built-in history command */
|
||||
int i;
|
||||
int len;
|
||||
char **history = linenoiseHistory(&len);
|
||||
for (i = 0; i < len; i++) {
|
||||
printf("%4d %s\n", i + 1, history[i]);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
int Jim_InteractivePrompt(Jim_Interp *interp)
|
||||
{
|
||||
int retcode = JIM_OK;
|
||||
char *history_file = NULL;
|
||||
#ifdef USE_LINENOISE
|
||||
const char *home;
|
||||
|
||||
home = getenv("HOME");
|
||||
if (home && isatty(STDIN_FILENO)) {
|
||||
int history_len = strlen(home) + sizeof("/.jim_history");
|
||||
history_file = Jim_Alloc(history_len);
|
||||
snprintf(history_file, history_len, "%s/.jim_history", home);
|
||||
Jim_HistoryLoad(history_file);
|
||||
}
|
||||
#endif
|
||||
|
||||
printf("Welcome to Jim version %d.%d" JIM_NL,
|
||||
JIM_VERSION / 100, JIM_VERSION % 100);
|
||||
Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "1");
|
||||
|
||||
while (1) {
|
||||
Jim_Obj *scriptObjPtr;
|
||||
const char *result;
|
||||
int reslen;
|
||||
char prompt[20];
|
||||
const char *str;
|
||||
|
||||
if (retcode != 0) {
|
||||
const char *retcodestr = Jim_ReturnCode(retcode);
|
||||
|
||||
if (*retcodestr == '?') {
|
||||
snprintf(prompt, sizeof(prompt) - 3, "[%d] ", retcode);
|
||||
}
|
||||
else {
|
||||
snprintf(prompt, sizeof(prompt) - 3, "[%s] ", retcodestr);
|
||||
}
|
||||
}
|
||||
else {
|
||||
prompt[0] = '\0';
|
||||
}
|
||||
strcat(prompt, ". ");
|
||||
|
||||
scriptObjPtr = Jim_NewStringObj(interp, "", 0);
|
||||
Jim_IncrRefCount(scriptObjPtr);
|
||||
while (1) {
|
||||
char state;
|
||||
int len;
|
||||
char *line;
|
||||
|
||||
line = Jim_HistoryGetline(prompt);
|
||||
if (line == NULL) {
|
||||
if (errno == EINTR) {
|
||||
continue;
|
||||
}
|
||||
Jim_DecrRefCount(interp, scriptObjPtr);
|
||||
retcode = JIM_OK;
|
||||
goto out;
|
||||
}
|
||||
if (Jim_Length(scriptObjPtr) != 0) {
|
||||
Jim_AppendString(interp, scriptObjPtr, "\n", 1);
|
||||
}
|
||||
Jim_AppendString(interp, scriptObjPtr, line, -1);
|
||||
free(line);
|
||||
str = Jim_GetString(scriptObjPtr, &len);
|
||||
if (len == 0) {
|
||||
continue;
|
||||
}
|
||||
if (Jim_ScriptIsComplete(str, len, &state))
|
||||
break;
|
||||
|
||||
snprintf(prompt, sizeof(prompt), "%c> ", state);
|
||||
}
|
||||
#ifdef USE_LINENOISE
|
||||
if (strcmp(str, "h") == 0) {
|
||||
/* built-in history command */
|
||||
Jim_HistoryShow();
|
||||
Jim_DecrRefCount(interp, scriptObjPtr);
|
||||
continue;
|
||||
}
|
||||
|
||||
Jim_HistoryAdd(Jim_String(scriptObjPtr));
|
||||
if (history_file) {
|
||||
Jim_HistorySave(history_file);
|
||||
}
|
||||
#endif
|
||||
retcode = Jim_EvalObj(interp, scriptObjPtr);
|
||||
Jim_DecrRefCount(interp, scriptObjPtr);
|
||||
|
||||
if (retcode == JIM_EXIT) {
|
||||
retcode = JIM_EXIT;
|
||||
break;
|
||||
}
|
||||
if (retcode == JIM_ERR) {
|
||||
Jim_MakeErrorMessage(interp);
|
||||
}
|
||||
result = Jim_GetString(Jim_GetResult(interp), &reslen);
|
||||
if (reslen) {
|
||||
printf("%s\n", result);
|
||||
}
|
||||
}
|
||||
out:
|
||||
Jim_Free(history_file);
|
||||
return retcode;
|
||||
}
|
||||
128
debuggers/openocd/jimtcl/jim-load.c
Normal file
128
debuggers/openocd/jimtcl/jim-load.c
Normal file
@ -0,0 +1,128 @@
|
||||
#include <string.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim.h>
|
||||
|
||||
/* -----------------------------------------------------------------------------
|
||||
* Dynamic libraries support (WIN32 not supported)
|
||||
* ---------------------------------------------------------------------------*/
|
||||
|
||||
#if defined(HAVE_DLOPEN) || defined(HAVE_DLOPEN_COMPAT)
|
||||
|
||||
#ifdef HAVE_DLFCN_H
|
||||
#include <dlfcn.h>
|
||||
#endif
|
||||
|
||||
#ifndef RTLD_NOW
|
||||
#define RTLD_NOW 0
|
||||
#endif
|
||||
#ifndef RTLD_LOCAL
|
||||
#define RTLD_LOCAL 0
|
||||
#endif
|
||||
|
||||
/**
|
||||
* Note that Jim_LoadLibrary() requires a path to an existing file.
|
||||
*
|
||||
* If it is necessary to search JIM_LIBPATH, use Jim_PackageRequire() instead.
|
||||
*/
|
||||
int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
|
||||
{
|
||||
void *handle = dlopen(pathName, RTLD_NOW | RTLD_LOCAL);
|
||||
if (handle == NULL) {
|
||||
Jim_SetResultFormatted(interp, "error loading extension \"%s\": %s", pathName,
|
||||
dlerror());
|
||||
}
|
||||
else {
|
||||
/* We use a unique init symbol depending on the extension name.
|
||||
* This is done for compatibility between static and dynamic extensions.
|
||||
* For extension readline.so, the init symbol is "Jim_readlineInit"
|
||||
*/
|
||||
const char *pt;
|
||||
const char *pkgname;
|
||||
int pkgnamelen;
|
||||
char initsym[40];
|
||||
typedef int jim_module_init_func_type(Jim_Interp *);
|
||||
jim_module_init_func_type *onload;
|
||||
|
||||
pt = strrchr(pathName, '/');
|
||||
if (pt) {
|
||||
pkgname = pt + 1;
|
||||
}
|
||||
else {
|
||||
pkgname = pathName;
|
||||
}
|
||||
pt = strchr(pkgname, '.');
|
||||
if (pt) {
|
||||
pkgnamelen = pt - pkgname;
|
||||
}
|
||||
else {
|
||||
pkgnamelen = strlen(pkgname);
|
||||
}
|
||||
snprintf(initsym, sizeof(initsym), "Jim_%.*sInit", pkgnamelen, pkgname);
|
||||
|
||||
if ((onload = (jim_module_init_func_type *)dlsym(handle, initsym)) == NULL) {
|
||||
Jim_SetResultFormatted(interp,
|
||||
"No %s symbol found in extension %s", initsym, pathName);
|
||||
}
|
||||
else if (onload(interp) != JIM_ERR) {
|
||||
/* Add this handle to the stack of handles to be freed */
|
||||
if (!interp->loadHandles) {
|
||||
interp->loadHandles = Jim_Alloc(sizeof(*interp->loadHandles));
|
||||
Jim_InitStack(interp->loadHandles);
|
||||
}
|
||||
Jim_StackPush(interp->loadHandles, handle);
|
||||
|
||||
Jim_SetEmptyResult(interp);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
}
|
||||
if (handle) {
|
||||
dlclose(handle);
|
||||
}
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
static void JimFreeOneLoadHandle(void *handle)
|
||||
{
|
||||
dlclose(handle);
|
||||
}
|
||||
|
||||
void Jim_FreeLoadHandles(Jim_Interp *interp)
|
||||
{
|
||||
if (interp->loadHandles) {
|
||||
Jim_FreeStackElements(interp->loadHandles, JimFreeOneLoadHandle);
|
||||
Jim_Free(interp->loadHandles);
|
||||
}
|
||||
}
|
||||
|
||||
#else /* JIM_DYNLIB */
|
||||
int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName)
|
||||
{
|
||||
JIM_NOTUSED(interp);
|
||||
JIM_NOTUSED(pathName);
|
||||
|
||||
Jim_SetResultString(interp, "the Jim binary has no support for [load]", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
void Jim_FreeLoadHandles(Jim_Interp *interp)
|
||||
{
|
||||
}
|
||||
#endif /* JIM_DYNLIB */
|
||||
|
||||
/* [load] */
|
||||
static int Jim_LoadCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
if (argc < 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "libaryFile");
|
||||
return JIM_ERR;
|
||||
}
|
||||
return Jim_LoadLibrary(interp, Jim_String(argv[1]));
|
||||
}
|
||||
|
||||
int Jim_loadInit(Jim_Interp *interp)
|
||||
{
|
||||
Jim_CreateCommand(interp, "load", Jim_LoadCoreCommand, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
2276
debuggers/openocd/jimtcl/jim-mk.cpp
Normal file
2276
debuggers/openocd/jimtcl/jim-mk.cpp
Normal file
File diff suppressed because it is too large
Load Diff
335
debuggers/openocd/jimtcl/jim-namespace.c
Normal file
335
debuggers/openocd/jimtcl/jim-namespace.c
Normal file
@ -0,0 +1,335 @@
|
||||
/*
|
||||
* Support for namespaces in jim
|
||||
*
|
||||
* (c) 2011 Steve Bennett <steveb@workware.net.au>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*
|
||||
* Based on code originally from Tcl 6.7:
|
||||
*
|
||||
* Copyright 1987-1991 Regents of the University of California
|
||||
* Permission to use, copy, modify, and distribute this
|
||||
* software and its documentation for any purpose and without
|
||||
* fee is hereby granted, provided that the above copyright
|
||||
* notice appear in all copies. The University of California
|
||||
* makes no representations about the suitability of this
|
||||
* software for any purpose. It is provided "as is" without
|
||||
* express or implied warranty.
|
||||
*/
|
||||
|
||||
#include <limits.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
#include <assert.h>
|
||||
|
||||
#include "jim.h"
|
||||
#include "jimautoconf.h"
|
||||
#include "jim-subcmd.h"
|
||||
|
||||
/* -----------------------------------------------------------------------------
|
||||
* Namespace support
|
||||
* ---------------------------------------------------------------------------*/
|
||||
|
||||
/**
|
||||
* nsObj is a canonical namespace name (.e.g. "" for root, "abc" for ::abc)
|
||||
*
|
||||
* The given name is appended to the namespace name to produce a complete canonical name.
|
||||
*
|
||||
* e.g. "" "abc" => abc
|
||||
* "" "::abc" => abc
|
||||
* "" "abc::def" => abc::def
|
||||
* "abc" "def" => abc::def
|
||||
* "abc" "::def" => def
|
||||
*
|
||||
*/
|
||||
Jim_Obj *JimCanonicalNamespace(Jim_Interp *interp, Jim_Obj *nsObj, Jim_Obj *nameObj)
|
||||
{
|
||||
Jim_Obj *objPtr;
|
||||
const char *name = Jim_String(nameObj);
|
||||
assert(nameObj->refCount != 0);
|
||||
assert(nsObj->refCount != 0);
|
||||
if (name[0] == ':' && name[1] == ':') {
|
||||
/* Absolute namespace */
|
||||
while (*++name == ':') {
|
||||
}
|
||||
return Jim_NewStringObj(interp, name, -1);
|
||||
}
|
||||
if (Jim_Length(nsObj) == 0) {
|
||||
/* Relative to the global namespace */
|
||||
return nameObj;
|
||||
}
|
||||
/* Relative to non-global namespace */
|
||||
objPtr = Jim_DuplicateObj(interp, nsObj);
|
||||
Jim_AppendString(interp, objPtr, "::", 2);
|
||||
Jim_AppendObj(interp, objPtr, nameObj);
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
int Jim_CreateNamespaceVariable(Jim_Interp *interp, Jim_Obj *varNameObj, Jim_Obj *targetNameObj)
|
||||
{
|
||||
int rc;
|
||||
Jim_IncrRefCount(varNameObj);
|
||||
Jim_IncrRefCount(targetNameObj);
|
||||
|
||||
/* push non-namespace vars if in namespace eval? */
|
||||
rc = Jim_SetVariableLink(interp, varNameObj, targetNameObj, interp->topFramePtr);
|
||||
|
||||
Jim_DecrRefCount(interp, varNameObj);
|
||||
Jim_DecrRefCount(interp, targetNameObj);
|
||||
|
||||
return rc;
|
||||
}
|
||||
|
||||
/**
|
||||
* Returns the parent of the given namespace.
|
||||
*
|
||||
* ::bob::tom => ::bob
|
||||
* bob::tom => bob
|
||||
* ::bob => ::
|
||||
* bob => ""
|
||||
* :: => ""
|
||||
* "" => ""
|
||||
*/
|
||||
Jim_Obj *Jim_NamespaceQualifiers(Jim_Interp *interp, Jim_Obj *ns)
|
||||
{
|
||||
const char *name = Jim_String(ns);
|
||||
const char *pt = strrchr(name, ':');
|
||||
if (pt && pt != name && pt[-1] == ':') {
|
||||
return Jim_NewStringObj(interp, name, pt - name - 1);
|
||||
}
|
||||
else {
|
||||
return interp->emptyObj;
|
||||
}
|
||||
}
|
||||
|
||||
Jim_Obj *Jim_NamespaceTail(Jim_Interp *interp, Jim_Obj *ns)
|
||||
{
|
||||
const char *name = Jim_String(ns);
|
||||
const char *pt = strrchr(name, ':');
|
||||
if (pt && pt != name && pt[-1] == ':') {
|
||||
return Jim_NewStringObj(interp, pt + 1, -1);
|
||||
}
|
||||
else {
|
||||
return ns;
|
||||
}
|
||||
}
|
||||
|
||||
static Jim_Obj *JimNamespaceCurrent(Jim_Interp *interp)
|
||||
{
|
||||
Jim_Obj *objPtr = Jim_NewStringObj(interp, "::", 2);
|
||||
Jim_AppendObj(interp, objPtr, interp->framePtr->nsObj);
|
||||
return objPtr;
|
||||
}
|
||||
|
||||
static int JimVariableCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int retcode = JIM_OK;
|
||||
|
||||
if (argc > 3) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "name ?value?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc > 1) {
|
||||
Jim_Obj *targetNameObj;
|
||||
Jim_Obj *localNameObj;
|
||||
|
||||
#if 0
|
||||
/* XXX should we give an error on dict sugar syntax? */
|
||||
if (JimValidName(interp, "variable", argv[1]) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
#endif
|
||||
|
||||
targetNameObj = JimCanonicalNamespace(interp, interp->framePtr->nsObj, argv[1]);
|
||||
|
||||
localNameObj = Jim_NamespaceTail(interp, argv[1]);
|
||||
Jim_IncrRefCount(localNameObj);
|
||||
if (interp->framePtr->level != 0 || Jim_Length(interp->framePtr->nsObj) != 0) {
|
||||
Jim_CreateNamespaceVariable(interp, localNameObj, targetNameObj);
|
||||
}
|
||||
|
||||
/* Set the variable via the local name */
|
||||
if (argc > 2) {
|
||||
retcode = Jim_SetVariable(interp, localNameObj, argv[2]);
|
||||
}
|
||||
Jim_DecrRefCount(interp, localNameObj);
|
||||
}
|
||||
return retcode;
|
||||
}
|
||||
|
||||
/* XXX: Temporary */
|
||||
static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1);
|
||||
|
||||
Jim_AppendString(interp, prefixObj, " ", 1);
|
||||
Jim_AppendString(interp, prefixObj, subcmd, -1);
|
||||
|
||||
return Jim_EvalObjPrefix(interp, prefixObj, argc, argv);
|
||||
}
|
||||
|
||||
static int JimNamespaceCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *nsObj;
|
||||
Jim_Obj *objPtr;
|
||||
int option;
|
||||
static const char * const options[] = {
|
||||
"eval", "current", "canonical", "qualifiers", "parent", "tail", "delete",
|
||||
"origin", "code", "inscope", "import", "export",
|
||||
"which", "upvar", NULL
|
||||
};
|
||||
enum
|
||||
{
|
||||
OPT_EVAL, OPT_CURRENT, OPT_CANONICAL, OPT_QUALIFIERS, OPT_PARENT, OPT_TAIL, OPT_DELETE,
|
||||
OPT_ORIGIN, OPT_CODE, OPT_INSCOPE, OPT_IMPORT, OPT_EXPORT,
|
||||
OPT_WHICH, OPT_UPVAR,
|
||||
};
|
||||
|
||||
if (argc < 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arg ...?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
switch (option) {
|
||||
case OPT_EVAL:
|
||||
if (argc < 4) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "name arg ?arg...?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc == 4) {
|
||||
objPtr = argv[3];
|
||||
}
|
||||
else {
|
||||
objPtr = Jim_ConcatObj(interp, argc - 3, argv + 3);
|
||||
}
|
||||
|
||||
nsObj = JimCanonicalNamespace(interp, interp->framePtr->nsObj, argv[2]);
|
||||
return Jim_EvalNamespace(interp, objPtr, nsObj);
|
||||
|
||||
case OPT_CURRENT:
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResult(interp, JimNamespaceCurrent(interp));
|
||||
return JIM_OK;
|
||||
|
||||
case OPT_CANONICAL:
|
||||
if (argc > 4) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "?current? ?name?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc == 2) {
|
||||
Jim_SetResult(interp, interp->framePtr->nsObj);
|
||||
}
|
||||
else if (argc == 3) {
|
||||
Jim_SetResult(interp, JimCanonicalNamespace(interp, interp->framePtr->nsObj, argv[2]));
|
||||
}
|
||||
else {
|
||||
Jim_SetResult(interp, JimCanonicalNamespace(interp, argv[2], argv[3]));
|
||||
}
|
||||
return JIM_OK;
|
||||
|
||||
case OPT_QUALIFIERS:
|
||||
if (argc != 3) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "string");
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResult(interp, Jim_NamespaceQualifiers(interp, argv[2]));
|
||||
return JIM_OK;
|
||||
|
||||
case OPT_EXPORT:
|
||||
return JIM_OK;
|
||||
|
||||
case OPT_TAIL:
|
||||
if (argc != 3) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "string");
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResult(interp, Jim_NamespaceTail(interp, argv[2]));
|
||||
return JIM_OK;
|
||||
|
||||
case OPT_PARENT:
|
||||
if (argc != 2 && argc != 3) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "?name?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
else {
|
||||
const char *name;
|
||||
|
||||
if (argc == 3) {
|
||||
objPtr = argv[2];
|
||||
}
|
||||
else {
|
||||
objPtr = interp->framePtr->nsObj;
|
||||
}
|
||||
if (Jim_Length(objPtr) == 0 || Jim_CompareStringImmediate(interp, objPtr, "::")) {
|
||||
return JIM_OK;
|
||||
}
|
||||
objPtr = Jim_NamespaceQualifiers(interp, objPtr);
|
||||
|
||||
name = Jim_String(objPtr);
|
||||
|
||||
if (name[0] != ':' || name[1] != ':') {
|
||||
/* Make it fully scoped */
|
||||
Jim_SetResultString(interp, "::", 2);
|
||||
Jim_AppendObj(interp, Jim_GetResult(interp), objPtr);
|
||||
Jim_IncrRefCount(objPtr);
|
||||
Jim_DecrRefCount(interp, objPtr);
|
||||
}
|
||||
else {
|
||||
Jim_SetResult(interp, objPtr);
|
||||
}
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
/* Implemented as a Tcl helper proc.
|
||||
* Note that calling a proc will change the current namespace,
|
||||
* so helper procs must call [uplevel namespace canon] to get the callers
|
||||
* namespace.
|
||||
*/
|
||||
return Jim_EvalEnsemble(interp, "namespace", options[option], argc - 2, argv + 2);
|
||||
}
|
||||
|
||||
int Jim_namespaceInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "namespace", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "namespace", JimNamespaceCmd, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "variable", JimVariableCmd, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
380
debuggers/openocd/jimtcl/jim-pack.c
Normal file
380
debuggers/openocd/jimtcl/jim-pack.c
Normal file
@ -0,0 +1,380 @@
|
||||
#include <string.h>
|
||||
#include <jim.h>
|
||||
|
||||
/* Provides the [pack] and [unpack] commands to pack and unpack
|
||||
* a binary string to/from arbitrary width integers and strings.
|
||||
*
|
||||
* This may be used to implement the [binary] command.
|
||||
*/
|
||||
|
||||
/**
|
||||
* Big endian bit test.
|
||||
*
|
||||
* Considers 'bitvect' as a big endian bit stream and returns
|
||||
* bit 'b' as zero or non-zero.
|
||||
*/
|
||||
static int JimTestBitBigEndian(const unsigned char *bitvec, int b)
|
||||
{
|
||||
div_t pos = div(b, 8);
|
||||
return bitvec[pos.quot] & (1 << (7 - pos.rem));
|
||||
}
|
||||
|
||||
/**
|
||||
* Little endian bit test.
|
||||
*
|
||||
* Considers 'bitvect' as a little endian bit stream and returns
|
||||
* bit 'b' as zero or non-zero.
|
||||
*/
|
||||
static int JimTestBitLittleEndian(const unsigned char *bitvec, int b)
|
||||
{
|
||||
div_t pos = div(b, 8);
|
||||
return bitvec[pos.quot] & (1 << pos.rem);
|
||||
}
|
||||
|
||||
/**
|
||||
* Sign extends the given value, 'n' of width 'width' bits.
|
||||
*
|
||||
* For example, sign extending 0x80 with a width of 8, produces -128
|
||||
*/
|
||||
static jim_wide JimSignExtend(jim_wide n, int width)
|
||||
{
|
||||
if (width == sizeof(jim_wide) * 8) {
|
||||
/* Can't sign extend the maximum size integer */
|
||||
return n;
|
||||
}
|
||||
if (n & ((jim_wide)1 << (width - 1))) {
|
||||
/* Need to extend */
|
||||
n -= ((jim_wide)1 << width);
|
||||
}
|
||||
|
||||
return n;
|
||||
}
|
||||
|
||||
/**
|
||||
* Big endian integer extraction.
|
||||
*
|
||||
* Considers 'bitvect' as a big endian bit stream.
|
||||
* Returns an integer of the given width (in bits)
|
||||
* starting at the given position (in bits).
|
||||
*
|
||||
* The pos/width must represent bits inside bitvec,
|
||||
* and the width be no more than the width of jim_wide.
|
||||
*/
|
||||
static jim_wide JimBitIntBigEndian(const unsigned char *bitvec, int pos, int width)
|
||||
{
|
||||
jim_wide result = 0;
|
||||
int i;
|
||||
|
||||
/* Aligned, byte extraction */
|
||||
if (pos % 8 == 0 && width % 8 == 0) {
|
||||
for (i = 0; i < width; i += 8) {
|
||||
result = (result << 8) + bitvec[(pos + i) / 8];
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
/* Unaligned */
|
||||
for (i = 0; i < width; i++) {
|
||||
if (JimTestBitBigEndian(bitvec, pos + width - i - 1)) {
|
||||
result |= ((jim_wide)1 << i);
|
||||
}
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Little endian integer extraction.
|
||||
*
|
||||
* Like JimBitIntBigEndian() but considers 'bitvect' as a little endian bit stream.
|
||||
*/
|
||||
static jim_wide JimBitIntLittleEndian(const unsigned char *bitvec, int pos, int width)
|
||||
{
|
||||
jim_wide result = 0;
|
||||
int i;
|
||||
|
||||
/* Aligned, byte extraction */
|
||||
if (pos % 8 == 0 && width % 8 == 0) {
|
||||
for (i = 0; i < width; i += 8) {
|
||||
result += (jim_wide)bitvec[(pos + i) / 8] << i;
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
/* Unaligned */
|
||||
for (i = 0; i < width; i++) {
|
||||
if (JimTestBitLittleEndian(bitvec, pos + i)) {
|
||||
result |= ((jim_wide)1 << i);
|
||||
}
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Big endian bit set.
|
||||
*
|
||||
* Considers 'bitvect' as a big endian bit stream and sets
|
||||
* bit 'b' to 'bit'
|
||||
*/
|
||||
static void JimSetBitBigEndian(unsigned char *bitvec, int b, int bit)
|
||||
{
|
||||
div_t pos = div(b, 8);
|
||||
if (bit) {
|
||||
bitvec[pos.quot] |= (1 << (7 - pos.rem));
|
||||
}
|
||||
else {
|
||||
bitvec[pos.quot] &= ~(1 << (7 - pos.rem));
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* Little endian bit set.
|
||||
*
|
||||
* Considers 'bitvect' as a little endian bit stream and sets
|
||||
* bit 'b' to 'bit'
|
||||
*/
|
||||
static void JimSetBitLittleEndian(unsigned char *bitvec, int b, int bit)
|
||||
{
|
||||
div_t pos = div(b, 8);
|
||||
if (bit) {
|
||||
bitvec[pos.quot] |= (1 << pos.rem);
|
||||
}
|
||||
else {
|
||||
bitvec[pos.quot] &= ~(1 << pos.rem);
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* Big endian integer packing.
|
||||
*
|
||||
* Considers 'bitvect' as a big endian bit stream.
|
||||
* Packs integer 'value' of the given width (in bits)
|
||||
* starting at the given position (in bits).
|
||||
*
|
||||
* The pos/width must represent bits inside bitvec,
|
||||
* and the width be no more than the width of jim_wide.
|
||||
*/
|
||||
static void JimSetBitsIntBigEndian(unsigned char *bitvec, jim_wide value, int pos, int width)
|
||||
{
|
||||
int i;
|
||||
|
||||
/* Common fast option */
|
||||
if (pos % 8 == 0 && width == 8) {
|
||||
bitvec[pos / 8] = value;
|
||||
return;
|
||||
}
|
||||
|
||||
for (i = 0; i < width; i++) {
|
||||
int bit = !!(value & ((jim_wide)1 << i));
|
||||
JimSetBitBigEndian(bitvec, pos + width - i - 1, bit);
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* Little endian version of JimSetBitsIntBigEndian()
|
||||
*/
|
||||
static void JimSetBitsIntLittleEndian(unsigned char *bitvec, jim_wide value, int pos, int width)
|
||||
{
|
||||
int i;
|
||||
|
||||
/* Common fast option */
|
||||
if (pos % 8 == 0 && width == 8) {
|
||||
bitvec[pos / 8] = value;
|
||||
return;
|
||||
}
|
||||
|
||||
for (i = 0; i < width; i++) {
|
||||
int bit = !!(value & ((jim_wide)1 << i));
|
||||
JimSetBitLittleEndian(bitvec, pos + i, bit);
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* [unpack]
|
||||
*
|
||||
* Usage: unpack binvalue -intbe|-intle|-uintbe|-uintle|-str bitpos bitwidth
|
||||
*
|
||||
* Unpacks bits from $binvalue at bit position $bitpos and with $bitwidth.
|
||||
* Interprets the value according to the type and returns it.
|
||||
*/
|
||||
static int Jim_UnpackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int option;
|
||||
static const char * const options[] = { "-intbe", "-intle", "-uintbe", "-uintle", "-str", NULL };
|
||||
enum { OPT_INTBE, OPT_INTLE, OPT_UINTBE, OPT_UINTLE, OPT_STR, };
|
||||
jim_wide pos;
|
||||
jim_wide width;
|
||||
|
||||
if (argc != 5) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "binvalue -intbe|-intle|-uintbe|-uintle|-str bitpos bitwidth");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (Jim_GetWide(interp, argv[3], &pos) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (option == OPT_STR) {
|
||||
int len;
|
||||
const char *str = Jim_GetString(argv[1], &len);
|
||||
|
||||
if (width % 8 || pos % 8) {
|
||||
Jim_SetResultString(interp, "string field is not on a byte boundary", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (pos >= 0 && width > 0 && pos < len * 8) {
|
||||
if (pos + width > len * 8) {
|
||||
width = len * 8 - pos;
|
||||
}
|
||||
Jim_SetResultString(interp, str + pos / 8, width / 8);
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
else {
|
||||
int len;
|
||||
const unsigned char *str = (const unsigned char *)Jim_GetString(argv[1], &len);
|
||||
jim_wide result = 0;
|
||||
|
||||
if (width > sizeof(jim_wide) * 8) {
|
||||
Jim_SetResultFormatted(interp, "int field is too wide: %#s", argv[4]);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (pos >= 0 && width > 0 && pos < len * 8) {
|
||||
if (pos + width > len * 8) {
|
||||
width = len * 8 - pos;
|
||||
}
|
||||
if (option == OPT_INTBE || option == OPT_UINTBE) {
|
||||
result = JimBitIntBigEndian(str, pos, width);
|
||||
}
|
||||
else {
|
||||
result = JimBitIntLittleEndian(str, pos, width);
|
||||
}
|
||||
if (option == OPT_INTBE || option == OPT_INTLE) {
|
||||
result = JimSignExtend(result, width);
|
||||
}
|
||||
}
|
||||
Jim_SetResultInt(interp, result);
|
||||
return JIM_OK;
|
||||
}
|
||||
}
|
||||
|
||||
/**
|
||||
* [pack]
|
||||
*
|
||||
* Usage: pack varname value -intle|-intbe|-str width ?bitoffset?
|
||||
*
|
||||
* Packs the binary representation of 'value' into the variable of the given name.
|
||||
* The value is packed according to the given type, width and bitoffset.
|
||||
* The variable is created if necessary (like [append])
|
||||
* Ihe variable is expanded if necessary
|
||||
*/
|
||||
static int Jim_PackCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int option;
|
||||
static const char * const options[] = { "-intle", "-intbe", "-str", NULL };
|
||||
enum { OPT_LE, OPT_BE, OPT_STR };
|
||||
jim_wide pos = 0;
|
||||
jim_wide width;
|
||||
jim_wide value;
|
||||
Jim_Obj *stringObjPtr;
|
||||
int len;
|
||||
int freeobj = 0;
|
||||
|
||||
if (argc != 5 && argc != 6) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "varName value -intle|-intbe|-str bitwidth ?bitoffset?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetEnum(interp, argv[3], options, &option, NULL, JIM_ERRMSG) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (option != OPT_STR && Jim_GetWide(interp, argv[2], &value) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetWide(interp, argv[4], &width) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (width <= 0 || (option == OPT_STR && width % 8) || (option != OPT_STR && width > sizeof(jim_wide) * 8)) {
|
||||
Jim_SetResultFormatted(interp, "bad bitwidth: %#s", argv[5]);
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc == 6) {
|
||||
if (Jim_GetWide(interp, argv[5], &pos) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (pos < 0 || (option == OPT_STR && pos % 8)) {
|
||||
Jim_SetResultFormatted(interp, "bad bitoffset: %#s", argv[5]);
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
|
||||
stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED);
|
||||
if (!stringObjPtr) {
|
||||
/* Create the string if it doesn't exist */
|
||||
stringObjPtr = Jim_NewEmptyStringObj(interp);
|
||||
freeobj = 1;
|
||||
}
|
||||
else if (Jim_IsShared(stringObjPtr)) {
|
||||
freeobj = 1;
|
||||
stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr);
|
||||
}
|
||||
|
||||
len = Jim_Length(stringObjPtr) * 8;
|
||||
|
||||
/* Extend the string as necessary first */
|
||||
while (len < pos + width) {
|
||||
Jim_AppendString(interp, stringObjPtr, "", 1);
|
||||
len += 8;
|
||||
}
|
||||
|
||||
Jim_SetResultInt(interp, pos + width);
|
||||
|
||||
/* Now set the bits. Note that the the string *must* have no non-string rep
|
||||
* since we are writing the bytes directly.
|
||||
*/
|
||||
Jim_AppendString(interp, stringObjPtr, "", 0);
|
||||
|
||||
if (option == OPT_BE) {
|
||||
JimSetBitsIntBigEndian((unsigned char *)stringObjPtr->bytes, value, pos, width);
|
||||
}
|
||||
else if (option == OPT_LE) {
|
||||
JimSetBitsIntLittleEndian((unsigned char *)stringObjPtr->bytes, value, pos, width);
|
||||
}
|
||||
else {
|
||||
pos /= 8;
|
||||
width /= 8;
|
||||
|
||||
if (width > Jim_Length(argv[2])) {
|
||||
width = Jim_Length(argv[2]);
|
||||
}
|
||||
memcpy(stringObjPtr->bytes + pos, Jim_GetString(argv[2], NULL), width);
|
||||
/* No padding is needed since the string is already extended */
|
||||
}
|
||||
|
||||
if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) {
|
||||
if (freeobj) {
|
||||
Jim_FreeNewObj(interp, stringObjPtr);
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_packInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "pack", "1.0", JIM_ERRMSG)) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
Jim_CreateCommand(interp, "unpack", Jim_UnpackCmd, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "pack", Jim_PackCmd, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
269
debuggers/openocd/jimtcl/jim-package.c
Normal file
269
debuggers/openocd/jimtcl/jim-package.c
Normal file
@ -0,0 +1,269 @@
|
||||
#include <string.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim-subcmd.h>
|
||||
|
||||
#ifdef HAVE_UNISTD_H
|
||||
#include <unistd.h>
|
||||
#else
|
||||
#define R_OK 4
|
||||
#endif
|
||||
|
||||
/* All packages have a fixed, dummy version */
|
||||
static const char *package_version_1 = "1.0";
|
||||
|
||||
/* -----------------------------------------------------------------------------
|
||||
* Packages handling
|
||||
* ---------------------------------------------------------------------------*/
|
||||
|
||||
int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags)
|
||||
{
|
||||
/* If the package was already provided returns an error. */
|
||||
Jim_HashEntry *he = Jim_FindHashEntry(&interp->packages, name);
|
||||
|
||||
/* An empty result means the automatic entry. This can be replaced */
|
||||
if (he && *(const char *)he->u.val) {
|
||||
if (flags & JIM_ERRMSG) {
|
||||
Jim_SetResultFormatted(interp, "package \"%s\" was already provided", name);
|
||||
}
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (he) {
|
||||
Jim_DeleteHashEntry(&interp->packages, name);
|
||||
}
|
||||
Jim_AddHashEntry(&interp->packages, name, (char *)ver);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static char *JimFindPackage(Jim_Interp *interp, char **prefixes, int prefixc, const char *pkgName)
|
||||
{
|
||||
int i;
|
||||
char *buf = Jim_Alloc(JIM_PATH_LEN);
|
||||
|
||||
for (i = 0; i < prefixc; i++) {
|
||||
if (prefixes[i] == NULL)
|
||||
continue;
|
||||
|
||||
/* Loadable modules are tried first */
|
||||
#ifdef jim_ext_load
|
||||
snprintf(buf, JIM_PATH_LEN, "%s/%s.so", prefixes[i], pkgName);
|
||||
if (access(buf, R_OK) == 0) {
|
||||
return buf;
|
||||
}
|
||||
#endif
|
||||
if (strcmp(prefixes[i], ".") == 0) {
|
||||
snprintf(buf, JIM_PATH_LEN, "%s.tcl", pkgName);
|
||||
}
|
||||
else {
|
||||
snprintf(buf, JIM_PATH_LEN, "%s/%s.tcl", prefixes[i], pkgName);
|
||||
}
|
||||
|
||||
if (access(buf, R_OK) == 0) {
|
||||
return buf;
|
||||
}
|
||||
}
|
||||
Jim_Free(buf);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Search for a suitable package under every dir specified by JIM_LIBPATH,
|
||||
* and load it if possible. If a suitable package was loaded with success
|
||||
* JIM_OK is returned, otherwise JIM_ERR is returned. */
|
||||
static int JimLoadPackage(Jim_Interp *interp, const char *name, int flags)
|
||||
{
|
||||
Jim_Obj *libPathObjPtr;
|
||||
char **prefixes, *path;
|
||||
int prefixc, i, retCode = JIM_ERR;
|
||||
|
||||
libPathObjPtr = Jim_GetGlobalVariableStr(interp, JIM_LIBPATH, JIM_NONE);
|
||||
if (libPathObjPtr == NULL) {
|
||||
prefixc = 0;
|
||||
libPathObjPtr = NULL;
|
||||
}
|
||||
else {
|
||||
Jim_IncrRefCount(libPathObjPtr);
|
||||
prefixc = Jim_ListLength(interp, libPathObjPtr);
|
||||
}
|
||||
|
||||
prefixes = Jim_Alloc(sizeof(char *) * prefixc);
|
||||
for (i = 0; i < prefixc; i++) {
|
||||
Jim_Obj *prefixObjPtr;
|
||||
|
||||
if (Jim_ListIndex(interp, libPathObjPtr, i, &prefixObjPtr, JIM_NONE) != JIM_OK) {
|
||||
prefixes[i] = NULL;
|
||||
continue;
|
||||
}
|
||||
prefixes[i] = Jim_StrDup(Jim_String(prefixObjPtr));
|
||||
}
|
||||
|
||||
/* Scan every directory for the the first match */
|
||||
path = JimFindPackage(interp, prefixes, prefixc, name);
|
||||
if (path != NULL) {
|
||||
char *p = strrchr(path, '.');
|
||||
|
||||
/* Note: Even if the file fails to load, we consider the package loaded.
|
||||
* This prevents issues with recursion.
|
||||
* Use a dummy version of "" to signify this case.
|
||||
*/
|
||||
Jim_PackageProvide(interp, name, "", 0);
|
||||
|
||||
/* Try to load/source it */
|
||||
if (p && strcmp(p, ".tcl") == 0) {
|
||||
retCode = Jim_EvalFileGlobal(interp, path);
|
||||
}
|
||||
#ifdef jim_ext_load
|
||||
else {
|
||||
retCode = Jim_LoadLibrary(interp, path);
|
||||
}
|
||||
#endif
|
||||
if (retCode != JIM_OK) {
|
||||
/* Upon failure, remove the dummy entry */
|
||||
Jim_DeleteHashEntry(&interp->packages, name);
|
||||
}
|
||||
Jim_Free(path);
|
||||
}
|
||||
for (i = 0; i < prefixc; i++)
|
||||
Jim_Free(prefixes[i]);
|
||||
Jim_Free(prefixes);
|
||||
if (libPathObjPtr)
|
||||
Jim_DecrRefCount(interp, libPathObjPtr);
|
||||
return retCode;
|
||||
}
|
||||
|
||||
int Jim_PackageRequire(Jim_Interp *interp, const char *name, int flags)
|
||||
{
|
||||
Jim_HashEntry *he;
|
||||
|
||||
/* Start with an empty error string */
|
||||
Jim_SetResultString(interp, "", 0);
|
||||
|
||||
he = Jim_FindHashEntry(&interp->packages, name);
|
||||
if (he == NULL) {
|
||||
/* Try to load the package. */
|
||||
int retcode = JimLoadPackage(interp, name, flags);
|
||||
if (retcode != JIM_OK) {
|
||||
if (flags & JIM_ERRMSG) {
|
||||
int len;
|
||||
|
||||
Jim_GetString(Jim_GetResult(interp), &len);
|
||||
Jim_SetResultFormatted(interp, "%#s%sCan't load package %s",
|
||||
Jim_GetResult(interp), len ? "\n" : "", name);
|
||||
}
|
||||
return retcode;
|
||||
}
|
||||
|
||||
/* In case the package did no 'package provide' */
|
||||
Jim_PackageProvide(interp, name, "1.0", 0);
|
||||
|
||||
/* Now it must exist */
|
||||
he = Jim_FindHashEntry(&interp->packages, name);
|
||||
}
|
||||
|
||||
Jim_SetResultString(interp, he->u.val, -1);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* package provide name ?version?
|
||||
*
|
||||
* This procedure is invoked to declare that
|
||||
* a particular package is now present in an interpreter.
|
||||
* The package must not already be provided in the interpreter.
|
||||
*
|
||||
* Results:
|
||||
* Returns JIM_OK and sets results as "1.0" (the given version is ignored)
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
static int package_cmd_provide(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return Jim_PackageProvide(interp, Jim_String(argv[0]), package_version_1, JIM_ERRMSG);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* package require name ?version?
|
||||
*
|
||||
* This procedure is load a given package.
|
||||
* Note that the version is ignored.
|
||||
*
|
||||
* Results:
|
||||
* Returns JIM_OK and sets the package version.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
static int package_cmd_require(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
/* package require failing is important enough to add to the stack */
|
||||
interp->addStackTrace++;
|
||||
|
||||
return Jim_PackageRequire(interp, Jim_String(argv[0]), JIM_ERRMSG);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* package list
|
||||
*
|
||||
* Returns a list of known packages
|
||||
*
|
||||
* Results:
|
||||
* Returns JIM_OK and sets a list of known packages.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
static int package_cmd_list(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_HashTableIterator *htiter;
|
||||
Jim_HashEntry *he;
|
||||
Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0);
|
||||
|
||||
htiter = Jim_GetHashTableIterator(&interp->packages);
|
||||
while ((he = Jim_NextHashEntry(htiter)) != NULL) {
|
||||
Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1));
|
||||
}
|
||||
Jim_FreeHashTableIterator(htiter);
|
||||
|
||||
Jim_SetResult(interp, listObjPtr);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static const jim_subcmd_type package_command_table[] = {
|
||||
{
|
||||
"provide",
|
||||
"name ?version?",
|
||||
package_cmd_provide,
|
||||
1,
|
||||
2,
|
||||
/* Description: Indicates that the current script provides the given package */
|
||||
},
|
||||
{
|
||||
"require",
|
||||
"name ?version?",
|
||||
package_cmd_require,
|
||||
1,
|
||||
2,
|
||||
/* Description: Loads the given package by looking in standard places */
|
||||
},
|
||||
{
|
||||
"list",
|
||||
NULL,
|
||||
package_cmd_list,
|
||||
0,
|
||||
0,
|
||||
/* Description: Lists all known packages */
|
||||
},
|
||||
{
|
||||
NULL
|
||||
}
|
||||
};
|
||||
|
||||
int Jim_packageInit(Jim_Interp *interp)
|
||||
{
|
||||
Jim_CreateCommand(interp, "package", Jim_SubCmdProc, (void *)package_command_table, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
245
debuggers/openocd/jimtcl/jim-posix.c
Normal file
245
debuggers/openocd/jimtcl/jim-posix.c
Normal file
@ -0,0 +1,245 @@
|
||||
/*
|
||||
* Jim - POSIX extension
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*/
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <sys/time.h>
|
||||
#include <sys/wait.h>
|
||||
#include <unistd.h>
|
||||
#include <string.h>
|
||||
#include <signal.h>
|
||||
#include <errno.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim.h>
|
||||
|
||||
#ifdef HAVE_SYS_SYSINFO_H
|
||||
#include <sys/sysinfo.h>
|
||||
#endif
|
||||
|
||||
static void Jim_PosixSetError(Jim_Interp *interp)
|
||||
{
|
||||
Jim_SetResultString(interp, strerror(errno), -1);
|
||||
}
|
||||
|
||||
#if defined(HAVE_FORK)
|
||||
static int Jim_PosixForkCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
pid_t pid;
|
||||
|
||||
JIM_NOTUSED(argv);
|
||||
|
||||
if (argc != 1) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if ((pid = fork()) == -1) {
|
||||
Jim_PosixSetError(interp);
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultInt(interp, (jim_wide) pid);
|
||||
return JIM_OK;
|
||||
}
|
||||
#endif
|
||||
|
||||
/*
|
||||
* os.wait ?-nohang? pid
|
||||
*
|
||||
* An interface to waitpid(2)
|
||||
*
|
||||
* Returns a 3 element list.
|
||||
*
|
||||
* If -nohang is specified, and the process is still alive, returns
|
||||
*
|
||||
* {0 none 0}
|
||||
*
|
||||
* If the process does not exist or has already been waited for, returns:
|
||||
*
|
||||
* {-1 error <error-description>}
|
||||
*
|
||||
* If the process exited normally, returns:
|
||||
*
|
||||
* {<pid> exit <exit-status>}
|
||||
*
|
||||
* If the process terminated on a signal, returns:
|
||||
*
|
||||
* {<pid> signal <signal-number>}
|
||||
*
|
||||
* Otherwise (core dump, stopped, continued, ...), returns:
|
||||
*
|
||||
* {<pid> other 0}
|
||||
*/
|
||||
static int Jim_PosixWaitCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int nohang = 0;
|
||||
long pid;
|
||||
int status;
|
||||
Jim_Obj *listObj;
|
||||
const char *type;
|
||||
int value;
|
||||
|
||||
if (argc > 1 && Jim_CompareStringImmediate(interp, argv[1], "-nohang")) {
|
||||
nohang = 1;
|
||||
}
|
||||
if (argc != nohang + 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "?-nohang? pid");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetLong(interp, argv[nohang + 1], &pid) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
pid = waitpid(pid, &status, nohang ? WNOHANG : 0);
|
||||
listObj = Jim_NewListObj(interp, NULL, 0);
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, pid));
|
||||
if (pid < 0) {
|
||||
type = "error";
|
||||
value = errno;
|
||||
}
|
||||
else if (pid == 0) {
|
||||
type = "none";
|
||||
value = 0;
|
||||
}
|
||||
else if (WIFEXITED(status)) {
|
||||
type = "exit";
|
||||
value = WEXITSTATUS(status);
|
||||
}
|
||||
else if (WIFSIGNALED(status)) {
|
||||
type = "signal";
|
||||
value = WTERMSIG(status);
|
||||
}
|
||||
else {
|
||||
type = "other";
|
||||
value = 0;
|
||||
}
|
||||
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, type, -1));
|
||||
if (pid < 0) {
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, strerror(value), -1));
|
||||
}
|
||||
else {
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, value));
|
||||
}
|
||||
Jim_SetResult(interp, listObj);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int Jim_PosixGetidsCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
Jim_Obj *objv[8];
|
||||
|
||||
if (argc != 1) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
objv[0] = Jim_NewStringObj(interp, "uid", -1);
|
||||
objv[1] = Jim_NewIntObj(interp, getuid());
|
||||
objv[2] = Jim_NewStringObj(interp, "euid", -1);
|
||||
objv[3] = Jim_NewIntObj(interp, geteuid());
|
||||
objv[4] = Jim_NewStringObj(interp, "gid", -1);
|
||||
objv[5] = Jim_NewIntObj(interp, getgid());
|
||||
objv[6] = Jim_NewStringObj(interp, "egid", -1);
|
||||
objv[7] = Jim_NewIntObj(interp, getegid());
|
||||
Jim_SetResult(interp, Jim_NewListObj(interp, objv, 8));
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
#define JIM_HOST_NAME_MAX 1024
|
||||
static int Jim_PosixGethostnameCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
char *buf;
|
||||
int rc = JIM_OK;
|
||||
|
||||
if (argc != 1) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
buf = Jim_Alloc(JIM_HOST_NAME_MAX);
|
||||
if (gethostname(buf, JIM_HOST_NAME_MAX) == -1) {
|
||||
Jim_PosixSetError(interp);
|
||||
rc = JIM_ERR;
|
||||
}
|
||||
else {
|
||||
Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, -1));
|
||||
}
|
||||
return rc;
|
||||
}
|
||||
|
||||
static int Jim_PosixUptimeCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
#ifdef HAVE_STRUCT_SYSINFO_UPTIME
|
||||
struct sysinfo info;
|
||||
|
||||
if (argc != 1) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (sysinfo(&info) == -1) {
|
||||
Jim_PosixSetError(interp);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
Jim_SetResultInt(interp, info.uptime);
|
||||
#else
|
||||
Jim_SetResultInt(interp, (long)time(NULL));
|
||||
#endif
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int Jim_PosixPidCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
if (argc != 1) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
Jim_SetResultInt(interp, getpid());
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_posixInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "posix", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
#ifdef HAVE_FORK
|
||||
Jim_CreateCommand(interp, "os.fork", Jim_PosixForkCommand, NULL, NULL);
|
||||
#endif
|
||||
Jim_CreateCommand(interp, "os.wait", Jim_PosixWaitCommand, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "os.getids", Jim_PosixGetidsCommand, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "os.gethostname", Jim_PosixGethostnameCommand, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "os.uptime", Jim_PosixUptimeCommand, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "pid", Jim_PosixPidCommand, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
122
debuggers/openocd/jimtcl/jim-readdir.c
Normal file
122
debuggers/openocd/jimtcl/jim-readdir.c
Normal file
@ -0,0 +1,122 @@
|
||||
|
||||
/*
|
||||
* Tcl readdir command.
|
||||
*
|
||||
* (c) 2008 Steve Bennett <steveb@worware.net.au>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*
|
||||
* Based on original work by:
|
||||
*-----------------------------------------------------------------------------
|
||||
* Copyright 1991-1994 Karl Lehenbauer and Mark Diekhans.
|
||||
*
|
||||
* Permission to use, copy, modify, and distribute this software and its
|
||||
* documentation for any purpose and without fee is hereby granted, provided
|
||||
* that the above copyright notice appear in all copies. Karl Lehenbauer and
|
||||
* Mark Diekhans make no representations about the suitability of this
|
||||
* software for any purpose. It is provided "as is" without express or
|
||||
* implied warranty.
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
|
||||
#include <errno.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
|
||||
#include <jim.h>
|
||||
#include <jimautoconf.h>
|
||||
|
||||
#ifdef HAVE_DIRENT_H
|
||||
#include <dirent.h>
|
||||
#endif
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* Jim_ReaddirCmd --
|
||||
* Implements the rename TCL command:
|
||||
* readdir ?-nocomplain? dirPath
|
||||
*
|
||||
* Results:
|
||||
* Standard TCL result.
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
int Jim_ReaddirCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
const char *dirPath;
|
||||
DIR *dirPtr;
|
||||
struct dirent *entryPtr;
|
||||
int nocomplain = 0;
|
||||
|
||||
if (argc == 3 && Jim_CompareStringImmediate(interp, argv[1], "-nocomplain")) {
|
||||
nocomplain = 1;
|
||||
}
|
||||
if (argc != 2 && !nocomplain) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "?-nocomplain? dirPath");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
dirPath = Jim_String(argv[1 + nocomplain]);
|
||||
|
||||
dirPtr = opendir(dirPath);
|
||||
if (dirPtr == NULL) {
|
||||
if (nocomplain) {
|
||||
return JIM_OK;
|
||||
}
|
||||
Jim_SetResultString(interp, strerror(errno), -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_SetResultString(interp, strerror(errno), -1);
|
||||
|
||||
Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
|
||||
|
||||
while ((entryPtr = readdir(dirPtr)) != NULL) {
|
||||
if (entryPtr->d_name[0] == '.') {
|
||||
if (entryPtr->d_name[1] == '\0') {
|
||||
continue;
|
||||
}
|
||||
if ((entryPtr->d_name[1] == '.') && (entryPtr->d_name[2] == '\0'))
|
||||
continue;
|
||||
}
|
||||
Jim_ListAppendElement(interp, Jim_GetResult(interp), Jim_NewStringObj(interp,
|
||||
entryPtr->d_name, -1));
|
||||
}
|
||||
closedir(dirPtr);
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_readdirInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "readdir", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "readdir", Jim_ReaddirCmd, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
74
debuggers/openocd/jimtcl/jim-readline.c
Normal file
74
debuggers/openocd/jimtcl/jim-readline.c
Normal file
@ -0,0 +1,74 @@
|
||||
/*
|
||||
* Jim - Readline bindings for Jim
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*/
|
||||
|
||||
#include <jim.h>
|
||||
|
||||
#include <readline/readline.h>
|
||||
#include <readline/history.h>
|
||||
|
||||
static int JimRlReadlineCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
char *line;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "prompt");
|
||||
return JIM_ERR;
|
||||
}
|
||||
line = readline(Jim_String(argv[1]));
|
||||
if (!line) {
|
||||
return JIM_EXIT;
|
||||
}
|
||||
Jim_SetResult(interp, Jim_NewStringObj(interp, line, -1));
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int JimRlAddHistoryCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "string");
|
||||
return JIM_ERR;
|
||||
}
|
||||
add_history(Jim_String(argv[1]));
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_readlineInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "readline", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "readline.readline", JimRlReadlineCommand, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "readline.addhistory", JimRlAddHistoryCommand, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
566
debuggers/openocd/jimtcl/jim-regexp.c
Normal file
566
debuggers/openocd/jimtcl/jim-regexp.c
Normal file
@ -0,0 +1,566 @@
|
||||
/*
|
||||
* Implements the regexp and regsub commands for Jim
|
||||
*
|
||||
* (c) 2008 Steve Bennett <steveb@workware.net.au>
|
||||
*
|
||||
* Uses C library regcomp()/regexec() for the matching.
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*
|
||||
* Based on code originally from Tcl 6.7:
|
||||
*
|
||||
* Copyright 1987-1991 Regents of the University of California
|
||||
* Permission to use, copy, modify, and distribute this
|
||||
* software and its documentation for any purpose and without
|
||||
* fee is hereby granted, provided that the above copyright
|
||||
* notice appear in all copies. The University of California
|
||||
* makes no representations about the suitability of this
|
||||
* software for any purpose. It is provided "as is" without
|
||||
* express or implied warranty.
|
||||
*/
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include "jim.h"
|
||||
#include "jimregexp.h"
|
||||
|
||||
static void FreeRegexpInternalRep(Jim_Interp *interp, Jim_Obj *objPtr)
|
||||
{
|
||||
regfree(objPtr->internalRep.regexpValue.compre);
|
||||
Jim_Free(objPtr->internalRep.regexpValue.compre);
|
||||
}
|
||||
|
||||
static const Jim_ObjType regexpObjType = {
|
||||
"regexp",
|
||||
FreeRegexpInternalRep,
|
||||
NULL,
|
||||
NULL,
|
||||
JIM_TYPE_NONE
|
||||
};
|
||||
|
||||
static regex_t *SetRegexpFromAny(Jim_Interp *interp, Jim_Obj *objPtr, unsigned flags)
|
||||
{
|
||||
regex_t *compre;
|
||||
const char *pattern;
|
||||
int ret;
|
||||
|
||||
/* Check if the object is already an uptodate variable */
|
||||
if (objPtr->typePtr == ®expObjType &&
|
||||
objPtr->internalRep.regexpValue.compre && objPtr->internalRep.regexpValue.flags == flags) {
|
||||
/* nothing to do */
|
||||
return objPtr->internalRep.regexpValue.compre;
|
||||
}
|
||||
|
||||
/* Not a regexp or the flags do not match */
|
||||
|
||||
/* Get the string representation */
|
||||
pattern = Jim_String(objPtr);
|
||||
compre = Jim_Alloc(sizeof(regex_t));
|
||||
|
||||
if ((ret = regcomp(compre, pattern, REG_EXTENDED | flags)) != 0) {
|
||||
char buf[100];
|
||||
|
||||
regerror(ret, compre, buf, sizeof(buf));
|
||||
Jim_SetResultFormatted(interp, "couldn't compile regular expression pattern: %s", buf);
|
||||
regfree(compre);
|
||||
Jim_Free(compre);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
Jim_FreeIntRep(interp, objPtr);
|
||||
|
||||
objPtr->typePtr = ®expObjType;
|
||||
objPtr->internalRep.regexpValue.flags = flags;
|
||||
objPtr->internalRep.regexpValue.compre = compre;
|
||||
|
||||
return compre;
|
||||
}
|
||||
|
||||
int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int opt_indices = 0;
|
||||
int opt_all = 0;
|
||||
int opt_inline = 0;
|
||||
regex_t *regex;
|
||||
int match, i, j;
|
||||
int offset = 0;
|
||||
regmatch_t *pmatch = NULL;
|
||||
int source_len;
|
||||
int result = JIM_OK;
|
||||
const char *pattern;
|
||||
const char *source_str;
|
||||
int num_matches = 0;
|
||||
int num_vars;
|
||||
Jim_Obj *resultListObj = NULL;
|
||||
int regcomp_flags = 0;
|
||||
int eflags = 0;
|
||||
int option;
|
||||
enum {
|
||||
OPT_INDICES, OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_INLINE, OPT_START, OPT_END
|
||||
};
|
||||
static const char * const options[] = {
|
||||
"-indices", "-nocase", "-line", "-all", "-inline", "-start", "--", NULL
|
||||
};
|
||||
|
||||
if (argc < 3) {
|
||||
wrongNumArgs:
|
||||
Jim_WrongNumArgs(interp, 1, argv,
|
||||
"?switches? exp string ?matchVar? ?subMatchVar subMatchVar ...?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
const char *opt = Jim_String(argv[i]);
|
||||
|
||||
if (*opt != '-') {
|
||||
break;
|
||||
}
|
||||
if (Jim_GetEnum(interp, argv[i], options, &option, "switch", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (option == OPT_END) {
|
||||
i++;
|
||||
break;
|
||||
}
|
||||
switch (option) {
|
||||
case OPT_INDICES:
|
||||
opt_indices = 1;
|
||||
break;
|
||||
|
||||
case OPT_NOCASE:
|
||||
regcomp_flags |= REG_ICASE;
|
||||
break;
|
||||
|
||||
case OPT_LINE:
|
||||
regcomp_flags |= REG_NEWLINE;
|
||||
break;
|
||||
|
||||
case OPT_ALL:
|
||||
opt_all = 1;
|
||||
break;
|
||||
|
||||
case OPT_INLINE:
|
||||
opt_inline = 1;
|
||||
break;
|
||||
|
||||
case OPT_START:
|
||||
if (++i == argc) {
|
||||
goto wrongNumArgs;
|
||||
}
|
||||
if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (argc - i < 2) {
|
||||
goto wrongNumArgs;
|
||||
}
|
||||
|
||||
regex = SetRegexpFromAny(interp, argv[i], regcomp_flags);
|
||||
if (!regex) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
pattern = Jim_String(argv[i]);
|
||||
source_str = Jim_GetString(argv[i + 1], &source_len);
|
||||
|
||||
num_vars = argc - i - 2;
|
||||
|
||||
if (opt_inline) {
|
||||
if (num_vars) {
|
||||
Jim_SetResultString(interp, "regexp match variables not allowed when using -inline",
|
||||
-1);
|
||||
result = JIM_ERR;
|
||||
goto done;
|
||||
}
|
||||
num_vars = regex->re_nsub + 1;
|
||||
}
|
||||
|
||||
pmatch = Jim_Alloc((num_vars + 1) * sizeof(*pmatch));
|
||||
|
||||
/* If an offset has been specified, adjust for that now.
|
||||
* If it points past the end of the string, point to the terminating null
|
||||
*/
|
||||
if (offset) {
|
||||
if (offset < 0) {
|
||||
offset += source_len + 1;
|
||||
}
|
||||
if (offset > source_len) {
|
||||
source_str += source_len;
|
||||
}
|
||||
else if (offset > 0) {
|
||||
source_str += offset;
|
||||
}
|
||||
eflags |= REG_NOTBOL;
|
||||
}
|
||||
|
||||
if (opt_inline) {
|
||||
resultListObj = Jim_NewListObj(interp, NULL, 0);
|
||||
}
|
||||
|
||||
next_match:
|
||||
match = regexec(regex, source_str, num_vars + 1, pmatch, eflags);
|
||||
if (match >= REG_BADPAT) {
|
||||
char buf[100];
|
||||
|
||||
regerror(match, regex, buf, sizeof(buf));
|
||||
Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf);
|
||||
result = JIM_ERR;
|
||||
goto done;
|
||||
}
|
||||
|
||||
if (match == REG_NOMATCH) {
|
||||
goto done;
|
||||
}
|
||||
|
||||
num_matches++;
|
||||
|
||||
if (opt_all && !opt_inline) {
|
||||
/* Just count the number of matches, so skip the substitution h */
|
||||
goto try_next_match;
|
||||
}
|
||||
|
||||
/*
|
||||
* If additional variable names have been specified, return
|
||||
* index information in those variables.
|
||||
*/
|
||||
|
||||
j = 0;
|
||||
for (i += 2; opt_inline ? j < num_vars : i < argc; i++, j++) {
|
||||
Jim_Obj *resultObj;
|
||||
|
||||
if (opt_indices) {
|
||||
resultObj = Jim_NewListObj(interp, NULL, 0);
|
||||
}
|
||||
else {
|
||||
resultObj = Jim_NewStringObj(interp, "", 0);
|
||||
}
|
||||
|
||||
if (pmatch[j].rm_so == -1) {
|
||||
if (opt_indices) {
|
||||
Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, -1));
|
||||
Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, -1));
|
||||
}
|
||||
}
|
||||
else {
|
||||
int len = pmatch[j].rm_eo - pmatch[j].rm_so;
|
||||
|
||||
if (opt_indices) {
|
||||
Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp,
|
||||
offset + pmatch[j].rm_so));
|
||||
Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp,
|
||||
offset + pmatch[j].rm_so + len - 1));
|
||||
}
|
||||
else {
|
||||
Jim_AppendString(interp, resultObj, source_str + pmatch[j].rm_so, len);
|
||||
}
|
||||
}
|
||||
|
||||
if (opt_inline) {
|
||||
Jim_ListAppendElement(interp, resultListObj, resultObj);
|
||||
}
|
||||
else {
|
||||
/* And now set the result variable */
|
||||
result = Jim_SetVariable(interp, argv[i], resultObj);
|
||||
|
||||
if (result != JIM_OK) {
|
||||
Jim_FreeObj(interp, resultObj);
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
try_next_match:
|
||||
if (opt_all && (pattern[0] != '^' || (regcomp_flags & REG_NEWLINE)) && *source_str) {
|
||||
if (pmatch[0].rm_eo) {
|
||||
offset += pmatch[0].rm_eo;
|
||||
source_str += pmatch[0].rm_eo;
|
||||
}
|
||||
else {
|
||||
source_str++;
|
||||
offset++;
|
||||
}
|
||||
if (*source_str) {
|
||||
eflags = REG_NOTBOL;
|
||||
goto next_match;
|
||||
}
|
||||
}
|
||||
|
||||
done:
|
||||
if (result == JIM_OK) {
|
||||
if (opt_inline) {
|
||||
Jim_SetResult(interp, resultListObj);
|
||||
}
|
||||
else {
|
||||
Jim_SetResultInt(interp, num_matches);
|
||||
}
|
||||
}
|
||||
|
||||
Jim_Free(pmatch);
|
||||
return result;
|
||||
}
|
||||
|
||||
#define MAX_SUB_MATCHES 50
|
||||
|
||||
int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int regcomp_flags = 0;
|
||||
int regexec_flags = 0;
|
||||
int opt_all = 0;
|
||||
int offset = 0;
|
||||
regex_t *regex;
|
||||
const char *p;
|
||||
int result;
|
||||
regmatch_t pmatch[MAX_SUB_MATCHES + 1];
|
||||
int num_matches = 0;
|
||||
|
||||
int i, j, n;
|
||||
Jim_Obj *varname;
|
||||
Jim_Obj *resultObj;
|
||||
const char *source_str;
|
||||
int source_len;
|
||||
const char *replace_str;
|
||||
int replace_len;
|
||||
const char *pattern;
|
||||
int option;
|
||||
enum {
|
||||
OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_START, OPT_END
|
||||
};
|
||||
static const char * const options[] = {
|
||||
"-nocase", "-line", "-all", "-start", "--", NULL
|
||||
};
|
||||
|
||||
if (argc < 4) {
|
||||
wrongNumArgs:
|
||||
Jim_WrongNumArgs(interp, 1, argv,
|
||||
"?switches? exp string subSpec ?varName?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
const char *opt = Jim_String(argv[i]);
|
||||
|
||||
if (*opt != '-') {
|
||||
break;
|
||||
}
|
||||
if (Jim_GetEnum(interp, argv[i], options, &option, "switch", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (option == OPT_END) {
|
||||
i++;
|
||||
break;
|
||||
}
|
||||
switch (option) {
|
||||
case OPT_NOCASE:
|
||||
regcomp_flags |= REG_ICASE;
|
||||
break;
|
||||
|
||||
case OPT_LINE:
|
||||
regcomp_flags |= REG_NEWLINE;
|
||||
break;
|
||||
|
||||
case OPT_ALL:
|
||||
opt_all = 1;
|
||||
break;
|
||||
|
||||
case OPT_START:
|
||||
if (++i == argc) {
|
||||
goto wrongNumArgs;
|
||||
}
|
||||
if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (argc - i != 3 && argc - i != 4) {
|
||||
goto wrongNumArgs;
|
||||
}
|
||||
|
||||
regex = SetRegexpFromAny(interp, argv[i], regcomp_flags);
|
||||
if (!regex) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
pattern = Jim_String(argv[i]);
|
||||
|
||||
source_str = Jim_GetString(argv[i + 1], &source_len);
|
||||
replace_str = Jim_GetString(argv[i + 2], &replace_len);
|
||||
varname = argv[i + 3];
|
||||
|
||||
/* Create the result string */
|
||||
resultObj = Jim_NewStringObj(interp, "", 0);
|
||||
|
||||
/* If an offset has been specified, adjust for that now.
|
||||
* If it points past the end of the string, point to the terminating null
|
||||
*/
|
||||
if (offset) {
|
||||
if (offset < 0) {
|
||||
offset += source_len + 1;
|
||||
}
|
||||
if (offset > source_len) {
|
||||
offset = source_len;
|
||||
}
|
||||
else if (offset < 0) {
|
||||
offset = 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* Copy the part before -start */
|
||||
Jim_AppendString(interp, resultObj, source_str, offset);
|
||||
|
||||
/*
|
||||
* The following loop is to handle multiple matches within the
|
||||
* same source string; each iteration handles one match and its
|
||||
* corresponding substitution. If "-all" hasn't been specified
|
||||
* then the loop body only gets executed once.
|
||||
*/
|
||||
|
||||
n = source_len - offset;
|
||||
p = source_str + offset;
|
||||
do {
|
||||
int match = regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags);
|
||||
|
||||
if (match >= REG_BADPAT) {
|
||||
char buf[100];
|
||||
|
||||
regerror(match, regex, buf, sizeof(buf));
|
||||
Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf);
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (match == REG_NOMATCH) {
|
||||
break;
|
||||
}
|
||||
|
||||
num_matches++;
|
||||
|
||||
/*
|
||||
* Copy the portion of the source string before the match to the
|
||||
* result variable.
|
||||
*/
|
||||
Jim_AppendString(interp, resultObj, p, pmatch[0].rm_so);
|
||||
|
||||
/*
|
||||
* Append the subSpec (replace_str) argument to the variable, making appropriate
|
||||
* substitutions. This code is a bit hairy because of the backslash
|
||||
* conventions and because the code saves up ranges of characters in
|
||||
* subSpec to reduce the number of calls to Jim_SetVar.
|
||||
*/
|
||||
|
||||
for (j = 0; j < replace_len; j++) {
|
||||
int idx;
|
||||
int c = replace_str[j];
|
||||
|
||||
if (c == '&') {
|
||||
idx = 0;
|
||||
}
|
||||
else if (c == '\\' && j < replace_len) {
|
||||
c = replace_str[++j];
|
||||
if ((c >= '0') && (c <= '9')) {
|
||||
idx = c - '0';
|
||||
}
|
||||
else if ((c == '\\') || (c == '&')) {
|
||||
Jim_AppendString(interp, resultObj, replace_str + j, 1);
|
||||
continue;
|
||||
}
|
||||
else {
|
||||
Jim_AppendString(interp, resultObj, replace_str + j - 1, 2);
|
||||
continue;
|
||||
}
|
||||
}
|
||||
else {
|
||||
Jim_AppendString(interp, resultObj, replace_str + j, 1);
|
||||
continue;
|
||||
}
|
||||
if ((idx < MAX_SUB_MATCHES) && pmatch[idx].rm_so != -1 && pmatch[idx].rm_eo != -1) {
|
||||
Jim_AppendString(interp, resultObj, p + pmatch[idx].rm_so,
|
||||
pmatch[idx].rm_eo - pmatch[idx].rm_so);
|
||||
}
|
||||
}
|
||||
|
||||
p += pmatch[0].rm_eo;
|
||||
n -= pmatch[0].rm_eo;
|
||||
|
||||
/* If -all is not specified, or there is no source left, we are done */
|
||||
if (!opt_all || n == 0) {
|
||||
break;
|
||||
}
|
||||
|
||||
/* An anchored pattern without -line must be done */
|
||||
if ((regcomp_flags & REG_NEWLINE) == 0 && pattern[0] == '^') {
|
||||
break;
|
||||
}
|
||||
|
||||
/* If the pattern is empty, need to step forwards */
|
||||
if (pattern[0] == '\0' && n) {
|
||||
/* Need to copy the char we are moving over */
|
||||
Jim_AppendString(interp, resultObj, p, 1);
|
||||
p++;
|
||||
n--;
|
||||
}
|
||||
|
||||
regexec_flags |= REG_NOTBOL;
|
||||
} while (n);
|
||||
|
||||
/*
|
||||
* Copy the portion of the string after the last match to the
|
||||
* result variable.
|
||||
*/
|
||||
Jim_AppendString(interp, resultObj, p, -1);
|
||||
|
||||
/* And now set or return the result variable */
|
||||
if (argc - i == 4) {
|
||||
result = Jim_SetVariable(interp, varname, resultObj);
|
||||
|
||||
if (result == JIM_OK) {
|
||||
Jim_SetResultInt(interp, num_matches);
|
||||
}
|
||||
else {
|
||||
Jim_FreeObj(interp, resultObj);
|
||||
}
|
||||
}
|
||||
else {
|
||||
Jim_SetResult(interp, resultObj);
|
||||
result = JIM_OK;
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
int Jim_regexpInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "regexp", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
Jim_CreateCommand(interp, "regexp", Jim_RegexpCmd, NULL, NULL);
|
||||
Jim_CreateCommand(interp, "regsub", Jim_RegsubCmd, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
247
debuggers/openocd/jimtcl/jim-sdl.c
Normal file
247
debuggers/openocd/jimtcl/jim-sdl.c
Normal file
@ -0,0 +1,247 @@
|
||||
/*
|
||||
* Jim - SDL extension
|
||||
*
|
||||
* Copyright 2005 Salvatore Sanfilippo <antirez@invece.org>
|
||||
*
|
||||
* Redistribution and use in source and binary forms, with or without
|
||||
* modification, are permitted provided that the following conditions
|
||||
* are met:
|
||||
*
|
||||
* 1. Redistributions of source code must retain the above copyright
|
||||
* notice, this list of conditions and the following disclaimer.
|
||||
* 2. Redistributions in binary form must reproduce the above
|
||||
* copyright notice, this list of conditions and the following
|
||||
* disclaimer in the documentation and/or other materials
|
||||
* provided with the distribution.
|
||||
*
|
||||
* THIS SOFTWARE IS PROVIDED BY THE JIM TCL PROJECT ``AS IS'' AND ANY
|
||||
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
|
||||
* THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
|
||||
* PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
||||
* JIM TCL PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
|
||||
* INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
|
||||
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
* STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
|
||||
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*
|
||||
* The views and conclusions contained in the software and documentation
|
||||
* are those of the authors and should not be interpreted as representing
|
||||
* official policies, either expressed or implied, of the Jim Tcl Project.
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <errno.h>
|
||||
#include <SDL/SDL.h>
|
||||
#include <SDL/SDL_gfxPrimitives.h>
|
||||
|
||||
#include <jim.h>
|
||||
|
||||
#define AIO_CMD_LEN 128
|
||||
|
||||
typedef struct JimSdlSurface
|
||||
{
|
||||
SDL_Surface *screen;
|
||||
} JimSdlSurface;
|
||||
|
||||
static void JimSdlSetError(Jim_Interp *interp)
|
||||
{
|
||||
Jim_SetResultString(interp, SDL_GetError(), -1);
|
||||
}
|
||||
|
||||
static void JimSdlDelProc(Jim_Interp *interp, void *privData)
|
||||
{
|
||||
JimSdlSurface *jss = privData;
|
||||
|
||||
JIM_NOTUSED(interp);
|
||||
|
||||
SDL_FreeSurface(jss->screen);
|
||||
Jim_Free(jss);
|
||||
}
|
||||
|
||||
/* Calls to commands created via [sdl.surface] are implemented by this
|
||||
* C command. */
|
||||
static int JimSdlHandlerCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
JimSdlSurface *jss = Jim_CmdPrivData(interp);
|
||||
int option;
|
||||
static const char * const options[] = {
|
||||
"free", "flip", "pixel", "rectangle", "box", "line", "aaline",
|
||||
"circle", "aacircle", "fcircle", NULL
|
||||
};
|
||||
enum
|
||||
{ OPT_FREE, OPT_FLIP, OPT_PIXEL, OPT_RECTANGLE, OPT_BOX, OPT_LINE,
|
||||
OPT_AALINE, OPT_CIRCLE, OPT_AACIRCLE, OPT_FCIRCLE
|
||||
};
|
||||
|
||||
if (argc < 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "method ?args ...?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetEnum(interp, argv[1], options, &option, "SDL surface method", JIM_ERRMSG) != JIM_OK)
|
||||
return JIM_ERR;
|
||||
if (option == OPT_PIXEL) {
|
||||
/* PIXEL */
|
||||
long x, y, red, green, blue, alpha = 255;
|
||||
|
||||
if (argc != 7 && argc != 8) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "x y red green blue ?alpha?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetLong(interp, argv[2], &x) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[3], &y) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[4], &red) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[5], &green) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[6], &blue) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc == 8 && Jim_GetLong(interp, argv[7], &alpha) != JIM_OK)
|
||||
return JIM_ERR;
|
||||
pixelRGBA(jss->screen, x, y, red, green, blue, alpha);
|
||||
return JIM_OK;
|
||||
}
|
||||
else if (option == OPT_RECTANGLE || option == OPT_BOX ||
|
||||
option == OPT_LINE || option == OPT_AALINE) {
|
||||
/* RECTANGLE, BOX, LINE, AALINE */
|
||||
long x1, y1, x2, y2, red, green, blue, alpha = 255;
|
||||
|
||||
if (argc != 9 && argc != 10) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "x y red green blue ?alpha?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetLong(interp, argv[2], &x1) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[3], &y1) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[4], &x2) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[5], &y2) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[6], &red) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[7], &green) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[8], &blue) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc == 10 && Jim_GetLong(interp, argv[9], &alpha) != JIM_OK)
|
||||
return JIM_ERR;
|
||||
switch (option) {
|
||||
case OPT_RECTANGLE:
|
||||
rectangleRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
|
||||
break;
|
||||
case OPT_BOX:
|
||||
boxRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
|
||||
break;
|
||||
case OPT_LINE:
|
||||
lineRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
|
||||
break;
|
||||
case OPT_AALINE:
|
||||
aalineRGBA(jss->screen, x1, y1, x2, y2, red, green, blue, alpha);
|
||||
break;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
else if (option == OPT_CIRCLE || option == OPT_AACIRCLE || option == OPT_FCIRCLE) {
|
||||
/* CIRCLE, AACIRCLE, FCIRCLE */
|
||||
long x, y, radius, red, green, blue, alpha = 255;
|
||||
|
||||
if (argc != 8 && argc != 9) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "x y radius red green blue ?alpha?");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetLong(interp, argv[2], &x) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[3], &y) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[4], &radius) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[5], &red) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[6], &green) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[7], &blue) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (argc == 9 && Jim_GetLong(interp, argv[8], &alpha) != JIM_OK)
|
||||
return JIM_ERR;
|
||||
switch (option) {
|
||||
case OPT_CIRCLE:
|
||||
circleRGBA(jss->screen, x, y, radius, red, green, blue, alpha);
|
||||
break;
|
||||
case OPT_AACIRCLE:
|
||||
aacircleRGBA(jss->screen, x, y, radius, red, green, blue, alpha);
|
||||
break;
|
||||
case OPT_FCIRCLE:
|
||||
filledCircleRGBA(jss->screen, x, y, radius, red, green, blue, alpha);
|
||||
break;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
else if (option == OPT_FREE) {
|
||||
/* FREE */
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
Jim_DeleteCommand(interp, Jim_String(argv[0]));
|
||||
return JIM_OK;
|
||||
}
|
||||
else if (option == OPT_FLIP) {
|
||||
/* FLIP */
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 2, argv, "");
|
||||
return JIM_ERR;
|
||||
}
|
||||
SDL_Flip(jss->screen);
|
||||
return JIM_OK;
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int JimSdlSurfaceCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
JimSdlSurface *jss;
|
||||
char buf[AIO_CMD_LEN];
|
||||
Jim_Obj *objPtr;
|
||||
long screenId, xres, yres;
|
||||
SDL_Surface *screen;
|
||||
|
||||
if (argc != 3) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "xres yres");
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (Jim_GetLong(interp, argv[1], &xres) != JIM_OK ||
|
||||
Jim_GetLong(interp, argv[2], &yres) != JIM_OK)
|
||||
return JIM_ERR;
|
||||
|
||||
/* Try to create the surface */
|
||||
screen = SDL_SetVideoMode(xres, yres, 32, SDL_SWSURFACE | SDL_ANYFORMAT);
|
||||
if (screen == NULL) {
|
||||
JimSdlSetError(interp);
|
||||
return JIM_ERR;
|
||||
}
|
||||
/* Get the next file id */
|
||||
if (Jim_EvalGlobal(interp, "if {[catch {incr sdl.surfaceId}]} {set sdl.surfaceId 0}") != JIM_OK)
|
||||
return JIM_ERR;
|
||||
objPtr = Jim_GetVariableStr(interp, "sdl.surfaceId", JIM_ERRMSG);
|
||||
if (objPtr == NULL)
|
||||
return JIM_ERR;
|
||||
if (Jim_GetLong(interp, objPtr, &screenId) != JIM_OK)
|
||||
return JIM_ERR;
|
||||
|
||||
/* Create the SDL screen command */
|
||||
jss = Jim_Alloc(sizeof(*jss));
|
||||
jss->screen = screen;
|
||||
sprintf(buf, "sdl.surface%ld", screenId);
|
||||
Jim_CreateCommand(interp, buf, JimSdlHandlerCommand, jss, JimSdlDelProc);
|
||||
Jim_SetResultString(interp, buf, -1);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
int Jim_sdlInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "sdl", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
if (SDL_Init(SDL_INIT_VIDEO) < 0) {
|
||||
JimSdlSetError(interp);
|
||||
return JIM_ERR;
|
||||
}
|
||||
atexit(SDL_Quit);
|
||||
Jim_CreateCommand(interp, "sdl.screen", JimSdlSurfaceCommand, NULL, NULL);
|
||||
return JIM_OK;
|
||||
}
|
||||
513
debuggers/openocd/jimtcl/jim-signal.c
Normal file
513
debuggers/openocd/jimtcl/jim-signal.c
Normal file
@ -0,0 +1,513 @@
|
||||
|
||||
/*
|
||||
* jim-signal.c
|
||||
*
|
||||
*/
|
||||
|
||||
#include <signal.h>
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <unistd.h>
|
||||
|
||||
#include "jimautoconf.h"
|
||||
#include <jim-subcmd.h>
|
||||
#include <jim-signal.h>
|
||||
|
||||
#define MAX_SIGNALS (sizeof(jim_wide) * 8)
|
||||
|
||||
static jim_wide *sigloc;
|
||||
static jim_wide sigsblocked;
|
||||
static struct sigaction *sa_old;
|
||||
static int signal_handling[MAX_SIGNALS];
|
||||
|
||||
/* Make sure to do this as a wide, not int */
|
||||
#define sig_to_bit(SIG) ((jim_wide)1 << (SIG))
|
||||
|
||||
static void signal_handler(int sig)
|
||||
{
|
||||
/* We just remember which signals occurred. Jim_Eval() will
|
||||
* notice this as soon as it can and throw an error
|
||||
*/
|
||||
*sigloc |= sig_to_bit(sig);
|
||||
}
|
||||
|
||||
static void signal_ignorer(int sig)
|
||||
{
|
||||
/* We just remember which signals occurred */
|
||||
sigsblocked |= sig_to_bit(sig);
|
||||
}
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SignalId --
|
||||
*
|
||||
* Return a textual identifier for a signal number.
|
||||
*
|
||||
* Results:
|
||||
* This procedure returns a machine-readable textual identifier
|
||||
* that corresponds to sig. The identifier is the same as the
|
||||
* #define name in signal.h.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
#define CHECK_SIG(NAME) if (sig == NAME) return #NAME
|
||||
|
||||
const char *Jim_SignalId(int sig)
|
||||
{
|
||||
CHECK_SIG(SIGABRT);
|
||||
CHECK_SIG(SIGALRM);
|
||||
CHECK_SIG(SIGBUS);
|
||||
CHECK_SIG(SIGCHLD);
|
||||
CHECK_SIG(SIGCONT);
|
||||
CHECK_SIG(SIGFPE);
|
||||
CHECK_SIG(SIGHUP);
|
||||
CHECK_SIG(SIGILL);
|
||||
CHECK_SIG(SIGINT);
|
||||
#ifdef SIGIO
|
||||
CHECK_SIG(SIGIO);
|
||||
#endif
|
||||
CHECK_SIG(SIGKILL);
|
||||
CHECK_SIG(SIGPIPE);
|
||||
CHECK_SIG(SIGPROF);
|
||||
CHECK_SIG(SIGQUIT);
|
||||
CHECK_SIG(SIGSEGV);
|
||||
CHECK_SIG(SIGSTOP);
|
||||
CHECK_SIG(SIGSYS);
|
||||
CHECK_SIG(SIGTERM);
|
||||
CHECK_SIG(SIGTRAP);
|
||||
CHECK_SIG(SIGTSTP);
|
||||
CHECK_SIG(SIGTTIN);
|
||||
CHECK_SIG(SIGTTOU);
|
||||
CHECK_SIG(SIGURG);
|
||||
CHECK_SIG(SIGUSR1);
|
||||
CHECK_SIG(SIGUSR2);
|
||||
CHECK_SIG(SIGVTALRM);
|
||||
CHECK_SIG(SIGWINCH);
|
||||
CHECK_SIG(SIGXCPU);
|
||||
CHECK_SIG(SIGXFSZ);
|
||||
#ifdef SIGPWR
|
||||
CHECK_SIG(SIGPWR);
|
||||
#endif
|
||||
#ifdef SIGCLD
|
||||
CHECK_SIG(SIGCLD);
|
||||
#endif
|
||||
#ifdef SIGEMT
|
||||
CHECK_SIG(SIGEMT);
|
||||
#endif
|
||||
#ifdef SIGLOST
|
||||
CHECK_SIG(SIGLOST);
|
||||
#endif
|
||||
#ifdef SIGPOLL
|
||||
CHECK_SIG(SIGPOLL);
|
||||
#endif
|
||||
#ifdef SIGINFO
|
||||
CHECK_SIG(SIGINFO);
|
||||
#endif
|
||||
return "unknown signal";
|
||||
}
|
||||
|
||||
const char *Jim_SignalName(int sig)
|
||||
{
|
||||
#ifdef HAVE_SYS_SIGLIST
|
||||
if (sig >= 0 && sig < NSIG) {
|
||||
return sys_siglist[sig];
|
||||
}
|
||||
#endif
|
||||
return Jim_SignalId(sig);
|
||||
}
|
||||
|
||||
/**
|
||||
* Given the name of a signal, returns the signal value if found,
|
||||
* or returns -1 (and sets an error) if not found.
|
||||
* We accept -SIGINT, SIGINT, INT or any lowercase version or a number,
|
||||
* either positive or negative.
|
||||
*/
|
||||
static int find_signal_by_name(Jim_Interp *interp, const char *name)
|
||||
{
|
||||
int i;
|
||||
const char *pt = name;
|
||||
|
||||
/* Remove optional - and SIG from the front of the name */
|
||||
if (*pt == '-') {
|
||||
pt++;
|
||||
}
|
||||
if (strncasecmp(name, "sig", 3) == 0) {
|
||||
pt += 3;
|
||||
}
|
||||
if (isdigit(UCHAR(pt[0]))) {
|
||||
i = atoi(pt);
|
||||
if (i > 0 && i < MAX_SIGNALS) {
|
||||
return i;
|
||||
}
|
||||
}
|
||||
else {
|
||||
for (i = 1; i < MAX_SIGNALS; i++) {
|
||||
/* Jim_SignalId() returns names such as SIGINT, and
|
||||
* returns "unknown signal id" if unknown, so this will work
|
||||
*/
|
||||
if (strcasecmp(Jim_SignalId(i) + 3, pt) == 0) {
|
||||
return i;
|
||||
}
|
||||
}
|
||||
}
|
||||
Jim_SetResultString(interp, "unknown signal ", -1);
|
||||
Jim_AppendString(interp, Jim_GetResult(interp), name, -1);
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
#define SIGNAL_ACTION_HANDLE 1
|
||||
#define SIGNAL_ACTION_IGNORE -1
|
||||
#define SIGNAL_ACTION_DEFAULT 0
|
||||
|
||||
static int do_signal_cmd(Jim_Interp *interp, int action, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
struct sigaction sa;
|
||||
int i;
|
||||
|
||||
if (argc == 0) {
|
||||
Jim_SetResult(interp, Jim_NewListObj(interp, NULL, 0));
|
||||
for (i = 1; i < MAX_SIGNALS; i++) {
|
||||
if (signal_handling[i] == action) {
|
||||
/* Add signal name to the list */
|
||||
Jim_ListAppendElement(interp, Jim_GetResult(interp),
|
||||
Jim_NewStringObj(interp, Jim_SignalId(i), -1));
|
||||
}
|
||||
}
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
/* Catch all the signals we care about */
|
||||
if (action != SIGNAL_ACTION_DEFAULT) {
|
||||
sa.sa_flags = 0;
|
||||
sigemptyset(&sa.sa_mask);
|
||||
if (action == SIGNAL_ACTION_HANDLE) {
|
||||
sa.sa_handler = signal_handler;
|
||||
}
|
||||
else {
|
||||
sa.sa_handler = signal_ignorer;
|
||||
}
|
||||
}
|
||||
|
||||
/* Iterate through the provided signals */
|
||||
for (i = 0; i < argc; i++) {
|
||||
int sig = find_signal_by_name(interp, Jim_String(argv[i]));
|
||||
|
||||
if (sig < 0) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
if (action != signal_handling[sig]) {
|
||||
/* Need to change the action for this signal */
|
||||
switch (action) {
|
||||
case SIGNAL_ACTION_HANDLE:
|
||||
case SIGNAL_ACTION_IGNORE:
|
||||
if (signal_handling[sig] == SIGNAL_ACTION_DEFAULT) {
|
||||
if (!sa_old) {
|
||||
/* Allocate the structure the first time through */
|
||||
sa_old = Jim_Alloc(sizeof(*sa_old) * MAX_SIGNALS);
|
||||
}
|
||||
sigaction(sig, &sa, &sa_old[sig]);
|
||||
}
|
||||
else {
|
||||
sigaction(sig, &sa, 0);
|
||||
}
|
||||
break;
|
||||
|
||||
case SIGNAL_ACTION_DEFAULT:
|
||||
/* Restore old handler */
|
||||
if (sa_old) {
|
||||
sigaction(sig, &sa_old[sig], 0);
|
||||
}
|
||||
}
|
||||
signal_handling[sig] = action;
|
||||
}
|
||||
}
|
||||
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int signal_cmd_handle(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return do_signal_cmd(interp, SIGNAL_ACTION_HANDLE, argc, argv);
|
||||
}
|
||||
|
||||
static int signal_cmd_ignore(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return do_signal_cmd(interp, SIGNAL_ACTION_IGNORE, argc, argv);
|
||||
}
|
||||
|
||||
static int signal_cmd_default(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
return do_signal_cmd(interp, SIGNAL_ACTION_DEFAULT, argc, argv);
|
||||
}
|
||||
|
||||
static int signal_set_sigmask_result(Jim_Interp *interp, jim_wide sigmask)
|
||||
{
|
||||
int i;
|
||||
Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0);
|
||||
|
||||
for (i = 0; i < MAX_SIGNALS; i++) {
|
||||
if (sigmask & sig_to_bit(i)) {
|
||||
Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, Jim_SignalId(i), -1));
|
||||
}
|
||||
}
|
||||
Jim_SetResult(interp, listObj);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int signal_cmd_check(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int clear = 0;
|
||||
jim_wide mask = 0;
|
||||
jim_wide blocked;
|
||||
|
||||
if (argc > 0 && Jim_CompareStringImmediate(interp, argv[0], "-clear")) {
|
||||
clear++;
|
||||
}
|
||||
if (argc > clear) {
|
||||
int i;
|
||||
|
||||
/* Signals specified */
|
||||
for (i = clear; i < argc; i++) {
|
||||
int sig = find_signal_by_name(interp, Jim_String(argv[i]));
|
||||
|
||||
if (sig < 0 || sig >= MAX_SIGNALS) {
|
||||
return -1;
|
||||
}
|
||||
mask |= sig_to_bit(sig);
|
||||
}
|
||||
}
|
||||
else {
|
||||
/* No signals specified, so check/clear all */
|
||||
mask = ~mask;
|
||||
}
|
||||
|
||||
if ((sigsblocked & mask) == 0) {
|
||||
/* No matching signals, so empty result and nothing to do */
|
||||
return JIM_OK;
|
||||
}
|
||||
/* Be careful we don't have a race condition where signals are cleared but not returned */
|
||||
blocked = sigsblocked & mask;
|
||||
if (clear) {
|
||||
sigsblocked &= ~blocked;
|
||||
}
|
||||
/* Set the result */
|
||||
signal_set_sigmask_result(interp, blocked);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
static int signal_cmd_throw(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int sig = SIGINT;
|
||||
|
||||
if (argc == 1) {
|
||||
if ((sig = find_signal_by_name(interp, Jim_String(argv[0]))) < 0) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
|
||||
/* If the signal is ignored (blocked) ... */
|
||||
if (signal_handling[sig] == SIGNAL_ACTION_IGNORE) {
|
||||
sigsblocked |= sig_to_bit(sig);
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
/* Just set the signal */
|
||||
interp->sigmask |= sig_to_bit(sig);
|
||||
|
||||
/* Set the canonical name of the signal as the result */
|
||||
Jim_SetResultString(interp, Jim_SignalId(sig), -1);
|
||||
|
||||
/* And simply say we caught the signal */
|
||||
return JIM_SIGNAL;
|
||||
}
|
||||
|
||||
/*
|
||||
*-----------------------------------------------------------------------------
|
||||
*
|
||||
* Jim_SignalCmd --
|
||||
* Implements the TCL signal command:
|
||||
* signal handle|ignore|default|throw ?signals ...?
|
||||
* signal throw signal
|
||||
*
|
||||
* Specifies which signals are handled by Tcl code.
|
||||
* If the one of the given signals is caught, it causes a JIM_SIGNAL
|
||||
* exception to be thrown which can be caught by catch.
|
||||
*
|
||||
* Use 'signal ignore' to ignore the signal(s)
|
||||
* Use 'signal default' to go back to the default behaviour
|
||||
* Use 'signal throw signal' to raise the given signal
|
||||
*
|
||||
* If no arguments are given, returns the list of signals which are being handled
|
||||
*
|
||||
* Results:
|
||||
* Standard TCL results.
|
||||
*
|
||||
*-----------------------------------------------------------------------------
|
||||
*/
|
||||
static const jim_subcmd_type signal_command_table[] = {
|
||||
{ "handle",
|
||||
"?signals ...?",
|
||||
signal_cmd_handle,
|
||||
0,
|
||||
-1,
|
||||
/* Description: Lists handled signals, or adds to handled signals */
|
||||
},
|
||||
{ "ignore",
|
||||
"?signals ...?",
|
||||
signal_cmd_ignore,
|
||||
0,
|
||||
-1,
|
||||
/* Description: Lists ignored signals, or adds to ignored signals */
|
||||
},
|
||||
{ "default",
|
||||
"?signals ...?",
|
||||
signal_cmd_default,
|
||||
0,
|
||||
-1,
|
||||
/* Description: Lists defaulted signals, or adds to defaulted signals */
|
||||
},
|
||||
{ "check",
|
||||
"?-clear? ?signals ...?",
|
||||
signal_cmd_check,
|
||||
0,
|
||||
-1,
|
||||
/* Description: Returns ignored signals which have occurred, and optionally clearing them */
|
||||
},
|
||||
{ "throw",
|
||||
"?signal?",
|
||||
signal_cmd_throw,
|
||||
0,
|
||||
1,
|
||||
/* Description: Raises the given signal (default SIGINT) */
|
||||
},
|
||||
{ NULL }
|
||||
};
|
||||
|
||||
static int Jim_AlarmCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int ret;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "seconds");
|
||||
return JIM_ERR;
|
||||
}
|
||||
else {
|
||||
#ifdef HAVE_UALARM
|
||||
double t;
|
||||
|
||||
ret = Jim_GetDouble(interp, argv[1], &t);
|
||||
if (ret == JIM_OK) {
|
||||
if (t < 1) {
|
||||
ualarm(t * 1e6, 0);
|
||||
}
|
||||
else {
|
||||
alarm(t);
|
||||
}
|
||||
}
|
||||
#else
|
||||
long t;
|
||||
|
||||
ret = Jim_GetLong(interp, argv[1], &t);
|
||||
if (ret == JIM_OK) {
|
||||
alarm(t);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int Jim_SleepCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int ret;
|
||||
|
||||
if (argc != 2) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "seconds");
|
||||
return JIM_ERR;
|
||||
}
|
||||
else {
|
||||
double t;
|
||||
|
||||
ret = Jim_GetDouble(interp, argv[1], &t);
|
||||
if (ret == JIM_OK) {
|
||||
#ifdef HAVE_USLEEP
|
||||
if (t < 1) {
|
||||
usleep(t * 1e6);
|
||||
}
|
||||
else
|
||||
#endif
|
||||
sleep(t);
|
||||
}
|
||||
}
|
||||
|
||||
return ret;
|
||||
}
|
||||
|
||||
static int Jim_KillCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
|
||||
{
|
||||
int sig;
|
||||
long pid;
|
||||
Jim_Obj *pidObj;
|
||||
const char *signame;
|
||||
|
||||
if (argc != 2 && argc != 3) {
|
||||
Jim_WrongNumArgs(interp, 1, argv, "?SIG|-0? pid");
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (argc == 2) {
|
||||
signame = "SIGTERM";
|
||||
pidObj = argv[1];
|
||||
}
|
||||
else {
|
||||
signame = Jim_String(argv[1]);
|
||||
pidObj = argv[2];
|
||||
}
|
||||
|
||||
/* Special 'kill -0 pid' to determine if a pid exists */
|
||||
if (strcmp(signame, "-0") == 0 || strcmp(signame, "0") == 0) {
|
||||
sig = 0;
|
||||
}
|
||||
else {
|
||||
sig = find_signal_by_name(interp, signame);
|
||||
if (sig < 0) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
}
|
||||
|
||||
if (Jim_GetLong(interp, pidObj, &pid) != JIM_OK) {
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
if (kill(pid, sig) == 0) {
|
||||
return JIM_OK;
|
||||
}
|
||||
|
||||
Jim_SetResultString(interp, "kill: Failed to deliver signal", -1);
|
||||
return JIM_ERR;
|
||||
}
|
||||
|
||||
int Jim_signalInit(Jim_Interp *interp)
|
||||
{
|
||||
if (Jim_PackageProvide(interp, "signal", "1.0", JIM_ERRMSG))
|
||||
return JIM_ERR;
|
||||
|
||||
/* Teach the jim core how to set a result from a sigmask */
|
||||
interp->signal_set_result = signal_set_sigmask_result;
|
||||
|
||||
/* Make sure we know where to store the signals which occur */
|
||||
sigloc = &interp->sigmask;
|
||||
|
||||
Jim_CreateCommand(interp, "signal", Jim_SubCmdProc, (void *)signal_command_table, NULL);
|
||||
Jim_CreateCommand(interp, "alarm", Jim_AlarmCmd, 0, 0);
|
||||
Jim_CreateCommand(interp, "kill", Jim_KillCmd, 0, 0);
|
||||
|
||||
/* Sleep is slightly dubious here */
|
||||
Jim_CreateCommand(interp, "sleep", Jim_SleepCmd, 0, 0);
|
||||
return JIM_OK;
|
||||
}
|
||||
24
debuggers/openocd/jimtcl/jim-signal.h
Normal file
24
debuggers/openocd/jimtcl/jim-signal.h
Normal file
@ -0,0 +1,24 @@
|
||||
#ifndef JIM_SIGNAL_H
|
||||
#define JIM_SIGNAL_H
|
||||
|
||||
/*
|
||||
*----------------------------------------------------------------------
|
||||
*
|
||||
* Tcl_SignalId --
|
||||
*
|
||||
* Return a textual identifier for a signal number.
|
||||
*
|
||||
* Results:
|
||||
* This procedure returns a machine-readable textual identifier
|
||||
* that corresponds to sig. The identifier is the same as the
|
||||
* #define name in signal.h.
|
||||
*
|
||||
* Side effects:
|
||||
* None.
|
||||
*
|
||||
*----------------------------------------------------------------------
|
||||
*/
|
||||
const char *Jim_SignalId(int sig);
|
||||
const char *Jim_SignalName(int sig);
|
||||
|
||||
#endif
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user