Mercurial > vim
changeset 1894:afb740b5dfab v7.2.191
updated for version 7.2-191
| author | vimboss |
|---|---|
| date | Tue, 26 May 2009 20:59:55 +0000 |
| parents | a75120dc3e26 |
| children | f637471a3607 |
| files | runtime/doc/if_mzsch.txt src/Make_ming.mak src/Make_mvc.mak src/Makefile src/auto/configure src/config.mk.in src/configure.in src/eval.c src/if_mzsch.c src/if_mzsch.h src/main.c src/proto/if_mzsch.pro src/version.c |
| diffstat | 13 files changed, 1154 insertions(+), 574 deletions(-) [+] |
line wrap: on
line diff
--- a/runtime/doc/if_mzsch.txt +++ b/runtime/doc/if_mzsch.txt @@ -1,4 +1,4 @@ -*if_mzsch.txt* For Vim version 7.2. Last change: 2008 Jun 28 +*if_mzsch.txt* For Vim version 7.2. Last change: 2009 May 26 VIM REFERENCE MANUAL by Sergey Khorev @@ -42,10 +42,6 @@ 1. Commands *mzscheme-commands* *:mzfile* *:mzf* :[range]mzf[ile] {file} Execute the MzScheme script in {file}. {not in Vi} - All statements are executed in the namespace of the - buffer that was current during :mzfile start. - If you want to access other namespaces, use - 'parameterize'. All of these commands do essentially the same thing - they execute a piece of MzScheme code, with the "current range" set to the given line @@ -54,8 +50,6 @@ range. In the case of :mzscheme, the code to execute is in the command-line. In the case of :mzfile, the code to execute is the contents of the given file. -Each buffer has its own MzScheme namespace. Global namespace is bound to -the "global-namespace" value from the 'vimext' module. MzScheme interface defines exception exn:vim, derived from exn. It is raised for various Vim errors. @@ -79,40 +73,8 @@ To avoid clashes with MzScheme, consider e.g.: > :mzscheme (require (prefix vim- vimext)) < -All the examples below assume this naming scheme. Note that you need to do -this again for every buffer. +All the examples below assume this naming scheme. -The auto-instantiation can be achieved with autocommands, e.g. you can put -something like this in your .vimrc (EOFs should not have indentation): > - function s:MzRequire() - if has("mzscheme") - :mz << EOF - (require (prefix vim- vimext)) - (let ((buf (vim-get-buff-by-name (vim-eval "expand(\"<afile>\")")))) - (when (and buf (not (eq? buf (vim-curr-buff)))) - (parameterize ((current-namespace (vim-get-buff-namespace buf))) - (namespace-attach-module vim-global-namespace 'vimext) - (namespace-require '(prefix vim vimext))))) - EOF - endif - endfunction - - function s:MzStartup() - if has("mzscheme") - au BufNew,BufNewFile,BufAdd,BufReadPre * :call s:MzRequire() - :mz << EOF - (current-library-collection-paths - (cons - (build-path (find-system-path 'addon-dir) (version) "collects") - (current-library-collection-paths))) - EOF - endif - endfunction - - call s:MzStartup() -< - -The global namespace just instantiated this module with the prefix "vimext:". *mzscheme-sandbox* When executed in the |sandbox|, access to some filesystem and Vim interface procedures is restricted. @@ -121,15 +83,20 @@ procedures is restricted. 2. Examples *mzscheme-examples* > :mzscheme (display "Hello") + :mz (display (string-append "Using MzScheme version " (version))) + :mzscheme (require (prefix vim- vimext)) ; for MzScheme < 4.x + :mzscheme (require (prefix-in vim- 'vimext)) ; MzScheme 4.x :mzscheme (vim-set-buff-line 10 "This is line #10") < Inline script usage: > function! <SID>SetFirstLine() :mz << EOF (display "!!!") + (require (prefix vim- vimext)) + ; for newer versions (require (prefix-in vim- 'vimext)) (vim-set-buff-line 1 "This is line #1") (vim-beep) - EOF + EOF endfunction nmap <F9> :call <SID>SetFirstLine() <CR> @@ -137,17 +104,33 @@ Inline script usage: > File execution: > :mzfile supascript.scm < -Accessing the current buffer namespace from an MzScheme program running in -another buffer within |:mzfile|-executed script : > - ; Move to the window below - (vim-command "wincmd j") - ; execute in the context of buffer, to which window belongs - ; assume that buffer has 'textstring' defined - (parameterize ((current-namespace - (vim-get-buff-namespace (vim-curr-buff)))) - (eval '(vim-set-buff-line 1 textstring))) +Vim exception handling: > + :mz << EOF + (require (prefix vim- vimext)) + ; for newer versions (require (prefix-in vim- 'vimext)) + (with-handlers + ([exn:vim? (lambda (e) (display (exn-message e)))]) + (vim-eval "nonsense-string")) + EOF < +Auto-instantiation of vimext module (can be placed in your |vimrc|): > + function! MzRequire() + :redir => l:mzversion + :mz (version) + :redir END + if strpart(l:mzversion, 1, 1) < "4" + " MzScheme versions < 4.x: + :mz (require (prefix vim- vimext)) + else + " newer versions: + :mz (require (prefix-in vim- 'vimext)) + endif + endfunction + if has("mzscheme") + silent call MzRequire() + endif +< ============================================================================== 3. Threads *mzscheme-threads* @@ -168,11 +151,11 @@ interface. Common ------ (command {command-string}) Perform the vim ":Ex" style command. - (eval {expr-string}) Evaluate the vim expression to a string. - A |List| is turned into a string by - joining the items and inserting line - breaks. - NOTE clashes with MzScheme eval + (eval {expr-string}) Evaluate the vim expression into + respective MzScheme object: |Lists| are + represented as Scheme lists, + |Dictionaries| as hash tables. + NOTE the name clashes with MzScheme eval (range-start) Start/End of the range passed with (range-end) the Scheme command. (beep) beep @@ -186,7 +169,6 @@ Common be set. The symbol 'global can be passed as {buffer-or-window}. Then |:setglobal| will be used. - global-namespace The MzScheme main namespace. Buffers *mzscheme-buffer* ------- @@ -228,7 +210,6 @@ Buffers *mzscheme-buffer* if there is no such buffer. (get-buff-by-num {buffernum}) Get a buffer by its number (return #f if there is no buffer with this number). - (get-buff-namespace [buffer]) Get buffer namespace. Windows *mzscheme-window* ------ @@ -250,7 +231,7 @@ Windows *mzscheme-window* (set-cursor (line . col) [window]) Set cursor position. ============================================================================== -5. Dynamic loading *mzscheme-dynamic* +5. Dynamic loading *mzscheme-dynamic* *E812* On MS-Windows the MzScheme libraries can be loaded dynamically. The |:version| output then includes |+mzscheme/dyn|.
--- a/src/Make_ming.mak +++ b/src/Make_ming.mak @@ -115,8 +115,21 @@ ifndef MZSCHEME_VER MZSCHEME_VER=205_000 endif +ifndef MZSCHEME_PRECISE_GC +MZSCHEME_PRECISE_GC=no +endif + +# for version 4.x we need to generate byte-code for Scheme base +ifndef MZSCHEME_GENERATE_BASE +MZSCHEME_GENERATE_BASE=no +endif + ifeq (no,$(DYNAMIC_MZSCHEME)) +ifeq (yes,$(MZSCHEME_PRECISE_GC)) +MZSCHEME_LIB=-lmzsch$(MZSCHEME_VER) +else MZSCHEME_LIB = -lmzsch$(MZSCHEME_VER) -lmzgc$(MZSCHEME_VER) +endif # the modern MinGW can dynamically link to dlls directly. # point MZSCHEME_DLLS to where you put libmzschXXXXXXX.dll and libgcXXXXXXX.dll ifndef MZSCHEME_DLLS @@ -410,6 +423,13 @@ endif ifdef MZSCHEME OBJ += $(OUTDIR)/if_mzsch.o MZSCHEME_INCL = if_mzsch.h +ifeq (yes,$(MZSCHEME_GENERATE_BASE)) +CFLAGS += -DINCLUDE_MZSCHEME_BASE +MZ_EXTRA_DEP += mzscheme_base.c +endif +ifeq (yes,$(MZSCHEME_PRECISE_GC)) +CFLAGS += -DMZ_PRECISE_GC +endif endif ifdef PYTHON OBJ += $(OUTDIR)/if_python.o @@ -588,6 +608,12 @@ if_perl.c: if_perl.xs typemap $(OUTDIR)/netbeans.o: netbeans.c $(INCL) $(NBDEBUG_INCL) $(NBDEBUG_SRC) $(CC) -c $(CFLAGS) netbeans.c -o $(OUTDIR)/netbeans.o +$(OUTDIR)/if_mzsch.o: if_mzsch.c $(INCL) if_mzsch.h $(MZ_EXTRA_DEP) + $(CC) -c $(CFLAGS) if_mzsch.c -o $(OUTDIR)/if_mzsch.o + +mzscheme_base.c: + $(MZSCHEME)/mzc --c-mods mzscheme_base.c ++lib scheme/base + pathdef.c: $(INCL) ifneq (sh.exe, $(SHELL)) @echo creating pathdef.c
--- a/src/Make_mvc.mak +++ b/src/Make_mvc.mak @@ -34,6 +34,7 @@ # MZSCHEME=[Path to MzScheme directory] # DYNAMIC_MZSCHEME=yes (to load the MzScheme DLLs dynamically) # MZSCHEME_VER=[version, 205_000, ...] +# MZSCHEME_DEBUG=no # # Perl interface: # PERL=[Path to Perl directory] @@ -621,15 +622,37 @@ PYTHON_LIB = $(PYTHON)\libs\python$(PYTH MZSCHEME_VER = 205_000 !endif CFLAGS = $(CFLAGS) -DFEAT_MZSCHEME -I $(MZSCHEME)\include +!if EXIST("$(MZSCHEME)\collects\scheme\base.ss") +# for MzScheme 4.x we need to include byte code for basic Scheme stuff +MZSCHEME_EXTRA_DEP = mzscheme_base.c +CFLAGS = $(CFLAGS) -DINCLUDE_MZSCHEME_BASE +!endif +!if EXIST("$(MZSCHEME)\lib\msvc\libmzsch$(MZSCHEME_VER).lib") \ + && !EXIST("$(MZSCHEME)\lib\msvc\libmzgc$(MZSCHEME_VER).lib") +!message Building with Precise GC +MZSCHEME_PRECISE_GC = yes +CFLAGS = $(CFLAGS) -DMZ_PRECISE_GC +!endif !if "$(DYNAMIC_MZSCHEME)" == "yes" +!if "$(MZSCHEME_PRECISE_GC)" == "yes" +!error MzScheme with Precise GC cannot be loaded dynamically +!endif !message MzScheme DLLs will be loaded dynamically CFLAGS = $(CFLAGS) -DDYNAMIC_MZSCHEME \ -DDYNAMIC_MZSCH_DLL=\"libmzsch$(MZSCHEME_VER).dll\" \ -DDYNAMIC_MZGC_DLL=\"libmzgc$(MZSCHEME_VER).dll\" !else +!if "$(MZSCHEME_DEBUG)" == "yes" +CFLAGS = $(CFLAGS) -DMZSCHEME_FORCE_GC +!endif +!if "$(MZSCHEME_PRECISE_GC)" == "yes" +# Precise GC does not use separate dll +MZSCHEME_LIB = $(MZSCHEME)\lib\msvc\libmzsch$(MZSCHEME_VER).lib +!else MZSCHEME_LIB = $(MZSCHEME)\lib\msvc\libmzgc$(MZSCHEME_VER).lib \ $(MZSCHEME)\lib\msvc\libmzsch$(MZSCHEME_VER).lib !endif +!endif MZSCHEME_OBJ = $(OUTDIR)\if_mzsch.obj !endif @@ -930,9 +953,11 @@ if_perl.c : if_perl.xs typemap $(OUTDIR)/if_perlsfio.obj: $(OUTDIR) if_perlsfio.c $(INCL) $(CC) $(CFLAGS) $(PERL_INC) if_perlsfio.c -$(OUTDIR)/if_mzsch.obj: $(OUTDIR) if_mzsch.c $(INCL) +$(OUTDIR)/if_mzsch.obj: $(OUTDIR) if_mzsch.c $(INCL) $(MZSCHEME_EXTRA_DEP) $(CC) $(CFLAGS) if_mzsch.c \ -DMZSCHEME_COLLECTS=\"$(MZSCHEME:\=\\)\\collects\" +mzscheme_base.c: + $(MZSCHEME)\mzc --c-mods mzscheme_base.c ++lib scheme/base $(OUTDIR)/if_python.obj: $(OUTDIR) if_python.c $(INCL) $(CC) $(CFLAGS) $(PYTHON_INC) if_python.c
--- a/src/Makefile +++ b/src/Makefile @@ -536,7 +536,7 @@ CClink = $(CC) # Use this with GCC to check for mistakes, unused arguments, etc. #CFLAGS = -g -Wall -Wextra -Wmissing-prototypes -Wunreachable-code #PYTHON_CFLAGS_EXTRA = -Wno-missing-field-initializers -#MZSCHEME_CFLAGS_EXTRA = -Wno-unreachable-code +#MZSCHEME_CFLAGS_EXTRA = -Wno-unreachable-code -Wno-unused-parameter # EFENCE - Electric-Fence malloc debugging: catches memory accesses beyond # allocated memory (and makes every malloc()/free() very slow). @@ -2200,6 +2200,7 @@ clean celan: testclean -rm -f $(TOOLS) auto/osdef.h auto/pathdef.c auto/if_perl.c -rm -f conftest* *~ auto/link.sed -rm -rf $(APPDIR) + -rm -rf mzscheme_base.c if test -d $(PODIR); then \ cd $(PODIR); $(MAKE) prefix=$(DESTDIR)$(prefix) clean; \ fi @@ -2433,8 +2434,11 @@ objects/if_cscope.o: if_cscope.c objects/if_xcmdsrv.o: if_xcmdsrv.c $(CCC) -o $@ if_xcmdsrv.c -objects/if_mzsch.o: if_mzsch.c +objects/if_mzsch.o: if_mzsch.c $(MZSCHEME_EXTRA) $(CCC) -o $@ $(MZSCHEME_CFLAGS_EXTRA) if_mzsch.c + +mzscheme_base.c: + $(MZSCHEME_MZC) --c-mods mzscheme_base.c ++lib scheme/base objects/if_perl.o: auto/if_perl.c $(CCC) -o $@ auto/if_perl.c
--- a/src/auto/configure +++ b/src/auto/configure @@ -701,6 +701,8 @@ PERL_SRC shrpenv vi_cv_perllib vi_cv_path_perl +MZSCHEME_MZC +MZSCHEME_EXTRA MZSCHEME_CFLAGS MZSCHEME_LIBS MZSCHEME_PRO @@ -4641,8 +4643,8 @@ fi $as_echo "\"$PLTHOME\"" >&6; } vi_cv_path_mzscheme_pfx="$PLTHOME" else - { $as_echo "$as_me:$LINENO: result: \"not set\"" >&5 -$as_echo "\"not set\"" >&6; } + { $as_echo "$as_me:$LINENO: result: not set" >&5 +$as_echo "not set" >&6; } # Extract the first word of "mzscheme", so it can be a program name with args. set dummy mzscheme; ac_word=$2 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5 @@ -4697,16 +4699,16 @@ fi if test "${vi_cv_path_mzscheme_pfx+set}" = set; then $as_echo_n "(cached) " >&6 else - vi_cv_path_mzscheme_pfx=` - ${vi_cv_path_mzscheme} -evm \ - "(display (simplify-path \ + echo "(display (simplify-path \ (build-path (call-with-values \ (lambda () (split-path (find-system-path (quote exec-file)))) \ - (lambda (base name must-be-dir?) base)) (quote up))))"` + (lambda (base name must-be-dir?) base)) (quote up))))" > mzdirs.scm + vi_cv_path_mzscheme_pfx=`${vi_cv_path_mzscheme} -r mzdirs.scm | \ + sed -e 's+/$++'` fi { $as_echo "$as_me:$LINENO: result: $vi_cv_path_mzscheme_pfx" >&5 $as_echo "$vi_cv_path_mzscheme_pfx" >&6; } - vi_cv_path_mzscheme_pfx=`echo "$vi_cv_path_mzscheme_pfx" | sed 's+/$++'` + rm -f mzdirs.scm fi fi fi @@ -4716,21 +4718,32 @@ fi { $as_echo "$as_me:$LINENO: checking if scheme.h can be found in $vi_cv_path_mzscheme_pfx/include" >&5 $as_echo_n "checking if scheme.h can be found in $vi_cv_path_mzscheme_pfx/include... " >&6; } if test -f $vi_cv_path_mzscheme_pfx/include/scheme.h; then - { $as_echo "$as_me:$LINENO: result: \"yes\"" >&5 -$as_echo "\"yes\"" >&6; } + SCHEME_INC=${vi_cv_path_mzscheme_pfx}/include + { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } else - { $as_echo "$as_me:$LINENO: result: \"no\"" >&5 -$as_echo "\"no\"" >&6; } - { $as_echo "$as_me:$LINENO: checking if scheme.h can be found in $vi_cv_path_mzscheme_pfx/plt/include" >&5 -$as_echo_n "checking if scheme.h can be found in $vi_cv_path_mzscheme_pfx/plt/include... " >&6; } + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } + { $as_echo "$as_me:$LINENO: checking if scheme.h can be found in $vi_cv_path_mzscheme_pfx/include/plt" >&5 +$as_echo_n "checking if scheme.h can be found in $vi_cv_path_mzscheme_pfx/include/plt... " >&6; } if test -f $vi_cv_path_mzscheme_pfx/include/plt/scheme.h; then - { $as_echo "$as_me:$LINENO: result: \"yes\"" >&5 -$as_echo "\"yes\"" >&6; } - SCHEME_INC=/plt + { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } + SCHEME_INC=${vi_cv_path_mzscheme_pfx}/include/plt else - { $as_echo "$as_me:$LINENO: result: \"no\"" >&5 -$as_echo "\"no\"" >&6; } - vi_cv_path_mzscheme_pfx= + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } + { $as_echo "$as_me:$LINENO: checking if scheme.h can be found in /usr/include/plt/" >&5 +$as_echo_n "checking if scheme.h can be found in /usr/include/plt/... " >&6; } + if test -f /usr/include/plt/scheme.h; then + { $as_echo "$as_me:$LINENO: result: yes" >&5 +$as_echo "yes" >&6; } + SCHEME_INC=/usr/include/plt + else + { $as_echo "$as_me:$LINENO: result: no" >&5 +$as_echo "no" >&6; } + vi_cv_path_mzscheme_pfx= + fi fi fi fi @@ -4738,21 +4751,34 @@ fi if test "X$vi_cv_path_mzscheme_pfx" != "X"; then if test "x$MACOSX" = "xyes"; then MZSCHEME_LIBS="-framework PLT_MzScheme" + elif test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a"; then + MZSCHEME_LIBS="${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a" + MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" elif test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzgc.a"; then MZSCHEME_LIBS="${vi_cv_path_mzscheme_pfx}/lib/libmzscheme.a ${vi_cv_path_mzscheme_pfx}/lib/libmzgc.a" else - MZSCHEME_LIBS="-L${vi_cv_path_mzscheme_pfx}/lib -lmzscheme -lmzgc" + if test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.so"; then + MZSCHEME_LIBS="-L${vi_cv_path_mzscheme_pfx}/lib -lmzscheme3m" + MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" + else + MZSCHEME_LIBS="-L${vi_cv_path_mzscheme_pfx}/lib -lmzscheme -lmzgc" + fi if test "$GCC" = yes; then - MZSCHEME_LIBS="$MZSCHEME_LIBS -Wl,-rpath -Wl,${vi_cv_path_mzscheme_pfx}/lib" + MZSCHEME_LIBS="${MZSCHEME_LIBS} -Wl,-rpath -Wl,${vi_cv_path_mzscheme_pfx}/lib" elif test "`(uname) 2>/dev/null`" = SunOS && uname -r | grep '^5' >/dev/null; then - MZSCHEME_LIBS="$MZSCHEME_LIBS -R ${vi_cv_path_mzscheme_pfx}/lib" + MZSCHEME_LIBS="${MZSCHEME_LIBS} -R ${vi_cv_path_mzscheme_pfx}/lib" fi fi if test -d $vi_cv_path_mzscheme_pfx/lib/plt/collects; then SCHEME_COLLECTS=lib/plt/ fi - MZSCHEME_CFLAGS="-I${vi_cv_path_mzscheme_pfx}/include${SCHEME_INC} \ + if test -f "${vi_cv_path_mzscheme_pfx}/${SCHEME_COLLECTS}collects/scheme/base.ss" ; then + MZSCHEME_EXTRA="mzscheme_base.c" + MZSCHEME_CFLAGS="${MZSCHEME_CFLAGS} -DINCLUDE_MZSCHEME_BASE" + MZSCHEME_MZC="${vi_cv_path_mzscheme_pfx}/bin/mzc" + fi + MZSCHEME_CFLAGS="${MZSCHEME_CFLAGS} -I${SCHEME_INC} \ -DMZSCHEME_COLLECTS='\"${vi_cv_path_mzscheme_pfx}/${SCHEME_COLLECTS}collects\"'" MZSCHEME_SRC="if_mzsch.c" MZSCHEME_OBJ="objects/if_mzsch.o" @@ -4767,6 +4793,8 @@ fi + + fi
--- a/src/config.mk.in +++ b/src/config.mk.in @@ -41,6 +41,8 @@ MZSCHEME_SRC = @MZSCHEME_SRC@ MZSCHEME_OBJ = @MZSCHEME_OBJ@ MZSCHEME_CFLAGS = @MZSCHEME_CFLAGS@ MZSCHEME_PRO = @MZSCHEME_PRO@ +MZSCHEME_EXTRA = @MZSCHEME_EXTRA@ +MZSCHEME_MZC = @MZSCHEME_MZC@ PERL = @vi_cv_path_perl@ PERLLIB = @vi_cv_perllib@
--- a/src/configure.in +++ b/src/configure.in @@ -414,7 +414,7 @@ if test "$enable_mzschemeinterp" = "yes" AC_MSG_RESULT("$PLTHOME") vi_cv_path_mzscheme_pfx="$PLTHOME" else - AC_MSG_RESULT("not set") + AC_MSG_RESULT(not set) dnl -- try to find MzScheme executable AC_PATH_PROG(vi_cv_path_mzscheme, mzscheme) @@ -430,14 +430,16 @@ if test "$enable_mzschemeinterp" = "yes" if test "X$vi_cv_path_mzscheme" != "X"; then dnl -- find where MzScheme thinks it was installed AC_CACHE_CHECK(MzScheme install prefix,vi_cv_path_mzscheme_pfx, - [ vi_cv_path_mzscheme_pfx=` - ${vi_cv_path_mzscheme} -evm \ - "(display (simplify-path \ + dnl different versions of MzScheme differ in command line processing + dnl use universal approach + echo "(display (simplify-path \ (build-path (call-with-values \ (lambda () (split-path (find-system-path (quote exec-file)))) \ - (lambda (base name must-be-dir?) base)) (quote up))))"` ]) - dnl Remove a trailing slash. - vi_cv_path_mzscheme_pfx=`echo "$vi_cv_path_mzscheme_pfx" | sed 's+/$++'` + (lambda (base name must-be-dir?) base)) (quote up))))" > mzdirs.scm + dnl Remove a trailing slash + [ vi_cv_path_mzscheme_pfx=`${vi_cv_path_mzscheme} -r mzdirs.scm | \ + sed -e 's+/$++'` ]) + rm -f mzdirs.scm fi fi fi @@ -446,16 +448,24 @@ if test "$enable_mzschemeinterp" = "yes" if test "X$vi_cv_path_mzscheme_pfx" != "X"; then AC_MSG_CHECKING(if scheme.h can be found in $vi_cv_path_mzscheme_pfx/include) if test -f $vi_cv_path_mzscheme_pfx/include/scheme.h; then - AC_MSG_RESULT("yes") + SCHEME_INC=${vi_cv_path_mzscheme_pfx}/include + AC_MSG_RESULT(yes) else - AC_MSG_RESULT("no") - AC_MSG_CHECKING(if scheme.h can be found in $vi_cv_path_mzscheme_pfx/plt/include) + AC_MSG_RESULT(no) + AC_MSG_CHECKING(if scheme.h can be found in $vi_cv_path_mzscheme_pfx/include/plt) if test -f $vi_cv_path_mzscheme_pfx/include/plt/scheme.h; then - AC_MSG_RESULT("yes") - SCHEME_INC=/plt + AC_MSG_RESULT(yes) + SCHEME_INC=${vi_cv_path_mzscheme_pfx}/include/plt else - AC_MSG_RESULT("no") - vi_cv_path_mzscheme_pfx= + AC_MSG_RESULT(no) + AC_MSG_CHECKING(if scheme.h can be found in /usr/include/plt/) + if test -f /usr/include/plt/scheme.h; then + AC_MSG_RESULT(yes) + SCHEME_INC=/usr/include/plt + else + AC_MSG_RESULT(no) + vi_cv_path_mzscheme_pfx= + fi fi fi fi @@ -463,23 +473,38 @@ if test "$enable_mzschemeinterp" = "yes" if test "X$vi_cv_path_mzscheme_pfx" != "X"; then if test "x$MACOSX" = "xyes"; then MZSCHEME_LIBS="-framework PLT_MzScheme" + elif test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a"; then + MZSCHEME_LIBS="${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.a" + MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" elif test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzgc.a"; then MZSCHEME_LIBS="${vi_cv_path_mzscheme_pfx}/lib/libmzscheme.a ${vi_cv_path_mzscheme_pfx}/lib/libmzgc.a" else - MZSCHEME_LIBS="-L${vi_cv_path_mzscheme_pfx}/lib -lmzscheme -lmzgc" + dnl Using shared objects + if test -f "${vi_cv_path_mzscheme_pfx}/lib/libmzscheme3m.so"; then + MZSCHEME_LIBS="-L${vi_cv_path_mzscheme_pfx}/lib -lmzscheme3m" + MZSCHEME_CFLAGS="-DMZ_PRECISE_GC" + else + MZSCHEME_LIBS="-L${vi_cv_path_mzscheme_pfx}/lib -lmzscheme -lmzgc" + fi if test "$GCC" = yes; then dnl Make Vim remember the path to the library. For when it's not in dnl $LD_LIBRARY_PATH. - MZSCHEME_LIBS="$MZSCHEME_LIBS -Wl,-rpath -Wl,${vi_cv_path_mzscheme_pfx}/lib" + MZSCHEME_LIBS="${MZSCHEME_LIBS} -Wl,-rpath -Wl,${vi_cv_path_mzscheme_pfx}/lib" elif test "`(uname) 2>/dev/null`" = SunOS && uname -r | grep '^5' >/dev/null; then - MZSCHEME_LIBS="$MZSCHEME_LIBS -R ${vi_cv_path_mzscheme_pfx}/lib" + MZSCHEME_LIBS="${MZSCHEME_LIBS} -R ${vi_cv_path_mzscheme_pfx}/lib" fi fi if test -d $vi_cv_path_mzscheme_pfx/lib/plt/collects; then SCHEME_COLLECTS=lib/plt/ fi - MZSCHEME_CFLAGS="-I${vi_cv_path_mzscheme_pfx}/include${SCHEME_INC} \ + if test -f "${vi_cv_path_mzscheme_pfx}/${SCHEME_COLLECTS}collects/scheme/base.ss" ; then + dnl need to generate bytecode for MzScheme base + MZSCHEME_EXTRA="mzscheme_base.c" + MZSCHEME_CFLAGS="${MZSCHEME_CFLAGS} -DINCLUDE_MZSCHEME_BASE" + MZSCHEME_MZC="${vi_cv_path_mzscheme_pfx}/bin/mzc" + fi + MZSCHEME_CFLAGS="${MZSCHEME_CFLAGS} -I${SCHEME_INC} \ -DMZSCHEME_COLLECTS='\"${vi_cv_path_mzscheme_pfx}/${SCHEME_COLLECTS}collects\"'" MZSCHEME_SRC="if_mzsch.c" MZSCHEME_OBJ="objects/if_mzsch.o" @@ -491,6 +516,8 @@ if test "$enable_mzschemeinterp" = "yes" AC_SUBST(MZSCHEME_PRO) AC_SUBST(MZSCHEME_LIBS) AC_SUBST(MZSCHEME_CFLAGS) + AC_SUBST(MZSCHEME_EXTRA) + AC_SUBST(MZSCHEME_MZC) fi
--- a/src/eval.c +++ b/src/eval.c @@ -5866,7 +5866,7 @@ list_equal(l1, l2, ic) return item1 == NULL && item2 == NULL; } -#if defined(FEAT_PYTHON) || defined(PROTO) +#if defined(FEAT_PYTHON) || defined(FEAT_MZSCHEME) || defined(PROTO) /* * Return the dictitem that an entry in a hashtable points to. */
--- a/src/if_mzsch.c +++ b/src/if_mzsch.c @@ -4,6 +4,8 @@ * Original work by Brent Fulgham <bfulgham@debian.org> * (Based on lots of help from Matthew Flatt) * + * TODO Convert byte-strings to char strings? + * * This consists of six parts: * 1. MzScheme interpreter main program * 2. Routines that handle the external interface between MzScheme and @@ -18,7 +20,7 @@ * garbage collector will do it self * 2. Requires at least NORMAL features. I can't imagine why one may want * to build with SMALL or TINY features but with MzScheme interface. - * 3. I don't use K&R-style functions. Anyway, MzScheme headers are ANSI. + * 3. I don't use K&R-style functions. Anyways, MzScheme headers are ANSI. */ #include "vim.h" @@ -29,14 +31,15 @@ * depend". */ #if defined(FEAT_MZSCHEME) || defined(PROTO) +#include <assert.h> + /* Base data structures */ #define SCHEME_VIMBUFFERP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_buffer_type) #define SCHEME_VIMWINDOWP(obj) SAME_TYPE(SCHEME_TYPE(obj), mz_window_type) typedef struct { - Scheme_Type tag; - Scheme_Env *env; + Scheme_Object so; buf_T *buf; } vim_mz_buffer; @@ -44,7 +47,7 @@ typedef struct typedef struct { - Scheme_Type tag; + Scheme_Object so; win_T *win; } vim_mz_window; @@ -67,19 +70,6 @@ typedef struct Scheme_Object *port; } Port_Info; -/* info for closed prim */ -/* - * data have different means: - * for do_eval it is char* - * for do_apply is Apply_Onfo* - * for do_load is Port_Info* - */ -typedef struct -{ - void *data; - Scheme_Env *env; -} Cmd_Info; - /* info for do_apply */ typedef struct { @@ -122,7 +112,6 @@ static Scheme_Object *set_buffer_line_li static Scheme_Object *insert_buffer_line_list(void *, int, Scheme_Object **); static Scheme_Object *get_range_start(void *, int, Scheme_Object **); static Scheme_Object *get_range_end(void *, int, Scheme_Object **); -static Scheme_Object *get_buffer_namespace(void *, int, Scheme_Object **); static vim_mz_buffer *get_vim_curr_buffer(void); /* Window-related commands */ @@ -163,8 +152,6 @@ static int vim_error_check(void); static int do_mzscheme_command(exarg_T *, void *, Scheme_Closed_Prim *what); static void startup_mzscheme(void); static char *string_to_line(Scheme_Object *obj); -static int mzscheme_io_init(void); -static void mzscheme_interface_init(vim_mz_buffer *self); static void do_output(char *mesg, long len); static void do_printf(char *format, ...); static void do_flush(void); @@ -174,19 +161,52 @@ static Scheme_Object *extract_exn_messag static Scheme_Object *do_eval(void *, int noargc, Scheme_Object **noargv); static Scheme_Object *do_load(void *, int noargc, Scheme_Object **noargv); static Scheme_Object *do_apply(void *, int noargc, Scheme_Object **noargv); -static void register_vim_exn(Scheme_Env *env); +static void register_vim_exn(void); static vim_mz_buffer *get_buffer_arg(const char *fname, int argnum, int argc, Scheme_Object **argv); static vim_mz_window *get_window_arg(const char *fname, int argnum, int argc, Scheme_Object **argv); -static void add_vim_exn(Scheme_Env *env); static int line_in_range(linenr_T, buf_T *); static void check_line_range(linenr_T, buf_T *); static void mz_fix_cursor(int lo, int hi, int extra); -static int eval_in_namespace(void *, Scheme_Closed_Prim *, Scheme_Env *, - Scheme_Object **ret); -static void make_modules(Scheme_Env *); +static int eval_with_exn_handling(void *, Scheme_Closed_Prim *, + Scheme_Object **ret); +static void make_modules(void); +static void init_exn_catching_apply(void); +static int mzscheme_env_main(Scheme_Env *env, int argc, char **argv); +static int mzscheme_init(void); +#ifdef FEAT_EVAL +static Scheme_Object *vim_to_mzscheme(typval_T *vim_value, int depth, + Scheme_Hash_Table *visited); +#endif + +#ifdef MZ_PRECISE_GC +static int buffer_size_proc(void *obj) +{ + return gcBYTES_TO_WORDS(sizeof(vim_mz_buffer)); +} +static int buffer_mark_proc(void *obj) +{ + return buffer_size_proc(obj); +} +static int buffer_fixup_proc(void *obj) +{ + return buffer_size_proc(obj); +} +static int window_size_proc(void *obj) +{ + return gcBYTES_TO_WORDS(sizeof(vim_mz_window)); +} +static int window_mark_proc(void *obj) +{ + return window_size_proc(obj); +} +static int window_fixup_proc(void *obj) +{ + return window_size_proc(obj); +} +#endif #ifdef DYNAMIC_MZSCHEME @@ -260,8 +280,6 @@ static Scheme_Object *(*dll_scheme_make_ (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina, mzshort maxa); static Scheme_Object *(*dll_scheme_make_integer_value)(long i); -static Scheme_Object *(*dll_scheme_make_namespace)(int argc, - Scheme_Object *argv[]); static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car, Scheme_Object *cdr); static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim, @@ -311,6 +329,17 @@ static Scheme_Object *(*dll_scheme_char_ static Scheme_Object *(*dll_scheme_char_string_to_path) (Scheme_Object *s); # endif +static Scheme_Hash_Table *(*dll_scheme_make_hash_table)(int type); +static void (*dll_scheme_hash_set)(Scheme_Hash_Table *table, + Scheme_Object *key, Scheme_Object *value); +static Scheme_Object *(*dll_scheme_hash_get)(Scheme_Hash_Table *table, + Scheme_Object *key); +static Scheme_Object *(*dll_scheme_make_double)(double d); +# ifdef INCLUDE_MZSCHEME_BASE +static Scheme_Object *(*dll_scheme_make_sized_byte_string)(char *chars, + long len, int copy); +static Scheme_Object *(*dll_scheme_namespace_require)(Scheme_Object *req); +# endif /* arrays are imported directly */ # define scheme_eof dll_scheme_eof @@ -368,7 +397,6 @@ static Scheme_Object *(*dll_scheme_char_ # define scheme_lookup_global dll_scheme_lookup_global # define scheme_make_closed_prim_w_arity dll_scheme_make_closed_prim_w_arity # define scheme_make_integer_value dll_scheme_make_integer_value -# define scheme_make_namespace dll_scheme_make_namespace # define scheme_make_pair dll_scheme_make_pair # define scheme_make_prim_w_arity dll_scheme_make_prim_w_arity # if MZSCHEME_VERSION_MAJOR < 299 @@ -403,6 +431,14 @@ static Scheme_Object *(*dll_scheme_char_ # define scheme_char_string_to_path \ dll_scheme_char_string_to_path # endif +# define scheme_make_hash_table dll_scheme_make_hash_table +# define scheme_hash_set dll_scheme_hash_set +# define scheme_hash_get dll_scheme_hash_get +# define scheme_make_double dll_scheme_make_double +# ifdef INCLUDE_MZSCHEME_BASE +# define scheme_make_sized_byte_string dll_scheme_make_sized_byte_string +# define scheme_namespace_require dll_scheme_namespace_require +# endif typedef struct { @@ -468,7 +504,6 @@ static Thunk_Info mzsch_imports[] = { {"scheme_make_closed_prim_w_arity", (void **)&dll_scheme_make_closed_prim_w_arity}, {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value}, - {"scheme_make_namespace", (void **)&dll_scheme_make_namespace}, {"scheme_make_pair", (void **)&dll_scheme_make_pair}, {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity}, # if MZSCHEME_VERSION_MAJOR < 299 @@ -502,9 +537,16 @@ static Thunk_Info mzsch_imports[] = { {"scheme_current_config", (void **)&dll_scheme_current_config}, {"scheme_char_string_to_byte_string", (void **)&dll_scheme_char_string_to_byte_string}, - {"scheme_char_string_to_path", - (void **)&dll_scheme_char_string_to_path}, + {"scheme_char_string_to_path", (void **)&dll_scheme_char_string_to_path}, # endif + {"scheme_make_hash_table", (void **)&dll_scheme_make_hash_table}, + {"scheme_hash_set", (void **)&dll_scheme_hash_set}, + {"scheme_hash_get", (void **)&dll_scheme_hash_get}, + {"scheme_make_double", (void **)&dll_scheme_make_double}, +# ifdef INCLUDE_MZSCHEME_BASE + {"scheme_make_sized_byte_string", (void **)&dll_scheme_make_sized_byte_string}, + {"scheme_namespace_require", (void **)&dll_scheme_namespace_require}, +#endif {NULL, NULL}}; static HINSTANCE hMzGC = 0; @@ -592,6 +634,11 @@ dynamic_mzscheme_end(void) } #endif /* DYNAMIC_MZSCHEME */ +/* need to put it here for dynamic stuff to work */ +#ifdef INCLUDE_MZSCHEME_BASE +# include "mzscheme_base.c" +#endif + /* *======================================================================== * 1. MzScheme interpreter startup @@ -601,21 +648,22 @@ dynamic_mzscheme_end(void) static Scheme_Type mz_buffer_type; static Scheme_Type mz_window_type; -static int initialized = 0; +static int initialized = FALSE; /* global environment */ static Scheme_Env *environment = NULL; /* output/error handlers */ static Scheme_Object *curout = NULL; static Scheme_Object *curerr = NULL; -/* vim:exn exception */ +/* exn:vim exception */ static Scheme_Object *exn_catching_apply = NULL; static Scheme_Object *exn_p = NULL; static Scheme_Object *exn_message = NULL; static Scheme_Object *vim_exn = NULL; /* Vim Error exception */ - /* values for exn:vim - constructor, predicate, accessors etc */ -static Scheme_Object *vim_exn_names = NULL; -static Scheme_Object *vim_exn_values = NULL; + +#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 +static void *stack_base = NULL; +#endif static long range_start; static long range_end; @@ -668,10 +716,10 @@ static void remove_timer(void); timer_proc(HWND hwnd, UINT uMsg, UINT idEvent, DWORD dwTime) # elif defined(FEAT_GUI_GTK) static gint -timer_proc(gpointer data UNUSED) +timer_proc(gpointer data) # elif defined(FEAT_GUI_MOTIF) || defined(FEAT_GUI_ATHENA) static void -timer_proc(XtPointer timed_out UNUSED, XtIntervalId *interval_id UNUSED) +timer_proc(XtPointer timed_out, XtIntervalId *interval_id) # elif defined(FEAT_GUI_MAC) pascal void timer_proc(EventLoopTimerRef theTimer, void *userData) @@ -751,12 +799,64 @@ mzscheme_end(void) #endif } + void +mzscheme_main(void) +{ +#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR >= 400 + /* use trampoline for precise GC in MzScheme >= 4.x */ + scheme_main_setup(TRUE, mzscheme_env_main, 0, NULL); +#else + mzscheme_env_main(NULL, 0, NULL); +#endif +} + + static int +mzscheme_env_main(Scheme_Env *env, int argc, char **argv) +{ + /* neither argument nor return values are used */ +#ifdef MZ_PRECISE_GC +# if MZSCHEME_VERSION_MAJOR < 400 + /* + * Starting from version 4.x, embedding applications must use + * scheme_main_setup/scheme_main_stack_setup trampolines + * rather than setting stack base directly with scheme_set_stack_base + */ + Scheme_Object *dummy = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, dummy); + + stack_base = &__gc_var_stack__; +# else + /* environment has been created by us by Scheme */ + environment = env; +# endif + /* + * In 4.x, all activities must be performed inside trampoline + * so we are forced to initialise GC immediately + * This can be postponed in 3.x but I see no point in implementing + * a feature which will work in older versions only. + * One would better use conservative GC if he needs dynamic MzScheme + */ + mzscheme_init(); +#else + int dummy = 0; + stack_base = (void *)&dummy; +#endif + main_loop(FALSE, FALSE); +#if defined(MZ_PRECISE_GC) && MZSCHEME_VERSION_MAJOR < 400 + /* releasing dummy */ + MZ_GC_REG(); + MZ_GC_UNREG(); +#endif + return 0; +} + static void startup_mzscheme(void) { - Scheme_Object *proc_make_security_guard; - - scheme_set_stack_base(NULL, 1); +#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 + scheme_set_stack_base(stack_base, 1); +#endif MZ_REGISTER_STATIC(environment); MZ_REGISTER_STATIC(curout); @@ -765,10 +865,35 @@ startup_mzscheme(void) MZ_REGISTER_STATIC(exn_p); MZ_REGISTER_STATIC(exn_message); MZ_REGISTER_STATIC(vim_exn); - MZ_REGISTER_STATIC(vim_exn_names); - MZ_REGISTER_STATIC(vim_exn_values); - + +#if !defined(MZ_PRECISE_GC) || MZSCHEME_VERSION_MAJOR < 400 + /* in newer versions of precise GC the initial env has been created */ environment = scheme_basic_env(); +#endif + MZ_GC_CHECK(); + +#ifdef INCLUDE_MZSCHEME_BASE + { + /* + * versions 4.x do not provide Scheme bindings by defaults + * we need to add them explicitly + */ + Scheme_Object *scheme_base_symbol = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, scheme_base_symbol); + MZ_GC_REG(); + /* invoke function from generated and included base.c */ + declare_modules(environment); + scheme_base_symbol = scheme_intern_symbol("scheme/base"); + MZ_GC_CHECK(); + scheme_namespace_require(scheme_base_symbol); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } +#endif + register_vim_exn(); + /* use new environment to initialise exception handling */ + init_exn_catching_apply(); /* redirect output */ scheme_console_output = do_output; @@ -776,48 +901,131 @@ startup_mzscheme(void) #ifdef MZSCHEME_COLLECTS /* setup 'current-library-collection-paths' parameter */ - scheme_set_param(scheme_config, MZCONFIG_COLLECTION_PATHS, - scheme_make_pair( # if MZSCHEME_VERSION_MAJOR >= 299 - scheme_char_string_to_path( - scheme_byte_string_to_char_string( - scheme_make_byte_string(MZSCHEME_COLLECTS))), + { + Scheme_Object *coll_byte_string = NULL; + Scheme_Object *coll_char_string = NULL; + Scheme_Object *coll_path = NULL; + Scheme_Object *coll_pair = NULL; + Scheme_Config *config = NULL; + + MZ_GC_DECL_REG(5); + MZ_GC_VAR_IN_REG(0, coll_byte_string); + MZ_GC_VAR_IN_REG(1, coll_char_string); + MZ_GC_VAR_IN_REG(2, coll_path); + MZ_GC_VAR_IN_REG(3, coll_pair); + MZ_GC_VAR_IN_REG(4, config); + MZ_GC_REG(); + coll_byte_string = scheme_make_byte_string(MZSCHEME_COLLECTS); + MZ_GC_CHECK(); + coll_char_string = scheme_byte_string_to_char_string(coll_byte_string); + MZ_GC_CHECK(); + coll_path = scheme_char_string_to_path(coll_char_string); + MZ_GC_CHECK(); + coll_pair = scheme_make_pair(coll_path, scheme_null); + MZ_GC_CHECK(); + config = scheme_config; + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } # else - scheme_make_string(MZSCHEME_COLLECTS), + { + Scheme_Object *coll_string = NULL; + Scheme_Object *coll_pair = NULL; + Scheme_Config *config = NULL; + + MZ_GC_DECL_REG(3); + MZ_GC_VAR_IN_REG(0, coll_string); + MZ_GC_VAR_IN_REG(1, coll_pair); + MZ_GC_VAR_IN_REG(2, config); + MZ_GC_REG(); + coll_string = scheme_make_string(MZSCHEME_COLLECTS); + MZ_GC_CHECK(); + coll_pair = scheme_make_pair(coll_string, scheme_null); + MZ_GC_CHECK(); + config = scheme_config; + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_COLLECTION_PATHS, coll_pair); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } # endif - scheme_null)); #endif #ifdef HAVE_SANDBOX - /* setup sandbox guards */ - proc_make_security_guard = scheme_lookup_global( - scheme_intern_symbol("make-security-guard"), - environment); - if (proc_make_security_guard != NULL) { - Scheme_Object *args[3]; - Scheme_Object *guard; - args[0] = scheme_get_param(scheme_config, MZCONFIG_SECURITY_GUARD); - args[1] = scheme_make_prim_w_arity(sandbox_file_guard, - "sandbox-file-guard", 3, 3); - args[2] = scheme_make_prim_w_arity(sandbox_network_guard, - "sandbox-network-guard", 4, 4); - guard = scheme_apply(proc_make_security_guard, 3, args); - scheme_set_param(scheme_config, MZCONFIG_SECURITY_GUARD, guard); + Scheme_Object *make_security_guard = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, make_security_guard); + MZ_GC_REG(); + +#if MZSCHEME_VERSION_MAJOR < 400 + { + Scheme_Object *make_security_guard_symbol = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, make_security_guard_symbol); + MZ_GC_REG(); + make_security_guard_symbol = scheme_intern_symbol("make-security-guard"); + MZ_GC_CHECK(); + make_security_guard = scheme_lookup_global( + make_security_guard_symbol, environment); + MZ_GC_UNREG(); + } +#else + make_security_guard = scheme_builtin_value("make-security-guard"); + MZ_GC_CHECK(); +#endif + + /* setup sandbox guards */ + if (make_security_guard != NULL) + { + Scheme_Object *args[3] = {NULL, NULL, NULL}; + Scheme_Object *guard = NULL; + Scheme_Config *config = NULL; + MZ_GC_DECL_REG(5); + MZ_GC_ARRAY_VAR_IN_REG(0, args, 3); + MZ_GC_VAR_IN_REG(3, guard); + MZ_GC_VAR_IN_REG(4, config); + MZ_GC_REG(); + config = scheme_config; + MZ_GC_CHECK(); + args[0] = scheme_get_param(config, MZCONFIG_SECURITY_GUARD); + MZ_GC_CHECK(); + args[1] = scheme_make_prim_w_arity(sandbox_file_guard, + "sandbox-file-guard", 3, 3); + args[2] = scheme_make_prim_w_arity(sandbox_network_guard, + "sandbox-network-guard", 4, 4); + guard = scheme_apply(make_security_guard, 3, args); + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_SECURITY_GUARD, guard); + MZ_GC_CHECK(); + MZ_GC_UNREG(); + } + MZ_GC_UNREG(); } #endif /* Create buffer and window types for use in Scheme code */ mz_buffer_type = scheme_make_type("<vim-buffer>"); + MZ_GC_CHECK(); mz_window_type = scheme_make_type("<vim-window>"); - - register_vim_exn(environment); - make_modules(environment); + MZ_GC_CHECK(); +#ifdef MZ_PRECISE_GC + GC_register_traversers(mz_buffer_type, + buffer_size_proc, buffer_mark_proc, buffer_fixup_proc, + TRUE, TRUE); + GC_register_traversers(mz_window_type, + window_size_proc, window_mark_proc, window_fixup_proc, + TRUE, TRUE); +#endif + + make_modules(); /* * setup callback to receive notifications * whether thread scheduling is (or not) required */ scheme_notify_multithread = notify_multithread; - initialized = 1; } /* @@ -827,102 +1035,66 @@ startup_mzscheme(void) static int mzscheme_init(void) { - int do_require = FALSE; - if (!initialized) { - do_require = TRUE; #ifdef DYNAMIC_MZSCHEME if (!mzscheme_enabled(TRUE)) { - EMSG(_("???: Sorry, this command is disabled, the MzScheme library could not be loaded.")); + EMSG(_("E812: Sorry, this command is disabled, the MzScheme libraries could not be loaded.")); return -1; } #endif startup_mzscheme(); - - if (mzscheme_io_init()) - return -1; - + initialized = TRUE; } - /* recreate ports each call effectivelly clearing these ones */ - curout = scheme_make_string_output_port(); - curerr = scheme_make_string_output_port(); - scheme_set_param(scheme_config, MZCONFIG_OUTPUT_PORT, curout); - scheme_set_param(scheme_config, MZCONFIG_ERROR_PORT, curerr); - - if (do_require) { - /* auto-instantiate in basic env */ - eval_in_namespace("(require (prefix vimext: vimext))", do_eval, - environment, NULL); + Scheme_Config *config = NULL; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, config); + MZ_GC_REG(); + config = scheme_config; + MZ_GC_CHECK(); + /* recreate ports each call effectivelly clearing these ones */ + curout = scheme_make_string_output_port(); + MZ_GC_CHECK(); + curerr = scheme_make_string_output_port(); + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_OUTPUT_PORT, curout); + MZ_GC_CHECK(); + scheme_set_param(config, MZCONFIG_ERROR_PORT, curerr); + MZ_GC_CHECK(); + MZ_GC_UNREG(); } return 0; } /* - * This routine fills the namespace with various important routines that can - * be used within MzScheme. - */ - static void -mzscheme_interface_init(vim_mz_buffer *mzbuff) -{ - Scheme_Object *attach; - - mzbuff->env = (Scheme_Env *)scheme_make_namespace(0, NULL); - - /* - * attach instantiated modules from global namespace - * so they can be easily instantiated in the buffer namespace - */ - attach = scheme_lookup_global( - scheme_intern_symbol("namespace-attach-module"), - environment); - - if (attach != NULL) - { - Scheme_Object *ret; - Scheme_Object *args[2]; - - args[0] = (Scheme_Object *)environment; - args[1] = scheme_intern_symbol("vimext"); - - ret = (Scheme_Object *)mzvim_apply(attach, 2, args); - } - - add_vim_exn(mzbuff->env); -} - -/* *======================================================================== * 2. External Interface *======================================================================== */ /* - * Evaluate command in namespace with exception handling + * Evaluate command with exception handling */ static int -eval_in_namespace(void *data, Scheme_Closed_Prim *what, Scheme_Env *env, - Scheme_Object **ret) +eval_with_exn_handling(void *data, Scheme_Closed_Prim *what, Scheme_Object **ret) { - Scheme_Object *value; - Scheme_Object *exn; - Cmd_Info info; /* closure info */ - - info.data = data; - info.env = env; - - scheme_set_param(scheme_config, MZCONFIG_ENV, - (Scheme_Object *) env); - /* - * ensure all evaluations will be in current buffer namespace, - * the second argument to scheme_eval_string isn't enough! - */ - value = _apply_thunk_catch_exceptions( - scheme_make_closed_prim_w_arity(what, &info, "mzvim", 0, 0), - &exn); + Scheme_Object *value = NULL; + Scheme_Object *exn = NULL; + Scheme_Object *prim = NULL; + + MZ_GC_DECL_REG(3); + MZ_GC_VAR_IN_REG(0, value); + MZ_GC_VAR_IN_REG(1, exn); + MZ_GC_VAR_IN_REG(2, prim); + MZ_GC_REG(); + + prim = scheme_make_closed_prim_w_arity(what, data, "mzvim", 0, 0); + MZ_GC_CHECK(); + value = _apply_thunk_catch_exceptions(prim, &exn); + MZ_GC_CHECK(); if (!value) { @@ -930,9 +1102,11 @@ eval_in_namespace(void *data, Scheme_Clo /* Got an exn? */ if (value) { - scheme_display(value, curerr); /* Send to stderr-vim */ + scheme_display(value, curerr); /* Send to stderr-vim */ + MZ_GC_CHECK(); do_flush(); } + MZ_GC_UNREG(); /* `raise' was called on some arbitrary value */ return FAIL; } @@ -941,9 +1115,13 @@ eval_in_namespace(void *data, Scheme_Clo *ret = value; /* Print any result, as long as it's not a void */ else if (!SCHEME_VOIDP(value)) + { scheme_display(value, curout); /* Send to stdout-vim */ + MZ_GC_CHECK(); + } do_flush(); + MZ_GC_UNREG(); return OK; } @@ -957,7 +1135,7 @@ do_mzscheme_command(exarg_T *eap, void * range_start = eap->line1; range_end = eap->line2; - return eval_in_namespace(data, what, get_vim_curr_buffer()->env, NULL); + return eval_with_exn_handling(data, what, NULL); } /* @@ -974,6 +1152,7 @@ mzscheme_buffer_free(buf_T *buf) bp->buf = INVALID_BUFFER_VALUE; buf->b_mzscheme_ref = NULL; scheme_gc_ptr_ok(bp); + MZ_GC_CHECK(); } } @@ -990,6 +1169,7 @@ mzscheme_window_free(win_T *win) wp->win = INVALID_WINDOW_VALUE; win->w_mzscheme_ref = NULL; scheme_gc_ptr_ok(wp); + MZ_GC_CHECK(); } } @@ -1014,18 +1194,6 @@ ex_mzscheme(exarg_T *eap) } } -/* eval MzScheme string */ - void * -mzvim_eval_string(char_u *str) -{ - Scheme_Object *ret = NULL; - if (mzscheme_init()) - return FAIL; - - eval_in_namespace(str, do_eval, get_vim_curr_buffer()->env, &ret); - return ret; -} - /* * apply MzScheme procedure with arguments, * handling errors @@ -1033,43 +1201,65 @@ mzvim_eval_string(char_u *str) Scheme_Object * mzvim_apply(Scheme_Object *proc, int argc, Scheme_Object **argv) { - Apply_Info data; - Scheme_Object *ret = NULL; - if (mzscheme_init()) return FAIL; - - data.proc = proc; - data.argc = argc; - data.argv = argv; - - eval_in_namespace(&data, do_apply, get_vim_curr_buffer()->env, &ret); - return ret; + else + { + Apply_Info data = {NULL, 0, NULL}; + Scheme_Object *ret = NULL; + + MZ_GC_DECL_REG(5); + MZ_GC_VAR_IN_REG(0, ret); + MZ_GC_VAR_IN_REG(1, data.proc); + MZ_GC_ARRAY_VAR_IN_REG(2, data.argv, argc); + MZ_GC_REG(); + + data.proc = proc; + data.argc = argc; + data.argv = argv; + + eval_with_exn_handling(&data, do_apply, &ret); + MZ_GC_UNREG(); + return ret; + } } static Scheme_Object * do_load(void *data, int noargc, Scheme_Object **noargv) { - Cmd_Info *info = (Cmd_Info *)data; - Scheme_Object *result = scheme_void; - Scheme_Object *expr; - char_u *file = scheme_malloc_fail_ok( - scheme_malloc_atomic, MAXPATHL + 1); - Port_Info *pinfo = (Port_Info *)(info->data); + Scheme_Object *expr = NULL; + Scheme_Object *result = NULL; + char *file = NULL; + Port_Info *pinfo = (Port_Info *)data; + + MZ_GC_DECL_REG(3); + MZ_GC_VAR_IN_REG(0, expr); + MZ_GC_VAR_IN_REG(1, result); + MZ_GC_VAR_IN_REG(2, file); + MZ_GC_REG(); + + file = (char *)scheme_malloc_fail_ok(scheme_malloc_atomic, MAXPATHL + 1); + MZ_GC_CHECK(); /* make Vim expansion */ - expand_env((char_u *)pinfo->name, file, MAXPATHL); - /* scheme_load looks strange working with namespaces and error handling*/ + expand_env((char_u *)pinfo->name, (char_u *)file, MAXPATHL); pinfo->port = scheme_open_input_file(file, "mzfile"); - scheme_count_lines(pinfo->port); /* to get accurate read error location*/ + MZ_GC_CHECK(); + scheme_count_lines(pinfo->port); /* to get accurate read error location*/ + MZ_GC_CHECK(); /* Like REPL but print only last result */ while (!SCHEME_EOFP(expr = scheme_read(pinfo->port))) - result = scheme_eval(expr, info->env); + { + result = scheme_eval(expr, environment); + MZ_GC_CHECK(); + } /* errors will be caught in do_mzscheme_comamnd and ex_mzfile */ scheme_close_input_port(pinfo->port); + MZ_GC_CHECK(); pinfo->port = NULL; + MZ_GC_UNREG(); return result; } @@ -1077,13 +1267,20 @@ do_load(void *data, int noargc, Scheme_O void ex_mzfile(exarg_T *eap) { - Port_Info pinfo; + Port_Info pinfo = {NULL, NULL}; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, pinfo.port); + MZ_GC_REG(); pinfo.name = (char *)eap->arg; - pinfo.port = NULL; if (do_mzscheme_command(eap, &pinfo, do_load) != OK && pinfo.port != NULL) /* looks like port was not closed */ + { scheme_close_input_port(pinfo.port); + MZ_GC_CHECK(); + } + MZ_GC_UNREG(); } @@ -1103,14 +1300,12 @@ init_exn_catching_apply(void) "(with-handlers ([void (lambda (exn) (cons #f exn))]) " "(cons #t (thunk))))"; - /* make sure we have a namespace with the standard syntax: */ - Scheme_Env *env = (Scheme_Env *)scheme_make_namespace(0, NULL); - add_vim_exn(env); - - exn_catching_apply = scheme_eval_string(e, env); - exn_p = scheme_lookup_global(scheme_intern_symbol("exn?"), env); - exn_message = scheme_lookup_global( - scheme_intern_symbol("exn-message"), env); + exn_catching_apply = scheme_eval_string(e, environment); + MZ_GC_CHECK(); + exn_p = scheme_builtin_value("exn?"); + MZ_GC_CHECK(); + exn_message = scheme_builtin_value("exn-message"); + MZ_GC_CHECK(); } } @@ -1124,8 +1319,6 @@ init_exn_catching_apply(void) { Scheme_Object *v; - init_exn_catching_apply(); - v = _scheme_apply(exn_catching_apply, 1, &f); /* v is a pair: (cons #t value) or (cons #f exn) */ @@ -1141,8 +1334,6 @@ init_exn_catching_apply(void) static Scheme_Object * extract_exn_message(Scheme_Object *v) { - init_exn_catching_apply(); - if (SCHEME_TRUEP(_scheme_apply(exn_p, 1, &v))) return _scheme_apply(exn_message, 1, &v); else @@ -1152,16 +1343,13 @@ extract_exn_message(Scheme_Object *v) static Scheme_Object * do_eval(void *s, int noargc, Scheme_Object **noargv) { - Cmd_Info *info = (Cmd_Info *)s; - - return scheme_eval_string_all((char *)(info->data), info->env, TRUE); + return scheme_eval_string_all((char *)s, environment, TRUE); } static Scheme_Object * do_apply(void *a, int noargc, Scheme_Object **noargv) { - Apply_Info *info = (Apply_Info *)(((Cmd_Info *)a)->data); - + Apply_Info *info = (Apply_Info *)a; return scheme_apply(info->proc, info->argc, info->argv); } @@ -1219,6 +1407,7 @@ do_flush(void) long length; buff = scheme_get_sized_string_output(curerr, &length); + MZ_GC_CHECK(); if (length) { do_err_output(buff, length); @@ -1226,17 +1415,11 @@ do_flush(void) } buff = scheme_get_sized_string_output(curout, &length); + MZ_GC_CHECK(); if (length) do_output(buff, length); } - static int -mzscheme_io_init(void) -{ - /* Nothing needed so far... */ - return 0; -} - /* *======================================================================== * 4. Implementation of the Vim Features for MzScheme @@ -1263,22 +1446,30 @@ vim_command(void *data, int argc, Scheme vim_eval(void *data, int argc, Scheme_Object **argv) { #ifdef FEAT_EVAL - Vim_Prim *prim = (Vim_Prim *)data; - char *expr; - char *str; - Scheme_Object *result; + Vim_Prim *prim = (Vim_Prim *)data; + char *expr; + Scheme_Object *result; + /* hash table to store visited values to avoid infinite loops */ + Scheme_Hash_Table *visited = NULL; + typval_T *vim_result; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, visited); + MZ_GC_REG(); + + visited = scheme_make_hash_table(SCHEME_hash_ptr); + MZ_GC_CHECK(); expr = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); - - str = (char *)eval_to_string((char_u *)expr, NULL, TRUE); - - if (str == NULL) + vim_result = eval_expr((char_u *)expr, NULL); + + if (vim_result == NULL) raise_vim_exn(_("invalid expression")); - result = scheme_make_string(str); - - vim_free(str); - + result = vim_to_mzscheme(vim_result, 1, visited); + free_tv(vim_result); + + MZ_GC_UNREG(); return result; #else raise_vim_exn(_("expressions disabled at compile time")); @@ -1318,7 +1509,7 @@ get_option(void *data, int argc, Scheme_ Vim_Prim *prim = (Vim_Prim *)data; char_u *name; long value; - char_u *strval; + char *strval; int rc; Scheme_Object *rval; int opt_flags = 0; @@ -1333,6 +1524,7 @@ get_option(void *data, int argc, Scheme_ { MZ_REGISTER_STATIC(M_global); M_global = scheme_intern_symbol("global"); + MZ_GC_CHECK(); } if (argv[1] == M_global) @@ -1354,7 +1546,7 @@ get_option(void *data, int argc, Scheme_ scheme_wrong_type(prim->name, "vim-buffer/window", 1, argc, argv); } - rc = get_option_value(name, &value, &strval, opt_flags); + rc = get_option_value(name, &value, (char_u **)&strval, opt_flags); curbuf = save_curb; curwin = save_curw; @@ -1364,6 +1556,7 @@ get_option(void *data, int argc, Scheme_ return scheme_make_integer_value(value); case 0: rval = scheme_make_string(strval); + MZ_GC_CHECK(); vim_free(strval); return rval; case -1: @@ -1393,6 +1586,7 @@ set_option(void *data, int argc, Scheme_ { MZ_REGISTER_STATIC(M_global); M_global = scheme_intern_symbol("global"); + MZ_GC_CHECK(); } if (argv[1] == M_global) @@ -1463,7 +1657,10 @@ get_window_list(void *data, int argc, Sc for (w = firstwin; w != NULL; w = w->w_next) if (w->w_buffer == buf->buf) + { list = scheme_make_pair(window_new(w), list); + MZ_GC_CHECK(); + } return list; } @@ -1471,7 +1668,11 @@ get_window_list(void *data, int argc, Sc static Scheme_Object * window_new(win_T *win) { - vim_mz_window *self; + vim_mz_window *self = NULL; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, self); + MZ_GC_REG(); /* We need to handle deletion of windows underneath us. * If we add a "w_mzscheme_ref" field to the win_T structure, @@ -1485,13 +1686,14 @@ window_new(win_T *win) return win->w_mzscheme_ref; self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_window)); - vim_memset(self, 0, sizeof(vim_mz_window)); scheme_dont_gc_ptr(self); /* because win isn't visible to GC */ + MZ_GC_CHECK(); win->w_mzscheme_ref = self; self->win = win; - self->tag = mz_window_type; - + self->so.type = mz_window_type; + + MZ_GC_UNREG(); return (Scheme_Object *)(self); } @@ -1660,7 +1862,6 @@ set_cursor(void *data, int argc, Scheme_ /* *=========================================================================== * 6. Vim Buffer-related Manipulation Functions - * Note that each buffer should have its own private namespace. *=========================================================================== */ @@ -1669,14 +1870,14 @@ set_cursor(void *data, int argc, Scheme_ mzscheme_open_buffer(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; - char *fname; + char_u *fname; int num = 0; Scheme_Object *onum; #ifdef HAVE_SANDBOX sandbox_check(); #endif - fname = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); /* TODO make open existing file */ num = buflist_add(fname, BLN_LISTED | BLN_CURBUF); @@ -1712,7 +1913,7 @@ get_buffer_by_name(void *data, int argc, buf_T *buf; char_u *fname; - fname = SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); + fname = (char_u *)SCHEME_STR_VAL(GUARANTEE_STRING(prim->name, 0)); for (buf = firstbuf; buf; buf = buf->b_next) if (buf->b_ffname == NULL || buf->b_sfname == NULL) @@ -1783,7 +1984,7 @@ get_buffer_name(void *data, int argc, Sc Vim_Prim *prim = (Vim_Prim *)data; vim_mz_buffer *buf = get_buffer_arg(prim->name, 0, argc, argv); - return scheme_make_string(buf->buf->b_ffname); + return scheme_make_string((char *)buf->buf->b_ffname); } /* (curr-buff) */ @@ -1796,7 +1997,11 @@ get_curr_buffer(void *data, int argc, Sc static Scheme_Object * buffer_new(buf_T *buf) { - vim_mz_buffer *self; + vim_mz_buffer *self = NULL; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, self); + MZ_GC_REG(); /* We need to handle deletion of buffers underneath us. * If we add a "b_mzscheme_ref" field to the buf_T structure, @@ -1806,15 +2011,14 @@ buffer_new(buf_T *buf) return buf->b_mzscheme_ref; self = scheme_malloc_fail_ok(scheme_malloc, sizeof(vim_mz_buffer)); - vim_memset(self, 0, sizeof(vim_mz_buffer)); - scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ + scheme_dont_gc_ptr(self); /* because buf isn't visible to GC */ + MZ_GC_CHECK(); buf->b_mzscheme_ref = self; self->buf = buf; - self->tag = mz_buffer_type; - - mzscheme_interface_init(self); /* Set up namespace */ - + self->so.type = mz_buffer_type; + + MZ_GC_UNREG(); return (Scheme_Object *)(self); } @@ -1845,14 +2049,14 @@ get_buffer_line(void *data, int argc, Sc Vim_Prim *prim = (Vim_Prim *)data; vim_mz_buffer *buf; int linenr; - char *line; + char_u *line; buf = get_buffer_arg(prim->name, 1, argc, argv); linenr = SCHEME_INT_VAL(GUARANTEE_INTEGER(prim->name, 0)); line = ml_get_buf(buf->buf, (linenr_T)linenr, FALSE); raise_if_error(); - return scheme_make_string(line); + return scheme_make_string((char *)line); } @@ -1869,7 +2073,11 @@ get_buffer_line_list(void *data, int arg Vim_Prim *prim = (Vim_Prim *)data; vim_mz_buffer *buf; int i, hi, lo, n; - Scheme_Object *list; + Scheme_Object *list = NULL; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, list); + MZ_GC_REG(); buf = get_buffer_arg(prim->name, 2, argc, argv); list = scheme_null; @@ -1897,8 +2105,9 @@ get_buffer_line_list(void *data, int arg /* Set the list item */ list = scheme_make_pair(str, list); + MZ_GC_CHECK(); } - + MZ_GC_UNREG(); return list; } @@ -1925,11 +2134,14 @@ set_buffer_line(void *data, int argc, Sc */ Vim_Prim *prim = (Vim_Prim *)data; vim_mz_buffer *buf; - Scheme_Object *line; + Scheme_Object *line = NULL; char *save; - buf_T *savebuf; int n; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, line); + MZ_GC_REG(); + #ifdef HAVE_SANDBOX sandbox_check(); #endif @@ -1943,7 +2155,8 @@ set_buffer_line(void *data, int argc, Sc if (SCHEME_FALSEP(line)) { - savebuf = curbuf; + buf_T *savebuf = curbuf; + curbuf = buf->buf; if (u_savedel((linenr_T)n, 1L) == FAIL) @@ -1962,33 +2175,56 @@ set_buffer_line(void *data, int argc, Sc curbuf = savebuf; + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } - - /* Otherwise it's a line */ - save = string_to_line(line); - savebuf = curbuf; - - curbuf = buf->buf; - - if (u_savesub((linenr_T)n) == FAIL) + else { + /* Otherwise it's a line */ + buf_T *savebuf = curbuf; + + save = string_to_line(line); + + curbuf = buf->buf; + + if (u_savesub((linenr_T)n) == FAIL) + { + curbuf = savebuf; + vim_free(save); + raise_vim_exn(_("cannot save undo information")); + } + else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL) + { + curbuf = savebuf; + vim_free(save); + raise_vim_exn(_("cannot replace line")); + } + else + { + vim_free(save); + changed_bytes((linenr_T)n, 0); + } + curbuf = savebuf; - raise_vim_exn(_("cannot save undo information")); + + /* Check that the cursor is not beyond the end of the line now. */ + if (buf->buf == curwin->w_buffer) + check_cursor_col(); + + MZ_GC_UNREG(); + raise_if_error(); + return scheme_void; } - else if (ml_replace((linenr_T)n, (char_u *)save, TRUE) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot replace line")); - } - else - changed_bytes((linenr_T)n, 0); - - curbuf = savebuf; - - raise_if_error(); - return scheme_void; +} + + static void +free_array(char **array) +{ + char **curr = array; + while (*curr != NULL) + vim_free(*curr++); + vim_free(array); } /* @@ -2013,15 +2249,15 @@ set_buffer_line_list(void *data, int arg * 3. Anything else - this is an error. */ Vim_Prim *prim = (Vim_Prim *)data; - vim_mz_buffer *buf; - Scheme_Object *line_list; - Scheme_Object *line; - Scheme_Object *rest; - char **array; - buf_T *savebuf; + vim_mz_buffer *buf = NULL; + Scheme_Object *line_list = NULL; int i, old_len, new_len, hi, lo; long extra; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, line_list); + MZ_GC_REG(); + #ifdef HAVE_SANDBOX sandbox_check(); #endif @@ -2047,7 +2283,7 @@ set_buffer_line_list(void *data, int arg if (SCHEME_FALSEP(line_list) || SCHEME_NULLP(line_list)) { - savebuf = curbuf; + buf_T *savebuf = curbuf; curbuf = buf->buf; if (u_savedel((linenr_T)lo, (long)old_len) == FAIL) @@ -2070,98 +2306,121 @@ set_buffer_line_list(void *data, int arg curbuf = savebuf; + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } - - /* List */ - new_len = scheme_proper_list_length(line_list); - if (new_len < 0) /* improper or cyclic list */ - scheme_wrong_type(prim->name, "proper list", - 2, argc, argv); - - /* Using MzScheme allocator, so we don't need to free this and - * can safely keep pointers to GC collected strings - */ - array = (char **)scheme_malloc_fail_ok(scheme_malloc, - (unsigned)(new_len * sizeof(char *))); - - rest = line_list; - for (i = 0; i < new_len; ++i) + else { - line = SCHEME_CAR(rest); - rest = SCHEME_CDR(rest); - if (!SCHEME_STRINGP(line)) - scheme_wrong_type(prim->name, "string-list", 2, argc, argv); - array[i] = string_to_line(line); - } - - savebuf = curbuf; - curbuf = buf->buf; - - if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot save undo information")); - } - - /* - * If the size of the range is reducing (ie, new_len < old_len) we - * need to delete some old_len. We do this at the start, by - * repeatedly deleting line "lo". - */ - for (i = 0; i < old_len - new_len; ++i) - { - if (ml_delete((linenr_T)lo, FALSE) == FAIL) + buf_T *savebuf = curbuf; + + /* List */ + new_len = scheme_proper_list_length(line_list); + MZ_GC_CHECK(); + if (new_len < 0) /* improper or cyclic list */ + scheme_wrong_type(prim->name, "proper list", + 2, argc, argv); + else { - curbuf = savebuf; - raise_vim_exn(_("cannot delete line")); + char **array = NULL; + Scheme_Object *line = NULL; + Scheme_Object *rest = NULL; + + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, line); + MZ_GC_VAR_IN_REG(1, rest); + MZ_GC_REG(); + + array = (char **)alloc(new_len * sizeof(char *)); + vim_memset(array, 0, new_len * sizeof(char *)); + + rest = line_list; + for (i = 0; i < new_len; ++i) + { + line = SCHEME_CAR(rest); + rest = SCHEME_CDR(rest); + if (!SCHEME_STRINGP(line)) + { + free_array(array); + scheme_wrong_type(prim->name, "string-list", 2, argc, argv); + } + array[i] = string_to_line(line); + } + + curbuf = buf->buf; + + if (u_save((linenr_T)(lo-1), (linenr_T)hi) == FAIL) + { + curbuf = savebuf; + free_array(array); + raise_vim_exn(_("cannot save undo information")); + } + + /* + * If the size of the range is reducing (ie, new_len < old_len) we + * need to delete some old_len. We do this at the start, by + * repeatedly deleting line "lo". + */ + for (i = 0; i < old_len - new_len; ++i) + { + if (ml_delete((linenr_T)lo, FALSE) == FAIL) + { + curbuf = savebuf; + free_array(array); + raise_vim_exn(_("cannot delete line")); + } + extra--; + } + + /* + * For as long as possible, replace the existing old_len with the + * new old_len. This is a more efficient operation, as it requires + * less memory allocation and freeing. + */ + for (i = 0; i < old_len && i < new_len; i++) + if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL) + { + curbuf = savebuf; + free_array(array); + raise_vim_exn(_("cannot replace line")); + } + + /* + * Now we may need to insert the remaining new_len. We don't need to + * free the string passed back because MzScheme has control of that + * memory. + */ + while (i < new_len) + { + if (ml_append((linenr_T)(lo + i - 1), + (char_u *)array[i], 0, FALSE) == FAIL) + { + curbuf = savebuf; + free_array(array); + raise_vim_exn(_("cannot insert line")); + } + ++i; + ++extra; + } + MZ_GC_UNREG(); + free_array(array); } - extra--; + + /* + * Adjust marks. Invalidate any which lie in the + * changed range, and move any in the remainder of the buffer. + */ + mark_adjust((linenr_T)lo, (linenr_T)(hi - 1), (long)MAXLNUM, (long)extra); + changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra); + + if (buf->buf == curwin->w_buffer) + mz_fix_cursor(lo, hi, extra); + curbuf = savebuf; + + MZ_GC_UNREG(); + raise_if_error(); + return scheme_void; } - - /* - * For as long as possible, replace the existing old_len with the - * new old_len. This is a more efficient operation, as it requires - * less memory allocation and freeing. - */ - for (i = 0; i < old_len && i < new_len; i++) - if (ml_replace((linenr_T)(lo+i), (char_u *)array[i], TRUE) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot replace line")); - } - - /* - * Now we may need to insert the remaining new_len. We don't need to - * free the string passed back because MzScheme has control of that - * memory. - */ - while (i < new_len) - { - if (ml_append((linenr_T)(lo + i - 1), - (char_u *)array[i], 0, FALSE) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot insert line")); - } - ++i; - ++extra; - } - - /* - * Adjust marks. Invalidate any which lie in the - * changed range, and move any in the remainder of the buffer. - */ - mark_adjust((linenr_T)lo, (linenr_T)(hi - 1), (long)MAXLNUM, (long)extra); - changed_lines((linenr_T)lo, 0, (linenr_T)hi, (long)extra); - - if (buf->buf == curwin->w_buffer) - mz_fix_cursor(lo, hi, extra); - curbuf = savebuf; - - raise_if_error(); - return scheme_void; } /* @@ -2179,15 +2438,15 @@ set_buffer_line_list(void *data, int arg insert_buffer_line_list(void *data, int argc, Scheme_Object **argv) { Vim_Prim *prim = (Vim_Prim *)data; - vim_mz_buffer *buf; - Scheme_Object *list; - Scheme_Object *line; - Scheme_Object *rest; - char **array; - char *str; - buf_T *savebuf; + vim_mz_buffer *buf = NULL; + Scheme_Object *list = NULL; + char *str = NULL; int i, n, size; + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, list); + MZ_GC_REG(); + #ifdef HAVE_SANDBOX sandbox_check(); #endif @@ -2206,89 +2465,99 @@ insert_buffer_line_list(void *data, int check_line_range(n, buf->buf); if (SCHEME_STRINGP(list)) { + buf_T *savebuf = curbuf; + str = string_to_line(list); - - savebuf = curbuf; curbuf = buf->buf; if (u_save((linenr_T)n, (linenr_T)(n+1)) == FAIL) { curbuf = savebuf; + vim_free(str); raise_vim_exn(_("cannot save undo information")); } else if (ml_append((linenr_T)n, (char_u *)str, 0, FALSE) == FAIL) { curbuf = savebuf; + vim_free(str); raise_vim_exn(_("cannot insert line")); } else + { + vim_free(str); appended_lines_mark((linenr_T)n, 1L); + } curbuf = savebuf; update_screen(VALID); + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } /* List */ size = scheme_proper_list_length(list); + MZ_GC_CHECK(); if (size < 0) /* improper or cyclic list */ scheme_wrong_type(prim->name, "proper list", 2, argc, argv); - - /* Using MzScheme allocator, so we don't need to free this and - * can safely keep pointers to GC collected strings - */ - array = (char **)scheme_malloc_fail_ok( - scheme_malloc, (unsigned)(size * sizeof(char *))); - - rest = list; - for (i = 0; i < size; ++i) - { - line = SCHEME_CAR(rest); - rest = SCHEME_CDR(rest); - array[i] = string_to_line(line); - } - - savebuf = curbuf; - curbuf = buf->buf; - - if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot save undo information")); - } else { + Scheme_Object *line = NULL; + Scheme_Object *rest = NULL; + char **array; + buf_T *savebuf = curbuf; + + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, line); + MZ_GC_VAR_IN_REG(1, rest); + MZ_GC_REG(); + + array = (char **)alloc(size * sizeof(char *)); + vim_memset(array, 0, size * sizeof(char *)); + + rest = list; for (i = 0; i < size; ++i) - if (ml_append((linenr_T)(n + i), (char_u *)array[i], - 0, FALSE) == FAIL) - { - curbuf = savebuf; - raise_vim_exn(_("cannot insert line")); - } - - if (i > 0) - appended_lines_mark((linenr_T)n, (long)i); + { + line = SCHEME_CAR(rest); + rest = SCHEME_CDR(rest); + array[i] = string_to_line(line); + } + + curbuf = buf->buf; + + if (u_save((linenr_T)n, (linenr_T)(n + 1)) == FAIL) + { + curbuf = savebuf; + free_array(array); + raise_vim_exn(_("cannot save undo information")); + } + else + { + for (i = 0; i < size; ++i) + if (ml_append((linenr_T)(n + i), (char_u *)array[i], + 0, FALSE) == FAIL) + { + curbuf = savebuf; + free_array(array); + raise_vim_exn(_("cannot insert line")); + } + + if (i > 0) + appended_lines_mark((linenr_T)n, (long)i); + } + free_array(array); + MZ_GC_UNREG(); + curbuf = savebuf; + update_screen(VALID); } - curbuf = savebuf; - update_screen(VALID); - + MZ_GC_UNREG(); raise_if_error(); return scheme_void; } -/* (get-buff-namespace [buffer]) */ - static Scheme_Object * -get_buffer_namespace(void *data, int argc, Scheme_Object **argv) -{ - Vim_Prim *prim = (Vim_Prim *)data; - - return (Scheme_Object *)get_buffer_arg(prim->name, 0, argc, argv)->env; -} - /* * Predicates */ @@ -2343,40 +2612,172 @@ vim_window_validp(void *data, int argc, /* * Convert an MzScheme string into a Vim line. * - * The result is in allocated memory. All internal nulls are replaced by - * newline characters. It is an error for the string to contain newline - * characters. + * All internal nulls are replaced by newline characters. + * It is an error for the string to contain newline characters. * + * Returns pointer to Vim allocated memory */ static char * string_to_line(Scheme_Object *obj) { - char *str; + char *scheme_str = NULL; + char *vim_str = NULL; long len; int i; - str = scheme_display_to_string(obj, &len); + scheme_str = scheme_display_to_string(obj, &len); /* Error checking: String must not contain newlines, as we * are replacing a single line, and we must replace it with * a single line. */ - if (memchr(str, '\n', len)) + if (memchr(scheme_str, '\n', len)) scheme_signal_error(_("string cannot contain newlines")); + vim_str = (char *)alloc(len + 1); + /* Create a copy of the string, with internal nulls replaced by * newline characters, as is the vim convention. */ for (i = 0; i < len; ++i) { - if (str[i] == '\0') - str[i] = '\n'; + if (scheme_str[i] == '\0') + vim_str[i] = '\n'; + else + vim_str[i] = scheme_str[i]; + } + + vim_str[i] = '\0'; + + MZ_GC_CHECK(); + return vim_str; +} + +#ifdef FEAT_EVAL +/* + * Convert Vim value into MzScheme, adopted from if_python.c + */ + static Scheme_Object * +vim_to_mzscheme(typval_T *vim_value, int depth, Scheme_Hash_Table *visited) +{ + Scheme_Object *result = NULL; + int new_value = TRUE; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, result); + MZ_GC_REG(); + + /* Avoid infinite recursion */ + if (depth > 100) + { + MZ_GC_UNREG(); + return scheme_void; + } + + /* Check if we run into a recursive loop. The item must be in visited + * then and we can use it again. + */ + result = scheme_hash_get(visited, (Scheme_Object *)vim_value); + MZ_GC_CHECK(); + if (result != NULL) /* found, do nothing */ + new_value = FALSE; + else if (vim_value->v_type == VAR_STRING) + { + result = scheme_make_string((char *)vim_value->vval.v_string); + MZ_GC_CHECK(); + } + else if (vim_value->v_type == VAR_NUMBER) + { + result = scheme_make_integer((long)vim_value->vval.v_number); + MZ_GC_CHECK(); + } +# ifdef FEAT_FLOAT + else if (vim_value->v_type == VAR_FLOAT) + { + result = scheme_make_double((double)vim_value->vval.v_float); + MZ_GC_CHECK(); } - - str[i] = '\0'; - - return str; +# endif + else if (vim_value->v_type == VAR_LIST) + { + list_T *list = vim_value->vval.v_list; + listitem_T *curr; + + if (list == NULL || list->lv_first == NULL) + result = scheme_null; + else + { + Scheme_Object *obj = NULL; + + MZ_GC_DECL_REG(1); + MZ_GC_VAR_IN_REG(0, obj); + MZ_GC_REG(); + + curr = list->lv_last; + obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited); + result = scheme_make_pair(obj, scheme_null); + MZ_GC_CHECK(); + + while (curr != list->lv_first) + { + curr = curr->li_prev; + obj = vim_to_mzscheme(&curr->li_tv, depth + 1, visited); + result = scheme_make_pair(obj, result); + MZ_GC_CHECK(); + } + } + MZ_GC_UNREG(); + } + else if (vim_value->v_type == VAR_DICT) + { + Scheme_Object *key = NULL; + Scheme_Object *obj = NULL; + + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, key); + MZ_GC_VAR_IN_REG(1, obj); + MZ_GC_REG(); + + result = (Scheme_Object *)scheme_make_hash_table(SCHEME_hash_ptr); + MZ_GC_CHECK(); + if (vim_value->vval.v_dict != NULL) + { + hashtab_T *ht = &vim_value->vval.v_dict->dv_hashtab; + long_u todo = ht->ht_used; + hashitem_T *hi; + dictitem_T *di; + + for (hi = ht->ht_array; todo > 0; ++hi) + { + if (!HASHITEM_EMPTY(hi)) + { + --todo; + + di = dict_lookup(hi); + obj = vim_to_mzscheme(&di->di_tv, depth + 1, visited); + key = scheme_make_string((char *)hi->hi_key); + MZ_GC_CHECK(); + scheme_hash_set((Scheme_Hash_Table *)result, key, obj); + MZ_GC_CHECK(); + } + } + } + MZ_GC_UNREG(); + } + else + { + result = scheme_void; + new_value = FALSE; + } + if (new_value) + { + scheme_hash_set(visited, (Scheme_Object *)vim_value, result); + MZ_GC_CHECK(); + } + MZ_GC_UNREG(); + return result; } +#endif /* * Check to see whether a Vim error has been reported, or a keyboard @@ -2392,50 +2793,59 @@ vim_error_check(void) * register Scheme exn:vim */ static void -register_vim_exn(Scheme_Env *env) +register_vim_exn(void) { - Scheme_Object *exn_name = scheme_intern_symbol("exn:vim"); + int nc = 0; + int i; + Scheme_Object *struct_exn = NULL; + Scheme_Object *exn_name = NULL; + + MZ_GC_DECL_REG(2); + MZ_GC_VAR_IN_REG(0, struct_exn); + MZ_GC_VAR_IN_REG(1, exn_name); + MZ_GC_REG(); + + exn_name = scheme_intern_symbol("exn:vim"); + MZ_GC_CHECK(); + struct_exn = scheme_builtin_value("struct:exn"); + MZ_GC_CHECK(); if (vim_exn == NULL) vim_exn = scheme_make_struct_type(exn_name, - scheme_builtin_value("struct:exn"), NULL, 0, 0, NULL, NULL + struct_exn, NULL, 0, 0, NULL, NULL #if MZSCHEME_VERSION_MAJOR >= 299 , NULL #endif ); - if (vim_exn_values == NULL) + { - int nc = 0; - - Scheme_Object **exn_names = scheme_make_struct_names( - exn_name, scheme_null, 0, &nc); - Scheme_Object **exn_values = scheme_make_struct_values( - vim_exn, exn_names, nc, 0); - - vim_exn_names = scheme_make_vector(nc, scheme_false); - vim_exn_values = scheme_make_vector(nc, scheme_false); - /* remember names and values */ - mch_memmove(SCHEME_VEC_ELS(vim_exn_names), exn_names, - nc * sizeof(Scheme_Object *)); - mch_memmove(SCHEME_VEC_ELS(vim_exn_values), exn_values, - nc * sizeof(Scheme_Object *)); + Scheme_Object **tmp = NULL; + Scheme_Object *exn_names[5] = {NULL, NULL, NULL, NULL, NULL}; + Scheme_Object *exn_values[5] = {NULL, NULL, NULL, NULL, NULL}; + MZ_GC_DECL_REG(6); + MZ_GC_ARRAY_VAR_IN_REG(0, exn_names, 5); + MZ_GC_ARRAY_VAR_IN_REG(3, exn_values, 5); + MZ_GC_REG(); + + tmp = scheme_make_struct_names(exn_name, scheme_null, 0, &nc); + assert(nc <= 5); + mch_memmove(exn_names, tmp, nc * sizeof(Scheme_Object *)); + MZ_GC_CHECK(); + + tmp = scheme_make_struct_values(vim_exn, exn_names, nc, 0); + mch_memmove(exn_values, tmp, nc * sizeof(Scheme_Object *)); + MZ_GC_CHECK(); + + for (i = 0; i < nc; i++) + { + scheme_add_global_symbol(exn_names[i], + exn_values[i], environment); + MZ_GC_CHECK(); + } + MZ_GC_UNREG(); } - - add_vim_exn(env); -} - -/* - * Add stuff of exn:vim to env - */ - static void -add_vim_exn(Scheme_Env *env) -{ - int i; - - for (i = 0; i < SCHEME_VEC_SIZE(vim_exn_values); i++) - scheme_add_global_symbol(SCHEME_VEC_ELS(vim_exn_names)[i], - SCHEME_VEC_ELS(vim_exn_values)[i], env); + MZ_GC_UNREG(); } /* @@ -2444,26 +2854,54 @@ add_vim_exn(Scheme_Env *env) void raise_vim_exn(const char *add_info) { - Scheme_Object *argv[2]; - char_u *fmt = _("Vim error: ~a"); + char *fmt = _("Vim error: ~a"); + Scheme_Object *argv[2] = {NULL, NULL}; + Scheme_Object *exn = NULL; + + MZ_GC_DECL_REG(4); + MZ_GC_ARRAY_VAR_IN_REG(0, argv, 2); + MZ_GC_VAR_IN_REG(3, exn); + MZ_GC_REG(); if (add_info != NULL) { - Scheme_Object *info = scheme_make_string(add_info); - argv[0] = scheme_byte_string_to_char_string(scheme_make_string( - scheme_format(fmt, strlen(fmt), 1, &info, NULL))); + char *c_string = NULL; + Scheme_Object *byte_string = NULL; + Scheme_Object *info = NULL; + + MZ_GC_DECL_REG(3); + MZ_GC_VAR_IN_REG(0, c_string); + MZ_GC_VAR_IN_REG(1, byte_string); + MZ_GC_VAR_IN_REG(2, info); + MZ_GC_REG(); + + info = scheme_make_string(add_info); + MZ_GC_CHECK(); + c_string = scheme_format(fmt, STRLEN(fmt), 1, &info, NULL); + MZ_GC_CHECK(); + byte_string = scheme_make_string(c_string); + MZ_GC_CHECK(); + argv[0] = scheme_byte_string_to_char_string(byte_string); + MZ_GC_CHECK(); SCHEME_SET_IMMUTABLE(argv[0]); + MZ_GC_UNREG(); } else argv[0] = scheme_make_string(_("Vim error")); + MZ_GC_CHECK(); #if MZSCHEME_VERSION_MAJOR < 360 argv[1] = scheme_current_continuation_marks(); + MZ_GC_CHECK(); #else argv[1] = scheme_current_continuation_marks(NULL); + MZ_GC_CHECK(); #endif - scheme_raise(scheme_make_struct_instance(vim_exn, 2, argv)); + exn = scheme_make_struct_instance(vim_exn, 2, argv); + MZ_GC_CHECK(); + scheme_raise(exn); + MZ_GC_UNREG(); } void @@ -2570,6 +3008,8 @@ mz_fix_cursor(int lo, int hi, int extra) curwin->w_cursor.lnum = lo; check_cursor(); } + else + check_cursor_col(); changed_cline_bef_curs(); } invalidate_botline(); @@ -2595,7 +3035,6 @@ static Vim_Prim prims[]= {mzscheme_open_buffer, "open-buff", 1, 1}, {get_buffer_by_name, "get-buff-by-name", 1, 1}, {get_buffer_by_num, "get-buff-by-num", 1, 1}, - {get_buffer_namespace, "get-buff-namespace", 0, 1}, /* * Window-related commands */ @@ -2653,23 +3092,35 @@ get_vim_curr_window(void) } static void -make_modules(Scheme_Env *env) +make_modules() { - int i; - Scheme_Env *mod; - - mod = scheme_primitive_module(scheme_intern_symbol("vimext"), env); + int i; + Scheme_Env *mod = NULL; + Scheme_Object *vimext_symbol = NULL; + Scheme_Object *closed_prim = NULL; + + MZ_GC_DECL_REG(3); + MZ_GC_VAR_IN_REG(0, mod); + MZ_GC_VAR_IN_REG(1, vimext_symbol); + MZ_GC_VAR_IN_REG(2, closed_prim); + MZ_GC_REG(); + + vimext_symbol = scheme_intern_symbol("vimext"); + MZ_GC_CHECK(); + mod = scheme_primitive_module(vimext_symbol, environment); + MZ_GC_CHECK(); /* all prims made closed so they can access their own names */ - for (i = 0; i < sizeof(prims)/sizeof(prims[0]); i++) + for (i = 0; i < (int)(sizeof(prims)/sizeof(prims[0])); i++) { Vim_Prim *prim = prims + i; - scheme_add_global(prim->name, - scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name, - prim->mina, prim->maxa), - mod); + closed_prim = scheme_make_closed_prim_w_arity(prim->prim, prim, prim->name, + prim->mina, prim->maxa); + scheme_add_global(prim->name, closed_prim, mod); + MZ_GC_CHECK(); } - scheme_add_global("global-namespace", (Scheme_Object *)environment, mod); scheme_finish_primitive_module(mod); + MZ_GC_CHECK(); + MZ_GC_UNREG(); } #ifdef HAVE_SANDBOX @@ -2697,21 +3148,25 @@ sandbox_file_guard(int argc, Scheme_Obje { MZ_REGISTER_STATIC(M_write); M_write = scheme_intern_symbol("write"); + MZ_GC_CHECK(); } if (M_read == NULL) { MZ_REGISTER_STATIC(M_read); M_read = scheme_intern_symbol("read"); + MZ_GC_CHECK(); } if (M_execute == NULL) { MZ_REGISTER_STATIC(M_execute); M_execute = scheme_intern_symbol("execute"); + MZ_GC_CHECK(); } if (M_delete == NULL) { MZ_REGISTER_STATIC(M_delete); M_delete = scheme_intern_symbol("delete"); + MZ_GC_CHECK(); } while (!SCHEME_NULLP(requested_access))
--- a/src/if_mzsch.h +++ b/src/if_mzsch.h @@ -11,6 +11,7 @@ /* #ifdef needed for "make depend" */ #ifdef FEAT_MZSCHEME +# include <schvers.h> # include <scheme.h> #endif @@ -46,4 +47,31 @@ # define scheme_byte_string_to_char_string(obj) (obj) #endif +/* Precise GC macros */ +#ifndef MZ_GC_DECL_REG +# define MZ_GC_DECL_REG(size) /* empty */ +#endif +#ifndef MZ_GC_VAR_IN_REG +# define MZ_GC_VAR_IN_REG(x, v) /* empty */ +#endif +#ifndef MZ_GC_ARRAY_VAR_IN_REG +# define MZ_GC_ARRAY_VAR_IN_REG(x, v, l) /* empty */ +#endif +#ifndef MZ_GC_REG +# define MZ_GC_REG() /* empty */ +#endif +#ifndef MZ_GC_UNREG +# define MZ_GC_UNREG() /* empty */ +#endif + +#ifdef MZSCHEME_FORCE_GC +/* + * force garbage collection to check all references are registered + * seg faults will indicate not registered refs + */ +# define MZ_GC_CHECK() scheme_collect_garbage(); +#else +# define MZ_GC_CHECK() /* empty */ +#endif + #endif /* _IF_MZSCH_H_ */
--- a/src/main.c +++ b/src/main.c @@ -935,8 +935,14 @@ main /* * Call the main command loop. This never returns. + * For embedded MzScheme the main_loop will be called by Scheme + * for proper stack tracking */ +#ifndef FEAT_MZSCHEME main_loop(FALSE, FALSE); +#else + mzscheme_main(); +#endif return 0; }
--- a/src/proto/if_mzsch.pro +++ b/src/proto/if_mzsch.pro @@ -15,10 +15,6 @@ void mzvim_reset_timer __ARGS((void)); void *mzvim_eval_string __ARGS((char_u *str)); struct Scheme_Object *mzvim_apply __ARGS((struct Scheme_Object *, int argc, struct Scheme_Object **)); -int mzthreads_allowed (void); -#ifdef FEAT_GUI_KDE -void timer_proc (void); -void mzscheme_kde_start_timer (void); -void mzscheme_kde_stop_timer (void); -#endif +int mzthreads_allowed __ARGS((void)); +void mzscheme_main __ARGS((void)); /* vim: set ft=c : */