--- /dev/null
+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
+++ /dev/null
-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
--- /dev/null
+LINK_CLFAGS =\r
+CL_FLAGS = /O2 /W3\r
+\r
+OBJS = vm\main-windows-nt.obj \\r
+ vm\os-windows-nt.obj \\r
+ vm\os-windows.obj \\r
+ vm\aging_collector.obj \\r
+ vm\alien.obj \\r
+ vm\arrays.obj \\r
+ vm\bignum.obj \\r
+ vm\booleans.obj \\r
+ vm\byte_arrays.obj \\r
+ vm\callbacks.obj \\r
+ vm\callstack.obj \\r
+ vm\code_blocks.obj \\r
+ vm\code_heap.obj \\r
+ vm\compaction.obj \\r
+ vm\contexts.obj \\r
+ vm\data_heap.obj \\r
+ vm\data_heap_checker.obj \\r
+ vm\debug.obj \\r
+ vm\dispatch.obj \\r
+ vm\entry_points.obj \\r
+ vm\errors.obj \\r
+ vm\factor.obj \\r
+ vm\free_list.obj \\r
+ vm\full_collector.obj \\r
+ vm\gc.obj \\r
+ vm\image.obj \\r
+ vm\inline_cache.obj \\r
+ vm\instruction_operands.obj \\r
+ vm\io.obj \\r
+ vm\jit.obj \\r
+ vm\math.obj \\r
+ vm\nursery_collector.obj \\r
+ vm\object_start_map.obj \\r
+ vm\objects.obj \\r
+ vm\primitives.obj \\r
+ vm\profiler.obj \\r
+ vm\quotations.obj \\r
+ vm\run.obj \\r
+ vm\strings.obj \\r
+ vm\to_tenured_collector.obj \\r
+ vm\tuples.obj \\r
+ vm\utilities.obj \\r
+ vm\vm.obj \\r
+ vm\words.obj\r
+\r
+.cpp.obj:\r
+ cl /nologo /EHsc $(CL_FLAGS) /Fo$@ /c $<\r
+\r
+all: factor.com factor.exe\r
+\r
+factor.com: $(OBJS)\r
+ link $(LINK_FLAGS) /nologo /out:factor.com /SUBSYSTEM:console $(OBJS)\r
+\r
+factor.exe: $(OBJS)\r
+ link $(LINK_FLAGS) /nologo /out:factor.exe /SUBSYSTEM:windows $(OBJS)\r
+\r
+clean:\r
+ del vm\*.obj\r
+ del factor.com\r
+ del factor.exe\r
+\r
+.PHONY: clean\r
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 ;
[ 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 <reversed> [ 2drop ] with each ] final-info ] unit-test
+
+! Reduction
+[ 1 ] [ [ 4 <reversed> [ nth-unsafe ] [ ] unless ] final-info length ] unit-test
100 <buffer> "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
! 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
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 )
[
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 )
FUNCTOR: define-array ( T -- )
A DEFINES-CLASS ${T}-array
-S DEFINES-CLASS ${T}-sequence
<A> DEFINES <${A}>
(A) DEFINES (${A})
<direct-A> DEFINES <direct-${A}>
WHERE
-MIXIN: S
-
TUPLE: A
{ underlying c-ptr read-only }
{ length array-capacity read-only } ;
V DEFINES-CLASS ${T}-vector
A IS ${T}-array
-S IS ${T}-sequence
<A> IS <${A}>
>V DEFERS >${V}
SYNTAX: V{ \ } [ >V ] parse-literal ;
INSTANCE: V growable
-INSTANCE: V S
;FUNCTOR
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 ] <search-table> ] must-infer
+
+[ t ] [ f <model> trivial-renderer [ second ] <search-table> pref-dim pair? ] unit-test
action
hook
font
-gap
selection-color
focus-border-color
mouse-color
logs
.git
.gitignore
-Makefile
+GNUmakefile
+Nmakefile
unmaintained
build-support
}
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"
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 ;
[ 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 ;
-! 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
: 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 ;
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
[ 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
--- /dev/null
+This is a text file
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 ;
[ 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 ;
-! 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
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 ;
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
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; \
}
{
dll *d = untag_check<dll>(library.value());
- if(d->dll == NULL)
+ if(d->handle == NULL)
ctx->push(false_object);
else
ctx->push(allot_alien(ffi_dlsym(d,sym)));
void factor_vm::primitive_dlclose()
{
dll *d = untag_check<dll>(ctx->pop());
- if(d->dll != NULL)
+ if(d->handle != NULL)
ffi_dlclose(d);
}
{
cell library = ctx->pop();
if(to_boolean(library))
- ctx->push(tag_boolean(untag_check<dll>(library)->dll != NULL));
+ ctx->push(tag_boolean(untag_check<dll>(library)->handle != NULL));
else
ctx->push(true_object);
}
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);
inline cell rightmost_set_bit(cell x)
{
- return log2(x & -x);
+ return log2(x & (~x + 1));
}
inline cell popcount(cell x)
dll *d = (to_boolean(library) ? untag<dll>(library) : NULL);
- if(d != NULL && !d->dll)
+ if(d != NULL && !d->handle)
return (cell)factor::undefined_symbol;
switch(tagged<object>(symbol).type())
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;
namespace factor
{
-factor_vm *vm;
std::map<THREADHANDLE, factor_vm*> thread_vms;
void init_globals()
#ifdef WINDOWS
p->console = false;
#else
- if (this == vm)
- p->console = true;
- else
- p->console = false;
-
+ p->console = true;
#endif
p->callback_size = 256;
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);
}
// 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;
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);
}
{
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);
+
}
};
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();
}
{
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()
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()
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()
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()
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())
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());
/* tagged byte array holding a C string */
cell path;
/* OS-specific handle */
- void *dll;
+ void *handle;
};
struct stack_frame {
#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;
}
#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;
}
#include <fcntl.h>
#include <limits.h>
#include <math.h>
-#include <stdbool.h>
#include <setjmp.h>
#include <stdio.h>
#include <stdlib.h>
#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
#error "Unsupported architecture"
#endif
-#ifdef WIN32
+#if defined(_MSC_VER)
#define WINDOWS
+ #define WINNT
+#elif defined(WIN32)
+ #define WINDOWS
+#endif
+
+#ifndef _MSC_VER
+ #include <stdbool.h>
#endif
/* Forward-declare this since it comes up in function prototypes */
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<byte_array>(array));
}
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()
if(n < fixnum_min || n > fixnum_max)
return tag<bignum>(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)
if(n > (u64)fixnum_max)
return tag<bignum>(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)
/* 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)
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));
}
}
}
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()
#define STRCMP strcmp
#define STRNCMP strncmp
#define STRDUP strdup
+#define SNPRINTF snprintf
#define FTELL ftello
#define FSEEK fseeko
#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);
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);
}
#include <windows.h>
#include <shellapi.h>
+#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
{
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,
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;
}
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);
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;
+}
+
}
#include <ctype.h>
#ifndef wcslen
- /* for cygwin */
- #include <wchar.h>
+ /* for cygwin */
+ #include <wchar.h>
#endif
namespace factor
#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"
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);
+
}
#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"
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)
write_barrier(&str->aux);
}
- aux->data<u16>()[index] = ((ch >> 7) ^ 1);
+ aux->data<u16>()[index] = (u16)((ch >> 7) ^ 1);
}
/* allocates memory */
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);
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();
projects / factor.git / commitdiff