USING: namespaces make math math.order math.parser sequences accessors
kernel kernel.private layouts assocs words summary arrays
combinators classes.algebra alien alien.c-types alien.structs
-alien.strings alien.arrays alien.complex sets libc alien.libraries
+alien.strings alien.arrays alien.complex alien.libraries sets libc
continuations.private fry cpu.architecture
source-files.errors
compiler.errors
: help-lint-all ( -- ) "" help-lint ;
-: :lint-failures ( -- ) lint-failures get errors. ;
+: :lint-failures ( -- ) lint-failures get values errors. ;
: unlinked-words ( words -- seq )
all-word-help [ article-parent not ] filter ;
: gl-program-shaders-length ( program -- shaders-length )
GL_ATTACHED_SHADERS gl-program-get-int ; inline
+! On some macosx-x86-64 graphics drivers, glGetAttachedShaders tries to treat the
+! shaders parameter as a ulonglong array rather than a GLuint array as documented.
+! We hack around this by allocating a buffer twice the size and sifting out the zero
+! values
+
: gl-program-shaders ( program -- shaders )
- dup gl-program-shaders-length
+ dup gl-program-shaders-length 2 *
0 <int>
over <uint-array>
- [ glGetAttachedShaders ] keep ;
+ [ glGetAttachedShaders ] keep [ zero? not ] filter ;
: delete-gl-program-only ( program -- )
glDeleteProgram ; inline
IN: present.tests
-USING: tools.test present math vocabs sequences kernel ;
+USING: tools.test vocabs.hierarchy present math vocabs sequences kernel ;
[ "3" ] [ 3 present ] unit-test
[ "Hi" ] [ "Hi" present ] unit-test
IN: ui.gadgets.glass.tests
USING: tools.test ui.gadgets.glass ui.gadgets.worlds ui.gadgets
-math.rectangles namespaces accessors models sequences ;
+math.rectangles namespaces accessors models sequences arrays ;
-<gadget> "" f <model> <world>
-{ 1000 1000 } >>dim
-"w" set
+[ ] [
+ <world-attributes>
+ <gadget> 1array >>gadgets
+ <world>
+ { 1000 1000 } >>dim
+ "w" set
+] unit-test
[ ] [ <gadget> "g" set ] unit-test
USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
-namespaces models kernel accessors ;
+namespaces models kernel accessors arrays ;
IN: ui.gadgets.worlds.tests
! Test focus behavior
<gadget> "g1" set
: <test-world> ( gadget -- world )
- "Hi" f <world> ;
+ <world-attributes> "Hi" >>title swap 1array >>gadgets <world> ;
[ ] [
"g1" get <test-world> "w" set
gadgets
{ pixel-format-attributes initial: $ default-world-pixel-format-attributes } ;
-C: <world-attributes> world-attributes
+: <world-attributes> ( -- world-attributes )
+ world-attributes new ; inline
: find-world ( gadget -- world/f ) [ world? ] find-parent ;
--- /dev/null
+IN: vocabs.files.tests
+USING: tools.test vocabs.files vocabs arrays grouping ;
+
+[ t ] [
+ "kernel" vocab-files
+ "kernel" vocab vocab-files
+ "kernel" <vocab-link> vocab-files
+ 3array all-equal?
+] unit-test
\ No newline at end of file
{ $description "Load all vocabularies in the source tree." } ;\r
\r
HELP: all-vocabs-under\r
-{ $values { "prefix" string } }\r
+{ $values { "prefix" string } { "vocabs" "a sequence of vocabularies" } }\r
{ $description "Return a sequence of vocab or vocab-links for each vocab matching the provided prefix. Unlike " { $link all-child-vocabs } " this word will return both loaded and unloaded vocabularies." } ;\r
IN: vocabs.hierarchy.tests
USING: continuations namespaces tools.test vocabs.hierarchy vocabs.hierarchy.private ;
-
-[ ] [
- changed-vocabs get-global
- f changed-vocabs set-global
- [ t ] [ "kernel" changed-vocab? ] unit-test
- [ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
-] unit-test
-
-[ t ] [ "some-vocab" valid-vocab-dirname ] unit-test
-[ f ] [ ".git" valid-vocab-dirname ] unit-test
--- /dev/null
+IN: vocabs.refresh.tests
+USING: vocabs.refresh tools.test continuations namespaces ;
+
+[ ] [
+ changed-vocabs get-global
+ f changed-vocabs set-global
+ [ t ] [ "kernel" changed-vocab? ] unit-test
+ [ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup
+] unit-test
-USING: alien.strings tools.test kernel libc
+USING: alien.strings alien.c-types tools.test kernel libc
io.encodings.8-bit io.encodings.utf8 io.encodings.utf16
io.encodings.utf16n io.encodings.ascii alien io.encodings.string ;
IN: alien.strings.tests
{ "set-innermost-frame-quot" "kernel.private" (( n callstack -- )) }
{ "call-clear" "kernel" (( quot -- )) }
{ "resize-byte-array" "byte-arrays" (( n byte-array -- newbyte-array )) }
- { "dll-valid?" "alien" (( dll -- ? )) }
+ { "dll-valid?" "alien.libraries" (( dll -- ? )) }
{ "unimplemented" "kernel.private" (( -- * )) }
{ "gc-reset" "memory" (( -- )) }
{ "jit-compile" "quotations" (( quot -- )) }
256 iota [
8 [
[ 2/ ] [ even? ] bi [ crc32-polynomial bitxor ] unless
- ] times >bignum
+ ] times
] map 0 crc32-table copy
: (crc32) ( crc ch -- crc )
- >bignum dupd bitxor
- mask-byte crc32-table nth-unsafe >bignum
+ dupd bitxor
+ mask-byte crc32-table nth-unsafe
swap -8 shift bitxor ; inline
SINGLETON: crc32
{ $description "Creates a stream which writes data by calling C standard library functions." }
{ $notes "Usually C streams are only used during bootstrap, and non-blocking OS-specific I/O routines are used during normal operation." } ;
-HELP: fopen ( path mode -- alien )
+HELP: fopen
{ $values { "path" "a pathname string" } { "mode" "an access mode specifier" } { "alien" "a C FILE* handle" } }
{ $description "Opens a file named by " { $snippet "path" } ". The " { $snippet "mode" } " parameter should be something like " { $snippet "\"r\"" } " or " { $snippet "\"rw\"" } "; consult the " { $snippet "fopen(3)" } " manual page for details." }
{ $errors "Throws an error if the file could not be opened." }
M: c-io-backend io-multiplex 60 60 * 1000 * 1000 * or (sleep) ;
-: fopen ( path mode -- handle )
+: fopen ( path mode -- alien )
[ utf8 string>alien ] bi@ (fopen) ;
M: c-io-backend (file-reader)
$nl
"Outputs " { $link f } " if the string does not represent a float." } ;
-HELP: float>string ( n -- str )
+HELP: float>string
{ $values { "n" real } { "str" string } }
{ $description "Primitive for getting a string representation of a float." }
{ $notes "The " { $link number>string } " word is more general." } ;
[ ".0" append ]
} cond ;
-: float>string ( x -- str )
+: float>string ( n -- str )
(float>string)
[ 0 = ] trim-tail >string
fix-float ;
kernel arrays sequences namespaces io.streams.string
parser source-files words assocs classes.tuple definitions
debugger compiler.units accessors eval
-combinators vocabs.parser grouping ;
+combinators vocabs.parser grouping vocabs.files vocabs.refresh ;
IN: vocabs.loader.tests
! This vocab should not exist, but just in case...
[ t ]
[ "kernel" >vocab-link "kernel" vocab = ] unit-test
-[ t ] [
- "kernel" vocab-files
- "kernel" vocab vocab-files
- "kernel" <vocab-link> vocab-files
- 3array all-equal?
-] unit-test
-
IN: vocabs.loader.test.2
: hello ( -- ) ;
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-openbsd.o
CC = egcc
+CPP = eg++
CFLAGS += -export-dynamic
LIBS = -L/usr/local/lib/ -lm $(X11_UI_LIBS) -lz -lssl -lcrypto -lpthread
{
gc_root<byte_array> path(dpop());
path.untag_check();
- gc_root<dll>
dll(allot<dll>(sizeof(dll)));
- dll->path = path.value();
- ffi_dlopen(dll.untagged());
- dpush(dll.value());
+ gc_root<dll>
library(allot<dll>(sizeof(dll)));
+ library->path = path.value();
+ ffi_dlopen(library.untagged());
+ dpush(library.value());
}
/* look up a symbol in a native library */
the code heap with dead PICs that will be freed on the next
GC, we add them to the free list immediately. */
else if(compiled->block.type == PIC_TYPE)
- {
- fflush(stdout);
heap_free(&code,&compiled->block);
- }
else
{
iterate_relocations(compiled,update_word_references_step);
-#if defined(FACTOR_X86)
+#if defined(i386) || defined(__i386) || defined(__i386__) || defined(WIN32)
#define F_STDCALL __attribute__((stdcall))
#else
#define F_STDCALL
#endif
-#define DLLEXPORT
-
-DLLEXPORT void ffi_test_0(void);
-DLLEXPORT int ffi_test_1(void);
-DLLEXPORT int ffi_test_2(int x, int y);
-DLLEXPORT int ffi_test_3(int x, int y, int z, int t);
-DLLEXPORT float ffi_test_4(void);
-DLLEXPORT double ffi_test_5(void);
-DLLEXPORT double ffi_test_6(float x, float y);
-DLLEXPORT double ffi_test_7(double x, double y);
-DLLEXPORT double ffi_test_8(double x, float y, double z, float t, int w);
-DLLEXPORT int ffi_test_9(int a, int b, int c, int d, int e, int f, int g);
-DLLEXPORT int ffi_test_10(int a, int b, double c, int d, float e, int f, int g, int h);
+#if defined(__APPLE__)
+ #define F_EXPORT __attribute__((visibility("default")))
+#elif defined(WINDOWS)
+ #define F_EXPORT __declspec(dllexport)
+#else
+ #define F_EXPORT
+#endif
+
+F_EXPORT void ffi_test_0(void);
+F_EXPORT int ffi_test_1(void);
+F_EXPORT int ffi_test_2(int x, int y);
+F_EXPORT int ffi_test_3(int x, int y, int z, int t);
+F_EXPORT float ffi_test_4(void);
+F_EXPORT double ffi_test_5(void);
+F_EXPORT double ffi_test_6(float x, float y);
+F_EXPORT double ffi_test_7(double x, double y);
+F_EXPORT double ffi_test_8(double x, float y, double z, float t, int w);
+F_EXPORT int ffi_test_9(int a, int b, int c, int d, int e, int f, int g);
+F_EXPORT int ffi_test_10(int a, int b, double c, int d, float e, int f, int g, int h);
struct foo { int x, y; };
-DLLEXPORT int ffi_test_11(int a, struct foo b, int c);
+F_EXPORT int ffi_test_11(int a, struct foo b, int c);
struct rect { float x, y, w, h; };
-DLLEXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f);
-DLLEXPORT int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k);
-DLLEXPORT struct foo ffi_test_14(int x, int y);
-DLLEXPORT char *ffi_test_15(char *x, char *y);
+F_EXPORT int ffi_test_12(int a, int b, struct rect c, int d, int e, int f);
+F_EXPORT int ffi_test_13(int a, int b, int c, int d, int e, int f, int g, int h, int i, int j, int k);
+F_EXPORT struct foo ffi_test_14(int x, int y);
+F_EXPORT char *ffi_test_15(char *x, char *y);
struct bar { long x, y, z; };
-DLLEXPORT struct bar ffi_test_16(long x, long y, long z);
+F_EXPORT struct bar ffi_test_16(long x, long y, long z);
struct tiny { int x; };
-DLLEXPORT struct tiny ffi_test_17(int x);
-DLLEXPORT F_STDCALL int ffi_test_18(int x, int y, int z, int t);
-DLLEXPORT F_STDCALL struct bar ffi_test_19(long x, long y, long z);
-DLLEXPORT void ffi_test_20(double x1, double x2, double x3,
+F_EXPORT struct tiny ffi_test_17(int x);
+F_EXPORT F_STDCALL int ffi_test_18(int x, int y, int z, int t);
+F_EXPORT F_STDCALL struct bar ffi_test_19(long x, long y, long z);
+F_EXPORT void ffi_test_20(double x1, double x2, double x3,
double y1, double y2, double y3,
double z1, double z2, double z3);
-DLLEXPORT long long ffi_test_21(long x, long y);
-DLLEXPORT long ffi_test_22(long x, long long y, long long z);
-DLLEXPORT float ffi_test_23(float x[3], float y[3]);
+F_EXPORT long long ffi_test_21(long x, long y);
+F_EXPORT long ffi_test_22(long x, long long y, long long z);
+F_EXPORT float ffi_test_23(float x[3], float y[3]);
struct test_struct_1 { char x; };
-DLLEXPORT struct test_struct_1 ffi_test_24(void);
+F_EXPORT struct test_struct_1 ffi_test_24(void);
struct test_struct_2 { char x, y; };
-DLLEXPORT struct test_struct_2 ffi_test_25(void);
+F_EXPORT struct test_struct_2 ffi_test_25(void);
struct test_struct_3 { char x, y, z; };
-DLLEXPORT struct test_struct_3 ffi_test_26(void);
+F_EXPORT struct test_struct_3 ffi_test_26(void);
struct test_struct_4 { char x, y, z, a; };
-DLLEXPORT struct test_struct_4 ffi_test_27(void);
+F_EXPORT struct test_struct_4 ffi_test_27(void);
struct test_struct_5 { char x, y, z, a, b; };
-DLLEXPORT struct test_struct_5 ffi_test_28(void);
+F_EXPORT struct test_struct_5 ffi_test_28(void);
struct test_struct_6 { char x, y, z, a, b, c; };
-DLLEXPORT struct test_struct_6 ffi_test_29(void);
+F_EXPORT struct test_struct_6 ffi_test_29(void);
struct test_struct_7 { char x, y, z, a, b, c, d; };
-DLLEXPORT struct test_struct_7 ffi_test_30(void);
-DLLEXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41);
-DLLEXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41);
+F_EXPORT struct test_struct_7 ffi_test_30(void);
+F_EXPORT int ffi_test_31(int x0, int x1, int x2, int x3, int x4, int x5, int x6, int x7, int x8, int x9, int x10, int x11, int x12, int x13, int x14, int x15, int x16, int x17, int x18, int x19, int x20, int x21, int x22, int x23, int x24, int x25, int x26, int x27, int x28, int x29, int x30, int x31, int x32, int x33, int x34, int x35, int x36, int x37, int x38, int x39, int x40, int x41);
+F_EXPORT float ffi_test_31_point_5(float x0, float x1, float x2, float x3, float x4, float x5, float x6, float x7, float x8, float x9, float x10, float x11, float x12, float x13, float x14, float x15, float x16, float x17, float x18, float x19, float x20, float x21, float x22, float x23, float x24, float x25, float x26, float x27, float x28, float x29, float x30, float x31, float x32, float x33, float x34, float x35, float x36, float x37, float x38, float x39, float x40, float x41);
struct test_struct_8 { double x; double y; };
-DLLEXPORT double ffi_test_32(struct test_struct_8 x, int y);
+F_EXPORT double ffi_test_32(struct test_struct_8 x, int y);
struct test_struct_9 { float x; float y; };
-DLLEXPORT double ffi_test_33(struct test_struct_9 x, int y);
+F_EXPORT double ffi_test_33(struct test_struct_9 x, int y);
struct test_struct_10 { float x; int y; };
-DLLEXPORT double ffi_test_34(struct test_struct_10 x, int y);
+F_EXPORT double ffi_test_34(struct test_struct_10 x, int y);
struct test_struct_11 { int x; int y; };
-DLLEXPORT double ffi_test_35(struct test_struct_11 x, int y);
+F_EXPORT double ffi_test_35(struct test_struct_11 x, int y);
struct test_struct_12 { int a; double x; };
-DLLEXPORT double ffi_test_36(struct test_struct_12 x);
+F_EXPORT double ffi_test_36(struct test_struct_12 x);
-DLLEXPORT void ffi_test_36_point_5(void);
+F_EXPORT void ffi_test_36_point_5(void);
-DLLEXPORT int ffi_test_37(int (*f)(int, int, int));
+F_EXPORT int ffi_test_37(int (*f)(int, int, int));
-DLLEXPORT unsigned long long ffi_test_38(unsigned long long x, unsigned long long y);
+F_EXPORT unsigned long long ffi_test_38(unsigned long long x, unsigned long long y);
struct test_struct_13 { float x1, x2, x3, x4, x5, x6; };
-DLLEXPORT int ffi_test_39(long a, long b, struct test_struct_13 s);
+F_EXPORT int ffi_test_39(long a, long b, struct test_struct_13 s);
struct test_struct_14 { double x1, x2; };
-DLLEXPORT struct test_struct_14 ffi_test_40(double x1, double x2);
+F_EXPORT struct test_struct_14 ffi_test_40(double x1, double x2);
-DLLEXPORT struct test_struct_12 ffi_test_41(int a, double x);
+F_EXPORT struct test_struct_12 ffi_test_41(int a, double x);
struct test_struct_15 { float x, y; };
-DLLEXPORT struct test_struct_15 ffi_test_42(float x, float y);
+F_EXPORT struct test_struct_15 ffi_test_42(float x, float y);
struct test_struct_16 { float x; int a; };
-DLLEXPORT struct test_struct_16 ffi_test_43(float x, int a);
+F_EXPORT struct test_struct_16 ffi_test_43(float x, int a);
-DLLEXPORT struct test_struct_14 ffi_test_44();
+F_EXPORT struct test_struct_14 ffi_test_44();
-DLLEXPORT _Complex float ffi_test_45(int x);
+F_EXPORT _Complex float ffi_test_45(int x);
-DLLEXPORT _Complex double ffi_test_46(int x);
+F_EXPORT _Complex double ffi_test_46(int x);
-DLLEXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y);
+F_EXPORT _Complex float ffi_test_47(_Complex float x, _Complex double y);
namespace factor
{
-void *primitives[] = {
- (void *)primitive_bignum_to_fixnum,
- (void *)primitive_float_to_fixnum,
- (void *)primitive_fixnum_to_bignum,
- (void *)primitive_float_to_bignum,
- (void *)primitive_fixnum_to_float,
- (void *)primitive_bignum_to_float,
- (void *)primitive_str_to_float,
- (void *)primitive_float_to_str,
- (void *)primitive_float_bits,
- (void *)primitive_double_bits,
- (void *)primitive_bits_float,
- (void *)primitive_bits_double,
- (void *)primitive_fixnum_add,
- (void *)primitive_fixnum_subtract,
- (void *)primitive_fixnum_multiply,
- (void *)primitive_fixnum_divint,
- (void *)primitive_fixnum_divmod,
- (void *)primitive_fixnum_shift,
- (void *)primitive_bignum_eq,
- (void *)primitive_bignum_add,
- (void *)primitive_bignum_subtract,
- (void *)primitive_bignum_multiply,
- (void *)primitive_bignum_divint,
- (void *)primitive_bignum_mod,
- (void *)primitive_bignum_divmod,
- (void *)primitive_bignum_and,
- (void *)primitive_bignum_or,
- (void *)primitive_bignum_xor,
- (void *)primitive_bignum_not,
- (void *)primitive_bignum_shift,
- (void *)primitive_bignum_less,
- (void *)primitive_bignum_lesseq,
- (void *)primitive_bignum_greater,
- (void *)primitive_bignum_greatereq,
- (void *)primitive_bignum_bitp,
- (void *)primitive_bignum_log2,
- (void *)primitive_byte_array_to_bignum,
- (void *)primitive_float_eq,
- (void *)primitive_float_add,
- (void *)primitive_float_subtract,
- (void *)primitive_float_multiply,
- (void *)primitive_float_divfloat,
- (void *)primitive_float_mod,
- (void *)primitive_float_less,
- (void *)primitive_float_lesseq,
- (void *)primitive_float_greater,
- (void *)primitive_float_greatereq,
- (void *)primitive_word,
- (void *)primitive_word_xt,
- (void *)primitive_getenv,
- (void *)primitive_setenv,
- (void *)primitive_existsp,
- (void *)primitive_gc,
- (void *)primitive_gc_stats,
- (void *)primitive_save_image,
- (void *)primitive_save_image_and_exit,
- (void *)primitive_datastack,
- (void *)primitive_retainstack,
- (void *)primitive_callstack,
- (void *)primitive_set_datastack,
- (void *)primitive_set_retainstack,
- (void *)primitive_set_callstack,
- (void *)primitive_exit,
- (void *)primitive_data_room,
- (void *)primitive_code_room,
- (void *)primitive_micros,
- (void *)primitive_modify_code_heap,
- (void *)primitive_dlopen,
- (void *)primitive_dlsym,
- (void *)primitive_dlclose,
- (void *)primitive_byte_array,
- (void *)primitive_uninitialized_byte_array,
- (void *)primitive_displaced_alien,
- (void *)primitive_alien_signed_cell,
- (void *)primitive_set_alien_signed_cell,
- (void *)primitive_alien_unsigned_cell,
- (void *)primitive_set_alien_unsigned_cell,
- (void *)primitive_alien_signed_8,
- (void *)primitive_set_alien_signed_8,
- (void *)primitive_alien_unsigned_8,
- (void *)primitive_set_alien_unsigned_8,
- (void *)primitive_alien_signed_4,
- (void *)primitive_set_alien_signed_4,
- (void *)primitive_alien_unsigned_4,
- (void *)primitive_set_alien_unsigned_4,
- (void *)primitive_alien_signed_2,
- (void *)primitive_set_alien_signed_2,
- (void *)primitive_alien_unsigned_2,
- (void *)primitive_set_alien_unsigned_2,
- (void *)primitive_alien_signed_1,
- (void *)primitive_set_alien_signed_1,
- (void *)primitive_alien_unsigned_1,
- (void *)primitive_set_alien_unsigned_1,
- (void *)primitive_alien_float,
- (void *)primitive_set_alien_float,
- (void *)primitive_alien_double,
- (void *)primitive_set_alien_double,
- (void *)primitive_alien_cell,
- (void *)primitive_set_alien_cell,
- (void *)primitive_alien_address,
- (void *)primitive_set_slot,
- (void *)primitive_string_nth,
- (void *)primitive_set_string_nth_fast,
- (void *)primitive_set_string_nth_slow,
- (void *)primitive_resize_array,
- (void *)primitive_resize_string,
- (void *)primitive_array,
- (void *)primitive_begin_scan,
- (void *)primitive_next_object,
- (void *)primitive_end_scan,
- (void *)primitive_size,
- (void *)primitive_die,
- (void *)primitive_fopen,
- (void *)primitive_fgetc,
- (void *)primitive_fread,
- (void *)primitive_fputc,
- (void *)primitive_fwrite,
- (void *)primitive_fflush,
- (void *)primitive_fseek,
- (void *)primitive_fclose,
- (void *)primitive_wrapper,
- (void *)primitive_clone,
- (void *)primitive_string,
- (void *)primitive_array_to_quotation,
- (void *)primitive_quotation_xt,
- (void *)primitive_tuple,
- (void *)primitive_profiling,
- (void *)primitive_become,
- (void *)primitive_sleep,
- (void *)primitive_tuple_boa,
- (void *)primitive_callstack_to_array,
- (void *)primitive_innermost_stack_frame_quot,
- (void *)primitive_innermost_stack_frame_scan,
- (void *)primitive_set_innermost_stack_frame_quot,
- (void *)primitive_call_clear,
- (void *)primitive_resize_byte_array,
- (void *)primitive_dll_validp,
- (void *)primitive_unimplemented,
- (void *)primitive_clear_gc_stats,
- (void *)primitive_jit_compile,
- (void *)primitive_load_locals,
- (void *)primitive_check_datastack,
- (void *)primitive_inline_cache_miss,
- (void *)primitive_mega_cache_miss,
- (void *)primitive_lookup_method,
- (void *)primitive_reset_dispatch_stats,
- (void *)primitive_dispatch_stats,
- (void *)primitive_reset_inline_cache_stats,
- (void *)primitive_inline_cache_stats,
- (void *)primitive_optimized_p,
+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_add,
+ primitive_fixnum_subtract,
+ primitive_fixnum_multiply,
+ 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,
+ primitive_word,
+ primitive_word_xt,
+ primitive_getenv,
+ primitive_setenv,
+ primitive_existsp,
+ primitive_gc,
+ primitive_gc_stats,
+ primitive_save_image,
+ primitive_save_image_and_exit,
+ primitive_datastack,
+ primitive_retainstack,
+ primitive_callstack,
+ primitive_set_datastack,
+ primitive_set_retainstack,
+ primitive_set_callstack,
+ primitive_exit,
+ primitive_data_room,
+ primitive_code_room,
+ primitive_micros,
+ 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_begin_scan,
+ primitive_next_object,
+ primitive_end_scan,
+ primitive_size,
+ primitive_die,
+ primitive_fopen,
+ primitive_fgetc,
+ primitive_fread,
+ primitive_fputc,
+ primitive_fwrite,
+ primitive_fflush,
+ 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_quot,
+ primitive_innermost_stack_frame_scan,
+ primitive_set_innermost_stack_frame_quot,
+ primitive_call_clear,
+ primitive_resize_byte_array,
+ primitive_dll_validp,
+ primitive_unimplemented,
+ primitive_clear_gc_stats,
+ primitive_jit_compile,
+ primitive_load_locals,
+ primitive_check_datastack,
+ primitive_inline_cache_miss,
+ primitive_mega_cache_miss,
+ primitive_lookup_method,
+ primitive_reset_dispatch_stats,
+ primitive_dispatch_stats,
+ primitive_reset_inline_cache_stats,
+ primitive_inline_cache_stats,
+ primitive_optimized_p,
};
}
namespace factor
{
-extern void *primitives[];
+extern "C" typedef void (*primitive_type)();
+extern const primitive_type primitives[];
#define PRIMITIVE(name) extern "C" void primitive_##name()
static bool reallot_string_in_place_p(string *str, cell capacity)
{
- return in_zone(&nursery,str) && capacity <= string_capacity(str);
+ return in_zone(&nursery,str)
+ && (str->aux == F || in_zone(&nursery,untag<byte_array>(str->aux)))
+ && capacity <= string_capacity(str);
}
string* reallot_string(string *str_, cell capacity)
projects / factor.git / commitdiff