From: Joe Groff Date: Sat, 16 Jan 2010 20:24:47 +0000 (-0800) Subject: Merge branch 'master' of git://factorcode.org/git/factor X-Git-Tag: 0.97~5067 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=f7e1ed18b0a8821256e00e42625db760186ede03;hp=6bbfa0b6d88ed411cbd8a5d181974e6f7b3e244d Merge branch 'master' of git://factorcode.org/git/factor --- diff --git a/GNUmakefile b/GNUmakefile new file mode 100755 index 0000000000..772f3f9875 --- /dev/null +++ b/GNUmakefile @@ -0,0 +1,223 @@ +CC = gcc +CPP = g++ +AR = ar +LD = ld + +EXECUTABLE = factor +CONSOLE_EXECUTABLE = factor-console +TEST_LIBRARY = factor-ffi-test +VERSION = 0.92 + +BUNDLE = Factor.app +LIBPATH = -L/usr/X11R6/lib +CFLAGS = -Wall + +ifdef DEBUG + CFLAGS += -g -DFACTOR_DEBUG +else + CFLAGS += -O3 +endif + +ifdef REENTRANT + CFLAGS += -DFACTOR_REENTRANT +endif + +CFLAGS += $(SITE_CFLAGS) + +ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION) + +ifdef CONFIG + include $(CONFIG) +endif + +DLL_OBJS = $(PLAF_DLL_OBJS) \ + vm/aging_collector.o \ + vm/alien.o \ + vm/arrays.o \ + vm/bignum.o \ + vm/booleans.o \ + vm/byte_arrays.o \ + vm/callbacks.o \ + vm/callstack.o \ + vm/code_blocks.o \ + vm/code_heap.o \ + vm/compaction.o \ + vm/contexts.o \ + vm/data_heap.o \ + vm/data_heap_checker.o \ + vm/debug.o \ + vm/dispatch.o \ + vm/entry_points.o \ + vm/errors.o \ + vm/factor.o \ + vm/free_list.o \ + vm/full_collector.o \ + vm/gc.o \ + vm/image.o \ + vm/inline_cache.o \ + vm/instruction_operands.o \ + vm/io.o \ + vm/jit.o \ + vm/math.o \ + vm/nursery_collector.o \ + vm/object_start_map.o \ + vm/objects.o \ + vm/primitives.o \ + vm/profiler.o \ + vm/quotations.o \ + vm/run.o \ + vm/strings.o \ + vm/to_tenured_collector.o \ + vm/tuples.o \ + vm/utilities.o \ + vm/vm.o \ + vm/words.o + +EXE_OBJS = $(PLAF_EXE_OBJS) + +TEST_OBJS = vm/ffi_test.o + +default: + $(MAKE) `./build-support/factor.sh make-target` + +help: + @echo "Run '$(MAKE)' with one of the following parameters:" + @echo "" + @echo "freebsd-x86-32" + @echo "freebsd-x86-64" + @echo "linux-x86-32" + @echo "linux-x86-64" + @echo "linux-ppc" + @echo "linux-arm" + @echo "openbsd-x86-32" + @echo "openbsd-x86-64" + @echo "netbsd-x86-32" + @echo "netbsd-x86-64" + @echo "macosx-x86-32" + @echo "macosx-x86-64" + @echo "macosx-ppc" + @echo "solaris-x86-32" + @echo "solaris-x86-64" + @echo "wince-arm" + @echo "winnt-x86-32" + @echo "winnt-x86-64" + @echo "" + @echo "Additional modifiers:" + @echo "" + @echo "DEBUG=1 compile VM with debugging information" + @echo "SITE_CFLAGS=... additional optimization flags" + @echo "NO_UI=1 don't link with X11 libraries (ignored on Mac OS X)" + @echo "X11=1 force link with X11 libraries instead of Cocoa (only on Mac OS X)" + +openbsd-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.32 + +openbsd-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.64 + +freebsd-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.32 + +freebsd-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.64 + +netbsd-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.32 + +netbsd-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.64 + +macosx-ppc: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.ppc + +macosx-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.32 + +macosx-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.64 + +linux-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.32 + +linux-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.64 + +linux-ppc: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.ppc + +linux-arm: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.arm + +solaris-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.32 + +solaris-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.64 + +winnt-x86-32: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.nt.x86.32 + $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 + +winnt-x86-64: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.nt.x86.64 + $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64 + +wince-arm: + $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.ce.arm + +macosx.app: factor + mkdir -p $(BUNDLE)/Contents/MacOS + mkdir -p $(BUNDLE)/Contents/Frameworks + mv $(EXECUTABLE) $(BUNDLE)/Contents/MacOS/factor + ln -s Factor.app/Contents/MacOS/factor ./factor + cp $(ENGINE) $(BUNDLE)/Contents/Frameworks/$(ENGINE) + + install_name_tool \ + -change libfactor.dylib \ + @executable_path/../Frameworks/libfactor.dylib \ + Factor.app/Contents/MacOS/factor + +$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) + $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS) + $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ + $(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) + +$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) + $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS) + $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ + $(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS) + +$(TEST_LIBRARY): vm/ffi_test.o + $(TOOLCHAIN_PREFIX)$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS) + +clean: + rm -f vm/*.o + rm -f factor.dll + rm -f libfactor.* + rm -f libfactor-ffi-test.* + rm -f Factor.app/Contents/Frameworks/libfactor.dylib + +tags: + etags vm/*.{cpp,hpp,mm,S,c} + +vm/resources.o: + $(TOOLCHAIN_PREFIX)$(WINDRES) vm/factor.rs vm/resources.o + +vm/ffi_test.o: vm/ffi_test.c + $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $< + +.c.o: + $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $< + +.cpp.o: + $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $< + +.S.o: + $(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $< + +.mm.o: + $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $< + +.PHONY: factor tags clean + +.SUFFIXES: .mm diff --git a/Makefile b/Makefile deleted file mode 100755 index 772f3f9875..0000000000 --- a/Makefile +++ /dev/null @@ -1,223 +0,0 @@ -CC = gcc -CPP = g++ -AR = ar -LD = ld - -EXECUTABLE = factor -CONSOLE_EXECUTABLE = factor-console -TEST_LIBRARY = factor-ffi-test -VERSION = 0.92 - -BUNDLE = Factor.app -LIBPATH = -L/usr/X11R6/lib -CFLAGS = -Wall - -ifdef DEBUG - CFLAGS += -g -DFACTOR_DEBUG -else - CFLAGS += -O3 -endif - -ifdef REENTRANT - CFLAGS += -DFACTOR_REENTRANT -endif - -CFLAGS += $(SITE_CFLAGS) - -ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION) - -ifdef CONFIG - include $(CONFIG) -endif - -DLL_OBJS = $(PLAF_DLL_OBJS) \ - vm/aging_collector.o \ - vm/alien.o \ - vm/arrays.o \ - vm/bignum.o \ - vm/booleans.o \ - vm/byte_arrays.o \ - vm/callbacks.o \ - vm/callstack.o \ - vm/code_blocks.o \ - vm/code_heap.o \ - vm/compaction.o \ - vm/contexts.o \ - vm/data_heap.o \ - vm/data_heap_checker.o \ - vm/debug.o \ - vm/dispatch.o \ - vm/entry_points.o \ - vm/errors.o \ - vm/factor.o \ - vm/free_list.o \ - vm/full_collector.o \ - vm/gc.o \ - vm/image.o \ - vm/inline_cache.o \ - vm/instruction_operands.o \ - vm/io.o \ - vm/jit.o \ - vm/math.o \ - vm/nursery_collector.o \ - vm/object_start_map.o \ - vm/objects.o \ - vm/primitives.o \ - vm/profiler.o \ - vm/quotations.o \ - vm/run.o \ - vm/strings.o \ - vm/to_tenured_collector.o \ - vm/tuples.o \ - vm/utilities.o \ - vm/vm.o \ - vm/words.o - -EXE_OBJS = $(PLAF_EXE_OBJS) - -TEST_OBJS = vm/ffi_test.o - -default: - $(MAKE) `./build-support/factor.sh make-target` - -help: - @echo "Run '$(MAKE)' with one of the following parameters:" - @echo "" - @echo "freebsd-x86-32" - @echo "freebsd-x86-64" - @echo "linux-x86-32" - @echo "linux-x86-64" - @echo "linux-ppc" - @echo "linux-arm" - @echo "openbsd-x86-32" - @echo "openbsd-x86-64" - @echo "netbsd-x86-32" - @echo "netbsd-x86-64" - @echo "macosx-x86-32" - @echo "macosx-x86-64" - @echo "macosx-ppc" - @echo "solaris-x86-32" - @echo "solaris-x86-64" - @echo "wince-arm" - @echo "winnt-x86-32" - @echo "winnt-x86-64" - @echo "" - @echo "Additional modifiers:" - @echo "" - @echo "DEBUG=1 compile VM with debugging information" - @echo "SITE_CFLAGS=... additional optimization flags" - @echo "NO_UI=1 don't link with X11 libraries (ignored on Mac OS X)" - @echo "X11=1 force link with X11 libraries instead of Cocoa (only on Mac OS X)" - -openbsd-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.32 - -openbsd-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.64 - -freebsd-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.32 - -freebsd-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.64 - -netbsd-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.32 - -netbsd-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.64 - -macosx-ppc: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.ppc - -macosx-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.32 - -macosx-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.64 - -linux-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.32 - -linux-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.64 - -linux-ppc: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.ppc - -linux-arm: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.arm - -solaris-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.32 - -solaris-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.64 - -winnt-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.nt.x86.32 - $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32 - -winnt-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.nt.x86.64 - $(MAKE) $(CONSOLE_EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64 - -wince-arm: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.ce.arm - -macosx.app: factor - mkdir -p $(BUNDLE)/Contents/MacOS - mkdir -p $(BUNDLE)/Contents/Frameworks - mv $(EXECUTABLE) $(BUNDLE)/Contents/MacOS/factor - ln -s Factor.app/Contents/MacOS/factor ./factor - cp $(ENGINE) $(BUNDLE)/Contents/Frameworks/$(ENGINE) - - install_name_tool \ - -change libfactor.dylib \ - @executable_path/../Frameworks/libfactor.dylib \ - Factor.app/Contents/MacOS/factor - -$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) - $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS) - $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ - $(CFLAGS) -o $@$(EXE_SUFFIX)$(EXE_EXTENSION) $(EXE_OBJS) - -$(CONSOLE_EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) - $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS) - $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ - $(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS) - -$(TEST_LIBRARY): vm/ffi_test.o - $(TOOLCHAIN_PREFIX)$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS) - -clean: - rm -f vm/*.o - rm -f factor.dll - rm -f libfactor.* - rm -f libfactor-ffi-test.* - rm -f Factor.app/Contents/Frameworks/libfactor.dylib - -tags: - etags vm/*.{cpp,hpp,mm,S,c} - -vm/resources.o: - $(TOOLCHAIN_PREFIX)$(WINDRES) vm/factor.rs vm/resources.o - -vm/ffi_test.o: vm/ffi_test.c - $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $< - -.c.o: - $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $< - -.cpp.o: - $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $< - -.S.o: - $(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $< - -.mm.o: - $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $< - -.PHONY: factor tags clean - -.SUFFIXES: .mm diff --git a/Nmakefile b/Nmakefile new file mode 100755 index 0000000000..04992e6771 --- /dev/null +++ b/Nmakefile @@ -0,0 +1,65 @@ +LINK_CLFAGS = +CL_FLAGS = /O2 /W3 + +OBJS = vm\main-windows-nt.obj \ + vm\os-windows-nt.obj \ + vm\os-windows.obj \ + vm\aging_collector.obj \ + vm\alien.obj \ + vm\arrays.obj \ + vm\bignum.obj \ + vm\booleans.obj \ + vm\byte_arrays.obj \ + vm\callbacks.obj \ + vm\callstack.obj \ + vm\code_blocks.obj \ + vm\code_heap.obj \ + vm\compaction.obj \ + vm\contexts.obj \ + vm\data_heap.obj \ + vm\data_heap_checker.obj \ + vm\debug.obj \ + vm\dispatch.obj \ + vm\entry_points.obj \ + vm\errors.obj \ + vm\factor.obj \ + vm\free_list.obj \ + vm\full_collector.obj \ + vm\gc.obj \ + vm\image.obj \ + vm\inline_cache.obj \ + vm\instruction_operands.obj \ + vm\io.obj \ + vm\jit.obj \ + vm\math.obj \ + vm\nursery_collector.obj \ + vm\object_start_map.obj \ + vm\objects.obj \ + vm\primitives.obj \ + vm\profiler.obj \ + vm\quotations.obj \ + vm\run.obj \ + vm\strings.obj \ + vm\to_tenured_collector.obj \ + vm\tuples.obj \ + vm\utilities.obj \ + vm\vm.obj \ + vm\words.obj + +.cpp.obj: + cl /nologo /EHsc $(CL_FLAGS) /Fo$@ /c $< + +all: factor.com factor.exe + +factor.com: $(OBJS) + link $(LINK_FLAGS) /nologo /out:factor.com /SUBSYSTEM:console $(OBJS) + +factor.exe: $(OBJS) + link $(LINK_FLAGS) /nologo /out:factor.exe /SUBSYSTEM:windows $(OBJS) + +clean: + del vm\*.obj + del factor.com + del factor.exe + +.PHONY: clean diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index 6dcf6f7317..28ffb96f8f 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/basis/compiler/tree/propagation/info/info.factor @@ -312,16 +312,12 @@ SYMBOL: value-infos value-info >literal< ; : possible-boolean-values ( info -- values ) - dup literal?>> [ - literal>> 1array - ] [ - class>> { - { [ dup null-class? ] [ { } ] } - { [ dup true-class? ] [ { t } ] } - { [ dup false-class? ] [ { f } ] } - [ { t f } ] - } cond nip - ] if ; + class>> { + { [ dup null-class? ] [ { } ] } + { [ dup true-class? ] [ { t } ] } + { [ dup false-class? ] [ { f } ] } + [ { t f } ] + } cond nip ; : node-value-info ( node value -- info ) swap info>> at* [ drop null-info ] unless ; diff --git a/basis/compiler/tree/propagation/propagation-tests.factor b/basis/compiler/tree/propagation/propagation-tests.factor index 2c80b87e76..ad17ccc1c9 100644 --- a/basis/compiler/tree/propagation/propagation-tests.factor +++ b/basis/compiler/tree/propagation/propagation-tests.factor @@ -946,3 +946,9 @@ M: tuple-with-read-only-slot clone [ t ] [ [ { float float } declare max ] { max } inlined? ] unit-test [ f ] [ [ { float float } declare max ] { float-max } inlined? ] unit-test + +! Propagation should not call equal?, hashcode, etc on literals in user code +[ V{ } ] [ [ 4 [ 2drop ] with each ] final-info ] unit-test + +! Reduction +[ 1 ] [ [ 4 [ nth-unsafe ] [ ] unless ] final-info length ] unit-test diff --git a/basis/io/buffers/buffers-tests.factor b/basis/io/buffers/buffers-tests.factor index 93d2f5b2fc..836b4d0cc8 100644 --- a/basis/io/buffers/buffers-tests.factor +++ b/basis/io/buffers/buffers-tests.factor @@ -58,3 +58,7 @@ strings accessors destructors ; 100 "b" set [ 1000 "b" get n>buffer >string ] must-fail "b" get dispose + +"hello world" string>buffer "b" set +[ "hello" CHAR: \s ] [ " " "b" get buffer-until [ >string ] dip ] unit-test +"b" get dispose diff --git a/basis/io/buffers/buffers.factor b/basis/io/buffers/buffers.factor index f45d3bb062..23358d9a0e 100644 --- a/basis/io/buffers/buffers.factor +++ b/basis/io/buffers/buffers.factor @@ -1,5 +1,5 @@ ! Copyright (C) 2004, 2005 Mackenzie Straight. -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien alien.accessors alien.c-types alien.data alien.syntax kernel libc math sequences byte-arrays @@ -73,7 +73,9 @@ HINTS: >buffer byte-array buffer ; bi ; inline : search-buffer-until ( pos fill ptr separators -- n ) - [ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry find-from drop ; inline + [ iota ] 2dip + [ [ swap alien-unsigned-1 ] dip member-eq? ] 2curry + find-from drop ; inline : finish-buffer-until ( buffer n -- byte-array separator ) [ diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index cc6218a4ea..799b6dc4b2 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -162,7 +162,7 @@ M: winnt file-system-info ( path -- file-system-info ) ret win32-error-string throw ] [ names names-length *uint ushort heap-size * head - utf16n alien>string CHAR: \0 split + utf16n alien>string { CHAR: \0 } split ] if ; : find-first-volume ( -- string handle ) diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 40d5d4c6a3..ba7c2723e9 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -30,7 +30,6 @@ M: bad-byte-array-length summary FUNCTOR: define-array ( T -- ) A DEFINES-CLASS ${T}-array -S DEFINES-CLASS ${T}-sequence DEFINES <${A}> (A) DEFINES (${A}) DEFINES @@ -46,8 +45,6 @@ SET-NTH [ T dup c-setter array-accessor ] WHERE -MIXIN: S - TUPLE: A { underlying c-ptr read-only } { length array-capacity read-only } ; diff --git a/basis/specialized-vectors/specialized-vectors.factor b/basis/specialized-vectors/specialized-vectors.factor index 75197d9ec0..f71e308ad1 100644 --- a/basis/specialized-vectors/specialized-vectors.factor +++ b/basis/specialized-vectors/specialized-vectors.factor @@ -15,7 +15,6 @@ FUNCTOR: define-vector ( T -- ) V DEFINES-CLASS ${T}-vector A IS ${T}-array -S IS ${T}-sequence IS <${A}> >V DEFERS >${V} @@ -38,7 +37,6 @@ M: V pprint* pprint-object ; SYNTAX: V{ \ } [ >V ] parse-literal ; INSTANCE: V growable -INSTANCE: V S ;FUNCTOR diff --git a/basis/ui/gadgets/search-tables/search-tables-tests.factor b/basis/ui/gadgets/search-tables/search-tables-tests.factor index 5a627286f9..5f72924954 100644 --- a/basis/ui/gadgets/search-tables/search-tables-tests.factor +++ b/basis/ui/gadgets/search-tables/search-tables-tests.factor @@ -1,3 +1,7 @@ IN: ui.gadgets.search-tables.tests -USING: ui.gadgets.search-tables sequences tools.test ; +USING: ui.gadgets.search-tables ui.gadgets.tables ui.gadgets models +arrays sequences tools.test ; + [ [ second ] ] must-infer + +[ t ] [ f trivial-renderer [ second ] pref-dim pair? ] unit-test diff --git a/basis/ui/gadgets/search-tables/search-tables.factor b/basis/ui/gadgets/search-tables/search-tables.factor index 9f55c7a67d..dd2232df60 100644 --- a/basis/ui/gadgets/search-tables/search-tables.factor +++ b/basis/ui/gadgets/search-tables/search-tables.factor @@ -51,7 +51,6 @@ renderer action hook font -gap selection-color focus-border-color mouse-color diff --git a/build-support/cleanup b/build-support/cleanup index 2d2aab0bba..2173619acb 100644 --- a/build-support/cleanup +++ b/build-support/cleanup @@ -3,6 +3,7 @@ temp logs .git .gitignore -Makefile +GNUmakefile +Nmakefile unmaintained build-support diff --git a/build-support/factor.sh b/build-support/factor.sh index c2775f435a..a02a2fad7e 100755 --- a/build-support/factor.sh +++ b/build-support/factor.sh @@ -406,9 +406,9 @@ backup_factor() { } check_makefile_exists() { - if [[ ! -e "Makefile" ]] ; then + if [[ ! -e "GNUmakefile" ]] ; then echo "" - echo "***Makefile not found***" + echo "***GNUmakefile not found***" echo "You are likely in the wrong directory." echo "Run this script from your factor directory:" echo " ./build-support/factor.sh" diff --git a/core/classes/tuple/tuple-tests.factor b/core/classes/tuple/tuple-tests.factor index eb033edfe4..710a011aa4 100644 --- a/core/classes/tuple/tuple-tests.factor +++ b/core/classes/tuple/tuple-tests.factor @@ -6,7 +6,7 @@ io.streams.string kernel kernel.private math math.constants math.order namespaces parser parser.notes prettyprint quotations random see sequences sequences.private slots slots.private splitting strings summary threads tools.test -vectors vocabs words words.symbol fry ; +vectors vocabs words words.symbol fry literals ; IN: classes.tuple.tests TUPLE: rect x y w h ; @@ -577,8 +577,31 @@ unit-test [ T{ bad-slot-value f "hi" fixnum } = ] must-fail-with -[ T{ declared-types f 0 "hi" } ] -[ 0.0 "hi" declared-types boa ] unit-test +! Check fixnum coercer +[ 0 ] [ 0.0 "hi" declared-types boa n>> ] unit-test + +[ 0 ] [ declared-types new 0.0 >>n n>> ] unit-test + +! Check bignum coercer +TUPLE: bignum-coercer { n bignum initial: $[ 0 >bignum ] } ; + +[ 13 bignum ] [ 13.5 bignum-coercer boa n>> dup class ] unit-test + +[ 13 bignum ] [ bignum-coercer new 13.5 >>n n>> dup class ] unit-test + +! Check float coercer +TUPLE: float-coercer { n float } ; + +[ 13.0 float ] [ 13 float-coercer boa n>> dup class ] unit-test + +[ 13.0 float ] [ float-coercer new 13 >>n n>> dup class ] unit-test + +! Check integer coercer +TUPLE: integer-coercer { n integer } ; + +[ 13 fixnum ] [ 13.5 integer-coercer boa n>> dup class ] unit-test + +[ 13 fixnum ] [ integer-coercer new 13.5 >>n n>> dup class ] unit-test : foo ( a b -- c ) declared-types boa ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index d5c8b4dcff..d5ae145203 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2008 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays definitions hashtables kernel kernel.private math namespaces make sequences sequences.private strings vectors @@ -121,25 +121,6 @@ ERROR: bad-superclass class ; : class-size ( class -- n ) superclasses [ "slots" word-prop length ] map-sum ; -: (instance-check-quot) ( class -- quot ) - [ - \ dup , - [ "predicate" word-prop % ] - [ [ literalize , \ bad-slot-value , ] [ ] make , ] bi - \ unless , - ] [ ] make ; - -: (fixnum-check-quot) ( class -- quot ) - (instance-check-quot) fixnum "coercer" word-prop prepend ; - -: instance-check-quot ( class -- quot ) - { - { [ dup object bootstrap-word eq? ] [ drop [ ] ] } - { [ dup "coercer" word-prop ] [ "coercer" word-prop ] } - { [ dup \ fixnum class<= ] [ (fixnum-check-quot) ] } - [ (instance-check-quot) ] - } cond ; - : boa-check-quot ( class -- quot ) all-slots [ class>> instance-check-quot ] map spread>quot f like ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 23d974254d..da5d670659 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -1,8 +1,8 @@ USING: arrays debugger.threads destructors io io.directories -io.encodings.ascii io.encodings.binary -io.files io.files.private io.files.temp io.files.unique kernel -make math sequences system threads tools.test generic.single -io.encodings.8-bit.latin1 ; +io.encodings.ascii io.encodings.binary io.encodings.string +io.encodings.8-bit.latin1 io.files io.files.private +io.files.temp io.files.unique kernel make math sequences system +threads tools.test generic.single ; IN: io.files.tests [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test @@ -23,6 +23,20 @@ IN: io.files.tests [ read1 ] with-file-reader >fixnum ] unit-test +[ + "This" CHAR: \s +] [ + "vocab:io/test/read-until-test.txt" ascii + [ " " read-until ] with-file-reader +] unit-test + +[ + "This" CHAR: \s +] [ + "vocab:io/test/read-until-test.txt" binary + [ " " read-until [ ascii decode ] dip ] with-file-reader +] unit-test + [ ] [ "It seems Jobs has lost his grasp on reality again.\n" "separator-test.txt" temp-file latin1 set-file-contents diff --git a/core/io/test/read-until-test.txt b/core/io/test/read-until-test.txt new file mode 100644 index 0000000000..a496efee84 --- /dev/null +++ b/core/io/test/read-until-test.txt @@ -0,0 +1 @@ +This is a text file diff --git a/core/slots/slots-tests.factor b/core/slots/slots-tests.factor index 957b525cb3..3548e22c33 100644 --- a/core/slots/slots-tests.factor +++ b/core/slots/slots-tests.factor @@ -1,5 +1,5 @@ USING: math accessors slots strings generic.single kernel -tools.test generic words parser eval math.functions ; +tools.test generic words parser eval math.functions arrays ; IN: slots.tests TUPLE: r/w-test foo ; @@ -8,9 +8,9 @@ TUPLE: r/o-test { foo read-only } ; [ r/o-test new 123 >>foo ] [ no-method? ] must-fail-with -TUPLE: decl-test { foo integer } ; +TUPLE: decl-test { foo array } ; -[ decl-test new 1.0 >>foo ] [ bad-slot-value? ] must-fail-with +[ decl-test new "" >>foo ] [ bad-slot-value? ] must-fail-with TUPLE: hello length ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 0422478884..7b97748249 100644 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays byte-arrays kernel kernel.private math namespaces make sequences strings effects generic generic.standard @@ -64,39 +64,29 @@ M: object reader-quot ERROR: bad-slot-value value class ; -: writer-quot/object ( slot-spec -- ) - offset>> , \ set-slot , ; - -: writer-quot/coerce ( slot-spec -- ) - [ class>> "coercer" word-prop [ dip ] curry % ] - [ offset>> , \ set-slot , ] - bi ; - -: writer-quot/check ( slot-spec -- ) - [ offset>> , ] +: (instance-check-quot) ( class -- quot ) [ - \ pick , - dup class>> "predicate" word-prop % - [ set-slot ] , - class>> [ 2nip bad-slot-value ] curry [ ] like , - \ if , - ] - bi ; + \ dup , + [ "predicate" word-prop % ] + [ [ bad-slot-value ] curry , ] bi + \ unless , + ] [ ] make ; -: writer-quot/fixnum ( slot-spec -- ) - [ [ >fixnum ] dip ] % writer-quot/check ; +: instance-check-quot ( class -- quot ) + { + { [ dup object bootstrap-word eq? ] [ drop [ ] ] } + { [ dup "coercer" word-prop ] [ "coercer" word-prop ] } + { [ dup integer bootstrap-word eq? ] [ drop [ >integer ] ] } + [ (instance-check-quot) ] + } cond ; GENERIC# writer-quot 1 ( class slot-spec -- quot ) M: object writer-quot - nip [ - { - { [ dup class>> object bootstrap-word eq? ] [ writer-quot/object ] } - { [ dup class>> "coercer" word-prop ] [ writer-quot/coerce ] } - { [ dup class>> fixnum bootstrap-word class<= ] [ writer-quot/fixnum ] } - [ writer-quot/check ] - } cond - ] [ ] make ; + nip + [ class>> instance-check-quot dup empty? [ [ dip ] curry ] unless ] + [ offset>> [ set-slot ] curry ] + bi append ; : writer-props ( slot-spec -- assoc ) "writing" associate ; diff --git a/extra/furnace/mongodb/mongodb.factor b/extra/furnace/mongodb/mongodb.factor index a3af4191ee..3c53c35e70 100644 --- a/extra/furnace/mongodb/mongodb.factor +++ b/extra/furnace/mongodb/mongodb.factor @@ -1,5 +1,5 @@ USING: accessors http.server http.server.filters io.pools kernel -mongodb.driver mongodb.connection namespaces unix destructors continuations ; +mongodb.driver mongodb.connection namespaces ; IN: furnace.mongodb diff --git a/vm/alien.cpp b/vm/alien.cpp index 84d31a69c0..48fda5d752 100755 --- a/vm/alien.cpp +++ b/vm/alien.cpp @@ -109,7 +109,7 @@ void *factor_vm::alien_pointer() PRIMITIVE(set_alien_##name) \ { \ type *ptr = (type *)parent->alien_pointer(); \ - type value = to(parent->ctx->pop(),parent); \ + type value = (type)to(parent->ctx->pop(),parent); \ *ptr = value; \ } @@ -151,7 +151,7 @@ void factor_vm::primitive_dlsym() { dll *d = untag_check(library.value()); - if(d->dll == NULL) + if(d->handle == NULL) ctx->push(false_object); else ctx->push(allot_alien(ffi_dlsym(d,sym))); @@ -164,7 +164,7 @@ void factor_vm::primitive_dlsym() void factor_vm::primitive_dlclose() { dll *d = untag_check(ctx->pop()); - if(d->dll != NULL) + if(d->handle != NULL) ffi_dlclose(d); } @@ -172,7 +172,7 @@ void factor_vm::primitive_dll_validp() { cell library = ctx->pop(); if(to_boolean(library)) - ctx->push(tag_boolean(untag_check(library)->dll != NULL)); + ctx->push(tag_boolean(untag_check(library)->handle != NULL)); else ctx->push(true_object); } diff --git a/vm/bitwise_hacks.hpp b/vm/bitwise_hacks.hpp old mode 100644 new mode 100755 index 6cd2a5b694..1927cd4736 --- a/vm/bitwise_hacks.hpp +++ b/vm/bitwise_hacks.hpp @@ -4,8 +4,18 @@ namespace factor inline cell log2(cell x) { cell n; -#if defined(FACTOR_X86) || defined(FACTOR_AMD64) - asm ("bsr %1, %0;":"=r"(n):"r"(x)); +#if defined(FACTOR_X86) + #if defined(_MSC_VER) + _BitScanReverse(&n,x); + #else + asm ("bsr %1, %0;":"=r"(n):"r"(x)); + #endif +#elif defined(FACTOR_AMD64) + #if defined(_MSC_VER) + _BitScanReverse64(&n,x); + #else + asm ("bsr %1, %0;":"=r"(n):"r"(x)); + #endif #elif defined(FACTOR_PPC) asm ("cntlzw %1, %0;":"=r"(n):"r"(x)); n = (31 - n); @@ -22,7 +32,7 @@ inline cell rightmost_clear_bit(cell x) inline cell rightmost_set_bit(cell x) { - return log2(x & -x); + return log2(x & (~x + 1)); } inline cell popcount(cell x) diff --git a/vm/code_blocks.cpp b/vm/code_blocks.cpp index d72d30cc96..aaa4369a1d 100755 --- a/vm/code_blocks.cpp +++ b/vm/code_blocks.cpp @@ -159,7 +159,7 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index) dll *d = (to_boolean(library) ? untag(library) : NULL); - if(d != NULL && !d->dll) + if(d != NULL && !d->handle) return (cell)factor::undefined_symbol; switch(tagged(symbol).type()) diff --git a/vm/compaction.cpp b/vm/compaction.cpp index 7a062998a7..240a725a08 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -168,7 +168,7 @@ void factor_vm::update_code_roots_for_compaction() for(; iter < end; iter++) { code_root *root = *iter; - code_block *block = (code_block *)(root->value & -data_alignment); + code_block *block = (code_block *)(root->value & (~data_alignment + 1)); /* Offset of return address within 16-byte allocation line */ cell offset = root->value - (cell)block; diff --git a/vm/factor.cpp b/vm/factor.cpp index 453ec71682..d5a1d2f30e 100755 --- a/vm/factor.cpp +++ b/vm/factor.cpp @@ -3,7 +3,6 @@ namespace factor { -factor_vm *vm; std::map thread_vms; void init_globals() @@ -31,11 +30,7 @@ void factor_vm::default_parameters(vm_parameters *p) #ifdef WINDOWS p->console = false; #else - if (this == vm) - p->console = true; - else - p->console = false; - + p->console = true; #endif p->callback_size = 256; @@ -120,7 +115,7 @@ void factor_vm::init_factor(vm_parameters *p) if(p->image_path == NULL) p->image_path = default_image_path(); - srand(system_micros()); + srand((unsigned int)system_micros()); init_ffi(); init_stacks(p->ds_size,p->rs_size); init_callbacks(p->callback_size); @@ -225,7 +220,7 @@ factor_vm *new_factor_vm() } // arg must be new'ed because we're going to delete it! -void* start_standalone_factor_thread(void *arg) +void *start_standalone_factor_thread(void *arg) { factor_vm *newvm = new_factor_vm(); startargs *args = (startargs*) arg; @@ -238,7 +233,6 @@ void* start_standalone_factor_thread(void *arg) VM_C_API void start_standalone_factor(int argc, vm_char **argv) { factor_vm *newvm = new_factor_vm(); - vm = newvm; return newvm->start_standalone_factor(argc,argv); } diff --git a/vm/factor.hpp b/vm/factor.hpp old mode 100644 new mode 100755 index 5f41c952e1..cec59bcc5c --- a/vm/factor.hpp +++ b/vm/factor.hpp @@ -2,7 +2,7 @@ namespace factor { VM_C_API void init_globals(); - VM_C_API void start_standalone_factor(int argc, vm_char **argv); VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv); + } diff --git a/vm/free_list.hpp b/vm/free_list.hpp old mode 100644 new mode 100755 index 0a0a5c7614..3fb06babc9 --- a/vm/free_list.hpp +++ b/vm/free_list.hpp @@ -32,7 +32,7 @@ struct free_heap_block }; struct block_size_compare { - bool operator()(free_heap_block *a, free_heap_block *b) + bool operator()(free_heap_block *a, free_heap_block *b) const { return a->size() < b->size(); } diff --git a/vm/gc.cpp b/vm/gc.cpp index 96eab18c47..a57f338c44 100755 --- a/vm/gc.cpp +++ b/vm/gc.cpp @@ -29,7 +29,7 @@ void gc_event::ended_card_scan(cell cards_scanned_, cell decks_scanned_) { cards_scanned += cards_scanned_; decks_scanned += decks_scanned_; - card_scan_time = (nano_count() - temp_time); + card_scan_time = (cell)(nano_count() - temp_time); } void gc_event::started_code_scan() @@ -40,7 +40,7 @@ void gc_event::started_code_scan() void gc_event::ended_code_scan(cell code_blocks_scanned_) { code_blocks_scanned += code_blocks_scanned_; - code_scan_time = (nano_count() - temp_time); + code_scan_time = (cell)(nano_count() - temp_time); } void gc_event::started_data_sweep() @@ -50,7 +50,7 @@ void gc_event::started_data_sweep() void gc_event::ended_data_sweep() { - data_sweep_time = (nano_count() - temp_time); + data_sweep_time = (cell)(nano_count() - temp_time); } void gc_event::started_code_sweep() @@ -60,7 +60,7 @@ void gc_event::started_code_sweep() void gc_event::ended_code_sweep() { - code_sweep_time = (nano_count() - temp_time); + code_sweep_time = (cell)(nano_count() - temp_time); } void gc_event::started_compaction() @@ -70,14 +70,14 @@ void gc_event::started_compaction() void gc_event::ended_compaction() { - compaction_time = (nano_count() - temp_time); + compaction_time = (cell)(nano_count() - temp_time); } void gc_event::ended_gc(factor_vm *parent) { data_heap_after = parent->data_room(); code_heap_after = parent->code_room(); - total_time = nano_count() - start_time; + total_time = (cell)(nano_count() - start_time); } gc_state::gc_state(gc_op op_, factor_vm *parent) : op(op_), start_time(nano_count()) diff --git a/vm/instruction_operands.cpp b/vm/instruction_operands.cpp index 69b82b1435..e022b093c4 100644 --- a/vm/instruction_operands.cpp +++ b/vm/instruction_operands.cpp @@ -122,7 +122,7 @@ void instruction_operand::store_value(fixnum absolute_value) store_value_masked(relative_value - sizeof(cell),rel_indirect_arm_mask,0); break; case RC_ABSOLUTE_2: - *(u16 *)(pointer - sizeof(u16)) = absolute_value; + *(u16 *)(pointer - sizeof(u16)) = (u16)absolute_value; break; default: critical_error("Bad rel class",rel.rel_class()); diff --git a/vm/layouts.hpp b/vm/layouts.hpp index b03a0d2244..2a3eee9214 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -298,7 +298,7 @@ struct dll : public object { /* tagged byte array holding a C string */ cell path; /* OS-specific handle */ - void *dll; + void *handle; }; struct stack_frame { diff --git a/vm/main-windows-ce.cpp b/vm/main-windows-ce.cpp old mode 100644 new mode 100755 index 526f3b2c36..e0b1d3b626 --- a/vm/main-windows-ce.cpp +++ b/vm/main-windows-ce.cpp @@ -1,134 +1,17 @@ #include "master.hpp" -/* - Windows CE argument parsing ported to work on - int main(int argc, wchar_t **argv). - - This would not be necessary if Windows CE had CommandLineToArgvW. - - Based on MinGW's public domain char** version. - -*/ - -int __argc; -wchar_t **__argv; - -static int -parse_tokens(wchar_t* string, wchar_t*** tokens, int length) -{ - /* Extract whitespace- and quotes- delimited tokens from the given string - and put them into the tokens array. Returns number of tokens - extracted. Length specifies the current size of tokens[]. - THIS METHOD MODIFIES string. */ - - const wchar_t* whitespace = L" \t\r\n"; - wchar_t* tokenEnd = 0; - const wchar_t* quoteCharacters = L"\"\'"; - wchar_t *end = string + wcslen(string); - - if (string == NULL) - return length; - - while (1) - { - const wchar_t* q; - /* Skip over initial whitespace. */ - string += wcsspn(string, whitespace); - if (*string == '\0') - break; - - for (q = quoteCharacters; *q; ++q) - { - if (*string == *q) - break; - } - if (*q) - { - /* Token is quoted. */ - wchar_t quote = *string++; - tokenEnd = wcschr(string, quote); - /* If there is no endquote, the token is the rest of the string. */ - if (!tokenEnd) - tokenEnd = end; - } - else - { - tokenEnd = string + wcscspn(string, whitespace); - } - - *tokenEnd = '\0'; - - { - wchar_t** new_tokens; - int newlen = length + 1; - new_tokens = realloc (*tokens, sizeof (wchar_t**) * newlen); - if (!new_tokens) - { - /* Out of memory. */ - return -1; - } - - *tokens = new_tokens; - (*tokens)[length] = string; - length = newlen; - } - if (tokenEnd == end) - break; - string = tokenEnd + 1; - } - return length; -} - -static void -parse_args(int *argc, wchar_t ***argv, wchar_t *cmdlinePtrW) -{ - wchar_t cmdnameBufW[MAX_UNICODE_PATH]; - int cmdlineLen = 0; - int modlen; - - /* argv[0] is the path of invoked program - get this from CE. */ - cmdnameBufW[0] = 0; - modlen = GetModuleFileNameW(NULL, cmdnameBufW, sizeof (cmdnameBufW)/sizeof (cmdnameBufW[0])); - - if (!cmdlinePtrW) - cmdlineLen = 0; - else - cmdlineLen = wcslen(cmdlinePtrW); - - /* gets realloc()'d later */ - *argv = malloc (sizeof (wchar_t**) * 1); - if (!*argv) - ExitProcess(-1); - - (*argv)[0] = wcsdup(cmdnameBufW); - if(!(*argv[0])) - ExitProcess(-1); - /* Add one to account for argv[0] */ - (*argc)++; - - if (cmdlineLen > 0) - { - wchar_t* argv1 = (*argv)[0] + wcslen((*argv)[0]) + 1; - argv1 = wcsdup(cmdlinePtrW); - if(!argv1) - ExitProcess(-1); - *argc = parse_tokens(argv1, argv, 1); - if (*argc < 0) - ExitProcess(-1); - } - (*argv)[*argc] = 0; - return; -} - -int WINAPI -WinMain( +int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPWSTR lpCmdLine, int nCmdShow) { - parse_args(&__argc, &__argv, lpCmdLine); + int __argc; + wchar_t **__argv; + factor::parse_args(&__argc, &__argv, lpCmdLine); + factor::init_globals(); factor::start_standalone_factor(__argc,(LPWSTR*)__argv); + // memory leak from malloc, wcsdup return 0; } diff --git a/vm/main-windows-nt.cpp b/vm/main-windows-nt.cpp old mode 100644 new mode 100755 index df4a1172f1..080a64c276 --- a/vm/main-windows-nt.cpp +++ b/vm/main-windows-nt.cpp @@ -1,30 +1,30 @@ #include "master.hpp" +VM_C_API int wmain(int argc, wchar_t **argv) +{ + factor::init_globals(); +#ifdef FACTOR_MULTITHREADED + factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(argv,argc); + WaitForSingleObject(thread, INFINITE); +#else + factor::start_standalone_factor(argc,argv); +#endif + return 0; +} + int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLine, int nCmdShow) { - LPWSTR *szArglist; - int nArgs; - - szArglist = CommandLineToArgvW(GetCommandLineW(), &nArgs); - if(NULL == szArglist) - { - puts("CommandLineToArgvW failed"); - return 1; - } + int argc; + wchar_t **argv; - factor::init_globals(); - #ifdef FACTOR_MULTITHREADED - factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist); - WaitForSingleObject(thread, INFINITE); - #else - factor::start_standalone_factor(nArgs,szArglist); - #endif + factor::parse_args(&argc, &argv, (wchar_t *)GetCommandLine()); - LocalFree(szArglist); + wmain(argc,argv); + // memory leak from malloc, wcsdup return 0; } diff --git a/vm/master.hpp b/vm/master.hpp index 9a920efce7..f4c0934478 100755 --- a/vm/master.hpp +++ b/vm/master.hpp @@ -16,7 +16,6 @@ #include #include #include -#include #include #include #include @@ -36,7 +35,7 @@ #elif defined(__amd64__) || defined(__x86_64__) #define FACTOR_AMD64 #define FACTOR_64 -#elif defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32) +#elif defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32) || defined(_MSC_VER) #define FACTOR_X86 #elif defined(__POWERPC__) || defined(__ppc__) || defined(_ARCH_PPC) #define FACTOR_PPC @@ -44,8 +43,15 @@ #error "Unsupported architecture" #endif -#ifdef WIN32 +#if defined(_MSC_VER) #define WINDOWS + #define WINNT +#elif defined(WIN32) + #define WINDOWS +#endif + +#ifndef _MSC_VER + #include #endif /* Forward-declare this since it comes up in function prototypes */ diff --git a/vm/math.cpp b/vm/math.cpp index f2056ee32e..a2c69c31f2 100755 --- a/vm/math.cpp +++ b/vm/math.cpp @@ -277,7 +277,7 @@ void factor_vm::primitive_str_to_float() void factor_vm::primitive_float_to_str() { byte_array *array = allot_byte_array(33); - snprintf((char *)(array + 1),32,"%.16g",untag_float_check(ctx->pop())); + SNPRINTF((char *)(array + 1),32,"%.16g",untag_float_check(ctx->pop())); ctx->push(tag(array)); } @@ -347,7 +347,7 @@ void factor_vm::primitive_float_greatereq() void factor_vm::primitive_float_bits() { - ctx->push(from_unsigned_4(float_bits(untag_float_check(ctx->pop())))); + ctx->push(from_unsigned_4(float_bits((float)untag_float_check(ctx->pop())))); } void factor_vm::primitive_bits_float() @@ -480,7 +480,7 @@ cell factor_vm::from_signed_8(s64 n) if(n < fixnum_min || n > fixnum_max) return tag(long_long_to_bignum(n)); else - return tag_fixnum(n); + return tag_fixnum((fixnum)n); } VM_C_API cell from_signed_8(s64 n, factor_vm *parent) @@ -513,7 +513,7 @@ cell factor_vm::from_unsigned_8(u64 n) if(n > (u64)fixnum_max) return tag(ulong_long_to_bignum(n)); else - return tag_fixnum(n); + return tag_fixnum((fixnum)n); } VM_C_API cell from_unsigned_8(u64 n, factor_vm *parent) @@ -549,7 +549,7 @@ VM_C_API cell from_float(float flo, factor_vm *parent) /* Cannot allocate */ float factor_vm::to_float(cell value) { - return untag_float_check(value); + return (float)untag_float_check(value); } VM_C_API float to_float(cell value, factor_vm *parent) diff --git a/vm/object_start_map.cpp b/vm/object_start_map.cpp index 105f934f99..6b5b5139b9 100644 --- a/vm/object_start_map.cpp +++ b/vm/object_start_map.cpp @@ -70,7 +70,7 @@ void object_start_map::update_card_for_sweep(cell index, u16 mask) else { /* Move the object start forward if necessary */ - object_start_offsets[index] = offset + (rightmost_set_bit(mask) * data_alignment); + object_start_offsets[index] = (card)(offset + (rightmost_set_bit(mask) * data_alignment)); } } } diff --git a/vm/os-unix.cpp b/vm/os-unix.cpp index 8276d3ee5c..4b5040ab8b 100644 --- a/vm/os-unix.cpp +++ b/vm/os-unix.cpp @@ -73,20 +73,20 @@ void factor_vm::init_ffi() void factor_vm::ffi_dlopen(dll *dll) { - dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY); + dll->handle = dlopen(alien_offset(dll->path), RTLD_LAZY); } void *factor_vm::ffi_dlsym(dll *dll, symbol_char *symbol) { - void *handle = (dll == NULL ? null_dll : dll->dll); + void *handle = (dll == NULL ? null_dll : dll->handle); return dlsym(handle,symbol); } void factor_vm::ffi_dlclose(dll *dll) { - if(dlclose(dll->dll)) + if(dlclose(dll->handle)) general_error(ERROR_FFI,false_object,false_object,NULL); - dll->dll = NULL; + dll->handle = NULL; } void factor_vm::primitive_existsp() diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp index bb784bc93c..7faab4d8b8 100644 --- a/vm/os-unix.hpp +++ b/vm/os-unix.hpp @@ -22,6 +22,7 @@ typedef char symbol_char; #define STRCMP strcmp #define STRNCMP strncmp #define STRDUP strdup +#define SNPRINTF snprintf #define FTELL ftello #define FSEEK fseeko diff --git a/vm/os-windows-ce.hpp b/vm/os-windows-ce.hpp old mode 100644 new mode 100755 index 48da3fa551..02de1cd4a8 --- a/vm/os-windows-ce.hpp +++ b/vm/os-windows-ce.hpp @@ -12,7 +12,6 @@ typedef wchar_t symbol_char; #define FACTOR_OS_STRING "wince" #define FACTOR_DLL L"factor-ce.dll" -#define FACTOR_DLL_NAME "factor-ce.dll" int errno; char *strerror(int err); diff --git a/vm/os-windows-nt.cpp b/vm/os-windows-nt.cpp index cab30b121e..2fceb130f4 100755 --- a/vm/os-windows-nt.cpp +++ b/vm/os-windows-nt.cpp @@ -112,7 +112,7 @@ LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe) return EXCEPTION_CONTINUE_EXECUTION; } -FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe) +FACTOR_STDCALL(LONG) exception_handler(PEXCEPTION_POINTERS pe) { return tls_vm()->exception_handler(pe); } diff --git a/vm/os-windows-nt.hpp b/vm/os-windows-nt.hpp index f8407aeee5..1559d1147d 100755 --- a/vm/os-windows-nt.hpp +++ b/vm/os-windows-nt.hpp @@ -8,18 +8,27 @@ #include #include +#ifdef _MSC_VER + #undef min + #undef max +#endif + namespace factor { typedef char symbol_char; #define FACTOR_OS_STRING "winnt" -#define FACTOR_DLL L"factor.dll" -#define FACTOR_DLL_NAME "factor.dll" -#define FACTOR_STDCALL __attribute__((stdcall)) +#ifdef _MSC_VER + #define FACTOR_DLL NULL + #define FACTOR_STDCALL(return_type) return_type __stdcall +#else + #define FACTOR_DLL L"factor.dll" + #define FACTOR_STDCALL(return_type) __attribute__((stdcall)) return_type +#endif -FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe); +FACTOR_STDCALL(LONG) exception_handler(PEXCEPTION_POINTERS pe); // SSE traps raise these exception codes, which are defined in internal NT headers // but not winbase.h diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index 5ca666d828..e7353c6517 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -9,26 +9,26 @@ void factor_vm::init_ffi() { hFactorDll = GetModuleHandle(FACTOR_DLL); if(!hFactorDll) - fatal_error("GetModuleHandle(\"" FACTOR_DLL_NAME "\") failed", 0); + fatal_error("GetModuleHandle() failed", 0); } void factor_vm::ffi_dlopen(dll *dll) { - dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0); + dll->handle = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0); } void *factor_vm::ffi_dlsym(dll *dll, symbol_char *symbol) { - return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol); + return (void *)GetProcAddress(dll ? (HMODULE)dll->handle : hFactorDll, symbol); } void factor_vm::ffi_dlclose(dll *dll) { - FreeLibrary((HMODULE)dll->dll); - dll->dll = NULL; + FreeLibrary((HMODULE)dll->handle); + dll->handle = NULL; } -bool factor_vm::windows_stat(vm_char *path) +BOOL factor_vm::windows_stat(vm_char *path) { BY_HANDLE_FILE_INFORMATION bhfi; HANDLE h = CreateFileW(path, @@ -50,15 +50,14 @@ bool factor_vm::windows_stat(vm_char *path) FindClose(h); return true; } - bool ret; - ret = GetFileInformationByHandle(h, &bhfi); + BOOL ret = GetFileInformationByHandle(h, &bhfi); CloseHandle(h); return ret; } void factor_vm::windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length) { - snwprintf(temp_path, length-1, L"%s.image", full_path); + SNWPRINTF(temp_path, length-1, L"%s.image", full_path); temp_path[length - 1] = 0; } @@ -75,7 +74,7 @@ const vm_char *factor_vm::default_image_path() if((ptr = wcsrchr(full_path, '.'))) *ptr = 0; - snwprintf(temp_path, MAX_UNICODE_PATH-1, L"%s.image", full_path); + SNWPRINTF(temp_path, MAX_UNICODE_PATH-1, L"%s.image", full_path); temp_path[MAX_UNICODE_PATH - 1] = 0; return safe_strdup(temp_path); @@ -138,4 +137,120 @@ long getpagesize() return g_pagesize; } +/* + Windows argument parsing ported to work on + int main(int argc, wchar_t **argv). + + Based on MinGW's public domain char** version. + + Used by WinMain() implementation in main-windows-ce.cpp + and main-windows-nt.cpp. + +*/ + +VM_C_API int parse_tokens(wchar_t *string, wchar_t ***tokens, int length) +{ + /* Extract whitespace- and quotes- delimited tokens from the given string + and put them into the tokens array. Returns number of tokens + extracted. Length specifies the current size of tokens[]. + THIS METHOD MODIFIES string. */ + + const wchar_t *whitespace = L" \t\r\n"; + wchar_t *tokenEnd = 0; + const wchar_t *quoteCharacters = L"\"\'"; + wchar_t *end = string + wcslen(string); + + if (string == NULL) + return length; + + while (1) + { + const wchar_t *q; + /* Skip over initial whitespace. */ + string += wcsspn(string, whitespace); + if (*string == '\0') + break; + + for (q = quoteCharacters; *q; ++q) + { + if (*string == *q) + break; + } + if (*q) + { + /* Token is quoted. */ + wchar_t quote = *string++; + tokenEnd = wcschr(string, quote); + /* If there is no endquote, the token is the rest of the string. */ + if (!tokenEnd) + tokenEnd = end; + } + else + { + tokenEnd = string + wcscspn(string, whitespace); + } + + *tokenEnd = '\0'; + + { + wchar_t **new_tokens; + int newlen = length + 1; + new_tokens = (wchar_t **)realloc (*tokens, sizeof (wchar_t**) * newlen); + if (!new_tokens) + { + /* Out of memory. */ + return -1; + } + + *tokens = new_tokens; + (*tokens)[length] = string; + length = newlen; + } + if (tokenEnd == end) + break; + string = tokenEnd + 1; + } + return length; +} + +VM_C_API void parse_args(int *argc, wchar_t ***argv, wchar_t *cmdlinePtrW) +{ + wchar_t cmdnameBufW[MAX_UNICODE_PATH]; + int cmdlineLen = 0; + int modlen; + + /* argv[0] is the path of invoked program - get this from CE. */ + cmdnameBufW[0] = 0; + modlen = GetModuleFileNameW(NULL, cmdnameBufW, sizeof (cmdnameBufW)/sizeof (cmdnameBufW[0])); + + if (!cmdlinePtrW) + cmdlineLen = 0; + else + cmdlineLen = wcslen(cmdlinePtrW); + + /* gets realloc()'d later */ + *argv = (wchar_t **)malloc (sizeof (wchar_t**) * 1); + if (!*argv) + ExitProcess(1); + + (*argv)[0] = wcsdup(cmdnameBufW); + if(!(*argv[0])) + ExitProcess(1); + /* Add one to account for argv[0] */ + (*argc)++; + + if (cmdlineLen > 0) + { + wchar_t *argv1 = (*argv)[0] + wcslen((*argv)[0]) + 1; + argv1 = wcsdup(cmdlinePtrW); + if(!argv1) + ExitProcess(1); + *argc = parse_tokens(argv1, argv, 1); + if (*argc < 0) + ExitProcess(1); + } + (*argv)[*argc] = 0; + return; +} + } diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp old mode 100644 new mode 100755 index 6a280ea580..13db2035bc --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -1,8 +1,8 @@ #include #ifndef wcslen - /* for cygwin */ - #include + /* for cygwin */ + #include #endif namespace factor @@ -18,8 +18,18 @@ typedef wchar_t vm_char; #define STRCMP wcscmp #define STRNCMP wcsncmp #define STRDUP _wcsdup -#define FTELL ftello64 -#define FSEEK fseeko64 + +#ifdef _MSC_VER + #define FTELL ftell + #define FSEEK fseek + #define SNPRINTF _snprintf + #define SNWPRINTF _snwprintf +#else + #define FTELL ftello64 + #define FSEEK fseeko64 + #define SNPRINTF snprintf + #define SNWPRINTF snwprintf +#endif #ifdef WIN64 #define CELL_HEX_FORMAT "%Ix" @@ -41,4 +51,8 @@ u64 nano_count(); void sleep_nanos(u64 nsec); long getpagesize(); +/* Used by-main-windows-*.cpp */ +VM_C_API int parse_tokens(wchar_t* string, wchar_t*** tokens, int length); +VM_C_API void parse_args(int *argc, wchar_t ***argv, wchar_t *cmdlinePtrW); + } diff --git a/vm/platform.hpp b/vm/platform.hpp old mode 100644 new mode 100755 index 96e19ad7f4..2a38c91171 --- a/vm/platform.hpp +++ b/vm/platform.hpp @@ -1,16 +1,20 @@ #if defined(WINDOWS) #if defined(WINCE) #include "os-windows-ce.hpp" - #else + #include "os-windows.hpp" + #elif defined(WINNT) #include "os-windows-nt.hpp" - #endif - - #include "os-windows.hpp" + #include "os-windows.hpp" - #if defined(FACTOR_AMD64) - #include "os-windows-nt.64.hpp" - #elif defined(FACTOR_X86) - #include "os-windows-nt.32.hpp" + #if defined(FACTOR_AMD64) + #include "os-windows-nt.64.hpp" + #elif defined(FACTOR_X86) + #include "os-windows-nt.32.hpp" + #else + #error "Unsupported Windows flavor" + #endif + #else + #error "Unsupported Windows flavor" #endif #else #include "os-unix.hpp" diff --git a/vm/strings.cpp b/vm/strings.cpp index c7e0354cba..67e4fb4508 100644 --- a/vm/strings.cpp +++ b/vm/strings.cpp @@ -24,7 +24,7 @@ cell string::nth(cell index) const void factor_vm::set_string_nth_fast(string *str, cell index, cell ch) { - str->data()[index] = ch; + str->data()[index] = (u8)ch; } void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch) @@ -51,7 +51,7 @@ void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch) write_barrier(&str->aux); } - aux->data()[index] = ((ch >> 7) ^ 1); + aux->data()[index] = (u16)((ch >> 7) ^ 1); } /* allocates memory */ diff --git a/vm/vm.hpp b/vm/vm.hpp index 92e921000b..348a7128cc 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -267,8 +267,8 @@ struct factor_vm inline void write_barrier(object *obj, cell size) { - cell start = (cell)obj & -card_size; - cell end = ((cell)obj + size + card_size - 1) & -card_size; + cell start = (cell)obj & (~card_size + 1); + cell end = ((cell)obj + size + card_size - 1) & (~card_size + 1); for(cell offset = start; offset < end; offset += card_size) write_barrier((cell *)offset); @@ -671,7 +671,7 @@ struct factor_vm const vm_char *vm_executable_path(); const vm_char *default_image_path(); void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length); - bool windows_stat(vm_char *path); + BOOL windows_stat(vm_char *path); #if defined(WINNT) void open_console();