diff --git a/GNUmakefile b/GNUmakefile index 772f3f9875..4447dfbede 100755 --- a/GNUmakefile +++ b/GNUmakefile @@ -1,82 +1,78 @@ -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 + CC = gcc + CPP = g++ + AR = ar + LD = ld + + VERSION = 0.92 + + BUNDLE = Factor.app + LIBPATH = -L/usr/X11R6/lib + + CFLAGS = -Wall $(SITE_CFLAGS) + + ifdef DEBUG + CFLAGS += -g -DFACTOR_DEBUG + else + CFLAGS += -O3 + endif + include $(CONFIG) + + ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION) + EXECUTABLE = factor$(EXE_SUFFIX)$(EXE_EXTENSION) + CONSOLE_EXECUTABLE = factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) + + 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) + + FFI_TEST_LIBRARY = libfactor-ffi-test$(SHARED_DLL_EXTENSION) + + TEST_OBJS = vm/ffi_test.o 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` @@ -110,60 +106,62 @@ help: @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 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.openbsd.x86.32 openbsd-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.openbsd.x86.64 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.openbsd.x86.64 freebsd-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.32 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.freebsd.x86.32 freebsd-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.freebsd.x86.64 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.freebsd.x86.64 netbsd-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.32 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.netbsd.x86.32 netbsd-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.netbsd.x86.64 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.netbsd.x86.64 macosx-ppc: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.ppc + $(MAKE) factor factor-ffi-test macosx.app CONFIG=vm/Config.macosx.ppc macosx-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.32 + $(MAKE) factor factor-ffi-test macosx.app CONFIG=vm/Config.macosx.x86.32 macosx-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) macosx.app CONFIG=vm/Config.macosx.x86.64 + $(MAKE) factor factor-ffi-test macosx.app CONFIG=vm/Config.macosx.x86.64 linux-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.32 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.linux.x86.32 linux-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.x86.64 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.linux.x86.64 linux-ppc: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.ppc + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.linux.ppc linux-arm: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.linux.arm + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.linux.arm solaris-x86-32: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.32 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.solaris.x86.32 solaris-x86-64: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.solaris.x86.64 + $(MAKE) factor factor-ffi-test 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 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.windows.nt.x86.32 + $(MAKE) factor-console 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 + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.windows.nt.x86.64 + $(MAKE) factor-console CONFIG=vm/Config.windows.nt.x86.64 wince-arm: - $(MAKE) $(EXECUTABLE) $(TEST_LIBRARY) CONFIG=vm/Config.windows.ce.arm + $(MAKE) factor factor-ffi-test CONFIG=vm/Config.windows.ce.arm + +ifdef CONFIG macosx.app: factor mkdir -p $(BUNDLE)/Contents/MacOS @@ -177,18 +175,40 @@ macosx.app: factor @executable_path/../Frameworks/libfactor.dylib \ Factor.app/Contents/MacOS/factor -$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS) +$(ENGINE): $(DLL_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) +factor: $(EXE_OBJS) $(ENGINE) $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ - $(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS) + $(CFLAGS) -o $(EXECUTABLE) $(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) +factor-console: $(EXE_OBJS) $(ENGINE) + $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \ + $(CFLAGS) $(CFLAGS_CONSOLE) -o $(CONSOLE_EXECUTABLE) $(EXE_OBJS) + +factor-ffi-test: $(FFI_TEST_LIBRARY) + +$(FFI_TEST_LIBRARY): vm/ffi_test.o + $(TOOLCHAIN_PREFIX)$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o $(FFI_TEST_LIBRARY) $(TEST_OBJS) + +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 $@ $< + +.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 $@ $< + +.SUFFIXES: .mm + +endif clean: rm -f vm/*.o @@ -200,24 +220,4 @@ clean: 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 +.PHONY: factor factor-console factor-ffi-test tags clean macosx.app diff --git a/Nmakefile b/Nmakefile index e9384fdff8..e964105d9f 100755 --- a/Nmakefile +++ b/Nmakefile @@ -1,4 +1,4 @@ -LINK_CLFAGS = /nologo +LINK_FLAGS = /nologo shell32.lib CL_FLAGS = /nologo /O2 /W3 EXE_OBJS = factor.dll.lib vm\main-windows-nt.obj vm\factor.res @@ -66,11 +66,12 @@ factor.exe: $(EXE_OBJS) clean: del vm\*.obj + del factor.lib del factor.com del factor.exe del factor.dll del factor.dll.lib -.PHONY: clean +.PHONY: all clean .SUFFIXES: .rs diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index 3b7848251b..2d0613a7f5 100644 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -76,7 +76,7 @@ gc "." write flush { - + 2/ < <= > >= shift + + * 2/ < <= > >= shift } compile-unoptimized "." write flush diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index efdc02cc1f..eef517a2bb 100644 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -62,16 +62,13 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ; [ add-dlsym-parameters ] dip rt-dlsym rel-fixup ; : rel-word ( word class -- ) - [ add-literal ] dip rt-xt rel-fixup ; + [ add-literal ] dip rt-entry-point rel-fixup ; : rel-word-pic ( word class -- ) - [ add-literal ] dip rt-xt-pic rel-fixup ; + [ add-literal ] dip rt-entry-point-pic rel-fixup ; : rel-word-pic-tail ( word class -- ) - [ add-literal ] dip rt-xt-pic-tail rel-fixup ; - -: rel-primitive ( word class -- ) - [ def>> first add-parameter ] dip rt-primitive rel-fixup ; + [ add-literal ] dip rt-entry-point-pic-tail rel-fixup ; : rel-immediate ( literal class -- ) [ add-literal ] dip rt-literal rel-fixup ; diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index a772855ab6..2375d8575d 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -32,7 +32,6 @@ SYMBOL: compiled [ "forgotten" word-prop ] [ compiled get key? ] [ inlined-block? ] - [ primitive? ] } 1|| not ; : queue-compile ( word -- ) @@ -126,7 +125,10 @@ M: word combinator? inline? ; } cond ; : optimize? ( word -- ? ) - single-generic? not ; + { + [ single-generic? ] + [ primitive? ] + } 1|| not ; : contains-breakpoints? ( -- ? ) dependencies get keys [ "break?" word-prop ] any? ; diff --git a/basis/compiler/constants/constants.factor b/basis/compiler/constants/constants.factor index 499a1b192f..73e77cca4d 100644 --- a/basis/compiler/constants/constants.factor +++ b/basis/compiler/constants/constants.factor @@ -20,8 +20,8 @@ CONSTANT: deck-bits 18 : alien-offset ( -- n ) 4 alien type-number slot-offset ; inline : underlying-alien-offset ( -- n ) 1 alien type-number slot-offset ; inline : tuple-class-offset ( -- n ) 1 tuple type-number slot-offset ; inline -: word-xt-offset ( -- n ) 10 \ word type-number slot-offset ; inline -: quot-xt-offset ( -- n ) 4 quotation type-number slot-offset ; inline +: word-entry-point-offset ( -- n ) 10 \ word type-number slot-offset ; inline +: quot-entry-point-offset ( -- n ) 4 quotation type-number slot-offset ; inline : word-code-offset ( -- n ) 11 \ word type-number slot-offset ; inline : array-start-offset ( -- n ) 2 array type-number slot-offset ; inline : compiled-header-size ( -- n ) 4 bootstrap-cells ; inline @@ -47,21 +47,18 @@ CONSTANT: rc-indirect-arm-pc 9 CONSTANT: rc-absolute-2 10 ! Relocation types -CONSTANT: rt-primitive 0 -CONSTANT: rt-dlsym 1 -CONSTANT: rt-dispatch 2 -CONSTANT: rt-xt 3 -CONSTANT: rt-xt-pic 4 -CONSTANT: rt-xt-pic-tail 5 -CONSTANT: rt-here 6 -CONSTANT: rt-this 7 -CONSTANT: rt-literal 8 -CONSTANT: rt-context 9 -CONSTANT: rt-untagged 10 -CONSTANT: rt-megamorphic-cache-hits 11 -CONSTANT: rt-vm 12 -CONSTANT: rt-cards-offset 13 -CONSTANT: rt-decks-offset 14 +CONSTANT: rt-dlsym 0 +CONSTANT: rt-entry-point 1 +CONSTANT: rt-entry-point-pic 2 +CONSTANT: rt-entry-point-pic-tail 3 +CONSTANT: rt-here 4 +CONSTANT: rt-this 5 +CONSTANT: rt-literal 6 +CONSTANT: rt-untagged 7 +CONSTANT: rt-megamorphic-cache-hits 8 +CONSTANT: rt-vm 9 +CONSTANT: rt-cards-offset 10 +CONSTANT: rt-decks-offset 11 : rc-absolute? ( n -- ? ) ${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ; diff --git a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor index debb66b8d4..6c50347c3a 100644 --- a/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor +++ b/basis/compiler/tree/escape-analysis/escape-analysis-tests.factor @@ -7,7 +7,7 @@ math.private kernel tools.test accessors slots.private quotations.private prettyprint classes.tuple.private classes classes.tuple namespaces compiler.tree.propagation.info stack-checker.errors -compiler.tree.checker +compiler.tree.checker compiler.tree.def-use compiler.tree.dead-code kernel.private vectors ; IN: compiler.tree.escape-analysis.tests @@ -37,6 +37,8 @@ M: node count-unboxed-allocations* drop ; cleanup escape-analysis dup check-nodes + compute-def-use + remove-dead-code 0 swap [ count-unboxed-allocations* ] each-node ; [ 0 ] [ [ [ + ] curry ] count-unboxed-allocations ] unit-test @@ -173,12 +175,6 @@ TUPLE: cons { car read-only } { cdr read-only } ; [ 10 [ drop ] each-integer ] count-unboxed-allocations ] unit-test -[ 2 ] [ - [ - 1 2 cons boa 10 [ 2drop 1 2 cons boa ] each-integer car>> - ] count-unboxed-allocations -] unit-test - [ 0 ] [ [ 1 2 cons boa 10 [ drop 2 cons boa ] each-integer car>> @@ -304,14 +300,6 @@ C: ro-box [ 0 ] [ [ 1 cons boa "x" get slot ] count-unboxed-allocations ] unit-test -: impeach-node ( quot: ( node -- ) -- ) - [ call ] keep impeach-node ; inline recursive - -: bleach-node ( quot: ( node -- ) -- ) - [ bleach-node ] curry [ ] compose impeach-node ; inline recursive - -[ 3 ] [ [ [ ] bleach-node ] count-unboxed-allocations ] unit-test - [ 0 ] [ [ dup -1 over >= [ 0 >= [ "A" throw ] unless ] [ drop ] if ] count-unboxed-allocations @@ -322,10 +310,6 @@ C: ro-box count-unboxed-allocations ] unit-test -[ 0 ] [ - [ { null } declare [ 1 ] [ 2 ] if ] count-unboxed-allocations -] unit-test - ! Doug found a regression TUPLE: empty-tuple ; diff --git a/basis/compiler/tree/propagation/call-effect/call-effect.factor b/basis/compiler/tree/propagation/call-effect/call-effect.factor index 439b428784..04320ee792 100644 --- a/basis/compiler/tree/propagation/call-effect/call-effect.factor +++ b/basis/compiler/tree/propagation/call-effect/call-effect.factor @@ -74,7 +74,7 @@ M: quotation cached-effect : call-effect-unsafe? ( quot effect -- ? ) [ cached-effect ] dip over +unknown+ eq? - [ 2drop f ] [ effect<= ] if ; inline + [ 2drop f ] [ [ { effect } declare ] dip effect<= ] if ; inline : (call-effect-slow>quot) ( in out effect -- quot ) [ diff --git a/basis/cpu/ppc/bootstrap.factor b/basis/cpu/ppc/bootstrap.factor index e3c212bd48..698fc6257a 100644 --- a/basis/cpu/ppc/bootstrap.factor +++ b/basis/cpu/ppc/bootstrap.factor @@ -1,10 +1,9 @@ ! Copyright (C) 2007, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel kernel.private namespaces -system cpu.ppc.assembler compiler.codegen.fixup compiler.units -compiler.constants math math.private math.ranges layouts words vocabs -slots.private locals locals.backend generic.single.private fry -sequences ; +system cpu.ppc.assembler compiler.units compiler.constants math +math.private math.ranges layouts words vocabs slots.private +locals locals.backend generic.single.private fry sequences ; FROM: cpu.ppc.assembler => B ; IN: bootstrap.ppc @@ -66,7 +65,7 @@ CONSTANT: ctx-reg 16 0 vm-reg LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel - 0 2 LOAD32 rc-absolute-ppc-2/2 rt-xt jit-rel + 0 2 LOAD32 rc-absolute-ppc-2/2 rt-entry-point jit-rel 2 MTLR BLRL @@ -126,25 +125,25 @@ CONSTANT: ctx-reg 16 [ jit-save-context 3 vm-reg MR - 0 4 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel + 0 4 LOAD32 rc-absolute-ppc-2/2 rt-dlsym jit-rel 4 MTLR BLRL jit-restore-context ] jit-primitive jit-define -[ 0 BL rc-relative-ppc-3 rt-xt-pic jit-rel ] jit-word-call jit-define +[ 0 BL rc-relative-ppc-3 rt-entry-point-pic jit-rel ] jit-word-call jit-define [ 0 6 LOAD32 rc-absolute-ppc-2/2 rt-here jit-rel - 0 B rc-relative-ppc-3 rt-xt-pic-tail jit-rel + 0 B rc-relative-ppc-3 rt-entry-point-pic-tail jit-rel ] jit-word-jump jit-define [ 3 ds-reg 0 LWZ ds-reg dup 4 SUBI 0 3 \ f type-number CMPI - [ BEQ ] [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-conditional* - 0 B rc-relative-ppc-3 rt-xt jit-rel + [ BEQ ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional* + 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-if jit-define : jit->r ( -- ) @@ -195,19 +194,19 @@ CONSTANT: ctx-reg 16 [ jit->r - 0 BL rc-relative-ppc-3 rt-xt jit-rel + 0 BL rc-relative-ppc-3 rt-entry-point jit-rel jit-r> ] jit-dip jit-define [ jit-2>r - 0 BL rc-relative-ppc-3 rt-xt jit-rel + 0 BL rc-relative-ppc-3 rt-entry-point jit-rel jit-2r> ] jit-2dip jit-define [ jit-3>r - 0 BL rc-relative-ppc-3 rt-xt jit-rel + 0 BL rc-relative-ppc-3 rt-entry-point jit-rel jit-3r> ] jit-3dip jit-define @@ -256,7 +255,7 @@ CONSTANT: ctx-reg 16 ] pic-check-tuple jit-define [ - [ BNE ] [ 0 B rc-relative-ppc-3 rt-xt jit-rel ] jit-conditional* + [ BNE ] [ 0 B rc-relative-ppc-3 rt-entry-point jit-rel ] jit-conditional* ] pic-hit jit-define ! Inline cache miss entry points @@ -308,7 +307,7 @@ CONSTANT: ctx-reg 16 5 4 0 STW ! ... goto get(cache + 4) 3 3 4 LWZ - 3 3 word-xt-offset LWZ + 3 3 word-entry-point-offset LWZ 3 MTCTR BCTR ] @@ -322,7 +321,7 @@ CONSTANT: ctx-reg 16 [ 3 ds-reg 0 LWZ ds-reg dup 4 SUBI - 5 3 quot-xt-offset LWZ + 5 3 quot-entry-point-offset LWZ ] [ 5 MTLR BLRL ] [ 5 MTCTR BCTR ] \ (call) define-combinator-primitive @@ -330,7 +329,7 @@ CONSTANT: ctx-reg 16 [ 3 ds-reg 0 LWZ ds-reg dup 4 SUBI - 4 3 word-xt-offset LWZ + 4 3 word-entry-point-offset LWZ ] [ 4 MTLR BLRL ] [ 4 MTCTR BCTR ] \ (execute) define-combinator-primitive @@ -338,7 +337,7 @@ CONSTANT: ctx-reg 16 [ 3 ds-reg 0 LWZ ds-reg dup 4 SUBI - 4 3 word-xt-offset LWZ + 4 3 word-entry-point-offset LWZ 4 MTCTR BCTR ] jit-execute jit-define @@ -348,7 +347,7 @@ CONSTANT: ctx-reg 16 ! Save ctx->callstack_bottom 1 ctx-reg context-callstack-bottom-offset STW ! Call quotation - 5 3 quot-xt-offset LWZ + 5 3 quot-entry-point-offset LWZ 5 MTLR BLRL jit-save-context @@ -370,7 +369,7 @@ CONSTANT: ctx-reg 16 0 MTLR ! Call quotation - 4 3 quot-xt-offset LWZ + 4 3 quot-entry-point-offset LWZ 4 MTCTR BCTR ] \ unwind-native-frames define-sub-primitive @@ -409,7 +408,7 @@ CONSTANT: ctx-reg 16 0 2 LOAD32 "lazy_jit_compile" f rc-absolute-ppc-2/2 jit-dlsym 2 MTLR BLRL - 5 3 quot-xt-offset LWZ + 5 3 quot-entry-point-offset LWZ ] [ 5 MTLR BLRL ] [ 5 MTCTR BCTR ] diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor index 4842327973..a914b3551e 100644 --- a/basis/cpu/ppc/ppc.factor +++ b/basis/cpu/ppc/ppc.factor @@ -81,7 +81,7 @@ M: ppc %inc-r ( n -- ) rs-reg (%inc) ; HOOK: reserved-area-size os ( -- n ) ! The start of the stack frame contains the size of this frame -! as well as the currently executing XT +! as well as the currently executing code block : factor-area-size ( -- n ) 2 cells ; foldable : next-save ( n -- i ) cell - ; foldable : xt-save ( n -- i ) 2 cells - ; foldable @@ -702,7 +702,7 @@ M: ppc %alien-invoke ( symbol dll -- ) M: ppc %alien-callback ( quot -- ) 3 4 %restore-context 3 swap %load-reference - 4 3 quot-xt-offset LWZ + 4 3 quot-entry-point-offset LWZ 4 MTLR BLRL 3 4 %save-context ; diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 0f98170d66..3348ef0e96 100644 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -244,7 +244,7 @@ M: x86.32 %alien-indirect ( -- ) M: x86.32 %alien-callback ( quot -- ) EAX EDX %restore-context EAX swap %load-reference - EAX quot-xt-offset [+] CALL + EAX quot-entry-point-offset [+] CALL EAX EDX %save-context ; M: x86.32 %callback-value ( ctype -- ) diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index bcab5a54ee..d11aa952d9 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -30,7 +30,7 @@ IN: bootstrap.x86 [ ! save stack frame size stack-frame-size PUSH - ! push XT + ! push entry point 0 PUSH rc-absolute-cell rt-this jit-rel ! alignment ESP stack-frame-size 3 bootstrap-cells - SUB @@ -59,7 +59,7 @@ IN: bootstrap.x86 jit-save-context ! call the primitive ESP [] vm-reg MOV - 0 CALL rc-relative rt-primitive jit-rel + 0 CALL rc-relative rt-dlsym jit-rel ! restore ds, rs registers jit-restore-context ] jit-primitive jit-define @@ -74,7 +74,7 @@ IN: bootstrap.x86 EDX stack-reg stack-frame-size 4 - [+] LEA ctx-reg context-callstack-bottom-offset [+] EDX MOV ! call the quotation - EAX quot-xt-offset [+] CALL + EAX quot-entry-point-offset [+] CALL ! save ds, rs registers jit-save-context ] \ c-to-factor define-sub-primitive @@ -83,8 +83,8 @@ IN: bootstrap.x86 EAX ds-reg [] MOV ds-reg bootstrap-cell SUB ] -[ EAX quot-xt-offset [+] CALL ] -[ EAX quot-xt-offset [+] JMP ] +[ EAX quot-entry-point-offset [+] CALL ] +[ EAX quot-entry-point-offset [+] JMP ] \ (call) define-combinator-primitive [ @@ -108,7 +108,7 @@ IN: bootstrap.x86 jit-restore-context ! Call quotation - EAX quot-xt-offset [+] JMP + EAX quot-entry-point-offset [+] JMP ] \ unwind-native-frames define-sub-primitive [ @@ -150,8 +150,8 @@ IN: bootstrap.x86 ! Call VM 0 CALL "lazy_jit_compile" f rc-relative jit-dlsym ] -[ EAX quot-xt-offset [+] CALL ] -[ EAX quot-xt-offset [+] JMP ] +[ EAX quot-entry-point-offset [+] CALL ] +[ EAX quot-entry-point-offset [+] JMP ] \ lazy-jit-compile define-combinator-primitive ! Inline cache miss entry points diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 676c96ce50..d3196397c3 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -234,7 +234,7 @@ M: x86.64 %alien-indirect ( -- ) M: x86.64 %alien-callback ( quot -- ) param-reg-0 param-reg-1 %restore-context param-reg-0 swap %load-reference - param-reg-0 quot-xt-offset [+] CALL + param-reg-0 quot-entry-point-offset [+] CALL param-reg-0 param-reg-1 %save-context ; M: x86.64 %callback-value ( ctype -- ) diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index 74943a94bb..828598074f 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -27,11 +27,11 @@ IN: bootstrap.x86 : rex-length ( -- n ) 1 ; [ - ! load XT + ! load entry point safe-reg 0 MOV rc-absolute-cell rt-this jit-rel ! save stack frame size stack-frame-size PUSH - ! push XT + ! push entry point safe-reg PUSH ! alignment RSP stack-frame-size 3 bootstrap-cells - SUB @@ -56,7 +56,7 @@ IN: bootstrap.x86 jit-save-context ! call the primitive arg1 vm-reg MOV - RAX 0 MOV rc-absolute-cell rt-primitive jit-rel + RAX 0 MOV rc-absolute-cell rt-dlsym jit-rel RAX CALL jit-restore-context ] jit-primitive jit-define @@ -67,7 +67,7 @@ IN: bootstrap.x86 safe-reg stack-reg stack-frame-size 8 - [+] LEA ctx-reg context-callstack-bottom-offset [+] safe-reg MOV ! call the quotation - arg1 quot-xt-offset [+] CALL + arg1 quot-entry-point-offset [+] CALL jit-save-context ] \ c-to-factor define-sub-primitive @@ -75,8 +75,8 @@ IN: bootstrap.x86 arg1 ds-reg [] MOV ds-reg bootstrap-cell SUB ] -[ arg1 quot-xt-offset [+] CALL ] -[ arg1 quot-xt-offset [+] JMP ] +[ arg1 quot-entry-point-offset [+] CALL ] +[ arg1 quot-entry-point-offset [+] JMP ] \ (call) define-combinator-primitive [ @@ -97,7 +97,7 @@ IN: bootstrap.x86 jit-restore-context ! Call quotation - arg1 quot-xt-offset [+] JMP + arg1 quot-entry-point-offset [+] JMP ] \ unwind-native-frames define-sub-primitive [ @@ -133,8 +133,8 @@ IN: bootstrap.x86 safe-reg 0 MOV "lazy_jit_compile" f rc-absolute-cell jit-dlsym safe-reg CALL ] -[ return-reg quot-xt-offset [+] CALL ] -[ return-reg quot-xt-offset [+] JMP ] +[ return-reg quot-entry-point-offset [+] CALL ] +[ return-reg quot-entry-point-offset [+] JMP ] \ lazy-jit-compile define-combinator-primitive ! Inline cache miss entry points diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 96d21972d5..2304f9c9f3 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -34,7 +34,7 @@ big-endian off vm-reg 0 MOV rc-absolute-cell rt-vm jit-rel ! Call into Factor code - safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel + safe-reg 0 MOV rc-absolute-cell rt-entry-point jit-rel safe-reg CALL ! Tear down register shadow area @@ -61,9 +61,9 @@ big-endian off temp0 profile-count-offset [+] 1 tag-fixnum ADD ! Load word->code temp0 temp0 word-code-offset [+] MOV - ! Compute word XT + ! Compute word entry point temp0 compiled-header-size ADD - ! Jump to XT + ! Jump to entry point temp0 JMP ] jit-profiling jit-define @@ -78,11 +78,11 @@ big-endian off [ temp3 0 MOV rc-absolute-cell rt-here jit-rel - 0 JMP rc-relative rt-xt-pic-tail jit-rel + 0 JMP rc-relative rt-entry-point-pic-tail jit-rel ] jit-word-jump jit-define [ - 0 CALL rc-relative rt-xt-pic jit-rel + 0 CALL rc-relative rt-entry-point-pic jit-rel ] jit-word-call jit-define [ @@ -93,9 +93,9 @@ big-endian off ! compare boolean with f temp0 \ f type-number CMP ! jump to true branch if not equal - 0 JNE rc-relative rt-xt jit-rel + 0 JNE rc-relative rt-entry-point jit-rel ! jump to false branch if equal - 0 JMP rc-relative rt-xt jit-rel + 0 JMP rc-relative rt-entry-point jit-rel ] jit-if jit-define : jit->r ( -- ) @@ -148,19 +148,19 @@ big-endian off [ jit->r - 0 CALL rc-relative rt-xt jit-rel + 0 CALL rc-relative rt-entry-point jit-rel jit-r> ] jit-dip jit-define [ jit-2>r - 0 CALL rc-relative rt-xt jit-rel + 0 CALL rc-relative rt-entry-point jit-rel jit-2r> ] jit-2dip jit-define [ jit-3>r - 0 CALL rc-relative rt-xt jit-rel + 0 CALL rc-relative rt-entry-point jit-rel jit-3r> ] jit-3dip jit-define @@ -170,14 +170,14 @@ big-endian off ! pop stack ds-reg bootstrap-cell SUB ] -[ temp0 word-xt-offset [+] CALL ] -[ temp0 word-xt-offset [+] JMP ] +[ temp0 word-entry-point-offset [+] CALL ] +[ temp0 word-entry-point-offset [+] JMP ] \ (execute) define-combinator-primitive [ temp0 ds-reg [] MOV ds-reg bootstrap-cell SUB - temp0 word-xt-offset [+] JMP + temp0 word-entry-point-offset [+] JMP ] jit-execute jit-define [ @@ -224,7 +224,7 @@ big-endian off temp1 temp2 CMP ] pic-check-tuple jit-define -[ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define +[ 0 JE rc-relative rt-entry-point jit-rel ] pic-hit jit-define ! ! ! Megamorphic caches @@ -248,7 +248,7 @@ big-endian off temp1 [] 1 ADD ! goto get(cache + bootstrap-cell) temp0 temp0 bootstrap-cell [+] MOV - temp0 word-xt-offset [+] JMP + temp0 word-entry-point-offset [+] JMP ! fall-through on miss ] mega-lookup jit-define diff --git a/basis/io/servers/connection/connection.factor b/basis/io/servers/connection/connection.factor index 345b739b61..fdd42352da 100644 --- a/basis/io/servers/connection/connection.factor +++ b/basis/io/servers/connection/connection.factor @@ -96,7 +96,7 @@ M: threaded-server handle-client* handler>> call( -- ) ; [ [ accept-connection ] with-semaphore ] [ accept-connection ] if* - ] [ accept-loop ] bi ; inline recursive + ] [ accept-loop ] bi ; : started-accept-loop ( threaded-server -- ) threaded-server get diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor index fb8332dffb..8cc6ef731d 100644 --- a/basis/io/sockets/sockets-docs.factor +++ b/basis/io/sockets/sockets-docs.factor @@ -155,7 +155,7 @@ HELP: with-client HELP: { $values { "addrspec" "an address specifier" } { "encoding" "an encoding descriptor" } { "server" "a handle" } } { $description - "Begins listening for network connections to a local address. Server objects responds to two words:" + "Begins listening for network connections to a local address. Server objects respond to two words:" { $list { { $link dispose } " - stops listening on the port and frees all associated resources" } { { $link accept } " - blocks until there is a connection, and returns a stream of the encoding passed to the constructor" } diff --git a/basis/math/vectors/vectors.factor b/basis/math/vectors/vectors.factor index 69d8929c65..6cb16e5efc 100644 --- a/basis/math/vectors/vectors.factor +++ b/basis/math/vectors/vectors.factor @@ -1,49 +1,49 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays alien.c-types assocs kernel sequences math math.functions -grouping hints math.order math.libm math.floats.private fry combinators -byte-arrays accessors locals ; +USING: arrays alien.c-types assocs kernel sequences math +math.functions grouping math.order math.libm math.floats.private +fry combinators byte-arrays accessors locals ; QUALIFIED-WITH: alien.c-types c IN: math.vectors GENERIC: vneg ( u -- v ) -M: object vneg [ neg ] map ; +M: object vneg [ neg ] map ; inline GENERIC# v+n 1 ( u n -- w ) -M: object v+n [ + ] curry map ; +M: object v+n [ + ] curry map ; inline GENERIC: n+v ( n v -- w ) -M: object n+v [ + ] with map ; +M: object n+v [ + ] with map ; inline GENERIC# v-n 1 ( u n -- w ) -M: object v-n [ - ] curry map ; +M: object v-n [ - ] curry map ; inline GENERIC: n-v ( n v -- w ) -M: object n-v [ - ] with map ; +M: object n-v [ - ] with map ; inline GENERIC# v*n 1 ( u n -- w ) -M: object v*n [ * ] curry map ; +M: object v*n [ * ] curry map ; inline GENERIC: n*v ( n v -- w ) -M: object n*v [ * ] with map ; +M: object n*v [ * ] with map ; inline GENERIC# v/n 1 ( u n -- w ) -M: object v/n [ / ] curry map ; +M: object v/n [ / ] curry map ; inline GENERIC: n/v ( n v -- w ) -M: object n/v [ / ] with map ; +M: object n/v [ / ] with map ; inline GENERIC: v+ ( u v -- w ) -M: object v+ [ + ] 2map ; +M: object v+ [ + ] 2map ; inline GENERIC: v- ( u v -- w ) -M: object v- [ - ] 2map ; +M: object v- [ - ] 2map ; inline GENERIC: [v-] ( u v -- w ) -M: object [v-] [ [-] ] 2map ; +M: object [v-] [ [-] ] 2map ; inline GENERIC: v* ( u v -- w ) -M: object v* [ * ] 2map ; +M: object v* [ * ] 2map ; inline GENERIC: v*high ( u v -- w ) @@ -53,43 +53,43 @@ GENERIC: v*high ( u v -- w ) PRIVATE> GENERIC: v*hs+ ( u v -- w ) -M: object v*hs+ [ * ] 2map (h+) ; +M: object v*hs+ [ * ] 2map (h+) ; inline GENERIC: v/ ( u v -- w ) -M: object v/ [ / ] 2map ; +M: object v/ [ / ] 2map ; inline GENERIC: vavg ( u v -- w ) -M: object vavg [ + 2 / ] 2map ; +M: object vavg [ + 2 / ] 2map ; inline GENERIC: vmax ( u v -- w ) -M: object vmax [ max ] 2map ; +M: object vmax [ max ] 2map ; inline GENERIC: vmin ( u v -- w ) -M: object vmin [ min ] 2map ; +M: object vmin [ min ] 2map ; inline GENERIC: v+- ( u v -- w ) M: object v+- [ t ] 2dip [ [ not ] 2dip pick [ + ] [ - ] if ] 2map - nip ; + nip ; inline GENERIC: vs+ ( u v -- w ) -M: object vs+ [ + ] 2map ; +M: object vs+ [ + ] 2map ; inline GENERIC: vs- ( u v -- w ) -M: object vs- [ - ] 2map ; +M: object vs- [ - ] 2map ; inline GENERIC: vs* ( u v -- w ) -M: object vs* [ * ] 2map ; +M: object vs* [ * ] 2map ; inline GENERIC: vabs ( u -- v ) -M: object vabs [ abs ] map ; +M: object vabs [ abs ] map ; inline GENERIC: vsqrt ( u -- v ) -M: object vsqrt [ >float fsqrt ] map ; +M: object vsqrt [ >float fsqrt ] map ; inline GENERIC: vsad ( u v -- n ) -M: object vsad [ - abs ] [ + ] 2map-reduce ; +M: object vsad [ - abs ] [ + ] 2map-reduce ; inline GENERIC: vbitand ( u v -- w ) -M: object vbitand [ bitand ] 2map ; +M: object vbitand [ bitand ] 2map ; inline GENERIC: vbitandn ( u v -- w ) -M: object vbitandn [ bitandn ] 2map ; +M: object vbitandn [ bitandn ] 2map ; inline GENERIC: vbitor ( u v -- w ) -M: object vbitor [ bitor ] 2map ; +M: object vbitor [ bitor ] 2map ; inline GENERIC: vbitxor ( u v -- w ) -M: object vbitxor [ bitxor ] 2map ; +M: object vbitxor [ bitxor ] 2map ; inline GENERIC: vbitnot ( u -- w ) -M: object vbitnot [ bitnot ] map ; +M: object vbitnot [ bitnot ] map ; inline GENERIC# vbroadcast 1 ( u n -- v ) -M:: object vbroadcast ( u n -- v ) u length n u nth u like ; +M:: object vbroadcast ( u n -- v ) u length n u nth u like ; inline GENERIC# vshuffle-elements 1 ( u perm -- v ) M: object vshuffle-elements over length 0 pad-tail - swap [ '[ _ nth ] ] keep map-as ; + swap [ '[ _ nth ] ] keep map-as ; inline GENERIC# vshuffle-bytes 1 ( u perm -- v ) @@ -123,66 +123,66 @@ M: array vshuffle ( u perm -- v ) vshuffle-elements ; inline GENERIC# vlshift 1 ( u n -- w ) -M: object vlshift '[ _ shift ] map ; +M: object vlshift '[ _ shift ] map ; inline GENERIC# vrshift 1 ( u n -- w ) -M: object vrshift neg '[ _ shift ] map ; +M: object vrshift neg '[ _ shift ] map ; inline GENERIC# hlshift 1 ( u n -- w ) GENERIC# hrshift 1 ( u n -- w ) GENERIC: (vmerge-head) ( u v -- h ) -M: object (vmerge-head) over length 2 /i '[ _ head-slice ] bi@ [ zip ] keep concat-as ; +M: object (vmerge-head) over length 2 /i '[ _ head-slice ] bi@ [ zip ] keep concat-as ; inline GENERIC: (vmerge-tail) ( u v -- t ) -M: object (vmerge-tail) over length 2 /i '[ _ tail-slice ] bi@ [ zip ] keep concat-as ; +M: object (vmerge-tail) over length 2 /i '[ _ tail-slice ] bi@ [ zip ] keep concat-as ; inline GENERIC: (vmerge) ( u v -- h t ) M: object (vmerge) [ (vmerge-head) ] [ (vmerge-tail) ] 2bi ; inline GENERIC: vmerge ( u v -- w ) -M: object vmerge [ zip ] keep concat-as ; +M: object vmerge [ zip ] keep concat-as ; inline GENERIC: vand ( u v -- w ) -M: object vand [ and ] 2map ; +M: object vand [ and ] 2map ; inline GENERIC: vandn ( u v -- w ) -M: object vandn [ [ not ] dip and ] 2map ; +M: object vandn [ [ not ] dip and ] 2map ; inline GENERIC: vor ( u v -- w ) -M: object vor [ or ] 2map ; +M: object vor [ or ] 2map ; inline GENERIC: vxor ( u v -- w ) -M: object vxor [ xor ] 2map ; +M: object vxor [ xor ] 2map ; inline GENERIC: vnot ( u -- w ) -M: object vnot [ not ] map ; +M: object vnot [ not ] map ; inline GENERIC: vall? ( v -- ? ) -M: object vall? [ ] all? ; +M: object vall? [ ] all? ; inline GENERIC: vany? ( v -- ? ) -M: object vany? [ ] any? ; +M: object vany? [ ] any? ; inline GENERIC: vnone? ( v -- ? ) -M: object vnone? [ not ] all? ; +M: object vnone? [ not ] all? ; inline GENERIC: v< ( u v -- w ) -M: object v< [ < ] 2map ; +M: object v< [ < ] 2map ; inline GENERIC: v<= ( u v -- w ) -M: object v<= [ <= ] 2map ; +M: object v<= [ <= ] 2map ; inline GENERIC: v>= ( u v -- w ) -M: object v>= [ >= ] 2map ; +M: object v>= [ >= ] 2map ; inline GENERIC: v> ( u v -- w ) -M: object v> [ > ] 2map ; +M: object v> [ > ] 2map ; inline GENERIC: vunordered? ( u v -- w ) -M: object vunordered? [ unordered? ] 2map ; +M: object vunordered? [ unordered? ] 2map ; inline GENERIC: v= ( u v -- w ) -M: object v= [ = ] 2map ; +M: object v= [ = ] 2map ; inline GENERIC: v? ( mask true false -- result ) M: object v? @@ -203,17 +203,17 @@ M: object v? : vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ; inline GENERIC: v. ( u v -- x ) -M: object v. [ conjugate * ] [ + ] 2map-reduce ; +M: object v. [ conjugate * ] [ + ] 2map-reduce ; inline GENERIC: norm-sq ( v -- x ) -M: object norm-sq [ absq ] [ + ] map-reduce ; +M: object norm-sq [ absq ] [ + ] map-reduce ; inline : norm ( v -- x ) norm-sq sqrt ; inline : normalize ( u -- v ) dup norm v/n ; inline GENERIC: distance ( u v -- x ) -M: object distance [ - absq ] [ + ] 2map-reduce sqrt ; +M: object distance [ - absq ] [ + ] 2map-reduce sqrt ; inline : set-axis ( u v axis -- w ) [ [ zero? 2over ? ] dip swap nth ] map-index 2nip ; @@ -245,28 +245,3 @@ PRIVATE> : v~ ( a b epsilon -- ? ) [ ~ ] curry 2all? ; inline - -HINTS: M\ object vneg { array } ; -HINTS: M\ object norm-sq { array } ; -HINTS: norm { array } ; -HINTS: M\ object distance { array array } ; - -HINTS: M\ object n*v { object array } ; -HINTS: M\ object v*n { array object } ; -HINTS: M\ object n/v { object array } ; -HINTS: M\ object v/n { array object } ; - -HINTS: M\ object v+ { array array } ; -HINTS: M\ object v- { array array } ; -HINTS: M\ object v* { array array } ; -HINTS: M\ object v/ { array array } ; -HINTS: M\ object vmax { array array } ; -HINTS: M\ object vmin { array array } ; -HINTS: M\ object v. { array array } ; - -HINTS: vlerp { array array array } ; -HINTS: vnlerp { array array object } ; - -HINTS: bilerp { object object object object array } ; -HINTS: trilerp { object object object object object object object object array } ; - diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index ba7c2723e9..eda793ff22 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -101,11 +101,11 @@ SYNTAX: A@ scan-object scan-object suffix! ; INSTANCE: A specialized-array -M: A vs+ [ + \ T c-type-clamp ] 2map ; -M: A vs- [ - \ T c-type-clamp ] 2map ; -M: A vs* [ * \ T c-type-clamp ] 2map ; +M: A vs+ [ + \ T c-type-clamp ] 2map ; inline +M: A vs- [ - \ T c-type-clamp ] 2map ; inline +M: A vs* [ * \ T c-type-clamp ] 2map ; inline -M: A v*high [ * \ T heap-size neg shift ] 2map ; +M: A v*high [ * \ T heap-size neg shift ] 2map ; inline ;FUNCTOR diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index b217f4d659..bdf2cc65ed 100644 --- a/basis/stack-checker/known-words/known-words.factor +++ b/basis/stack-checker/known-words/known-words.factor @@ -486,8 +486,8 @@ M: bad-executable summary \ (word) { object object object } { word } define-primitive \ (word) make-flushable -\ word-xt { word } { integer integer } define-primitive -\ word-xt make-flushable +\ word-code { word } { integer integer } define-primitive +\ word-code make-flushable \ special-object { fixnum } { object } define-primitive \ special-object make-flushable @@ -648,6 +648,8 @@ M: bad-executable summary \ fseek { alien integer integer } { } define-primitive +\ ftell { alien } { integer } define-primitive + \ fclose { alien } { } define-primitive \ { object } { wrapper } define-primitive @@ -662,8 +664,8 @@ M: bad-executable summary \ array>quotation { array } { quotation } define-primitive \ array>quotation make-flushable -\ quotation-xt { quotation } { integer } define-primitive -\ quotation-xt make-flushable +\ quotation-code { quotation } { integer integer } define-primitive +\ quotation-code make-flushable \ { tuple-layout } { tuple } define-primitive \ make-flushable diff --git a/basis/tools/annotations/annotations-tests.factor b/basis/tools/annotations/annotations-tests.factor index c21e9e0c60..dcfc6ae522 100644 --- a/basis/tools/annotations/annotations-tests.factor +++ b/basis/tools/annotations/annotations-tests.factor @@ -1,5 +1,5 @@ USING: tools.test tools.annotations tools.time math parser eval -io.streams.string kernel strings ; +io.streams.string kernel strings sequences memory ; IN: tools.annotations.tests : foo ( -- ) ; @@ -60,3 +60,10 @@ M: object my-generic ; f my-generic drop ; [ ] [ some-code ] unit-test + +! Make sure annotations work on primitives +\ gc watch + +[ f ] [ [ gc ] with-string-writer empty? ] unit-test + +\ gc reset diff --git a/basis/tools/disassembler/disassembler.factor b/basis/tools/disassembler/disassembler.factor index 4aec909e88..c0b3c9a586 100644 --- a/basis/tools/disassembler/disassembler.factor +++ b/basis/tools/disassembler/disassembler.factor @@ -7,12 +7,16 @@ IN: tools.disassembler GENERIC: disassemble ( obj -- ) +spaces "\t" "\s" ; +PRIVATE> + M: byte-array disassemble [ [ malloc-byte-array &free alien-address dup ] @@ -22,7 +26,7 @@ M: byte-array disassemble M: pair disassemble first2 disassemble* [ tabs>spaces print ] each ; -M: word disassemble word-xt 2array disassemble ; +M: word disassemble word-code 2array disassemble ; M: quotation disassemble [ dup infer define-temp ] with-compilation-unit disassemble ; diff --git a/basis/tools/disassembler/gdb/gdb.factor b/basis/tools/disassembler/gdb/gdb.factor index c4c724b696..dda666ce6a 100644 --- a/basis/tools/disassembler/gdb/gdb.factor +++ b/basis/tools/disassembler/gdb/gdb.factor @@ -1,9 +1,9 @@ -! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia. +! Copyright (C) 2008, 2010 Slava Pestov, Jorge Acereda Macia. ! See http://factorcode.org/license.txt for BSD license. USING: io.files io.files.temp io words alien kernel math.parser -alien.syntax io.launcher assocs arrays sequences -namespaces make system math io.encodings.ascii -accessors tools.disassembler ; +alien.syntax io.launcher assocs arrays sequences namespaces make +system math io.encodings.ascii accessors tools.disassembler +tools.disassembler.private ; IN: tools.disassembler.gdb SINGLETON: gdb-disassembler diff --git a/basis/tools/disassembler/udis/udis.factor b/basis/tools/disassembler/udis/udis.factor index effb2d6f0e..82c47a5c84 100644 --- a/basis/tools/disassembler/udis/udis.factor +++ b/basis/tools/disassembler/udis/udis.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2008 Slava Pestov, Jorge Acereda Macia. +! Copyright (C) 2008, 2010 Slava Pestov, Jorge Acereda Macia. ! See http://factorcode.org/license.txt for BSD license. USING: tools.disassembler namespaces combinators alien alien.syntax alien.c-types lexer parser kernel sequences layouts math math.order alien.libraries math.parser system make fry arrays libc destructors -tools.disassembler.utils splitting alien.data -classes.struct ; +tools.disassembler.utils tools.disassembler.private splitting +alien.data classes.struct ; IN: tools.disassembler.udis << @@ -105,7 +105,7 @@ FUNCTION: char* ud_lookup_mnemonic ( int c ) ; dup UD_SYN_INTEL ud_set_syntax ; : with-ud ( quot: ( ud -- ) -- ) - [ [ [ ] dip call ] with-destructors ] with-words-xt ; inline + [ [ [ ] dip call ] with-destructors ] with-word-entry-points ; inline SINGLETON: udis-disassembler diff --git a/basis/tools/disassembler/utils/utils.factor b/basis/tools/disassembler/utils/utils.factor index fb936cf08a..60e094ac34 100644 --- a/basis/tools/disassembler/utils/utils.factor +++ b/basis/tools/disassembler/utils/utils.factor @@ -2,13 +2,13 @@ USING: accessors arrays binary-search kernel math math.order math.parser namespaces sequences sorting splitting vectors vocabs words ; IN: tools.disassembler.utils -SYMBOL: words-xt +SYMBOL: word-entry-points SYMBOL: smallest-xt SYMBOL: greatest-xt -: (words-xt) ( -- assoc ) - vocabs [ words ] map concat [ [ word-xt ] keep 3array ] map - [ [ first ] bi@ <=> ] sort >vector ; +: (word-entry-points) ( -- assoc ) + vocabs [ words ] map concat [ [ word-code ] keep 3array ] map + [ first ] sort-with ; : complete-address ( n seq -- str ) [ first - ] [ third name>> ] bi @@ -18,7 +18,7 @@ SYMBOL: greatest-xt dup [ smallest-xt get < ] [ greatest-xt get > ] bi or [ drop f ] [ - words-xt get over [ swap first <=> ] curry search nip + word-entry-points get over [ swap first <=> ] curry search nip 2dup second <= [ [ complete-address ] [ drop f ] if* ] [ @@ -33,9 +33,11 @@ SYMBOL: greatest-xt : resolve-call ( str -- str' ) "0x" split1-last [ resolve-xt "0x" glue ] when* ; -: with-words-xt ( quot -- ) - [ (words-xt) - [ words-xt set ] - [ first first smallest-xt set ] - [ last second greatest-xt set ] tri - ] prepose with-scope ; inline +: with-word-entry-points ( quot -- ) + [ + (word-entry-points) + [ word-entry-points set ] + [ first first smallest-xt set ] + [ last second greatest-xt set ] tri + call + ] with-scope ; inline diff --git a/build-support/cleanup b/build-support/cleanup index 2173619acb..06cb09a4dd 100644 --- a/build-support/cleanup +++ b/build-support/cleanup @@ -7,3 +7,4 @@ GNUmakefile Nmakefile unmaintained build-support +images diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 2a791bf42d..ef02340e9e 100644 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2004, 2009 Slava Pestov. +! Copyright (C) 2004, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien arrays byte-arrays generic hashtables -hashtables.private io kernel math math.private math.order -namespaces make parser sequences strings vectors words -quotations assocs layouts classes classes.builtin classes.tuple -classes.tuple.private kernel.private vocabs vocabs.loader -source-files definitions slots classes.union +USING: alien alien.strings arrays byte-arrays generic hashtables +hashtables.private io io.encodings.ascii kernel math +math.private math.order namespaces make parser sequences strings +vectors words quotations assocs layouts classes classes.builtin +classes.tuple classes.tuple.private kernel.private vocabs +vocabs.loader source-files definitions slots classes.union classes.intersection classes.predicate compiler.units bootstrap.image.private io.files accessors combinators ; IN: bootstrap.primitives @@ -309,7 +309,11 @@ tuple ! Sub-primitive words : make-sub-primitive ( word vocab effect -- ) - [ create dup 1quotation ] dip define-declared ; + [ + create + dup t "primitive" set-word-prop + dup 1quotation + ] dip define-declared ; { { "mega-cache-lookup" "generic.single.private" (( methods index cache -- )) } @@ -364,169 +368,173 @@ tuple } [ first3 make-sub-primitive ] each ! Primitive words -: make-primitive ( word vocab n effect -- ) +: make-primitive ( word vocab function effect -- ) [ - [ create dup reset-word ] dip - [ do-primitive ] curry + [ + create + dup reset-word + dup t "primitive" set-word-prop + ] dip + ascii string>alien [ do-primitive ] curry ] dip define-declared ; { - { "bignum>fixnum" "math.private" (( x -- y )) } - { "float>fixnum" "math.private" (( x -- y )) } - { "fixnum>bignum" "math.private" (( x -- y )) } - { "float>bignum" "math.private" (( x -- y )) } - { "fixnum>float" "math.private" (( x -- y )) } - { "bignum>float" "math.private" (( x -- y )) } - { "(string>float)" "math.parser.private" (( str -- n/f )) } - { "(float>string)" "math.parser.private" (( n -- str )) } - { "float>bits" "math" (( x -- n )) } - { "double>bits" "math" (( x -- n )) } - { "bits>float" "math" (( n -- x )) } - { "bits>double" "math" (( n -- x )) } - { "fixnum/i" "math.private" (( x y -- z )) } - { "fixnum/mod" "math.private" (( x y -- z w )) } - { "fixnum-shift" "math.private" (( x y -- z )) } - { "bignum=" "math.private" (( x y -- ? )) } - { "bignum+" "math.private" (( x y -- z )) } - { "bignum-" "math.private" (( x y -- z )) } - { "bignum*" "math.private" (( x y -- z )) } - { "bignum/i" "math.private" (( x y -- z )) } - { "bignum-mod" "math.private" (( x y -- z )) } - { "bignum/mod" "math.private" (( x y -- z w )) } - { "bignum-bitand" "math.private" (( x y -- z )) } - { "bignum-bitor" "math.private" (( x y -- z )) } - { "bignum-bitxor" "math.private" (( x y -- z )) } - { "bignum-bitnot" "math.private" (( x -- y )) } - { "bignum-shift" "math.private" (( x y -- z )) } - { "bignum<" "math.private" (( x y -- ? )) } - { "bignum<=" "math.private" (( x y -- ? )) } - { "bignum>" "math.private" (( x y -- ? )) } - { "bignum>=" "math.private" (( x y -- ? )) } - { "bignum-bit?" "math.private" (( n x -- ? )) } - { "bignum-log2" "math.private" (( x -- n )) } - { "byte-array>bignum" "math" (( x -- y )) } - { "float=" "math.private" (( x y -- ? )) } - { "float+" "math.private" (( x y -- z )) } - { "float-" "math.private" (( x y -- z )) } - { "float*" "math.private" (( x y -- z )) } - { "float/f" "math.private" (( x y -- z )) } - { "float-mod" "math.private" (( x y -- z )) } - { "float<" "math.private" (( x y -- ? )) } - { "float<=" "math.private" (( x y -- ? )) } - { "float>" "math.private" (( x y -- ? )) } - { "float>=" "math.private" (( x y -- ? )) } - { "float-u<" "math.private" (( x y -- ? )) } - { "float-u<=" "math.private" (( x y -- ? )) } - { "float-u>" "math.private" (( x y -- ? )) } - { "float-u>=" "math.private" (( x y -- ? )) } - { "(word)" "words.private" (( name vocab -- word )) } - { "word-xt" "words" (( word -- start end )) } - { "special-object" "kernel.private" (( n -- obj )) } - { "set-special-object" "kernel.private" (( obj n -- )) } - { "(exists?)" "io.files.private" (( path -- ? )) } - { "minor-gc" "memory" (( -- )) } - { "gc" "memory" (( -- )) } - { "compact-gc" "memory" (( -- )) } - { "(save-image)" "memory.private" (( path -- )) } - { "(save-image-and-exit)" "memory.private" (( path -- )) } - { "datastack" "kernel" (( -- ds )) } - { "retainstack" "kernel" (( -- rs )) } - { "callstack" "kernel" (( -- cs )) } - { "set-datastack" "kernel.private" (( ds -- )) } - { "set-retainstack" "kernel.private" (( rs -- )) } - { "(exit)" "system" (( n -- )) } - { "data-room" "memory" (( -- data-room )) } - { "code-room" "memory" (( -- code-room )) } - { "system-micros" "system" (( -- us )) } - { "nano-count" "system" (( -- ns )) } - { "modify-code-heap" "compiler.units" (( alist -- )) } - { "(dlopen)" "alien.libraries" (( path -- dll )) } - { "(dlsym)" "alien.libraries" (( name dll -- alien )) } - { "dlclose" "alien.libraries" (( dll -- )) } - { "" "byte-arrays" (( n -- byte-array )) } - { "(byte-array)" "byte-arrays" (( n -- byte-array )) } - { "" "alien" (( displacement c-ptr -- alien )) } - { "alien-signed-cell" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-signed-cell" "alien.accessors" (( value c-ptr n -- )) } - { "alien-unsigned-cell" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-unsigned-cell" "alien.accessors" (( value c-ptr n -- )) } - { "alien-signed-8" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-signed-8" "alien.accessors" (( value c-ptr n -- )) } - { "alien-unsigned-8" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-unsigned-8" "alien.accessors" (( value c-ptr n -- )) } - { "alien-signed-4" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-signed-4" "alien.accessors" (( value c-ptr n -- )) } - { "alien-unsigned-4" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-unsigned-4" "alien.accessors" (( value c-ptr n -- )) } - { "alien-signed-2" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-signed-2" "alien.accessors" (( value c-ptr n -- )) } - { "alien-unsigned-2" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-unsigned-2" "alien.accessors" (( value c-ptr n -- )) } - { "alien-signed-1" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-signed-1" "alien.accessors" (( value c-ptr n -- )) } - { "alien-unsigned-1" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-unsigned-1" "alien.accessors" (( value c-ptr n -- )) } - { "alien-float" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-float" "alien.accessors" (( value c-ptr n -- )) } - { "alien-double" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-double" "alien.accessors" (( value c-ptr n -- )) } - { "alien-cell" "alien.accessors" (( c-ptr n -- value )) } - { "set-alien-cell" "alien.accessors" (( value c-ptr n -- )) } - { "alien-address" "alien" (( c-ptr -- addr )) } - { "set-slot" "slots.private" (( value obj n -- )) } - { "string-nth" "strings.private" (( n string -- ch )) } - { "set-string-nth-fast" "strings.private" (( ch n string -- )) } - { "set-string-nth-slow" "strings.private" (( ch n string -- )) } - { "resize-array" "arrays" (( n array -- newarray )) } - { "resize-string" "strings" (( n str -- newstr )) } - { "" "arrays" (( n elt -- array )) } - { "all-instances" "memory" (( -- array )) } - { "size" "memory" (( obj -- n )) } - { "die" "kernel" (( -- )) } - { "(fopen)" "io.streams.c" (( path mode -- alien )) } - { "fgetc" "io.streams.c" (( alien -- ch/f )) } - { "fread" "io.streams.c" (( n alien -- str/f )) } - { "fputc" "io.streams.c" (( ch alien -- )) } - { "fwrite" "io.streams.c" (( string alien -- )) } - { "fflush" "io.streams.c" (( alien -- )) } - { "ftell" "io.streams.c" (( alien -- n )) } - { "fseek" "io.streams.c" (( alien offset whence -- )) } - { "fclose" "io.streams.c" (( alien -- )) } - { "" "kernel" (( obj -- wrapper )) } - { "(clone)" "kernel" (( obj -- newobj )) } - { "" "strings" (( n ch -- string )) } - { "array>quotation" "quotations.private" (( array -- quot )) } - { "quotation-xt" "quotations" (( quot -- xt )) } - { "" "classes.tuple.private" (( layout -- tuple )) } - { "profiling" "tools.profiler.private" (( ? -- )) } - { "become" "kernel.private" (( old new -- )) } - { "(sleep)" "threads.private" (( nanos -- )) } - { "" "classes.tuple.private" (( ... layout -- tuple )) } - { "callstack>array" "kernel" (( callstack -- array )) } - { "innermost-frame-executing" "kernel.private" (( callstack -- obj )) } - { "innermost-frame-scan" "kernel.private" (( callstack -- n )) } - { "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) } - { "call-clear" "kernel.private" (( quot -- * )) } - { "resize-byte-array" "byte-arrays" (( n byte-array -- newbyte-array )) } - { "dll-valid?" "alien.libraries" (( dll -- ? )) } - { "unimplemented" "kernel.private" (( -- * )) } - { "jit-compile" "quotations" (( quot -- )) } - { "load-locals" "locals.backend" (( ... n -- )) } - { "check-datastack" "kernel.private" (( array in# out# -- ? )) } - { "mega-cache-miss" "generic.single.private" (( methods index cache -- method )) } - { "lookup-method" "generic.single.private" (( object methods -- method )) } - { "reset-dispatch-stats" "tools.dispatch.private" (( -- )) } - { "dispatch-stats" "tools.dispatch.private" (( -- stats )) } - { "optimized?" "words" (( word -- ? )) } - { "quot-compiled?" "quotations" (( quot -- ? )) } - { "vm-ptr" "vm" (( -- ptr )) } - { "strip-stack-traces" "kernel.private" (( -- )) } - { "" "alien" (( return-rewind word -- alien )) } - { "enable-gc-events" "memory" (( -- )) } - { "disable-gc-events" "memory" (( -- events )) } - { "(identity-hashcode)" "kernel.private" (( obj -- code )) } - { "compute-identity-hashcode" "kernel.private" (( obj -- )) } -} [ [ first3 ] dip swap make-primitive ] each-index + { "" "alien" "primitive_callback" (( return-rewind word -- alien )) } + { "" "alien" "primitive_displaced_alien" (( displacement c-ptr -- alien )) } + { "alien-address" "alien" "primitive_alien_address" (( c-ptr -- addr )) } + { "alien-cell" "alien.accessors" "primitive_alien_cell" (( c-ptr n -- value )) } + { "alien-double" "alien.accessors" "primitive_alien_double" (( c-ptr n -- value )) } + { "alien-float" "alien.accessors" "primitive_alien_float" (( c-ptr n -- value )) } + { "alien-signed-1" "alien.accessors" "primitive_alien_signed_1" (( c-ptr n -- value )) } + { "alien-signed-2" "alien.accessors" "primitive_alien_signed_2" (( c-ptr n -- value )) } + { "alien-signed-4" "alien.accessors" "primitive_alien_signed_4" (( c-ptr n -- value )) } + { "alien-signed-8" "alien.accessors" "primitive_alien_signed_8" (( c-ptr n -- value )) } + { "alien-signed-cell" "alien.accessors" "primitive_alien_signed_cell" (( c-ptr n -- value )) } + { "alien-unsigned-1" "alien.accessors" "primitive_alien_unsigned_1" (( c-ptr n -- value )) } + { "alien-unsigned-2" "alien.accessors" "primitive_alien_unsigned_2" (( c-ptr n -- value )) } + { "alien-unsigned-4" "alien.accessors" "primitive_alien_unsigned_4" (( c-ptr n -- value )) } + { "alien-unsigned-8" "alien.accessors" "primitive_alien_unsigned_8" (( c-ptr n -- value )) } + { "alien-unsigned-cell" "alien.accessors" "primitive_alien_unsigned_cell" (( c-ptr n -- value )) } + { "set-alien-cell" "alien.accessors" "primitive_set_alien_cell" (( value c-ptr n -- )) } + { "set-alien-double" "alien.accessors" "primitive_set_alien_double" (( value c-ptr n -- )) } + { "set-alien-float" "alien.accessors" "primitive_set_alien_float" (( value c-ptr n -- )) } + { "set-alien-signed-1" "alien.accessors" "primitive_set_alien_signed_1" (( value c-ptr n -- )) } + { "set-alien-signed-2" "alien.accessors" "primitive_set_alien_signed_2" (( value c-ptr n -- )) } + { "set-alien-signed-4" "alien.accessors" "primitive_set_alien_signed_4" (( value c-ptr n -- )) } + { "set-alien-signed-8" "alien.accessors" "primitive_set_alien_signed_8" (( value c-ptr n -- )) } + { "set-alien-signed-cell" "alien.accessors" "primitive_set_alien_signed_cell" (( value c-ptr n -- )) } + { "set-alien-unsigned-1" "alien.accessors" "primitive_set_alien_unsigned_1" (( value c-ptr n -- )) } + { "set-alien-unsigned-2" "alien.accessors" "primitive_set_alien_unsigned_2" (( value c-ptr n -- )) } + { "set-alien-unsigned-4" "alien.accessors" "primitive_set_alien_unsigned_4" (( value c-ptr n -- )) } + { "set-alien-unsigned-8" "alien.accessors" "primitive_set_alien_unsigned_8" (( value c-ptr n -- )) } + { "set-alien-unsigned-cell" "alien.accessors" "primitive_set_alien_unsigned_cell" (( value c-ptr n -- )) } + { "(dlopen)" "alien.libraries" "primitive_dlopen" (( path -- dll )) } + { "(dlsym)" "alien.libraries" "primitive_dlsym" (( name dll -- alien )) } + { "dlclose" "alien.libraries" "primitive_dlclose" (( dll -- )) } + { "dll-valid?" "alien.libraries" "primitive_dll_validp" (( dll -- ? )) } + { "" "arrays" "primitive_array" (( n elt -- array )) } + { "resize-array" "arrays" "primitive_resize_array" (( n array -- newarray )) } + { "(byte-array)" "byte-arrays" "primitive_uninitialized_byte_array" (( n -- byte-array )) } + { "" "byte-arrays" "primitive_byte_array" (( n -- byte-array )) } + { "resize-byte-array" "byte-arrays" "primitive_resize_byte_array" (( n byte-array -- newbyte-array )) } + { "" "classes.tuple.private" "primitive_tuple_boa" (( ... layout -- tuple )) } + { "" "classes.tuple.private" "primitive_tuple" (( layout -- tuple )) } + { "modify-code-heap" "compiler.units" "primitive_modify_code_heap" (( alist -- )) } + { "lookup-method" "generic.single.private" "primitive_lookup_method" (( object methods -- method )) } + { "mega-cache-miss" "generic.single.private" "primitive_mega_cache_miss" (( methods index cache -- method )) } + { "(exists?)" "io.files.private" "primitive_existsp" (( path -- ? )) } + { "(fopen)" "io.streams.c" "primitive_fopen" (( path mode -- alien )) } + { "fclose" "io.streams.c" "primitive_fclose" (( alien -- )) } + { "fflush" "io.streams.c" "primitive_fflush" (( alien -- )) } + { "fgetc" "io.streams.c" "primitive_fgetc" (( alien -- ch/f )) } + { "fputc" "io.streams.c" "primitive_fputc" (( ch alien -- )) } + { "fread" "io.streams.c" "primitive_fread" (( n alien -- str/f )) } + { "fseek" "io.streams.c" "primitive_fseek" (( alien offset whence -- )) } + { "ftell" "io.streams.c" "primitive_ftell" (( alien -- n )) } + { "fwrite" "io.streams.c" "primitive_fwrite" (( string alien -- )) } + { "(clone)" "kernel" "primitive_clone" (( obj -- newobj )) } + { "" "kernel" "primitive_wrapper" (( obj -- wrapper )) } + { "callstack" "kernel" "primitive_callstack" (( -- cs )) } + { "callstack>array" "kernel" "primitive_callstack_to_array" (( callstack -- array )) } + { "datastack" "kernel" "primitive_datastack" (( -- ds )) } + { "die" "kernel" "primitive_die" (( -- )) } + { "retainstack" "kernel" "primitive_retainstack" (( -- rs )) } + { "(identity-hashcode)" "kernel.private" "primitive_identity_hashcode" (( obj -- code )) } + { "become" "kernel.private" "primitive_become" (( old new -- )) } + { "call-clear" "kernel.private" "primitive_call_clear" (( quot -- * )) } + { "check-datastack" "kernel.private" "primitive_check_datastack" (( array in# out# -- ? )) } + { "compute-identity-hashcode" "kernel.private" "primitive_compute_identity_hashcode" (( obj -- )) } + { "innermost-frame-executing" "kernel.private" "primitive_innermost_stack_frame_executing" (( callstack -- obj )) } + { "innermost-frame-scan" "kernel.private" "primitive_innermost_stack_frame_scan" (( callstack -- n )) } + { "set-datastack" "kernel.private" "primitive_set_datastack" (( ds -- )) } + { "set-innermost-frame-quot" "kernel.private" "primitive_set_innermost_stack_frame_quot" (( n callstack -- )) } + { "set-retainstack" "kernel.private" "primitive_set_retainstack" (( rs -- )) } + { "set-special-object" "kernel.private" "primitive_set_special_object" (( obj n -- )) } + { "special-object" "kernel.private" "primitive_special_object" (( n -- obj )) } + { "strip-stack-traces" "kernel.private" "primitive_strip_stack_traces" (( -- )) } + { "unimplemented" "kernel.private" "primitive_unimplemented" (( -- * )) } + { "load-locals" "locals.backend" "primitive_load_locals" (( ... n -- )) } + { "bits>double" "math" "primitive_bits_double" (( n -- x )) } + { "bits>float" "math" "primitive_bits_float" (( n -- x )) } + { "byte-array>bignum" "math" "primitive_byte_array_to_bignum" (( x -- y )) } + { "double>bits" "math" "primitive_double_bits" (( x -- n )) } + { "float>bits" "math" "primitive_float_bits" (( x -- n )) } + { "(float>string)" "math.parser.private" "primitive_float_to_str" (( n -- str )) } + { "(string>float)" "math.parser.private" "primitive_str_to_float" (( str -- n/f )) } + { "bignum*" "math.private" "primitive_bignum_multiply" (( x y -- z )) } + { "bignum+" "math.private" "primitive_bignum_add" (( x y -- z )) } + { "bignum-" "math.private" "primitive_bignum_subtract" (( x y -- z )) } + { "bignum-bit?" "math.private" "primitive_bignum_bitp" (( n x -- ? )) } + { "bignum-bitand" "math.private" "primitive_bignum_and" (( x y -- z )) } + { "bignum-bitnot" "math.private" "primitive_bignum_not" (( x -- y )) } + { "bignum-bitor" "math.private" "primitive_bignum_or" (( x y -- z )) } + { "bignum-bitxor" "math.private" "primitive_bignum_xor" (( x y -- z )) } + { "bignum-log2" "math.private" "primitive_bignum_log2" (( x -- n )) } + { "bignum-mod" "math.private" "primitive_bignum_mod" (( x y -- z )) } + { "bignum-shift" "math.private" "primitive_bignum_shift" (( x y -- z )) } + { "bignum/i" "math.private" "primitive_bignum_divint" (( x y -- z )) } + { "bignum/mod" "math.private" "primitive_bignum_divmod" (( x y -- z w )) } + { "bignum<" "math.private" "primitive_bignum_less" (( x y -- ? )) } + { "bignum<=" "math.private" "primitive_bignum_lesseq" (( x y -- ? )) } + { "bignum=" "math.private" "primitive_bignum_eq" (( x y -- ? )) } + { "bignum>" "math.private" "primitive_bignum_greater" (( x y -- ? )) } + { "bignum>=" "math.private" "primitive_bignum_greatereq" (( x y -- ? )) } + { "bignum>fixnum" "math.private" "primitive_bignum_to_fixnum" (( x -- y )) } + { "bignum>float" "math.private" "primitive_bignum_to_float" (( x -- y )) } + { "fixnum-shift" "math.private" "primitive_fixnum_shift" (( x y -- z )) } + { "fixnum/i" "math.private" "primitive_fixnum_divint" (( x y -- z )) } + { "fixnum/mod" "math.private" "primitive_fixnum_divmod" (( x y -- z w )) } + { "fixnum>bignum" "math.private" "primitive_fixnum_to_bignum" (( x -- y )) } + { "fixnum>float" "math.private" "primitive_fixnum_to_float" (( x -- y )) } + { "float*" "math.private" "primitive_float_multiply" (( x y -- z )) } + { "float+" "math.private" "primitive_float_add" (( x y -- z )) } + { "float-" "math.private" "primitive_float_subtract" (( x y -- z )) } + { "float-mod" "math.private" "primitive_float_mod" (( x y -- z )) } + { "float-u<" "math.private" "primitive_float_less" (( x y -- ? )) } + { "float-u<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) } + { "float-u>" "math.private" "primitive_float_greater" (( x y -- ? )) } + { "float-u>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) } + { "float/f" "math.private" "primitive_float_divfloat" (( x y -- z )) } + { "float<" "math.private" "primitive_float_less" (( x y -- ? )) } + { "float<=" "math.private" "primitive_float_lesseq" (( x y -- ? )) } + { "float=" "math.private" "primitive_float_eq" (( x y -- ? )) } + { "float>" "math.private" "primitive_float_greater" (( x y -- ? )) } + { "float>=" "math.private" "primitive_float_greatereq" (( x y -- ? )) } + { "float>bignum" "math.private" "primitive_float_to_bignum" (( x -- y )) } + { "float>fixnum" "math.private" "primitive_float_to_fixnum" (( x -- y )) } + { "all-instances" "memory" "primitive_all_instances" (( -- array )) } + { "code-room" "memory" "primitive_code_room" (( -- code-room )) } + { "compact-gc" "memory" "primitive_compact_gc" (( -- )) } + { "data-room" "memory" "primitive_data_room" (( -- data-room )) } + { "disable-gc-events" "memory" "primitive_disable_gc_events" (( -- events )) } + { "enable-gc-events" "memory" "primitive_enable_gc_events" (( -- )) } + { "gc" "memory" "primitive_full_gc" (( -- )) } + { "minor-gc" "memory" "primitive_minor_gc" (( -- )) } + { "size" "memory" "primitive_size" (( obj -- n )) } + { "(save-image)" "memory.private" "primitive_save_image" (( path -- )) } + { "(save-image-and-exit)" "memory.private" "primitive_save_image_and_exit" (( path -- )) } + { "jit-compile" "quotations" "primitive_jit_compile" (( quot -- )) } + { "quot-compiled?" "quotations" "primitive_quot_compiled_p" (( quot -- ? )) } + { "quotation-code" "quotations" "primitive_quotation_code" (( quot -- start end )) } + { "array>quotation" "quotations.private" "primitive_array_to_quotation" (( array -- quot )) } + { "set-slot" "slots.private" "primitive_set_slot" (( value obj n -- )) } + { "" "strings" "primitive_string" (( n ch -- string )) } + { "resize-string" "strings" "primitive_resize_string" (( n str -- newstr )) } + { "set-string-nth-fast" "strings.private" "primitive_set_string_nth_fast" (( ch n string -- )) } + { "set-string-nth-slow" "strings.private" "primitive_set_string_nth_slow" (( ch n string -- )) } + { "string-nth" "strings.private" "primitive_string_nth" (( n string -- ch )) } + { "(exit)" "system" "primitive_exit" (( n -- )) } + { "nano-count" "system" "primitive_nano_count" (( -- ns )) } + { "system-micros" "system" "primitive_system_micros" (( -- us )) } + { "(sleep)" "threads.private" "primitive_sleep" (( nanos -- )) } + { "dispatch-stats" "tools.dispatch.private" "primitive_dispatch_stats" (( -- stats )) } + { "reset-dispatch-stats" "tools.dispatch.private" "primitive_reset_dispatch_stats" (( -- )) } + { "profiling" "tools.profiler.private" "primitive_profiling" (( ? -- )) } + { "vm-ptr" "vm" "primitive_vm_ptr" (( -- ptr )) } + { "optimized?" "words" "primitive_optimized_p" (( word -- ? )) } + { "word-code" "words" "primitive_word_code" (( word -- start end )) } + { "(word)" "words.private" "primitive_word" (( name vocab -- word )) } +} [ first4 make-primitive ] each ! Bump build number "build" "kernel" create build 1 + [ ] curry (( -- n )) define-declared diff --git a/core/quotations/quotations-docs.factor b/core/quotations/quotations-docs.factor index b6be8d36f3..e99a7ef695 100644 --- a/core/quotations/quotations-docs.factor +++ b/core/quotations/quotations-docs.factor @@ -3,7 +3,9 @@ vectors kernel combinators ; IN: quotations ARTICLE: "quotations" "Quotations" -"A quotation is an anonymous function (a value denoting a snippet of code) which can be used as a value and called. Quotations are delimited by square brackets (" { $snippet "[ ]" } "); see " { $link "syntax-quots" } " for details on their syntax." +"A quotation is an anonymous function (a value denoting a snippet of code) which can be used as a value and called using the " { $link "call" } "." +$nl +"Quotation literals appearing in source code are delimited by square brackets, for example " { $snippet "[ 2 + ]" } "; see " { $link "syntax-quots" } " for details on their syntax." $nl "Quotations form a class of objects:" { $subsections diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index 7d1e45aca0..b8a8d5f89d 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -221,8 +221,8 @@ TUPLE: slice-error from to seq reason ; 3tri ; inline : ( from to seq -- slice ) - dup slice? [ collapse-slice ] when check-slice + dup slice? [ collapse-slice ] when slice boa ; inline M: slice virtual-exemplar seq>> ; inline @@ -836,6 +836,12 @@ PRIVATE> [ 3dup ] dip [ + swap nth-unsafe ] keep rot nth-unsafe = ] all? nip ; inline +: prepare-2map-reduce ( seq1 seq2 map-quot -- initial length seq1 seq2 ) + [ drop min-length dup 1 < [ "Empty sequence" throw ] when 1 - ] + [ drop [ [ 1 + ] 2dip 2nth-unsafe ] 2curry ] + [ [ [ first-unsafe ] bi@ ] dip call ] + 3tri -rot ; inline + PRIVATE> : start* ( subseq seq n -- i ) @@ -868,8 +874,8 @@ PRIVATE> compose reduce ; inline : 2map-reduce ( seq1 seq2 map-quot reduce-quot -- result ) - [ [ 2unclip-slice ] dip [ call ] keep ] dip - compose 2reduce ; inline + [ [ prepare-2map-reduce ] keep ] dip + compose compose each-integer ; inline > ; -ERROR: undefined ; - -PREDICATE: deferred < word ( obj -- ? ) - def>> [ undefined ] = ; -M: deferred definer drop \ DEFER: f ; -M: deferred definition drop f ; - -PREDICATE: primitive < word ( obj -- ? ) - [ def>> [ do-primitive ] tail? ] - [ sub-primitive>> >boolean ] - bi or ; -M: primitive definer drop \ PRIMITIVE: f ; -M: primitive definition drop f ; - : word-prop ( word name -- value ) swap props>> at ; : remove-word-prop ( word name -- ) swap props>> delete-at ; @@ -46,6 +32,16 @@ M: primitive definition drop f ; : reset-props ( word seq -- ) [ remove-word-prop ] with each ; +ERROR: undefined ; + +PREDICATE: deferred < word ( obj -- ? ) def>> [ undefined ] = ; +M: deferred definer drop \ DEFER: f ; +M: deferred definition drop f ; + +PREDICATE: primitive < word ( obj -- ? ) "primitive" word-prop ; +M: primitive definer drop \ PRIMITIVE: f ; +M: primitive definition drop f ; + : lookup ( name vocab -- word ) vocab-words at ; : target-word ( word -- target ) diff --git a/vm/alien.cpp b/vm/alien.cpp index 48fda5d752..b15ffee2c9 100755 --- a/vm/alien.cpp +++ b/vm/alien.cpp @@ -102,11 +102,11 @@ void *factor_vm::alien_pointer() /* define words to read/write values at an alien address */ #define DEFINE_ALIEN_ACCESSOR(name,type,from,to) \ - PRIMITIVE(alien_##name) \ + VM_C_API void primitive_alien_##name(factor_vm *parent) \ { \ parent->ctx->push(from(*(type*)(parent->alien_pointer()),parent)); \ } \ - PRIMITIVE(set_alien_##name) \ + VM_C_API void primitive_set_alien_##name(factor_vm *parent) \ { \ type *ptr = (type *)parent->alien_pointer(); \ type value = (type)to(parent->ctx->pop(),parent); \ diff --git a/vm/callbacks.cpp b/vm/callbacks.cpp index ebb66bae12..416c1395d4 100644 --- a/vm/callbacks.cpp +++ b/vm/callbacks.cpp @@ -38,7 +38,7 @@ void callback_heap::store_callback_operand(code_block *stub, cell index, cell va void callback_heap::update(code_block *stub) { - store_callback_operand(stub,1,(cell)callback_xt(stub)); + store_callback_operand(stub,1,(cell)callback_entry_point(stub)); stub->flush_icache(); } @@ -60,7 +60,7 @@ code_block *callback_heap::add(cell owner, cell return_rewind) stub->parameters = false_object; stub->relocation = false_object; - memcpy(stub->xt(),insns->data(),size); + memcpy(stub->entry_point(),insns->data(),size); /* Store VM pointer */ store_callback_operand(stub,0,(cell)parent); @@ -99,7 +99,7 @@ void factor_vm::primitive_callback() tagged w(ctx->pop()); w.untag_check(this); - ctx->push(allot_alien(callbacks->add(w.value(),return_rewind)->xt())); + ctx->push(allot_alien(callbacks->add(w.value(),return_rewind)->entry_point())); } } diff --git a/vm/callbacks.hpp b/vm/callbacks.hpp index 0bed3f406d..607984ad23 100644 --- a/vm/callbacks.hpp +++ b/vm/callbacks.hpp @@ -4,13 +4,13 @@ namespace factor /* The callback heap is used to store the machine code that alien-callbacks actually jump to when C code invokes them. -The callback heap has entries that look like code_blocks from the code heap, -but callback heap entries are allocated contiguously, never deallocated, and all +The callback heap has entries that look like code_blocks from the code heap, but +callback heap entries are allocated contiguously, never deallocated, and all fields but the owner are set to false_object. The owner points to the callback -bottom word, whose XT is the callback body itself, generated by the optimizing -compiler. The machine code that follows a callback stub consists of a single -CALLBACK_STUB machine code template, which performs a jump to a "far" address -(on PowerPC and x86-64, its loaded into a register first). +bottom word, whose entry point is the callback body itself, generated by the +optimizing compiler. The machine code that follows a callback stub consists of a +single CALLBACK_STUB machine code template, which performs a jump to a "far" +address (on PowerPC and x86-64, its loaded into a register first). GC updates the CALLBACK_STUB code if the code block of the callback bottom word is ever moved. The callback stub itself won't move, though, and is never @@ -32,10 +32,10 @@ struct callback_heap { explicit callback_heap(cell size, factor_vm *parent); ~callback_heap(); - void *callback_xt(code_block *stub) + void *callback_entry_point(code_block *stub) { word *w = (word *)UNTAG(stub->owner); - return w->xt; + return w->entry_point; } void store_callback_operand(code_block *stub, cell index, cell value); diff --git a/vm/callstack.cpp b/vm/callstack.cpp index b6742534b9..4aa9321353 100755 --- a/vm/callstack.cpp +++ b/vm/callstack.cpp @@ -6,7 +6,7 @@ namespace factor void factor_vm::check_frame(stack_frame *frame) { #ifdef FACTOR_DEBUG - check_code_pointer((cell)frame->xt); + check_code_pointer((cell)frame->entry_point); assert(frame->size != 0); #endif } @@ -63,7 +63,7 @@ void factor_vm::primitive_callstack() code_block *factor_vm::frame_code(stack_frame *frame) { check_frame(frame); - return (code_block *)frame->xt - 1; + return (code_block *)frame->entry_point - 1; } code_block_type factor_vm::frame_type(stack_frame *frame) @@ -105,10 +105,10 @@ cell factor_vm::frame_scan(stack_frame *frame) if(obj.type_p(QUOTATION_TYPE)) { char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this); - char *quot_xt = (char *)(frame_code(frame) + 1); + char *quot_entry_point = (char *)(frame_code(frame) + 1); return tag_fixnum(quot_code_offset_to_scan( - obj.value(),(cell)(return_addr - quot_xt))); + obj.value(),(cell)(return_addr - quot_entry_point))); } else return false_object; @@ -190,9 +190,9 @@ void factor_vm::primitive_set_innermost_stack_frame_quot() jit_compile_quot(quot.value(),true); stack_frame *inner = innermost_stack_frame(callstack.untagged()); - cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt; - inner->xt = quot->xt; - FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset; + cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->entry_point; + inner->entry_point = quot->entry_point; + FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->entry_point + offset; } } diff --git a/vm/code_block_visitor.hpp b/vm/code_block_visitor.hpp index dce82843f8..ac5d140783 100644 --- a/vm/code_block_visitor.hpp +++ b/vm/code_block_visitor.hpp @@ -42,12 +42,12 @@ struct call_frame_code_block_visitor { void operator()(stack_frame *frame) { - cell offset = (cell)FRAME_RETURN_ADDRESS(frame,parent) - (cell)frame->xt; + cell offset = (cell)FRAME_RETURN_ADDRESS(frame,parent) - (cell)frame->entry_point; code_block *new_block = visitor(parent->frame_code(frame)); - frame->xt = new_block->xt(); + frame->entry_point = new_block->entry_point(); - FRAME_RETURN_ADDRESS(frame,parent) = (void *)((cell)frame->xt + offset); + FRAME_RETURN_ADDRESS(frame,parent) = (void *)((cell)frame->entry_point + offset); } }; @@ -64,14 +64,14 @@ void code_block_visitor::visit_object_code_block(object *obj) if(w->profiling) w->profiling = visitor(w->profiling); - parent->update_word_xt(w); + parent->update_word_entry_point(w); break; } case QUOTATION_TYPE: { quotation *q = (quotation *)obj; if(q->code) - parent->set_quot_xt(q,visitor(q->code)); + parent->set_quot_entry_point(q,visitor(q->code)); break; } case CALLSTACK_TYPE: @@ -93,7 +93,9 @@ struct embedded_code_pointers_visitor { void operator()(instruction_operand op) { relocation_type type = op.rel_type(); - if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL) + if(type == RT_ENTRY_POINT + || type == RT_ENTRY_POINT_PIC + || type == RT_ENTRY_POINT_PIC_TAIL) op.store_code_block(visitor(op.load_code_block())); } }; diff --git a/vm/code_blocks.cpp b/vm/code_blocks.cpp index aaa4369a1d..89106499da 100755 --- a/vm/code_blocks.cpp +++ b/vm/code_blocks.cpp @@ -3,44 +3,44 @@ namespace factor { -cell factor_vm::compute_xt_address(cell obj) +cell factor_vm::compute_entry_point_address(cell obj) { switch(tagged(obj).type()) { case WORD_TYPE: - return (cell)untag(obj)->xt; + return (cell)untag(obj)->entry_point; case QUOTATION_TYPE: - return (cell)untag(obj)->xt; + return (cell)untag(obj)->entry_point; default: critical_error("Expected word or quotation",obj); return 0; } } -cell factor_vm::compute_xt_pic_address(word *w, cell tagged_quot) +cell factor_vm::compute_entry_point_pic_address(word *w, cell tagged_quot) { if(!to_boolean(tagged_quot) || max_pic_size == 0) - return (cell)w->xt; + return (cell)w->entry_point; else { quotation *quot = untag(tagged_quot); if(quot_compiled_p(quot)) - return (cell)quot->xt; + return (cell)quot->entry_point; else - return (cell)w->xt; + return (cell)w->entry_point; } } -cell factor_vm::compute_xt_pic_address(cell w_) +cell factor_vm::compute_entry_point_pic_address(cell w_) { tagged w(w_); - return compute_xt_pic_address(w.untagged(),w->pic_def); + return compute_entry_point_pic_address(w.untagged(),w->pic_def); } -cell factor_vm::compute_xt_pic_tail_address(cell w_) +cell factor_vm::compute_entry_point_pic_tail_address(cell w_) { tagged w(w_); - return compute_xt_pic_address(w.untagged(),w->pic_tail_def); + return compute_entry_point_pic_address(w.untagged(),w->pic_tail_def); } cell factor_vm::code_block_owner(code_block *compiled) @@ -74,25 +74,28 @@ struct update_word_references_relocation_visitor { { switch(op.rel_type()) { - case RT_XT: + case RT_ENTRY_POINT: { code_block *compiled = op.load_code_block(); cell owner = compiled->owner; - if(to_boolean(owner)) op.store_value(parent->compute_xt_address(owner)); + if(to_boolean(owner)) + op.store_value(parent->compute_entry_point_address(owner)); break; } - case RT_XT_PIC: + case RT_ENTRY_POINT_PIC: { code_block *compiled = op.load_code_block(); cell owner = parent->code_block_owner(compiled); - if(to_boolean(owner)) op.store_value(parent->compute_xt_pic_address(owner)); + if(to_boolean(owner)) + op.store_value(parent->compute_entry_point_pic_address(owner)); break; } - case RT_XT_PIC_TAIL: + case RT_ENTRY_POINT_PIC_TAIL: { code_block *compiled = op.load_code_block(); cell owner = parent->code_block_owner(compiled); - if(to_boolean(owner)) op.store_value(parent->compute_xt_pic_tail_address(owner)); + if(to_boolean(owner)) + op.store_value(parent->compute_entry_point_pic_tail_address(owner)); break; } default: @@ -111,7 +114,7 @@ void factor_vm::update_word_references(code_block *compiled) initialize_code_block(compiled); /* update_word_references() is always applied to every block in the code heap. Since it resets all call sites to point to - their canonical XT (cold entry point for non-tail calls, + their canonical entry point (cold entry point for non-tail calls, standard entry point for tail calls), it means that no PICs are referenced after this is done. So instead of polluting the code heap with dead PICs that will be freed on the next @@ -133,12 +136,6 @@ void factor_vm::check_code_address(cell address) #endif } - -cell factor_vm::compute_primitive_address(cell arg) -{ - return (cell)primitives[untag_fixnum(arg)]; -} - /* References to undefined symbols are patched up to call this function on image load */ void factor_vm::undefined_symbol() @@ -193,11 +190,6 @@ cell factor_vm::compute_dlsym_address(array *literals, cell index) } } -cell factor_vm::compute_context_address() -{ - return (cell)&ctx; -} - cell factor_vm::compute_vm_address(cell arg) { return (cell)this + untag_fixnum(arg); @@ -211,17 +203,11 @@ void factor_vm::store_external_address(instruction_operand op) switch(op.rel_type()) { - case RT_PRIMITIVE: - op.store_value(compute_primitive_address(array_nth(parameters,index))); - break; case RT_DLSYM: op.store_value(compute_dlsym_address(parameters,index)); break; case RT_THIS: - op.store_value((cell)compiled->xt()); - break; - case RT_CONTEXT: - op.store_value(compute_context_address()); + op.store_value((cell)compiled->entry_point()); break; case RT_MEGAMORPHIC_CACHE_HITS: op.store_value((cell)&dispatch_stats.megamorphic_cache_hits); @@ -244,7 +230,10 @@ void factor_vm::store_external_address(instruction_operand op) cell factor_vm::compute_here_address(cell arg, cell offset, code_block *compiled) { fixnum n = untag_fixnum(arg); - return n >= 0 ? ((cell)compiled->xt() + offset + n) : ((cell)compiled->xt() - n); + if(n >= 0) + return (cell)compiled->entry_point() + offset + n; + else + return (cell)compiled->entry_point() - n; } struct initial_code_block_visitor { @@ -267,14 +256,14 @@ struct initial_code_block_visitor { case RT_LITERAL: op.store_value(next_literal()); break; - case RT_XT: - op.store_value(parent->compute_xt_address(next_literal())); + case RT_ENTRY_POINT: + op.store_value(parent->compute_entry_point_address(next_literal())); break; - case RT_XT_PIC: - op.store_value(parent->compute_xt_pic_address(next_literal())); + case RT_ENTRY_POINT_PIC: + op.store_value(parent->compute_entry_point_pic_address(next_literal())); break; - case RT_XT_PIC_TAIL: - op.store_value(parent->compute_xt_pic_tail_address(next_literal())); + case RT_ENTRY_POINT_PIC_TAIL: + op.store_value(parent->compute_entry_point_pic_tail_address(next_literal())); break; case RT_HERE: op.store_value(parent->compute_here_address(next_literal(),op.rel_offset(),op.parent_code_block())); @@ -320,7 +309,7 @@ void factor_vm::fixup_labels(array *labels, code_block *compiled) relocation_entry new_entry(RT_HERE,rel_class,offset); instruction_operand op(new_entry,compiled,0); - op.store_value(target + (cell)compiled->xt()); + op.store_value(target + (cell)compiled->entry_point()); } } diff --git a/vm/code_blocks.hpp b/vm/code_blocks.hpp index 35abe22342..baf763357c 100644 --- a/vm/code_blocks.hpp +++ b/vm/code_blocks.hpp @@ -43,7 +43,7 @@ struct code_block return size; } - void *xt() const + void *entry_point() const { return (void *)(this + 1); } diff --git a/vm/code_heap.cpp b/vm/code_heap.cpp index ac1c0157d2..b0435bb11f 100755 --- a/vm/code_heap.cpp +++ b/vm/code_heap.cpp @@ -141,7 +141,7 @@ void factor_vm::primitive_modify_code_heap() break; } - update_word_xt(word.untagged()); + update_word_entry_point(word.untagged()); } update_code_heap_words(); diff --git a/vm/compaction.cpp b/vm/compaction.cpp index 240a725a08..5e52c70b0c 100644 --- a/vm/compaction.cpp +++ b/vm/compaction.cpp @@ -104,16 +104,16 @@ struct code_block_compaction_relocation_visitor { void operator()(instruction_operand op) { - cell old_offset = op.rel_offset() + (cell)old_address->xt(); + cell old_offset = op.rel_offset() + (cell)old_address->entry_point(); switch(op.rel_type()) { case RT_LITERAL: op.store_value(slot_forwarder.visit_pointer(op.load_value(old_offset))); break; - case RT_XT: - case RT_XT_PIC: - case RT_XT_PIC_TAIL: + case RT_ENTRY_POINT: + case RT_ENTRY_POINT_PIC: + case RT_ENTRY_POINT_PIC_TAIL: op.store_code_block(code_forwarder.visit_code_block(op.load_code_block(old_offset))); break; case RT_HERE: diff --git a/vm/debug.cpp b/vm/debug.cpp index dc87c5f301..419eb690ff 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -171,7 +171,7 @@ struct stack_frame_printer { std::cout << std::hex << (cell)parent->frame_executing(frame) << std::dec; std::cout << std::endl; std::cout << "word/quot xt: "; - std::cout << std::hex << (cell)frame->xt << std::dec; + std::cout << std::hex << (cell)frame->entry_point << std::dec; std::cout << std::endl; std::cout << "return address: "; std::cout << std::hex << (cell)FRAME_RETURN_ADDRESS(frame,parent) << std::dec; diff --git a/vm/entry_points.cpp b/vm/entry_points.cpp index f5f37ce00e..e07e343a96 100644 --- a/vm/entry_points.cpp +++ b/vm/entry_points.cpp @@ -13,7 +13,7 @@ void factor_vm::c_to_factor(cell quot) { tagged c_to_factor_word(special_objects[C_TO_FACTOR_WORD]); code_block *c_to_factor_block = callbacks->add(c_to_factor_word.value(),0); - c_to_factor_func = (c_to_factor_func_type)c_to_factor_block->xt(); + c_to_factor_func = (c_to_factor_func_type)c_to_factor_block->entry_point(); } c_to_factor_func(quot); @@ -22,7 +22,7 @@ void factor_vm::c_to_factor(cell quot) void factor_vm::unwind_native_frames(cell quot, stack_frame *to) { tagged unwind_native_frames_word(special_objects[UNWIND_NATIVE_FRAMES_WORD]); - unwind_native_frames_func_type unwind_native_frames_func = (unwind_native_frames_func_type)unwind_native_frames_word->xt; + unwind_native_frames_func_type unwind_native_frames_func = (unwind_native_frames_func_type)unwind_native_frames_word->entry_point; unwind_native_frames_func(quot,to); } diff --git a/vm/image.cpp b/vm/image.cpp index cda07c9b0e..68701c4736 100755 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -178,16 +178,16 @@ struct code_block_fixup_relocation_visitor { void operator()(instruction_operand op) { code_block *compiled = op.parent_code_block(); - cell old_offset = op.rel_offset() + (cell)compiled->xt() - code_offset; + cell old_offset = op.rel_offset() + (cell)compiled->entry_point() - code_offset; switch(op.rel_type()) { case RT_LITERAL: op.store_value(data_visitor.visit_pointer(op.load_value(old_offset))); break; - case RT_XT: - case RT_XT_PIC: - case RT_XT_PIC_TAIL: + case RT_ENTRY_POINT: + case RT_ENTRY_POINT_PIC: + case RT_ENTRY_POINT_PIC_TAIL: op.store_code_block(code_visitor(op.load_code_block(old_offset))); break; case RT_HERE: diff --git a/vm/inline_cache.cpp b/vm/inline_cache.cpp index 092b210cc8..c8a1b22879 100755 --- a/vm/inline_cache.cpp +++ b/vm/inline_cache.cpp @@ -11,10 +11,10 @@ void factor_vm::init_inline_caching(int max_size) void factor_vm::deallocate_inline_cache(cell return_address) { /* Find the call target. */ - void *old_xt = get_call_target(return_address); - check_code_pointer((cell)old_xt); + void *old_entry_point = get_call_target(return_address); + check_code_pointer((cell)old_entry_point); - code_block *old_block = (code_block *)old_xt - 1; + code_block *old_block = (code_block *)old_entry_point - 1; /* Free the old PIC since we know its unreachable */ if(old_block->pic_p()) @@ -148,7 +148,7 @@ code_block *factor_vm::compile_inline_cache(fixnum index, /* A generic word's definition performs general method lookup. */ void *factor_vm::megamorphic_call_stub(cell generic_word) { - return untag(generic_word)->xt; + return untag(generic_word)->entry_point; } cell factor_vm::inline_cache_size(cell cache_entries) @@ -226,7 +226,7 @@ void *factor_vm::inline_cache_miss(cell return_address_) generic_word.value(), methods.value(), new_cache_entries.value(), - tail_call_site)->xt(); + tail_call_site)->entry_point(); } /* Install the new stub. */ diff --git a/vm/instruction_operands.cpp b/vm/instruction_operands.cpp index e022b093c4..db869d9d01 100644 --- a/vm/instruction_operands.cpp +++ b/vm/instruction_operands.cpp @@ -4,7 +4,7 @@ namespace factor { instruction_operand::instruction_operand(relocation_entry rel_, code_block *compiled_, cell index_) : - rel(rel_), compiled(compiled_), index(index_), pointer((cell)compiled_->xt() + rel_.rel_offset()) {} + rel(rel_), compiled(compiled_), index(index_), pointer((cell)compiled_->entry_point() + rel_.rel_offset()) {} /* Load a 32-bit value from a PowerPC LIS/ORI sequence */ fixnum instruction_operand::load_value_2_2() @@ -132,7 +132,7 @@ void instruction_operand::store_value(fixnum absolute_value) void instruction_operand::store_code_block(code_block *compiled) { - store_value((cell)compiled->xt()); + store_value((cell)compiled->entry_point()); } } diff --git a/vm/instruction_operands.hpp b/vm/instruction_operands.hpp index 0798e5178f..d46b5cf391 100644 --- a/vm/instruction_operands.hpp +++ b/vm/instruction_operands.hpp @@ -2,26 +2,20 @@ namespace factor { enum relocation_type { - /* arg is a primitive number */ - RT_PRIMITIVE, - /* arg is a literal table index, holding an array pair (symbol/dll) */ + /* arg is a literal table index, holding a pair (symbol/dll) */ RT_DLSYM, - /* a pointer to a compiled word reference */ - RT_DISPATCH, /* a word or quotation's general entry point */ - RT_XT, + RT_ENTRY_POINT, /* a word's PIC entry point */ - RT_XT_PIC, + RT_ENTRY_POINT_PIC, /* a word's tail-call PIC entry point */ - RT_XT_PIC_TAIL, + RT_ENTRY_POINT_PIC_TAIL, /* current offset */ RT_HERE, /* current code block */ RT_THIS, /* data heap literal */ RT_LITERAL, - /* address of ctx var */ - RT_CONTEXT, /* untagged fixnum literal */ RT_UNTAGGED, /* address of megamorphic_cache_hits var */ @@ -97,19 +91,17 @@ struct relocation_entry { { switch(rel_type()) { - case RT_PRIMITIVE: case RT_VM: return 1; case RT_DLSYM: return 2; - case RT_XT: - case RT_XT_PIC: - case RT_XT_PIC_TAIL: + case RT_ENTRY_POINT: + case RT_ENTRY_POINT_PIC: + case RT_ENTRY_POINT_PIC_TAIL: case RT_LITERAL: case RT_HERE: case RT_UNTAGGED: case RT_THIS: - case RT_CONTEXT: case RT_MEGAMORPHIC_CACHE_HITS: case RT_CARDS_OFFSET: case RT_DECKS_OFFSET: diff --git a/vm/layouts.hpp b/vm/layouts.hpp index 2a3eee9214..9b574e554d 100644 --- a/vm/layouts.hpp +++ b/vm/layouts.hpp @@ -232,8 +232,8 @@ struct word : public object { cell counter; /* TAGGED machine code for sub-primitive */ cell subprimitive; - /* UNTAGGED execution token: jump here to execute word */ - void *xt; + /* UNTAGGED entry point: jump here to execute word */ + void *entry_point; /* UNTAGGED compiled code block */ code_block *code; /* UNTAGGED profiler stub */ @@ -266,8 +266,8 @@ struct quotation : public object { cell cached_effect; /* tagged */ cell cache_counter; - /* UNTAGGED */ - void *xt; + /* UNTAGGED entry point; jump here to call quotation */ + void *entry_point; /* UNTAGGED compiled code block */ code_block *code; }; @@ -302,7 +302,8 @@ struct dll : public object { }; struct stack_frame { - void *xt; + /* Updated by procedure prologue with procedure start address */ + void *entry_point; /* Frame size in bytes */ cell size; }; diff --git a/vm/main-windows-ce.cpp b/vm/main-windows-ce.cpp index e0b1d3b626..ed5844167a 100755 --- a/vm/main-windows-ce.cpp +++ b/vm/main-windows-ce.cpp @@ -1,5 +1,120 @@ #include "master.hpp" +/* + Windows argument parsing ported to work on + int main(int argc, wchar_t **argv). + + Based on MinGW's public domain char** version. +*/ + +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) +{ + int cmdlineLen = 0; + + if (!cmdlinePtrW) + cmdlineLen = 0; + else + cmdlineLen = wcslen(cmdlinePtrW); + + /* gets realloc()'d later */ + *argc = 0; + *argv = (wchar_t **)malloc (sizeof (wchar_t**)); + + if (!*argv) + ExitProcess(1); + +#ifdef WINCE + wchar_t cmdnameBufW[MAX_UNICODE_PATH]; + + /* argv[0] is the path of invoked program - get this from CE. */ + cmdnameBufW[0] = 0; + GetModuleFileNameW(NULL, cmdnameBufW, sizeof (cmdnameBufW)/sizeof (cmdnameBufW[0])); + + (*argv)[0] = wcsdup(cmdnameBufW); + if(!(*argv[0])) + ExitProcess(1); + /* Add one to account for argv[0] */ + (*argc)++; +#endif + + if (cmdlineLen > 0) + { + wchar_t *string = wcsdup(cmdlinePtrW); + if(!string) + ExitProcess(1); + *argc = parse_tokens(string, argv, *argc); + if (*argc < 0) + ExitProcess(1); + } + (*argv)[*argc] = 0; + return; +} + int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, diff --git a/vm/main-windows-nt.cpp b/vm/main-windows-nt.cpp index 4fced136e8..64e2cce54b 100755 --- a/vm/main-windows-nt.cpp +++ b/vm/main-windows-nt.cpp @@ -21,7 +21,7 @@ int WINAPI WinMain( int argc; wchar_t **argv; - factor::parse_args(&argc, &argv, (wchar_t *)GetCommandLine()); + argv = CommandLineToArgvW(GetCommandLine(),&argc); wmain(argc,argv); // memory leak from malloc, wcsdup diff --git a/vm/os-windows.cpp b/vm/os-windows.cpp index ab55beacdb..df2a57f2e8 100755 --- a/vm/os-windows.cpp +++ b/vm/os-windows.cpp @@ -137,123 +137,4 @@ 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) -{ - int cmdlineLen = 0; - - if (!cmdlinePtrW) - cmdlineLen = 0; - else - cmdlineLen = wcslen(cmdlinePtrW); - - /* gets realloc()'d later */ - *argc = 0; - *argv = (wchar_t **)malloc (sizeof (wchar_t**)); - - if (!*argv) - ExitProcess(1); - -#ifdef WINCE - wchar_t cmdnameBufW[MAX_UNICODE_PATH]; - - /* argv[0] is the path of invoked program - get this from CE. */ - cmdnameBufW[0] = 0; - GetModuleFileNameW(NULL, cmdnameBufW, sizeof (cmdnameBufW)/sizeof (cmdnameBufW[0])); - - (*argv)[0] = wcsdup(cmdnameBufW); - if(!(*argv[0])) - ExitProcess(1); - /* Add one to account for argv[0] */ - (*argc)++; -#endif - - if (cmdlineLen > 0) - { - wchar_t *argv1 = wcsdup(cmdlinePtrW); - if(!argv1) - ExitProcess(1); - *argc = parse_tokens(argv1, argv, *argc); - if (*argc < 0) - ExitProcess(1); - } - (*argv)[*argc] = 0; - return; -} - } diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index 13db2035bc..8a2dfe38f5 100755 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -51,8 +51,4 @@ 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/primitives.cpp b/vm/primitives.cpp index 5521b26a3f..2159e1d081 100644 --- a/vm/primitives.cpp +++ b/vm/primitives.cpp @@ -3,290 +3,135 @@ namespace factor { -PRIMITIVE_FORWARD(bignum_to_fixnum) -PRIMITIVE_FORWARD(float_to_fixnum) -PRIMITIVE_FORWARD(fixnum_to_bignum) -PRIMITIVE_FORWARD(float_to_bignum) -PRIMITIVE_FORWARD(fixnum_to_float) -PRIMITIVE_FORWARD(bignum_to_float) -PRIMITIVE_FORWARD(str_to_float) -PRIMITIVE_FORWARD(float_to_str) -PRIMITIVE_FORWARD(float_bits) -PRIMITIVE_FORWARD(double_bits) -PRIMITIVE_FORWARD(bits_float) -PRIMITIVE_FORWARD(bits_double) -PRIMITIVE_FORWARD(fixnum_divint) -PRIMITIVE_FORWARD(fixnum_divmod) -PRIMITIVE_FORWARD(fixnum_shift) -PRIMITIVE_FORWARD(bignum_eq) -PRIMITIVE_FORWARD(bignum_add) -PRIMITIVE_FORWARD(bignum_subtract) -PRIMITIVE_FORWARD(bignum_multiply) -PRIMITIVE_FORWARD(bignum_divint) -PRIMITIVE_FORWARD(bignum_mod) -PRIMITIVE_FORWARD(bignum_divmod) -PRIMITIVE_FORWARD(bignum_and) -PRIMITIVE_FORWARD(bignum_or) -PRIMITIVE_FORWARD(bignum_xor) -PRIMITIVE_FORWARD(bignum_not) -PRIMITIVE_FORWARD(bignum_shift) -PRIMITIVE_FORWARD(bignum_less) -PRIMITIVE_FORWARD(bignum_lesseq) -PRIMITIVE_FORWARD(bignum_greater) -PRIMITIVE_FORWARD(bignum_greatereq) -PRIMITIVE_FORWARD(bignum_bitp) -PRIMITIVE_FORWARD(bignum_log2) -PRIMITIVE_FORWARD(byte_array_to_bignum) -PRIMITIVE_FORWARD(float_eq) -PRIMITIVE_FORWARD(float_add) -PRIMITIVE_FORWARD(float_subtract) -PRIMITIVE_FORWARD(float_multiply) -PRIMITIVE_FORWARD(float_divfloat) -PRIMITIVE_FORWARD(float_mod) -PRIMITIVE_FORWARD(float_less) -PRIMITIVE_FORWARD(float_lesseq) -PRIMITIVE_FORWARD(float_greater) -PRIMITIVE_FORWARD(float_greatereq) -PRIMITIVE_FORWARD(word) -PRIMITIVE_FORWARD(word_xt) -PRIMITIVE_FORWARD(special_object) -PRIMITIVE_FORWARD(set_special_object) -PRIMITIVE_FORWARD(existsp) -PRIMITIVE_FORWARD(minor_gc) -PRIMITIVE_FORWARD(full_gc) -PRIMITIVE_FORWARD(compact_gc) -PRIMITIVE_FORWARD(save_image) -PRIMITIVE_FORWARD(save_image_and_exit) -PRIMITIVE_FORWARD(datastack) -PRIMITIVE_FORWARD(retainstack) -PRIMITIVE_FORWARD(callstack) -PRIMITIVE_FORWARD(set_datastack) -PRIMITIVE_FORWARD(set_retainstack) -PRIMITIVE_FORWARD(exit) -PRIMITIVE_FORWARD(data_room) -PRIMITIVE_FORWARD(code_room) -PRIMITIVE_FORWARD(system_micros) -PRIMITIVE_FORWARD(nano_count) -PRIMITIVE_FORWARD(modify_code_heap) -PRIMITIVE_FORWARD(dlopen) -PRIMITIVE_FORWARD(dlsym) -PRIMITIVE_FORWARD(dlclose) -PRIMITIVE_FORWARD(byte_array) -PRIMITIVE_FORWARD(uninitialized_byte_array) -PRIMITIVE_FORWARD(displaced_alien) -PRIMITIVE_FORWARD(alien_address) -PRIMITIVE_FORWARD(set_slot) -PRIMITIVE_FORWARD(string_nth) -PRIMITIVE_FORWARD(set_string_nth_fast) -PRIMITIVE_FORWARD(set_string_nth_slow) -PRIMITIVE_FORWARD(resize_array) -PRIMITIVE_FORWARD(resize_string) -PRIMITIVE_FORWARD(array) -PRIMITIVE_FORWARD(all_instances) -PRIMITIVE_FORWARD(size) -PRIMITIVE_FORWARD(die) -PRIMITIVE_FORWARD(fopen) -PRIMITIVE_FORWARD(fgetc) -PRIMITIVE_FORWARD(fread) -PRIMITIVE_FORWARD(fputc) -PRIMITIVE_FORWARD(fwrite) -PRIMITIVE_FORWARD(fflush) -PRIMITIVE_FORWARD(ftell) -PRIMITIVE_FORWARD(fseek) -PRIMITIVE_FORWARD(fclose) -PRIMITIVE_FORWARD(wrapper) -PRIMITIVE_FORWARD(clone) -PRIMITIVE_FORWARD(string) -PRIMITIVE_FORWARD(array_to_quotation) -PRIMITIVE_FORWARD(quotation_xt) -PRIMITIVE_FORWARD(tuple) -PRIMITIVE_FORWARD(profiling) -PRIMITIVE_FORWARD(become) -PRIMITIVE_FORWARD(sleep) -PRIMITIVE_FORWARD(tuple_boa) -PRIMITIVE_FORWARD(callstack_to_array) -PRIMITIVE_FORWARD(innermost_stack_frame_executing) -PRIMITIVE_FORWARD(innermost_stack_frame_scan) -PRIMITIVE_FORWARD(set_innermost_stack_frame_quot) -PRIMITIVE_FORWARD(call_clear) -PRIMITIVE_FORWARD(resize_byte_array) -PRIMITIVE_FORWARD(dll_validp) -PRIMITIVE_FORWARD(unimplemented) -PRIMITIVE_FORWARD(jit_compile) -PRIMITIVE_FORWARD(load_locals) -PRIMITIVE_FORWARD(check_datastack) -PRIMITIVE_FORWARD(mega_cache_miss) -PRIMITIVE_FORWARD(lookup_method) -PRIMITIVE_FORWARD(reset_dispatch_stats) -PRIMITIVE_FORWARD(dispatch_stats) -PRIMITIVE_FORWARD(optimized_p) -PRIMITIVE_FORWARD(quot_compiled_p) -PRIMITIVE_FORWARD(vm_ptr) -PRIMITIVE_FORWARD(strip_stack_traces) -PRIMITIVE_FORWARD(callback) -PRIMITIVE_FORWARD(enable_gc_events) -PRIMITIVE_FORWARD(disable_gc_events) -PRIMITIVE_FORWARD(identity_hashcode) -PRIMITIVE_FORWARD(compute_identity_hashcode) +#define PRIMITIVE(name) VM_C_API void primitive_##name(factor_vm *parent) \ +{ \ + parent->primitive_##name(); \ +} -const primitive_type primitives[] = { - primitive_bignum_to_fixnum, - primitive_float_to_fixnum, - primitive_fixnum_to_bignum, - primitive_float_to_bignum, - primitive_fixnum_to_float, - primitive_bignum_to_float, - primitive_str_to_float, - primitive_float_to_str, - primitive_float_bits, - primitive_double_bits, - primitive_bits_float, - primitive_bits_double, - primitive_fixnum_divint, - primitive_fixnum_divmod, - primitive_fixnum_shift, - primitive_bignum_eq, - primitive_bignum_add, - primitive_bignum_subtract, - primitive_bignum_multiply, - primitive_bignum_divint, - primitive_bignum_mod, - primitive_bignum_divmod, - primitive_bignum_and, - primitive_bignum_or, - primitive_bignum_xor, - primitive_bignum_not, - primitive_bignum_shift, - primitive_bignum_less, - primitive_bignum_lesseq, - primitive_bignum_greater, - primitive_bignum_greatereq, - primitive_bignum_bitp, - primitive_bignum_log2, - primitive_byte_array_to_bignum, - primitive_float_eq, - primitive_float_add, - primitive_float_subtract, - primitive_float_multiply, - primitive_float_divfloat, - primitive_float_mod, - primitive_float_less, - primitive_float_lesseq, - primitive_float_greater, - primitive_float_greatereq, - /* The unordered comparison primitives don't have a non-optimizing - compiler implementation */ - primitive_float_less, - primitive_float_lesseq, - primitive_float_greater, - primitive_float_greatereq, - primitive_word, - primitive_word_xt, - primitive_special_object, - primitive_set_special_object, - primitive_existsp, - primitive_minor_gc, - primitive_full_gc, - primitive_compact_gc, - primitive_save_image, - primitive_save_image_and_exit, - primitive_datastack, - primitive_retainstack, - primitive_callstack, - primitive_set_datastack, - primitive_set_retainstack, - primitive_exit, - primitive_data_room, - primitive_code_room, - primitive_system_micros, - primitive_nano_count, - primitive_modify_code_heap, - primitive_dlopen, - primitive_dlsym, - primitive_dlclose, - primitive_byte_array, - primitive_uninitialized_byte_array, - primitive_displaced_alien, - primitive_alien_signed_cell, - primitive_set_alien_signed_cell, - primitive_alien_unsigned_cell, - primitive_set_alien_unsigned_cell, - primitive_alien_signed_8, - primitive_set_alien_signed_8, - primitive_alien_unsigned_8, - primitive_set_alien_unsigned_8, - primitive_alien_signed_4, - primitive_set_alien_signed_4, - primitive_alien_unsigned_4, - primitive_set_alien_unsigned_4, - primitive_alien_signed_2, - primitive_set_alien_signed_2, - primitive_alien_unsigned_2, - primitive_set_alien_unsigned_2, - primitive_alien_signed_1, - primitive_set_alien_signed_1, - primitive_alien_unsigned_1, - primitive_set_alien_unsigned_1, - primitive_alien_float, - primitive_set_alien_float, - primitive_alien_double, - primitive_set_alien_double, - primitive_alien_cell, - primitive_set_alien_cell, - primitive_alien_address, - primitive_set_slot, - primitive_string_nth, - primitive_set_string_nth_fast, - primitive_set_string_nth_slow, - primitive_resize_array, - primitive_resize_string, - primitive_array, - primitive_all_instances, - primitive_size, - primitive_die, - primitive_fopen, - primitive_fgetc, - primitive_fread, - primitive_fputc, - primitive_fwrite, - primitive_fflush, - primitive_ftell, - primitive_fseek, - primitive_fclose, - primitive_wrapper, - primitive_clone, - primitive_string, - primitive_array_to_quotation, - primitive_quotation_xt, - primitive_tuple, - primitive_profiling, - primitive_become, - primitive_sleep, - primitive_tuple_boa, - primitive_callstack_to_array, - primitive_innermost_stack_frame_executing, - primitive_innermost_stack_frame_scan, - primitive_set_innermost_stack_frame_quot, - primitive_call_clear, - primitive_resize_byte_array, - primitive_dll_validp, - primitive_unimplemented, - primitive_jit_compile, - primitive_load_locals, - primitive_check_datastack, - primitive_mega_cache_miss, - primitive_lookup_method, - primitive_reset_dispatch_stats, - primitive_dispatch_stats, - primitive_optimized_p, - primitive_quot_compiled_p, - primitive_vm_ptr, - primitive_strip_stack_traces, - primitive_callback, - primitive_enable_gc_events, - primitive_disable_gc_events, - primitive_identity_hashcode, - primitive_compute_identity_hashcode, -}; +PRIMITIVE(alien_address) +PRIMITIVE(all_instances) +PRIMITIVE(array) +PRIMITIVE(array_to_quotation) +PRIMITIVE(become) +PRIMITIVE(bignum_add) +PRIMITIVE(bignum_and) +PRIMITIVE(bignum_bitp) +PRIMITIVE(bignum_divint) +PRIMITIVE(bignum_divmod) +PRIMITIVE(bignum_eq) +PRIMITIVE(bignum_greater) +PRIMITIVE(bignum_greatereq) +PRIMITIVE(bignum_less) +PRIMITIVE(bignum_lesseq) +PRIMITIVE(bignum_log2) +PRIMITIVE(bignum_mod) +PRIMITIVE(bignum_multiply) +PRIMITIVE(bignum_not) +PRIMITIVE(bignum_or) +PRIMITIVE(bignum_shift) +PRIMITIVE(bignum_subtract) +PRIMITIVE(bignum_to_fixnum) +PRIMITIVE(bignum_to_float) +PRIMITIVE(bignum_xor) +PRIMITIVE(bits_double) +PRIMITIVE(bits_float) +PRIMITIVE(byte_array) +PRIMITIVE(byte_array_to_bignum) +PRIMITIVE(call_clear) +PRIMITIVE(callback) +PRIMITIVE(callstack) +PRIMITIVE(callstack_to_array) +PRIMITIVE(check_datastack) +PRIMITIVE(clone) +PRIMITIVE(code_room) +PRIMITIVE(compact_gc) +PRIMITIVE(compute_identity_hashcode) +PRIMITIVE(data_room) +PRIMITIVE(datastack) +PRIMITIVE(die) +PRIMITIVE(disable_gc_events) +PRIMITIVE(dispatch_stats) +PRIMITIVE(displaced_alien) +PRIMITIVE(dlclose) +PRIMITIVE(dll_validp) +PRIMITIVE(dlopen) +PRIMITIVE(dlsym) +PRIMITIVE(double_bits) +PRIMITIVE(enable_gc_events) +PRIMITIVE(existsp) +PRIMITIVE(exit) +PRIMITIVE(fclose) +PRIMITIVE(fflush) +PRIMITIVE(fgetc) +PRIMITIVE(fixnum_divint) +PRIMITIVE(fixnum_divmod) +PRIMITIVE(fixnum_shift) +PRIMITIVE(fixnum_to_bignum) +PRIMITIVE(fixnum_to_float) +PRIMITIVE(float_add) +PRIMITIVE(float_bits) +PRIMITIVE(float_divfloat) +PRIMITIVE(float_eq) +PRIMITIVE(float_greater) +PRIMITIVE(float_greatereq) +PRIMITIVE(float_less) +PRIMITIVE(float_lesseq) +PRIMITIVE(float_mod) +PRIMITIVE(float_multiply) +PRIMITIVE(float_subtract) +PRIMITIVE(float_to_bignum) +PRIMITIVE(float_to_fixnum) +PRIMITIVE(float_to_str) +PRIMITIVE(fopen) +PRIMITIVE(fputc) +PRIMITIVE(fread) +PRIMITIVE(fseek) +PRIMITIVE(ftell) +PRIMITIVE(full_gc) +PRIMITIVE(fwrite) +PRIMITIVE(identity_hashcode) +PRIMITIVE(innermost_stack_frame_executing) +PRIMITIVE(innermost_stack_frame_scan) +PRIMITIVE(jit_compile) +PRIMITIVE(load_locals) +PRIMITIVE(lookup_method) +PRIMITIVE(mega_cache_miss) +PRIMITIVE(minor_gc) +PRIMITIVE(modify_code_heap) +PRIMITIVE(nano_count) +PRIMITIVE(optimized_p) +PRIMITIVE(profiling) +PRIMITIVE(quot_compiled_p) +PRIMITIVE(quotation_code) +PRIMITIVE(reset_dispatch_stats) +PRIMITIVE(resize_array) +PRIMITIVE(resize_byte_array) +PRIMITIVE(resize_string) +PRIMITIVE(retainstack) +PRIMITIVE(save_image) +PRIMITIVE(save_image_and_exit) +PRIMITIVE(set_datastack) +PRIMITIVE(set_innermost_stack_frame_quot) +PRIMITIVE(set_retainstack) +PRIMITIVE(set_slot) +PRIMITIVE(set_special_object) +PRIMITIVE(set_string_nth_fast) +PRIMITIVE(set_string_nth_slow) +PRIMITIVE(size) +PRIMITIVE(sleep) +PRIMITIVE(special_object) +PRIMITIVE(str_to_float) +PRIMITIVE(string) +PRIMITIVE(string_nth) +PRIMITIVE(strip_stack_traces) +PRIMITIVE(system_micros) +PRIMITIVE(tuple) +PRIMITIVE(tuple_boa) +PRIMITIVE(unimplemented) +PRIMITIVE(uninitialized_byte_array) +PRIMITIVE(vm_ptr) +PRIMITIVE(word) +PRIMITIVE(word_code) +PRIMITIVE(wrapper) } diff --git a/vm/primitives.hpp b/vm/primitives.hpp index c5ad9d889e..c1dd0e30dc 100644 --- a/vm/primitives.hpp +++ b/vm/primitives.hpp @@ -1,41 +1,162 @@ namespace factor { -extern "C" typedef void (*primitive_type)(factor_vm *parent); -#define PRIMITIVE(name) extern "C" void primitive_##name(factor_vm *parent) -#define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(factor_vm *parent) \ -{ \ - parent->primitive_##name(); \ -} +#define DECLARE_PRIMITIVE(name) VM_C_API void primitive_##name(factor_vm *parent); -extern const primitive_type primitives[]; +/* Generated with PRIMITIVE in primitives.cpp */ +DECLARE_PRIMITIVE(alien_address) +DECLARE_PRIMITIVE(all_instances) +DECLARE_PRIMITIVE(array) +DECLARE_PRIMITIVE(array_to_quotation) +DECLARE_PRIMITIVE(become) +DECLARE_PRIMITIVE(bignum_add) +DECLARE_PRIMITIVE(bignum_and) +DECLARE_PRIMITIVE(bignum_bitp) +DECLARE_PRIMITIVE(bignum_divint) +DECLARE_PRIMITIVE(bignum_divmod) +DECLARE_PRIMITIVE(bignum_eq) +DECLARE_PRIMITIVE(bignum_greater) +DECLARE_PRIMITIVE(bignum_greatereq) +DECLARE_PRIMITIVE(bignum_less) +DECLARE_PRIMITIVE(bignum_lesseq) +DECLARE_PRIMITIVE(bignum_log2) +DECLARE_PRIMITIVE(bignum_mod) +DECLARE_PRIMITIVE(bignum_multiply) +DECLARE_PRIMITIVE(bignum_not) +DECLARE_PRIMITIVE(bignum_or) +DECLARE_PRIMITIVE(bignum_shift) +DECLARE_PRIMITIVE(bignum_subtract) +DECLARE_PRIMITIVE(bignum_to_fixnum) +DECLARE_PRIMITIVE(bignum_to_float) +DECLARE_PRIMITIVE(bignum_xor) +DECLARE_PRIMITIVE(bits_double) +DECLARE_PRIMITIVE(bits_float) +DECLARE_PRIMITIVE(byte_array) +DECLARE_PRIMITIVE(byte_array_to_bignum) +DECLARE_PRIMITIVE(call_clear) +DECLARE_PRIMITIVE(callback) +DECLARE_PRIMITIVE(callstack) +DECLARE_PRIMITIVE(callstack_to_array) +DECLARE_PRIMITIVE(check_datastack) +DECLARE_PRIMITIVE(clone) +DECLARE_PRIMITIVE(code_room) +DECLARE_PRIMITIVE(compact_gc) +DECLARE_PRIMITIVE(compute_identity_hashcode) +DECLARE_PRIMITIVE(data_room) +DECLARE_PRIMITIVE(datastack) +DECLARE_PRIMITIVE(die) +DECLARE_PRIMITIVE(disable_gc_events) +DECLARE_PRIMITIVE(dispatch_stats) +DECLARE_PRIMITIVE(displaced_alien) +DECLARE_PRIMITIVE(dlclose) +DECLARE_PRIMITIVE(dll_validp) +DECLARE_PRIMITIVE(dlopen) +DECLARE_PRIMITIVE(dlsym) +DECLARE_PRIMITIVE(double_bits) +DECLARE_PRIMITIVE(enable_gc_events) +DECLARE_PRIMITIVE(existsp) +DECLARE_PRIMITIVE(exit) +DECLARE_PRIMITIVE(fclose) +DECLARE_PRIMITIVE(fflush) +DECLARE_PRIMITIVE(fgetc) +DECLARE_PRIMITIVE(fixnum_divint) +DECLARE_PRIMITIVE(fixnum_divmod) +DECLARE_PRIMITIVE(fixnum_shift) +DECLARE_PRIMITIVE(fixnum_to_bignum) +DECLARE_PRIMITIVE(fixnum_to_float) +DECLARE_PRIMITIVE(float_add) +DECLARE_PRIMITIVE(float_bits) +DECLARE_PRIMITIVE(float_divfloat) +DECLARE_PRIMITIVE(float_eq) +DECLARE_PRIMITIVE(float_greater) +DECLARE_PRIMITIVE(float_greatereq) +DECLARE_PRIMITIVE(float_less) +DECLARE_PRIMITIVE(float_lesseq) +DECLARE_PRIMITIVE(float_mod) +DECLARE_PRIMITIVE(float_multiply) +DECLARE_PRIMITIVE(float_subtract) +DECLARE_PRIMITIVE(float_to_bignum) +DECLARE_PRIMITIVE(float_to_fixnum) +DECLARE_PRIMITIVE(float_to_str) +DECLARE_PRIMITIVE(fopen) +DECLARE_PRIMITIVE(fputc) +DECLARE_PRIMITIVE(fread) +DECLARE_PRIMITIVE(fseek) +DECLARE_PRIMITIVE(ftell) +DECLARE_PRIMITIVE(full_gc) +DECLARE_PRIMITIVE(fwrite) +DECLARE_PRIMITIVE(identity_hashcode) +DECLARE_PRIMITIVE(innermost_stack_frame_executing) +DECLARE_PRIMITIVE(innermost_stack_frame_scan) +DECLARE_PRIMITIVE(jit_compile) +DECLARE_PRIMITIVE(load_locals) +DECLARE_PRIMITIVE(lookup_method) +DECLARE_PRIMITIVE(mega_cache_miss) +DECLARE_PRIMITIVE(minor_gc) +DECLARE_PRIMITIVE(modify_code_heap) +DECLARE_PRIMITIVE(nano_count) +DECLARE_PRIMITIVE(optimized_p) +DECLARE_PRIMITIVE(profiling) +DECLARE_PRIMITIVE(quot_compiled_p) +DECLARE_PRIMITIVE(quotation_code) +DECLARE_PRIMITIVE(reset_dispatch_stats) +DECLARE_PRIMITIVE(resize_array) +DECLARE_PRIMITIVE(resize_byte_array) +DECLARE_PRIMITIVE(resize_string) +DECLARE_PRIMITIVE(retainstack) +DECLARE_PRIMITIVE(save_image) +DECLARE_PRIMITIVE(save_image_and_exit) +DECLARE_PRIMITIVE(set_datastack) +DECLARE_PRIMITIVE(set_innermost_stack_frame_quot) +DECLARE_PRIMITIVE(set_retainstack) +DECLARE_PRIMITIVE(set_slot) +DECLARE_PRIMITIVE(set_special_object) +DECLARE_PRIMITIVE(set_string_nth_fast) +DECLARE_PRIMITIVE(set_string_nth_slow) +DECLARE_PRIMITIVE(size) +DECLARE_PRIMITIVE(sleep) +DECLARE_PRIMITIVE(special_object) +DECLARE_PRIMITIVE(str_to_float) +DECLARE_PRIMITIVE(string) +DECLARE_PRIMITIVE(string_nth) +DECLARE_PRIMITIVE(strip_stack_traces) +DECLARE_PRIMITIVE(system_micros) +DECLARE_PRIMITIVE(tuple) +DECLARE_PRIMITIVE(tuple_boa) +DECLARE_PRIMITIVE(unimplemented) +DECLARE_PRIMITIVE(uninitialized_byte_array) +DECLARE_PRIMITIVE(vm_ptr) +DECLARE_PRIMITIVE(word) +DECLARE_PRIMITIVE(word_code) +DECLARE_PRIMITIVE(wrapper) -/* These are generated with macros in alien.c */ -PRIMITIVE(alien_signed_cell); -PRIMITIVE(set_alien_signed_cell); -PRIMITIVE(alien_unsigned_cell); -PRIMITIVE(set_alien_unsigned_cell); -PRIMITIVE(alien_signed_8); -PRIMITIVE(set_alien_signed_8); -PRIMITIVE(alien_unsigned_8); -PRIMITIVE(set_alien_unsigned_8); -PRIMITIVE(alien_signed_4); -PRIMITIVE(set_alien_signed_4); -PRIMITIVE(alien_unsigned_4); -PRIMITIVE(set_alien_unsigned_4); -PRIMITIVE(alien_signed_2); -PRIMITIVE(set_alien_signed_2); -PRIMITIVE(alien_unsigned_2); -PRIMITIVE(set_alien_unsigned_2); -PRIMITIVE(alien_signed_1); -PRIMITIVE(set_alien_signed_1); -PRIMITIVE(alien_unsigned_1); -PRIMITIVE(set_alien_unsigned_1); -PRIMITIVE(alien_float); -PRIMITIVE(set_alien_float); -PRIMITIVE(alien_double); -PRIMITIVE(set_alien_double); -PRIMITIVE(alien_cell); -PRIMITIVE(set_alien_cell); +/* These are generated with macros in alien.cpp, and not with PRIMIIVE in +primitives.cpp */ +DECLARE_PRIMITIVE(alien_signed_cell) +DECLARE_PRIMITIVE(set_alien_signed_cell) +DECLARE_PRIMITIVE(alien_unsigned_cell) +DECLARE_PRIMITIVE(set_alien_unsigned_cell) +DECLARE_PRIMITIVE(alien_signed_8) +DECLARE_PRIMITIVE(set_alien_signed_8) +DECLARE_PRIMITIVE(alien_unsigned_8) +DECLARE_PRIMITIVE(set_alien_unsigned_8) +DECLARE_PRIMITIVE(alien_signed_4) +DECLARE_PRIMITIVE(set_alien_signed_4) +DECLARE_PRIMITIVE(alien_unsigned_4) +DECLARE_PRIMITIVE(set_alien_unsigned_4) +DECLARE_PRIMITIVE(alien_signed_2) +DECLARE_PRIMITIVE(set_alien_signed_2) +DECLARE_PRIMITIVE(alien_unsigned_2) +DECLARE_PRIMITIVE(set_alien_unsigned_2) +DECLARE_PRIMITIVE(alien_signed_1) +DECLARE_PRIMITIVE(set_alien_signed_1) +DECLARE_PRIMITIVE(alien_unsigned_1) +DECLARE_PRIMITIVE(set_alien_unsigned_1) +DECLARE_PRIMITIVE(alien_float) +DECLARE_PRIMITIVE(set_alien_float) +DECLARE_PRIMITIVE(alien_double) +DECLARE_PRIMITIVE(set_alien_double) +DECLARE_PRIMITIVE(alien_cell) +DECLARE_PRIMITIVE(set_alien_cell) } diff --git a/vm/profiler.cpp b/vm/profiler.cpp index c7acc8fe67..fea78692ea 100755 --- a/vm/profiler.cpp +++ b/vm/profiler.cpp @@ -52,7 +52,7 @@ void factor_vm::set_profiling(bool profiling) word->counter = tag_fixnum(0); } - update_word_xt(word.untagged()); + update_word_entry_point(word.untagged()); } update_code_heap_words(); diff --git a/vm/quotations.cpp b/vm/quotations.cpp index e4836fe96b..faa770c512 100755 --- a/vm/quotations.cpp +++ b/vm/quotations.cpp @@ -43,7 +43,7 @@ void quotation_jit::init_quotation(cell quot) bool quotation_jit::primitive_call_p(cell i, cell length) { - return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_PRIMITIVE_WORD]; + return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent->special_objects[JIT_PRIMITIVE_WORD]; } bool quotation_jit::fast_if_p(cell i, cell length) @@ -178,7 +178,7 @@ void quotation_jit::iterate_quotation() case WRAPPER_TYPE: push(obj.as()->object); break; - case FIXNUM_TYPE: + case BYTE_ARRAY_TYPE: /* Primitive calls */ if(primitive_call_p(i,length)) { @@ -189,6 +189,7 @@ void quotation_jit::iterate_quotation() parameter(tag_fixnum(0)); #endif parameter(obj.value()); + parameter(false_object); emit(parent->special_objects[JIT_PRIMITIVE]); i++; @@ -267,10 +268,10 @@ void quotation_jit::iterate_quotation() } } -void factor_vm::set_quot_xt(quotation *quot, code_block *code) +void factor_vm::set_quot_entry_point(quotation *quot, code_block *code) { quot->code = code; - quot->xt = code->xt(); + quot->entry_point = code->entry_point(); } /* Allocates memory */ @@ -296,7 +297,7 @@ void factor_vm::jit_compile_quot(cell quot_, bool relocating) if(!quot_compiled_p(quot.untagged())) { code_block *compiled = jit_compile_quot(quot.value(),quot.value(),relocating); - set_quot_xt(quot.untagged(),compiled); + set_quot_entry_point(quot.untagged(),compiled); } } @@ -318,15 +319,17 @@ void factor_vm::primitive_array_to_quotation() quot->array = ctx->peek(); quot->cached_effect = false_object; quot->cache_counter = false_object; - set_quot_xt(quot,lazy_jit_compile_block()); + set_quot_entry_point(quot,lazy_jit_compile_block()); ctx->replace(tag(quot)); } -void factor_vm::primitive_quotation_xt() +void factor_vm::primitive_quotation_code() { - quotation *quot = untag_check(ctx->peek()); - ctx->replace(allot_cell((cell)quot->xt)); + quotation *quot = untag_check(ctx->pop()); + + ctx->push(allot_cell((cell)quot->code->entry_point())); + ctx->push(allot_cell((cell)quot->code + quot->code->size())); } /* Allocates memory */ @@ -346,7 +349,12 @@ fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset) cell factor_vm::lazy_jit_compile(cell quot_) { data_root quot(quot_,this); - jit_compile_quot(quot.value(),true); + + assert(!quot_compiled_p(quot.untagged())); + + code_block *compiled = jit_compile_quot(quot.value(),quot.value(),true); + set_quot_entry_point(quot.untagged(),compiled); + return quot.value(); } @@ -381,7 +389,7 @@ void factor_vm::initialize_all_quotations() { data_root quot(array_nth(quotations.untagged(),i),this); if(!quot->code) - set_quot_xt(quot.untagged(),lazy_jit_compile_block()); + set_quot_entry_point(quot.untagged(),lazy_jit_compile_block()); } } diff --git a/vm/vm.hpp b/vm/vm.hpp index 348a7128cc..8fb866dbef 100755 --- a/vm/vm.hpp +++ b/vm/vm.hpp @@ -393,8 +393,8 @@ struct factor_vm //words word *allot_word(cell name_, cell vocab_, cell hashcode_); void primitive_word(); - void primitive_word_xt(); - void update_word_xt(word *w_); + void primitive_word_code(); + void update_word_entry_point(word *w_); void primitive_optimized_p(); void primitive_wrapper(); void jit_compile_word(cell word_, cell def_, bool relocating); @@ -503,17 +503,15 @@ struct factor_vm void primitive_fclose(); //code_block - cell compute_xt_address(cell obj); - cell compute_xt_pic_address(word *w, cell tagged_quot); - cell compute_xt_pic_address(cell w_); - cell compute_xt_pic_tail_address(cell w_); + cell compute_entry_point_address(cell obj); + cell compute_entry_point_pic_address(word *w, cell tagged_quot); + cell compute_entry_point_pic_address(cell w_); + cell compute_entry_point_pic_tail_address(cell w_); cell code_block_owner(code_block *compiled); void update_word_references(code_block *compiled); void check_code_address(cell address); - cell compute_primitive_address(cell arg); void undefined_symbol(); cell compute_dlsym_address(array *literals, cell index); - cell compute_context_address(); cell compute_vm_address(cell arg); void store_external_address(instruction_operand op); cell compute_here_address(cell arg, cell offset, code_block *compiled); @@ -600,8 +598,8 @@ struct factor_vm void primitive_jit_compile(); code_block *lazy_jit_compile_block(); void primitive_array_to_quotation(); - void primitive_quotation_xt(); - void set_quot_xt(quotation *quot, code_block *code); + void primitive_quotation_code(); + void set_quot_entry_point(quotation *quot, code_block *code); code_block *jit_compile_quot(cell owner_, cell quot_, bool relocating); void jit_compile_quot(cell quot_, bool relocating); fixnum quot_code_offset_to_scan(cell quot_, cell offset); diff --git a/vm/words.cpp b/vm/words.cpp index 4b3dad71df..31041a6a19 100644 --- a/vm/words.cpp +++ b/vm/words.cpp @@ -9,6 +9,11 @@ void factor_vm::jit_compile_word(cell word_, cell def_, bool relocating) data_root word(word_,this); data_root def(def_,this); + /* Refuse to compile this word more than once, because quot_compiled_p() + depends on the identity of its code block */ + if(word->code && word.value() == special_objects[LAZY_JIT_COMPILE_WORD]) + return; + code_block *compiled = jit_compile_quot(word.value(),def.value(),relocating); word->code = compiled; @@ -33,7 +38,7 @@ void factor_vm::compile_all_words() if(!word->code || !word->code->optimized_p()) jit_compile_word(word.value(),word->def,false); - update_word_xt(word.untagged()); + update_word_entry_point(word.untagged()); } } @@ -64,7 +69,7 @@ word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_) initialize_code_block(new_word->profiling); } - update_word_xt(new_word.untagged()); + update_word_entry_point(new_word.untagged()); return new_word.untagged(); } @@ -78,30 +83,30 @@ void factor_vm::primitive_word() ctx->push(tag(allot_word(name,vocab,hashcode))); } -/* word-xt ( word -- start end ) */ -void factor_vm::primitive_word_xt() +/* word-code ( word -- start end ) */ +void factor_vm::primitive_word_code() { data_root w(ctx->pop(),this); w.untag_check(this); if(profiling_p) { - ctx->push(allot_cell((cell)w->profiling->xt())); + ctx->push(allot_cell((cell)w->profiling->entry_point())); ctx->push(allot_cell((cell)w->profiling + w->profiling->size())); } else { - ctx->push(allot_cell((cell)w->code->xt())); + ctx->push(allot_cell((cell)w->code->entry_point())); ctx->push(allot_cell((cell)w->code + w->code->size())); } } -void factor_vm::update_word_xt(word *w) +void factor_vm::update_word_entry_point(word *w) { if(profiling_p && w->profiling) - w->xt = w->profiling->xt(); + w->entry_point = w->profiling->entry_point(); else - w->xt = w->code->xt(); + w->entry_point = w->code->entry_point(); } void factor_vm::primitive_optimized_p()