CFLAGS += -O3
endif
+ifdef REENTRANT
+ CFLAGS += -DFACTOR_REENTRANT
+endif
+
CFLAGS += $(SITE_CFLAGS)
ENGINE = $(DLL_PREFIX)factor$(DLL_SUFFIX)$(DLL_EXTENSION)
vm/byte_arrays.o \
vm/callstack.o \
vm/code_block.o \
- vm/code_gc.o \
vm/code_heap.o \
vm/contexts.o \
vm/data_gc.o \
vm/dispatch.o \
vm/errors.o \
vm/factor.o \
+ vm/heap.o \
vm/image.o \
vm/inline_cache.o \
vm/io.o \
vm/strings.o \
vm/tuples.o \
vm/utilities.o \
+ vm/vm.o \
vm/words.o \
vm/write_barrier.o
Factor.app/Contents/MacOS/factor
$(EXECUTABLE): $(DLL_OBJS) $(EXE_OBJS)
- $(LINKER) $(ENGINE) $(DLL_OBJS)
- $(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
+ $(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)
- $(LINKER) $(ENGINE) $(DLL_OBJS)
- $(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
+ $(TOOLCHAIN_PREFIX)$(LINKER) $(ENGINE) $(DLL_OBJS)
+ $(TOOLCHAIN_PREFIX)$(CPP) $(LIBS) $(LIBPATH) -L. $(LINK_WITH_ENGINE) \
$(CFLAGS) $(CFLAGS_CONSOLE) -o factor$(EXE_SUFFIX)$(CONSOLE_EXTENSION) $(EXE_OBJS)
$(TEST_LIBRARY): vm/ffi_test.o
- $(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
+ $(TOOLCHAIN_PREFIX)$(CC) $(LIBPATH) $(CFLAGS) $(FFI_TEST_CFLAGS) $(SHARED_FLAG) -o libfactor-ffi-test$(SHARED_DLL_EXTENSION) $(TEST_OBJS)
clean:
rm -f vm/*.o
etags vm/*.{cpp,hpp,mm,S,c}
vm/resources.o:
- $(WINDRES) vm/factor.rs vm/resources.o
+ $(TOOLCHAIN_PREFIX)$(WINDRES) vm/factor.rs vm/resources.o
vm/ffi_test.o: vm/ffi_test.c
- $(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) $(FFI_TEST_CFLAGS) -o $@ $<
.c.o:
- $(CC) -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CC) -c $(CFLAGS) -o $@ $<
.cpp.o:
- $(CPP) -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
.S.o:
- $(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CC) -x assembler-with-cpp -c $(CFLAGS) -o $@ $<
.mm.o:
- $(CPP) -c $(CFLAGS) -o $@ $<
+ $(TOOLCHAIN_PREFIX)$(CPP) -c $(CFLAGS) -o $@ $<
.PHONY: factor tags clean
\r
ARTICLE: "alarms" "Alarms"\r
"The " { $vocab-link "alarms" } " vocabulary provides a lightweight way to schedule one-time and recurring tasks without spawning a new thread."\r
-{ $subsection alarm }\r
-{ $subsection add-alarm }\r
-{ $subsection later }\r
-{ $subsection cancel-alarm }\r
+{ $subsections\r
+ alarm\r
+ add-alarm\r
+ later\r
+ cancel-alarm\r
+}\r
"Alarms do not persist across image saves. Saving and restoring an image has the effect of calling " { $link cancel-alarm } " on all " { $link alarm } " instances." ;\r
\r
ABOUT: "alarms"\r
+++ /dev/null
-IN: alien.arrays\r
-USING: help.syntax help.markup byte-arrays alien.c-types ;\r
-\r
-ARTICLE: "c-arrays" "C arrays"\r
-"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "."\r
-$nl\r
-"C type specifiers for array types are documented in " { $link "c-types-specs" } "."\r
-$nl\r
-"Specialized sequences are provided for accessing memory as an array of primitive type values. These sequences are implemented in the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets. They can also be loaded and constructed through their primitive C types:"\r
-{ $subsection require-c-type-arrays }\r
-{ $subsection <c-type-array> }\r
-{ $subsection <c-type-direct-array> } ;\r
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.strings alien.c-types alien.accessors alien.structs
-arrays words sequences math kernel namespaces fry libc cpu.architecture
+USING: alien alien.strings alien.c-types alien.data alien.accessors
+arrays words sequences math kernel namespaces fry cpu.architecture
io.encodings.utf8 accessors ;
IN: alien.arrays
-UNION: value-type array struct-type ;
+INSTANCE: array value-type
M: array c-type ;
M: array c-type-stack-align? drop f ;
-M: array unbox-parameter drop "void*" unbox-parameter ;
+M: array unbox-parameter drop void* unbox-parameter ;
-M: array unbox-return drop "void*" unbox-return ;
+M: array unbox-return drop void* unbox-return ;
-M: array box-parameter drop "void*" box-parameter ;
+M: array box-parameter drop void* box-parameter ;
-M: array box-return drop "void*" box-return ;
+M: array box-return drop void* box-return ;
-M: array stack-size drop "void*" stack-size ;
+M: array stack-size drop void* stack-size ;
M: array c-type-boxer-quot
unclip
[ array-length ]
- [ [ require-c-type-arrays ] keep ] bi*
- [ <c-type-direct-array> ] 2curry ;
+ [ [ require-c-array ] keep ] bi*
+ [ <c-direct-array> ] 2curry ;
M: array c-type-unboxer-quot drop [ >c-ptr ] ;
-M: value-type c-type-rep drop int-rep ;
-
-M: value-type c-type-getter
- drop [ swap <displaced-alien> ] ;
-
-M: value-type c-type-setter ( type -- quot )
- [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
- '[ @ swap @ _ memcpy ] ;
-
PREDICATE: string-type < pair
- first2 [ "char*" = ] [ word? ] bi* and ;
+ first2 [ char* = ] [ word? ] bi* and ;
M: string-type c-type ;
M: string-type c-type-boxed-class drop object ;
M: string-type heap-size
- drop "void*" heap-size ;
+ drop void* heap-size ;
M: string-type c-type-align
- drop "void*" c-type-align ;
+ drop void* c-type-align ;
M: string-type c-type-stack-align?
- drop "void*" c-type-stack-align? ;
+ drop void* c-type-stack-align? ;
M: string-type unbox-parameter
- drop "void*" unbox-parameter ;
+ drop void* unbox-parameter ;
M: string-type unbox-return
- drop "void*" unbox-return ;
+ drop void* unbox-return ;
M: string-type box-parameter
- drop "void*" box-parameter ;
+ drop void* box-parameter ;
M: string-type box-return
- drop "void*" box-return ;
+ drop void* box-return ;
M: string-type stack-size
- drop "void*" stack-size ;
+ drop void* stack-size ;
M: string-type c-type-rep
drop int-rep ;
M: string-type c-type-boxer
- drop "void*" c-type-boxer ;
+ drop void* c-type-boxer ;
M: string-type c-type-unboxer
- drop "void*" c-type-unboxer ;
+ drop void* c-type-unboxer ;
M: string-type c-type-boxer-quot
second '[ _ alien>string ] ;
M: string-type c-type-setter
drop [ set-alien-cell ] ;
-{ "char*" utf8 } "char*" typedef
-"char*" "uchar*" typedef
+{ char* utf8 } char* typedef
+char* uchar* typedef
+char char* "pointer-c-type" set-word-prop
+uchar uchar* "pointer-c-type" set-word-prop
+USING: alien alien.complex help.syntax help.markup libc kernel.private
+byte-arrays strings hashtables alien.syntax alien.strings sequences
+io.encodings.string debugger destructors vocabs.loader
+classes.struct ;
+QUALIFIED: math
+QUALIFIED: sequences
IN: alien.c-types
-USING: alien help.syntax help.markup libc kernel.private
-byte-arrays math strings hashtables alien.syntax alien.strings sequences
-io.encodings.string debugger destructors vocabs.loader ;
+
+HELP: byte-length
+{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
+{ $contract "Outputs the size of the byte array, struct, or specialized array data in bytes." } ;
+
+HELP: heap-size
+{ $values { "name" "a C type name" } { "size" math:integer } }
+{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
+{ $examples
+ { $example "USING: alien alien.c-types prettyprint ;\nint heap-size ." "4" }
+}
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
+
+HELP: stack-size
+{ $values { "name" "a C type name" } { "size" math:integer } }
+{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
+{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
HELP: <c-type>
-{ $values { "type" hashtable } }
+{ $values { "c-type" c-type } }
{ $description "Creates a prototypical C type. User code should use higher-level facilities to define C types; see " { $link "c-data" } "." } ;
HELP: no-c-type
-{ $values { "type" string } }
+{ $values { "name" "a C type name" } }
{ $description "Throws a " { $link no-c-type } " error." }
{ $error-description "Thrown by " { $link c-type } " if a given string does not name a C type. When thrown during compile time, indicates a typo in an " { $link alien-invoke } " or " { $link alien-callback } " form." } ;
{ $var-description "Global variable holding a hashtable mapping C type names to C types. Use the " { $link c-type } " word to look up C types." } ;
HELP: c-type
-{ $values { "name" string } { "type" hashtable } }
+{ $values { "name" "a C type" } { "c-type" c-type } }
{ $description "Looks up a C type by name." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-HELP: heap-size
-{ $values { "type" string } { "size" integer } }
-{ $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
-{ $examples
- "On a 32-bit system, you will get the following output:"
- { $unchecked-example "USE: alien\n\"void*\" heap-size ." "4" }
-}
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-
-HELP: stack-size
-{ $values { "type" string } { "size" integer } }
-{ $description "Outputs the number of bytes to reserve on the C stack by a value of this C type. In most cases this is equal to " { $link heap-size } ", except on some platforms where C structs are passed by invisible reference, in which case a C struct type only uses as much space as a pointer on the C stack." }
-{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
-
-HELP: byte-length
-{ $values { "seq" "A byte array or float array" } { "n" "a non-negative integer" } }
-{ $contract "Outputs the size of the byte array or float array data in bytes as presented to the C library interface." } ;
-
HELP: c-getter
-{ $values { "name" string } { "quot" { $quotation "( c-ptr n -- obj )" } } }
+{ $values { "name" "a C type" } { "quot" { $quotation "( c-ptr n -- obj )" } } }
{ $description "Outputs a quotation which reads values of this C type from a C structure." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
HELP: c-setter
-{ $values { "name" string } { "quot" { $quotation "( obj c-ptr n -- )" } } }
+{ $values { "name" "a C type" } { "quot" { $quotation "( obj c-ptr n -- )" } } }
{ $description "Outputs a quotation which writes values of this C type to a C structure." }
{ $errors "Throws an error if the type does not exist." } ;
-HELP: <c-array>
-{ $deprecated "New code should use " { $link <c-type-array> } " or the " { $vocab-link "specialized-arrays" } " vocabularies." }
-{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" byte-array } }
-{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
-{ $errors "Throws an error if the type does not exist or the requested size is negative." } ;
-
-HELP: <c-object>
-{ $values { "type" "a C type" } { "array" byte-array } }
-{ $description "Creates a byte array suitable for holding a value with the given C type." }
-{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
-
-{ <c-object> malloc-object } related-words
-
-HELP: memory>byte-array
-{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
-{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
-
-HELP: byte-array>memory
-{ $values { "byte-array" byte-array } { "base" c-ptr } }
-{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
-{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
-
-HELP: malloc-array
-{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-type-direct-array> } "." }
-{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
-
-HELP: malloc-object
-{ $values { "type" "a C type" } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ;
-
-HELP: malloc-byte-array
-{ $values { "byte-array" byte-array } { "alien" alien } }
-{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if memory allocation fails." } ;
-
-{ <c-type-array> <c-type-direct-array> malloc-array } related-words
-
HELP: box-parameter
-{ $values { "n" integer } { "ctype" string } }
+{ $values { "n" math:integer } { "c-type" "a C type" } }
{ $description "Generates code for converting a C value stored at offset " { $snippet "n" } " from the top of the stack into a Factor object to be pushed on the data stack." }
{ $notes "This is an internal word used by the compiler when compiling callbacks." } ;
HELP: box-return
-{ $values { "ctype" string } }
+{ $values { "c-type" "a C type" } }
{ $description "Generates code for converting a C value stored in return registers into a Factor object to be pushed on the data stack." }
{ $notes "This is an internal word used by the compiler when compiling alien calls." } ;
HELP: unbox-return
-{ $values { "ctype" string } }
+{ $values { "c-type" "a C type" } }
{ $description "Generates code for converting a Factor value on the data stack into a C value to be stored in the return registers." }
{ $notes "This is an internal word used by the compiler when compiling callbacks." } ;
{ $description "Defines a word " { $snippet "<" { $emphasis "name" } ">" } " with stack effect " { $snippet "( value -- array )" } ". This word allocates a byte array large enough to hold a value with C type " { $snippet "name" } ", and writes the value at the top of the stack to the array." }
{ $notes "This is an internal word called when defining C types, there is no need to call it on your own." } ;
-{ string>alien alien>string malloc-string } related-words
-
-HELP: malloc-string
-{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
-{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
-{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
-{ $errors "Throws an error if one of the following conditions occurs:"
- { $list
- "the string contains null code points"
- "the string contains characters not representable using the encoding specified"
- "memory allocation fails"
- }
-} ;
-
-HELP: require-c-type-arrays
-{ $values { "c-type" "a C type" } }
-{ $description { $link require } "s any unloaded vocabularies needed to construct a specialized array or direct array of " { $snippet "c-type" } " using the " { $link <c-type-array> } " or " { $link <c-type-direct-array> } " vocabularies." }
-{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "specialized-arrays.direct" } " vocabulary sets for details on the underlying sequence types loaded." } ;
+HELP: char
+{ $description "This C type represents a one-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to eight bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: uchar
+{ $description "This C type represents a one-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to eight bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: short
+{ $description "This C type represents a two-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to sixteen bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: ushort
+{ $description "This C type represents a two-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to sixteen bits; output values will be returned as " { $link math:fixnum } "s." } ;
+HELP: int
+{ $description "This C type represents a four-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to 32 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: uint
+{ $description "This C type represents a four-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 32 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: long
+{ $description "This C type represents a four- or eight-byte signed integer type. On Windows and on 32-bit Unix platforms, it will be four bytes. On 64-bit Unix platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: intptr_t
+{ $description "This C type represents a signed integer type large enough to hold any pointer value; that is, on 32-bit platforms, it will be four bytes, and on 64-bit platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: ulong
+{ $description "This C type represents a four- or eight-byte unsigned integer type. On Windows and on 32-bit Unix platforms, it will be four bytes. On 64-bit Unix platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: uintptr_t
+{ $description "This C type represents an unsigned integer type large enough to hold any pointer value; that is, on 32-bit platforms, it will be four bytes, and on 64-bit platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: ptrdiff_t
+{ $description "This C type represents a signed integer type large enough to hold the distance between two pointer values; that is, on 32-bit platforms, it will be four bytes, and on 64-bit platforms, it will be eight bytes. Input values will be converted to " { $link math:integer } "s and truncated to 32 or 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: size_t
+{ $description "This C type represents unsigned size values of the size expected by the platform's standard C library (usually four bytes on a 32-bit platform, and eight on a 64-bit platform). Input values will be converted to " { $link math:integer } "s and truncated to the appropriate size; output values will be returned as " { $link math:integer } "s." } ;
+HELP: longlong
+{ $description "This C type represents an eight-byte signed integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: ulonglong
+{ $description "This C type represents an eight-byte unsigned integer type. Input values will be converted to " { $link math:integer } "s and truncated to 64 bits; output values will be returned as " { $link math:integer } "s." } ;
+HELP: void
+{ $description "This symbol is not a valid C type, but it can be used as the return type for a " { $link POSTPONE: FUNCTION: } " or " { $link POSTPONE: CALLBACK: } " definition or for an " { $link alien-invoke } " or " { $link alien-callback } " call." } ;
+HELP: void*
+{ $description "This C type represents a pointer to C memory. " { $link byte-array } " and " { $link alien } " values can be passed as " { $snippet "void*" } " function inputs, but see " { $link "byte-arrays-gc" } " for notes about passing byte arrays into C functions. " { $snippet "void*" } " output values are returned as " { $link alien } "s." } ;
+HELP: char*
+{ $description "This C type represents a pointer to a C string. See " { $link "c-strings" } " for details about using strings with the FFI." } ;
+HELP: float
+{ $description "This C type represents a single-precision IEEE 754 floating-point type. Input values will be converted to Factor " { $link math:float } "s and demoted to single-precision; output values will be returned as Factor " { $link math:float } "s." } ;
+HELP: double
+{ $description "This C type represents a double-precision IEEE 754 floating-point type. Input values will be converted to Factor " { $link math:float } "s; output values will be returned as Factor " { $link math:float } "s." } ;
+HELP: complex-float
+{ $description "This C type represents a single-precision IEEE 754 floating-point complex type. Input values will be converted from Factor " { $link math:complex } " objects into a single-precision complex float type; output values will be returned as Factor " { $link math:complex } " objects." } ;
+HELP: complex-double
+{ $description "This C type represents a double-precision IEEE 754 floating-point complex type. Input values will be converted from Factor " { $link math:complex } " objects into a double-precision complex float type; output values will be returned as Factor " { $link math:complex } " objects." } ;
-HELP: <c-type-array>
-{ $values { "len" integer } { "c-type" "a C type" } { "array" "a specialized array" } }
-{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } "." }
-{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary set for details on the underlying sequence type constructed." } ;
-
-HELP: <c-type-direct-array>
-{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
-{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
-{ $notes "The appropriate direct specialized array vocabulary must be loaded; otherwise, a " { $link specialized-array-vocab-not-loaded } " error will be thrown. The vocabulary can be loaded with a " { $link POSTPONE: USING: } " form as usual, or with the " { $link require-c-type-arrays } " word. See the " { $vocab-link "specialized-arrays.direct" } " vocabulary set for details on the underlying sequence type constructed." } ;
-
-ARTICLE: "c-strings" "C strings"
-"C string types are arrays with shape " { $snippet "{ \"char*\" encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $snippet "\"char*\"" } " is an alias for " { $snippet "{ \"char*\" utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
-$nl
-"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
-$nl
-"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
-$nl
-"Care must be taken if the C function expects a " { $snippet "char*" } " with a length in bytes, rather than a null-terminated " { $snippet "char*" } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
-$nl
-"Sometimes a C function has a parameter type of " { $snippet "void*" } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
-{ $subsection string>alien }
-{ $subsection malloc-string }
-"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
-$nl
-"A word to read strings from arbitrary addresses:"
-{ $subsection alien>string }
-"For example, if a C function returns a " { $snippet "char*" } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $snippet "void*" } ", and call one of the above words before passing the pointer to " { $link free } "." ;
ARTICLE: "byte-arrays-gc" "Byte arrays and the garbage collector"
"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the garbage collector will not run while C code still has a reference to the data."
"A frequently-occurring idiom in C code is the \"out parameter\". If a C function returns more than one value, the caller passes pointers of the correct type, and the C function writes its return values to those locations."
$nl
"Each numerical C type, together with " { $snippet "void*" } ", has an associated " { $emphasis "out parameter constructor" } " word which takes a Factor object as input, constructs a byte array of the correct size, and converts the Factor object to a C value stored into the byte array:"
-{ $subsection <char> }
-{ $subsection <uchar> }
-{ $subsection <short> }
-{ $subsection <ushort> }
-{ $subsection <int> }
-{ $subsection <uint> }
-{ $subsection <long> }
-{ $subsection <ulong> }
-{ $subsection <longlong> }
-{ $subsection <ulonglong> }
-{ $subsection <float> }
-{ $subsection <double> }
-{ $subsection <void*> }
+{ $subsections
+ <char>
+ <uchar>
+ <short>
+ <ushort>
+ <int>
+ <uint>
+ <long>
+ <ulong>
+ <longlong>
+ <ulonglong>
+ <float>
+ <double>
+ <void*>
+}
"You call the out parameter constructor with the required initial value, then pass the byte array to the C function, which receives a pointer to the start of the byte array's data area. The C function then returns, leaving the result in the byte array; you read it back using the next set of words:"
-{ $subsection *char }
-{ $subsection *uchar }
-{ $subsection *short }
-{ $subsection *ushort }
-{ $subsection *int }
-{ $subsection *uint }
-{ $subsection *long }
-{ $subsection *ulong }
-{ $subsection *longlong }
-{ $subsection *ulonglong }
-{ $subsection *float }
-{ $subsection *double }
-{ $subsection *void* }
+{ $subsections
+ *char
+ *uchar
+ *short
+ *ushort
+ *int
+ *uint
+ *long
+ *ulong
+ *longlong
+ *ulonglong
+ *float
+ *double
+ *void*
+}
"Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link <void*> } " and " { $link *void* } " may be used." ;
-ARTICLE: "c-types-specs" "C type specifiers"
-"C types are identified by strings, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words, as well as " { $link POSTPONE: C-STRUCT: } ", " { $link POSTPONE: C-UNION: } " and " { $link POSTPONE: TYPEDEF: } "."
-$nl
-"The following numerical types are available; a " { $snippet "u" } " prefix denotes an unsigned type:"
+ARTICLE: "c-types.primitives" "Primitive C types"
+"The following numerical types are defined in the " { $vocab-link "alien.c-types" } " vocabulary; a " { $snippet "u" } " prefix denotes an unsigned type:"
{ $table
{ "C type" "Notes" }
- { { $snippet "char" } "always 1 byte" }
- { { $snippet "uchar" } { } }
- { { $snippet "short" } "always 2 bytes" }
- { { $snippet "ushort" } { } }
- { { $snippet "int" } "always 4 bytes" }
- { { $snippet "uint" } { } }
- { { $snippet "long" } { "same size as CPU word size and " { $snippet "void*" } ", except on 64-bit Windows, where it is 4 bytes" } }
- { { $snippet "ulong" } { } }
- { { $snippet "longlong" } "always 8 bytes" }
- { { $snippet "ulonglong" } { } }
- { { $snippet "float" } { } }
- { { $snippet "double" } { "same format as " { $link float } " objects" } }
- { { $snippet "complex-float" } { "C99 " { $snippet "complex float" } " type, converted to and from " { $link complex } " values" } }
- { { $snippet "complex-double" } { "C99 " { $snippet "complex double" } " type, converted to and from " { $link complex } " values" } }
+ { { $link char } "always 1 byte" }
+ { { $link uchar } { } }
+ { { $link short } "always 2 bytes" }
+ { { $link ushort } { } }
+ { { $link int } "always 4 bytes" }
+ { { $link uint } { } }
+ { { $link long } { "same size as CPU word size and " { $link void* } ", except on 64-bit Windows, where it is 4 bytes" } }
+ { { $link ulong } { } }
+ { { $link longlong } "always 8 bytes" }
+ { { $link ulonglong } { } }
+ { { $link float } { "single-precision float (not the same as Factor's " { $link math:float } " class!)" } }
+ { { $link double } { "double-precision float (the same format as Factor's " { $link math:float } " objects)" } }
}
-"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision."
-$nl
-"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $snippet "void*" } ", which denotes a generic pointer; " { $snippet "void" } " by itself is not a valid C type specifier. With the exception of strings (see " { $link "c-strings" } "), all pointer types are identical to " { $snippet "void*" } " as far as the C library interface is concerned."
+"The following C99 complex number types are defined in the " { $vocab-link "alien.complex" } " vocabulary:"
+{ $table
+ { { $link complex-float } { "C99 or Fortran " { $snippet "complex float" } " type, converted to and from Factor " { $link math:complex } " values" } }
+ { { $link complex-double } { "C99 or Fortran " { $snippet "complex double" } " type, converted to and from Factor " { $link math:complex } " values" } }
+}
+"When making alien calls, Factor numbers are converted to and from the above types in a canonical way. Converting a Factor number to a C value may result in a loss of precision." ;
+
+ARTICLE: "c-types.pointers" "Pointer and array types"
+"Pointer types are specified by suffixing a C type with " { $snippet "*" } ", for example " { $snippet "float*" } ". One special case is " { $link void* } ", which denotes a generic pointer; " { $link void } " by itself is not a valid C type specifier. With the exception of strings (see " { $link "c-strings" } "), all pointer types are identical to " { $snippet "void*" } " as far as the C library interface is concerned."
$nl
"Fixed-size array types are supported; the syntax consists of a C type name followed by dimension sizes in brackets; the following denotes a 3 by 4 array of integers:"
{ $code "int[3][4]" }
-"Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation."
-$nl
-"Structure and union types are specified by the name of the structure or union." ;
+"Fixed-size arrays differ from pointers in that they are allocated inside structures and unions; however when used as function parameters they behave exactly like pointers and thus the dimensions only serve as documentation." ;
-ARTICLE: "c-byte-arrays" "Passing data in byte arrays"
-"Instances of the " { $link byte-array } " class can be passed to C functions; the C function receives a pointer to the first element of the array."
-$nl
-"Byte arrays can be allocated directly with a byte count using the " { $link <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
-{ $subsection <c-object> }
-{ $subsection <c-array> }
-{ $warning
-"The Factor garbage collector can move byte arrays around, and code passing byte arrays to C must obey important guidelines. See " { $link "byte-arrays-gc" } "." }
-{ $see-also "c-arrays" } ;
+ARTICLE: "c-types.ambiguity" "Word name clashes with C types"
+"Note that some of the C type word names clash with commonly-used Factor words:"
+{ $list
+ { { $link short } " clashes with the " { $link sequences:short } " word in the " { $vocab-link "sequences" } " vocabulary" }
+ { { $link float } " clashes with the " { $link math:float } " word in the " { $vocab-link "math" } " vocabulary" }
+}
+"If you use the wrong vocabulary, you will see a " { $link no-c-type } " error. For example, the following is " { $strong "not" } " valid, and will raise an error because the " { $link math:float } " word from the " { $vocab-link "math" } " vocabulary is not a C type:"
+{ $code
+ "USING: alien.syntax math prettyprint ;"
+ "FUNCTION: float magic_number ( ) ;"
+ "magic_number 3.0 + ."
+}
+"The following won't work either; now the problem is that there are two vocabularies in the search path that define a word named " { $snippet "float" } ":"
+{ $code
+ "USING: alien.c-types alien.syntax math prettyprint ;"
+ "FUNCTION: float magic_number ( ) ;"
+ "magic_number 3.0 + ."
+}
+"The correct solution is to use one of " { $link POSTPONE: FROM: } ", " { $link POSTPONE: QUALIFIED: } " or " { $link POSTPONE: QUALIFIED-WITH: } " to disambiguate word lookup:"
+{ $code
+ "USING: alien.syntax math prettyprint ;"
+ "QUALIFIED-WITH: alien.c-types c"
+ "FUNCTION: c:float magic_number ( ) ;"
+ "magic_number 3.0 + ."
+}
+"See " { $link "word-search-semantics" } " for details." ;
-ARTICLE: "malloc" "Manual memory management"
-"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case."
-$nl
-"Allocating a C datum with a fixed address:"
-{ $subsection malloc-object }
-{ $subsection malloc-array }
-{ $subsection malloc-byte-array }
-"There is a set of words in the " { $vocab-link "libc" } " vocabulary which directly call C standard library memory management functions:"
-{ $subsection malloc }
-{ $subsection calloc }
-{ $subsection realloc }
-"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
-{ $subsection free }
-"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
-{ $subsection &free }
-{ $subsection |free }
-"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
-$nl
-"You can unsafely copy a range of bytes from one memory location to another:"
-{ $subsection memcpy }
-"You can copy a range of bytes from memory into a byte array:"
-{ $subsection memory>byte-array }
-"You can copy a byte array to memory unsafely:"
-{ $subsection byte-array>memory } ;
+ARTICLE: "c-types.structs" "Struct and union types"
+"Struct and union types are identified by their class word. See " { $link "classes.struct" } "." ;
-ARTICLE: "c-data" "Passing data between Factor and C"
-"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
-$nl
-"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
-{ $subsection "c-types-specs" }
-{ $subsection "c-byte-arrays" }
-{ $subsection "malloc" }
-{ $subsection "c-strings" }
-{ $subsection "c-arrays" }
-{ $subsection "c-out-params" }
-"Important guidelines for passing data in byte arrays:"
-{ $subsection "byte-arrays-gc" }
-"C-style enumerated types are supported:"
-{ $subsection POSTPONE: C-ENUM: }
-"C types can be aliased for convenience and consitency with native library documentation:"
-{ $subsection POSTPONE: TYPEDEF: }
-"New C types can be defined:"
-{ $subsection "c-structs" }
-{ $subsection "c-unions" }
-"A utility for defining " { $link "destructors" } " for deallocating memory:"
-{ $subsection "alien.destructors" }
-{ $see-also "aliens" } ;
+ARTICLE: "c-types-specs" "C type specifiers"
+"C types are identified by special words, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words."
+$nl
+"Defining new C types:"
+{ $subsections
+ POSTPONE: STRUCT:
+ POSTPONE: UNION-STRUCT:
+ POSTPONE: CALLBACK:
+ POSTPONE: TYPEDEF:
+}
+{ $heading "Related articles" }
+{ $subsections
+ "c-types.primitives"
+ "c-types.pointers"
+ "c-types.ambiguity"
+ "c-types.structs"
+}
+;
+
+ABOUT: "c-types-specs"
-USING: alien alien.syntax alien.c-types kernel tools.test
-sequences system libc alien.strings io.encodings.utf8 ;
+USING: alien alien.syntax alien.c-types alien.parser
+eval kernel tools.test sequences system libc alien.strings
+io.encodings.utf8 math.constants classes.struct classes ;
IN: alien.c-types.tests
CONSTANT: xyz 123
-[ 492 ] [ { "int" xyz } heap-size ] unit-test
+[ 492 ] [ { int xyz } heap-size ] unit-test
[ -1 ] [ -1 <char> *char ] unit-test
[ -1 ] [ -1 <short> *short ] unit-test
[ -1 ] [ -1 <int> *int ] unit-test
-C-UNION: foo
- "int"
- "int" ;
+UNION-STRUCT: foo
+ { a int }
+ { b int } ;
-[ f ] [ "char*" c-type "void*" c-type eq? ] unit-test
-[ t ] [ "char**" c-type "void*" c-type eq? ] unit-test
+[ f ] [ char resolve-pointer-type c-type void* c-type eq? ] unit-test
+[ t ] [ char* resolve-pointer-type c-type void* c-type eq? ] unit-test
-[ t ] [ "foo" heap-size "int" heap-size = ] unit-test
+[ t ] [ foo heap-size int heap-size = ] unit-test
TYPEDEF: int MyInt
-[ t ] [ "int" c-type "MyInt" c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyInt*" c-type eq? ] unit-test
+[ t ] [ int c-type MyInt c-type eq? ] unit-test
+[ t ] [ void* c-type MyInt resolve-pointer-type c-type eq? ] unit-test
TYPEDEF: char MyChar
-[ t ] [ "char" c-type "MyChar" c-type eq? ] unit-test
-[ f ] [ "void*" c-type "MyChar*" c-type eq? ] unit-test
-[ t ] [ "char*" c-type "MyChar*" c-type eq? ] unit-test
+[ t ] [ char c-type MyChar c-type eq? ] unit-test
+[ f ] [ void* c-type MyChar resolve-pointer-type c-type eq? ] unit-test
+[ t ] [ char* c-type MyChar resolve-pointer-type c-type eq? ] unit-test
-[ 32 ] [ { "int" 8 } heap-size ] unit-test
+[ 32 ] [ { int 8 } heap-size ] unit-test
TYPEDEF: char* MyString
-[ t ] [ "char*" c-type "MyString" c-type eq? ] unit-test
-[ t ] [ "void*" c-type "MyString*" c-type eq? ] unit-test
+[ t ] [ char* c-type MyString c-type eq? ] unit-test
+[ t ] [ void* c-type MyString resolve-pointer-type c-type eq? ] unit-test
TYPEDEF: int* MyIntArray
-[ t ] [ "void*" c-type "MyIntArray" c-type eq? ] unit-test
+[ t ] [ void* c-type MyIntArray c-type eq? ] unit-test
TYPEDEF: uchar* MyLPBYTE
-[ t ] [ { "char*" utf8 } c-type "MyLPBYTE" c-type = ] unit-test
+[ t ] [ { char* utf8 } c-type MyLPBYTE c-type = ] unit-test
[
0 B{ 1 2 3 4 } <displaced-alien> <void*>
os windows? cpu x86.64? and [
[ -2147467259 ] [ 2147500037 <long> *long ] unit-test
] when
+
+[ 0 ] [ -10 uchar c-type-clamp ] unit-test
+[ 12 ] [ 12 uchar c-type-clamp ] unit-test
+[ -10 ] [ -10 char c-type-clamp ] unit-test
+[ 127 ] [ 230 char c-type-clamp ] unit-test
+[ t ] [ pi dup float c-type-clamp = ] unit-test
+
+C-TYPE: opaque
+
+[ t ] [ void* c-type opaque resolve-pointer-type c-type eq? ] unit-test
+[ opaque c-type ] [ no-c-type? ] must-fail-with
+
+[ """
+ USING: alien.syntax ;
+ IN: alien.c-types.tests
+ FUNCTION: opaque return_opaque ( ) ;
+""" eval( -- ) ] [ no-c-type? ] must-fail-with
+
+C-TYPE: forward
+STRUCT: backward { x forward* } ;
+STRUCT: forward { x backward* } ;
+
+[ t ] [ forward c-type struct-c-type? ] unit-test
+[ t ] [ backward c-type struct-c-type? ] unit-test
+
+DEFER: struct-redefined
+
+[ f ]
+[
+
+ """
+ USING: alien.c-types classes.struct ;
+ IN: alien.c-types.tests
+
+ STRUCT: struct-redefined { x int } ;
+ """ eval( -- )
+
+ """
+ USING: alien.syntax ;
+ IN: alien.c-types.tests
+
+ C-TYPE: struct-redefined
+ """ eval( -- )
+
+ \ struct-redefined class?
+] unit-test
+
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays arrays assocs kernel kernel.private libc math
-namespaces make parser sequences strings words splitting math.parser
-cpu.architecture alien alien.accessors alien.strings quotations
-layouts system compiler.units io io.files io.encodings.binary
-io.streams.memory accessors combinators effects continuations fry
-classes vocabs vocabs.loader ;
+USING: byte-arrays arrays assocs kernel kernel.private math
+math.order math.parser namespaces make parser sequences strings
+words splitting cpu.architecture alien alien.accessors
+alien.strings quotations layouts system compiler.units io
+io.files io.encodings.binary io.streams.memory accessors
+combinators effects continuations fry classes vocabs
+vocabs.loader words.symbol ;
+QUALIFIED: math
IN: alien.c-types
+SYMBOLS:
+ char uchar
+ short ushort
+ int uint
+ long ulong
+ longlong ulonglong
+ float double
+ void* bool
+ void ;
+
DEFER: <int>
DEFER: *char
-: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
-
TUPLE: abstract-c-type
{ class class initial: object }
{ boxed-class class initial: object }
{ getter callable }
{ setter callable }
size
-align
-array-class
-array-constructor
-direct-array-class
-direct-array-constructor
-sequence-mixin-class ;
+align ;
TUPLE: c-type < abstract-c-type
boxer
{ rep initial: int-rep }
stack-align? ;
-: <c-type> ( -- type )
- \ c-type new ;
+: <c-type> ( -- c-type )
+ \ c-type new ; inline
SYMBOL: c-types
ERROR: no-c-type name ;
-: (c-type) ( name -- type/f )
- c-types get-global at dup [
- dup string? [ (c-type) ] when
- ] when ;
+PREDICATE: c-type-word < word
+ "c-type" word-prop ;
+
+UNION: c-type-name string c-type-word ;
! C type protocol
-GENERIC: c-type ( name -- type ) foldable
+GENERIC: c-type ( name -- c-type ) foldable
+
+GENERIC: resolve-pointer-type ( name -- c-type )
-: resolve-pointer-type ( name -- name )
- c-types get at dup string?
- [ "*" append ] [ drop "void*" ] if
- c-type ;
+<< \ void \ void* "pointer-c-type" set-word-prop >>
+
+: void? ( c-type -- ? )
+ { void "void" } member? ;
+
+M: word resolve-pointer-type
+ dup "pointer-c-type" word-prop
+ [ ] [ drop void* ] ?if ;
+
+M: string resolve-pointer-type
+ dup "*" append dup c-types get at
+ [ nip ] [
+ drop
+ c-types get at dup c-type-name?
+ [ resolve-pointer-type ] [ drop void* ] if
+ ] if ;
-: resolve-typedef ( name -- type )
- dup string? [ c-type ] when ;
+: resolve-typedef ( name -- c-type )
+ dup void? [ no-c-type ] when
+ dup c-type-name? [ c-type ] when ;
-: parse-array-type ( name -- array )
+: parse-array-type ( name -- dims c-type )
"[" split unclip
- [ [ "]" ?tail drop string>number ] map ] dip prefix ;
+ [ [ "]" ?tail drop string>number ] map ] dip ;
-M: string c-type ( name -- type )
+M: string c-type ( name -- c-type )
CHAR: ] over member? [
- parse-array-type
+ parse-array-type prefix
] [
- dup c-types get at [
- resolve-typedef
- ] [
+ dup c-types get at [ ] [
"*" ?tail [ resolve-pointer-type ] [ no-c-type ] if
- ] ?if
+ ] ?if resolve-typedef
] if ;
-: ?require-word ( word/pair -- )
- dup word? [ drop ] [ first require ] ?if ;
-
-GENERIC: require-c-type-arrays ( c-type -- )
-
-M: object require-c-type-arrays
- drop ;
-
-M: c-type require-c-type-arrays
- [ array-class>> ?require-word ]
- [ sequence-mixin-class>> ?require-word ]
- [ direct-array-class>> ?require-word ] tri ;
-
-M: string require-c-type-arrays
- c-type require-c-type-arrays ;
-
-M: array require-c-type-arrays
- first c-type require-c-type-arrays ;
-
-ERROR: specialized-array-vocab-not-loaded vocab word ;
-
-: c-type-array-constructor ( c-type -- word )
- array-constructor>> dup array?
- [ first2 specialized-array-vocab-not-loaded ] when ; foldable
-
-: c-type-direct-array-constructor ( c-type -- word )
- direct-array-constructor>> dup array?
- [ first2 specialized-array-vocab-not-loaded ] when ; foldable
+M: word c-type
+ dup "c-type" word-prop resolve-typedef
+ [ ] [ no-c-type ] ?if ;
-GENERIC: <c-type-array> ( len c-type -- array )
-M: object <c-type-array>
- c-type-array-constructor execute( len -- array ) ; inline
-M: string <c-type-array>
- c-type <c-type-array> ; inline
-M: array <c-type-array>
- first c-type <c-type-array> ; inline
+GENERIC: c-struct? ( c-type -- ? )
-GENERIC: <c-type-direct-array> ( alien len c-type -- array )
-M: object <c-type-direct-array>
- c-type-direct-array-constructor execute( alien len -- array ) ; inline
-M: string <c-type-direct-array>
- c-type <c-type-direct-array> ; inline
-M: array <c-type-direct-array>
- first c-type <c-type-direct-array> ; inline
+M: object c-struct?
+ drop f ;
+M: c-type-name c-struct?
+ dup void? [ drop f ] [ c-type c-struct? ] if ;
+! These words being foldable means that words need to be
+! recompiled if a C type is redefined. Even so, folding the
+! size facilitates some optimizations.
GENERIC: c-type-class ( name -- class )
M: abstract-c-type c-type-class class>> ;
-M: string c-type-class c-type c-type-class ;
+M: c-type-name c-type-class c-type c-type-class ;
GENERIC: c-type-boxed-class ( name -- class )
M: abstract-c-type c-type-boxed-class boxed-class>> ;
-M: string c-type-boxed-class c-type c-type-boxed-class ;
+M: c-type-name c-type-boxed-class c-type c-type-boxed-class ;
GENERIC: c-type-boxer ( name -- boxer )
M: c-type c-type-boxer boxer>> ;
-M: string c-type-boxer c-type c-type-boxer ;
+M: c-type-name c-type-boxer c-type c-type-boxer ;
GENERIC: c-type-boxer-quot ( name -- quot )
M: abstract-c-type c-type-boxer-quot boxer-quot>> ;
-M: string c-type-boxer-quot c-type c-type-boxer-quot ;
+M: c-type-name c-type-boxer-quot c-type c-type-boxer-quot ;
GENERIC: c-type-unboxer ( name -- boxer )
M: c-type c-type-unboxer unboxer>> ;
-M: string c-type-unboxer c-type c-type-unboxer ;
+M: c-type-name c-type-unboxer c-type c-type-unboxer ;
GENERIC: c-type-unboxer-quot ( name -- quot )
M: abstract-c-type c-type-unboxer-quot unboxer-quot>> ;
-M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
+M: c-type-name c-type-unboxer-quot c-type c-type-unboxer-quot ;
GENERIC: c-type-rep ( name -- rep )
M: c-type c-type-rep rep>> ;
-M: string c-type-rep c-type c-type-rep ;
+M: c-type-name c-type-rep c-type c-type-rep ;
GENERIC: c-type-getter ( name -- quot )
M: c-type c-type-getter getter>> ;
-M: string c-type-getter c-type c-type-getter ;
+M: c-type-name c-type-getter c-type c-type-getter ;
GENERIC: c-type-setter ( name -- quot )
M: c-type c-type-setter setter>> ;
-M: string c-type-setter c-type c-type-setter ;
+M: c-type-name c-type-setter c-type c-type-setter ;
GENERIC: c-type-align ( name -- n )
M: abstract-c-type c-type-align align>> ;
-M: string c-type-align c-type c-type-align ;
+M: c-type-name c-type-align c-type c-type-align ;
GENERIC: c-type-stack-align? ( name -- ? )
M: c-type c-type-stack-align? stack-align?>> ;
-M: string c-type-stack-align? c-type c-type-stack-align? ;
+M: c-type-name c-type-stack-align? c-type c-type-stack-align? ;
-: c-type-box ( n type -- )
+: c-type-box ( n c-type -- )
[ c-type-rep ] [ c-type-boxer [ "No boxer" throw ] unless* ] bi
%box ;
-: c-type-unbox ( n ctype -- )
+: c-type-unbox ( n c-type -- )
[ c-type-rep ] [ c-type-unboxer [ "No unboxer" throw ] unless* ] bi
%unbox ;
-GENERIC: box-parameter ( n ctype -- )
+GENERIC: box-parameter ( n c-type -- )
M: c-type box-parameter c-type-box ;
-M: string box-parameter c-type box-parameter ;
+M: c-type-name box-parameter c-type box-parameter ;
-GENERIC: box-return ( ctype -- )
+GENERIC: box-return ( c-type -- )
M: c-type box-return f swap c-type-box ;
-M: string box-return c-type box-return ;
+M: c-type-name box-return c-type box-return ;
-GENERIC: unbox-parameter ( n ctype -- )
+GENERIC: unbox-parameter ( n c-type -- )
M: c-type unbox-parameter c-type-unbox ;
-M: string unbox-parameter c-type unbox-parameter ;
+M: c-type-name unbox-parameter c-type unbox-parameter ;
-GENERIC: unbox-return ( ctype -- )
+GENERIC: unbox-return ( c-type -- )
M: c-type unbox-return f swap c-type-unbox ;
-M: string unbox-return c-type unbox-return ;
+M: c-type-name unbox-return c-type unbox-return ;
-! These words being foldable means that words need to be
-! recompiled if a C type is redefined. Even so, folding the
-! size facilitates some optimizations.
-GENERIC: heap-size ( type -- size ) foldable
+: little-endian? ( -- ? ) 1 <int> *char 1 = ; foldable
+
+GENERIC: heap-size ( name -- size ) foldable
-M: string heap-size c-type heap-size ;
+M: c-type-name heap-size c-type heap-size ;
M: abstract-c-type heap-size size>> ;
-GENERIC: stack-size ( type -- size ) foldable
+GENERIC: stack-size ( name -- size ) foldable
-M: string stack-size c-type stack-size ;
+M: c-type-name stack-size c-type stack-size ;
M: c-type stack-size size>> cell align ;
M: f byte-length drop 0 ; inline
+MIXIN: value-type
+
: c-getter ( name -- quot )
c-type-getter [
[ "Cannot read struct fields with this type" throw ]
[ "Cannot write struct fields with this type" throw ]
] unless* ;
-: <c-array> ( n type -- array )
- heap-size * <byte-array> ; inline deprecated
-
-: <c-object> ( type -- array )
- heap-size <byte-array> ; inline
-
-: (c-object) ( type -- array )
- heap-size (byte-array) ; inline
-
-: malloc-array ( n type -- alien )
- [ heap-size calloc ] [ <c-type-direct-array> ] 2bi ; inline
-
-: (malloc-array) ( n type -- alien )
- [ heap-size * malloc ] [ <c-type-direct-array> ] 2bi ; inline
-
-: malloc-object ( type -- alien )
- 1 swap heap-size calloc ; inline
-
-: (malloc-object) ( type -- alien )
- heap-size malloc ; inline
-
-: malloc-byte-array ( byte-array -- alien )
- dup byte-length [ nip malloc dup ] 2keep memcpy ;
-
-: memory>byte-array ( alien len -- byte-array )
- [ nip (byte-array) dup ] 2keep memcpy ;
-
-: malloc-string ( string encoding -- alien )
- string>alien malloc-byte-array ;
-
-M: memory-stream stream-read
- [
- [ index>> ] [ alien>> ] bi <displaced-alien>
- swap memory>byte-array
- ] [ [ + ] change-index drop ] 2bi ;
-
-: byte-array>memory ( byte-array base -- )
- swap dup byte-length memcpy ; inline
-
-: array-accessor ( type quot -- def )
+: array-accessor ( c-type quot -- def )
[
\ swap , [ heap-size , [ * >fixnum ] % ] [ % ] bi*
] [ ] make ;
-: typedef ( old new -- ) c-types get set-at ;
+GENERIC: typedef ( old new -- )
+
+PREDICATE: typedef-word < c-type-word
+ "c-type" word-prop c-type-name? ;
+
+M: string typedef ( old new -- ) c-types get set-at ;
+M: word typedef ( old new -- )
+ {
+ [ nip define-symbol ]
+ [ name>> typedef ]
+ [ swap "c-type" set-word-prop ]
+ [
+ swap dup c-type-name? [
+ resolve-pointer-type
+ "pointer-c-type" set-word-prop
+ ] [ 2drop ] if
+ ]
+ } 2cleave ;
TUPLE: long-long-type < c-type ;
-: <long-long-type> ( -- type )
+: <long-long-type> ( -- c-type )
long-long-type new ;
-M: long-long-type unbox-parameter ( n type -- )
+M: long-long-type unbox-parameter ( n c-type -- )
c-type-unboxer %unbox-long-long ;
-M: long-long-type unbox-return ( type -- )
+M: long-long-type unbox-return ( c-type -- )
f swap unbox-parameter ;
-M: long-long-type box-parameter ( n type -- )
+M: long-long-type box-parameter ( n c-type -- )
c-type-boxer %box-long-long ;
-M: long-long-type box-return ( type -- )
+M: long-long-type box-return ( c-type -- )
f swap box-parameter ;
: define-deref ( name -- )
: define-out ( name -- )
[ "alien.c-types" constructor-word ]
- [ dup c-setter '[ _ <c-object> [ 0 @ ] keep ] ] bi
+ [ dup c-setter '[ _ heap-size <byte-array> [ 0 @ ] keep ] ] bi
(( value -- c-ptr )) define-inline ;
-: >c-bool ( ? -- int ) 1 0 ? ; inline
-
-: c-bool> ( int -- ? ) 0 = not ; inline
-
-: define-primitive-type ( type name -- )
+: define-primitive-type ( c-type name -- )
[ typedef ]
- [ define-deref ]
- [ define-out ]
+ [ name>> define-deref ]
+ [ name>> define-out ]
tri ;
-: malloc-file-contents ( path -- alien len )
- binary file-contents [ malloc-byte-array ] [ length ] bi ;
-
-: if-void ( type true false -- )
- pick "void" = [ drop nip call ] [ nip call ] if ; inline
-
-: ?lookup ( vocab word -- word/pair )
- over vocab [ swap lookup ] [ 2array ] if ;
-
-: set-array-class* ( c-type vocab-stem type-stem -- c-type )
- {
- [
- [ "specialized-arrays." prepend ]
- [ "-array" append ] bi* ?lookup >>array-class
- ]
- [
- [ "specialized-arrays." prepend ]
- [ "<" "-array>" surround ] bi* ?lookup >>array-constructor
- ]
- [
- [ "specialized-arrays." prepend ]
- [ "-sequence" append ] bi* ?lookup >>sequence-mixin-class
- ]
- [
- [ "specialized-arrays.direct." prepend ]
- [ "direct-" "-array" surround ] bi* ?lookup >>direct-array-class
- ]
- [
- [ "specialized-arrays.direct." prepend ]
- [ "<direct-" "-array>" surround ] bi* ?lookup >>direct-array-constructor
- ]
- } 2cleave ;
-
-: set-array-class ( c-type stem -- c-type )
- dup set-array-class* ;
+: if-void ( c-type true false -- )
+ pick void? [ drop nip call ] [ nip call ] if ; inline
CONSTANT: primitive-types
{
- "char" "uchar"
- "short" "ushort"
- "int" "uint"
- "long" "ulong"
- "longlong" "ulonglong"
- "float" "double"
- "void*" "bool"
+ char uchar
+ short ushort
+ int uint
+ long ulong
+ longlong ulonglong
+ float double
+ void* bool
}
+SYMBOLS:
+ ptrdiff_t intptr_t uintptr_t size_t
+ char* uchar* ;
+
[
<c-type>
c-ptr >>class
[ >c-ptr ] >>unboxer-quot
"box_alien" >>boxer
"alien_offset" >>unboxer
- "alien" "void*" set-array-class*
- "void*" define-primitive-type
+ \ void* define-primitive-type
<long-long-type>
integer >>class
8 >>align
"box_signed_8" >>boxer
"to_signed_8" >>unboxer
- "longlong" set-array-class
- "longlong" define-primitive-type
+ \ longlong define-primitive-type
<long-long-type>
integer >>class
8 >>align
"box_unsigned_8" >>boxer
"to_unsigned_8" >>unboxer
- "ulonglong" set-array-class
- "ulonglong" define-primitive-type
+ \ ulonglong define-primitive-type
<c-type>
integer >>class
bootstrap-cell >>align
"box_signed_cell" >>boxer
"to_fixnum" >>unboxer
- "long" set-array-class
- "long" define-primitive-type
+ \ long define-primitive-type
<c-type>
integer >>class
bootstrap-cell >>align
"box_unsigned_cell" >>boxer
"to_cell" >>unboxer
- "ulong" set-array-class
- "ulong" define-primitive-type
+ \ ulong define-primitive-type
<c-type>
integer >>class
4 >>align
"box_signed_4" >>boxer
"to_fixnum" >>unboxer
- "int" set-array-class
- "int" define-primitive-type
+ \ int define-primitive-type
<c-type>
integer >>class
4 >>align
"box_unsigned_4" >>boxer
"to_cell" >>unboxer
- "uint" set-array-class
- "uint" define-primitive-type
+ \ uint define-primitive-type
<c-type>
fixnum >>class
2 >>align
"box_signed_2" >>boxer
"to_fixnum" >>unboxer
- "short" set-array-class
- "short" define-primitive-type
+ \ short define-primitive-type
<c-type>
fixnum >>class
2 >>align
"box_unsigned_2" >>boxer
"to_cell" >>unboxer
- "ushort" set-array-class
- "ushort" define-primitive-type
+ \ ushort define-primitive-type
<c-type>
fixnum >>class
1 >>align
"box_signed_1" >>boxer
"to_fixnum" >>unboxer
- "char" set-array-class
- "char" define-primitive-type
+ \ char define-primitive-type
<c-type>
fixnum >>class
1 >>align
"box_unsigned_1" >>boxer
"to_cell" >>unboxer
- "uchar" set-array-class
- "uchar" define-primitive-type
+ \ uchar define-primitive-type
<c-type>
- [ alien-unsigned-1 c-bool> ] >>getter
- [ [ >c-bool ] 2dip set-alien-unsigned-1 ] >>setter
+ [ alien-unsigned-1 0 = not ] >>getter
+ [ [ 1 0 ? ] 2dip set-alien-unsigned-1 ] >>setter
1 >>size
1 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
- "bool" set-array-class
- "bool" define-primitive-type
+ \ bool define-primitive-type
<c-type>
- float >>class
- float >>boxed-class
+ math:float >>class
+ math:float >>boxed-class
[ alien-float ] >>getter
[ [ >float ] 2dip set-alien-float ] >>setter
4 >>size
4 >>align
"box_float" >>boxer
"to_float" >>unboxer
- single-float-rep >>rep
+ float-rep >>rep
[ >float ] >>unboxer-quot
- "float" set-array-class
- "float" define-primitive-type
+ \ float define-primitive-type
<c-type>
- float >>class
- float >>boxed-class
+ math:float >>class
+ math:float >>boxed-class
[ alien-double ] >>getter
[ [ >float ] 2dip set-alien-double ] >>setter
8 >>size
8 >>align
"box_double" >>boxer
"to_double" >>unboxer
- double-float-rep >>rep
+ double-rep >>rep
[ >float ] >>unboxer-quot
- "double" set-array-class
- "double" define-primitive-type
+ \ double define-primitive-type
- "long" "ptrdiff_t" typedef
- "long" "intptr_t" typedef
- "ulong" "size_t" typedef
+ \ long c-type \ ptrdiff_t typedef
+ \ long c-type \ intptr_t typedef
+ \ ulong c-type \ uintptr_t typedef
+ \ ulong c-type \ size_t typedef
] with-compilation-unit
+M: char-16-rep rep-component-type drop char ;
+M: uchar-16-rep rep-component-type drop uchar ;
+M: short-8-rep rep-component-type drop short ;
+M: ushort-8-rep rep-component-type drop ushort ;
+M: int-4-rep rep-component-type drop int ;
+M: uint-4-rep rep-component-type drop uint ;
+M: longlong-2-rep rep-component-type drop longlong ;
+M: ulonglong-2-rep rep-component-type drop ulonglong ;
+M: float-4-rep rep-component-type drop float ;
+M: double-2-rep rep-component-type drop double ;
+
+: (unsigned-interval) ( bytes -- from to ) [ 0 ] dip 8 * 2^ 1 - ; foldable
+: unsigned-interval ( c-type -- from to ) heap-size (unsigned-interval) ; foldable
+: (signed-interval) ( bytes -- from to ) 8 * 1 - 2^ [ neg ] [ 1 - ] bi ; foldable
+: signed-interval ( c-type -- from to ) heap-size (signed-interval) ; foldable
+
+: c-type-interval ( c-type -- from to )
+ {
+ { [ dup { float double } memq? ] [ drop -1/0. 1/0. ] }
+ { [ dup { char short int long longlong } memq? ] [ signed-interval ] }
+ { [ dup { uchar ushort uint ulong ulonglong } memq? ] [ unsigned-interval ] }
+ } cond ; foldable
+
+: c-type-clamp ( value c-type -- value' ) c-type-interval clamp ; inline
[ C{ 1.0 2.0 } ] [ "h" get z>> ] unit-test
-[ number ] [ "complex-float" c-type-boxed-class ] unit-test
+[ complex ] [ "complex-float" c-type-boxed-class ] unit-test
-[ number ] [ "complex-double" c-type-boxed-class ] unit-test
+[ complex ] [ "complex-double" c-type-boxed-class ] unit-test
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.structs alien.complex.functor accessors
+USING: alien.c-types alien.complex.functor accessors
sequences kernel ;
IN: alien.complex
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.structs alien.c-types classes.struct math
+USING: accessors alien alien.c-types classes.struct math
math.functions sequences arrays kernel functors vocabs.parser
namespaces quotations ;
IN: alien.complex.functor
T-class c-type
<T> 1quotation >>unboxer-quot
*T 1quotation >>boxer-quot
-number >>boxed-class
-T set-array-class
+complex >>boxed-class
drop
;FUNCTOR
--- /dev/null
+Slava Pestov
--- /dev/null
+USING: alien alien.c-types help.syntax help.markup libc
+kernel.private byte-arrays math strings hashtables alien.syntax
+alien.strings sequences io.encodings.string debugger destructors
+vocabs.loader classes.struct ;
+IN: alien.data
+
+HELP: <c-array>
+{ $values { "len" "a non-negative integer" } { "c-type" "a C type" } { "array" byte-array } }
+{ $description "Creates a byte array large enough to hold " { $snippet "n" } " values of a C type." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $errors "Throws an error if the type does not exist, the necessary specialized array vocabulary is not loaded, or the requested size is negative." } ;
+
+HELP: <c-object>
+{ $values { "type" "a C type" } { "array" byte-array } }
+{ $description "Creates a byte array suitable for holding a value with the given C type." }
+{ $errors "Throws an " { $link no-c-type } " error if the type does not exist." } ;
+
+{ <c-object> malloc-object } related-words
+
+HELP: memory>byte-array
+{ $values { "alien" c-ptr } { "len" "a non-negative integer" } { "byte-array" byte-array } }
+{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new byte array." } ;
+
+HELP: byte-array>memory
+{ $values { "byte-array" byte-array } { "base" c-ptr } }
+{ $description "Writes a byte array to memory starting from the " { $snippet "base" } " address." }
+{ $warning "This word is unsafe. Improper use can corrupt memory." } ;
+
+HELP: malloc-array
+{ $values { "n" "a non-negative integer" } { "type" "a C type" } { "array" "a specialized array" } }
+{ $description "Allocates an unmanaged memory block large enough to hold " { $snippet "n" } " values of a C type, then wraps the memory in a sequence object using " { $link <c-direct-array> } "." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if the type does not exist, if the requested size is negative, if a direct specialized array class appropriate to the type is not loaded, or if memory allocation fails." } ;
+
+HELP: malloc-object
+{ $values { "type" "a C type" } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block large enough to hold a value of a C type." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if the type does not exist or if memory allocation fails." } ;
+
+HELP: malloc-byte-array
+{ $values { "byte-array" byte-array } { "alien" alien } }
+{ $description "Allocates an unmanaged memory block of the same size as the byte array, and copies the contents of the byte array there." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if memory allocation fails." } ;
+
+{ <c-array> <c-direct-array> malloc-array } related-words
+
+{ string>alien alien>string malloc-string } related-words
+
+ARTICLE: "malloc" "Manual memory management"
+"Sometimes data passed to C functions must be allocated at a fixed address. See " { $link "byte-arrays-gc" } " for an explanation of when this is the case."
+$nl
+"Allocating a C datum with a fixed address:"
+{ $subsections
+ malloc-object
+ malloc-byte-array
+ malloc-file-contents
+}
+"The " { $vocab-link "libc" } " vocabulary defines several words which directly call C standard library memory management functions:"
+{ $subsections
+ malloc
+ calloc
+ realloc
+}
+"You must always free pointers returned by any of the above words when the block of memory is no longer in use:"
+{ $subsections free }
+"Utilities for automatically freeing memory in conjunction with " { $link with-destructors } ":"
+{ $subsections
+ &free
+ |free
+}
+"The " { $link &free } " and " { $link |free } " words are generated using " { $link "alien.destructors" } "."
+$nl
+"You can unsafely copy a range of bytes from one memory location to another:"
+{ $subsections memcpy }
+"You can copy a range of bytes from memory into a byte array:"
+{ $subsections memory>byte-array }
+"You can copy a byte array to memory unsafely:"
+{ $subsections byte-array>memory } ;
+
+ARTICLE: "c-pointers" "Passing pointers to C functions"
+"The following Factor objects may be passed to C function parameters with pointer types:"
+{ $list
+ { "Instances of " { $link alien } "." }
+ { "Instances of " { $link f } "; this is interpreted as a null pointer." }
+ { "Instances of " { $link byte-array } "; the C function receives a pointer to the first element of the array." }
+ { "Any data type which defines a method on " { $link >c-ptr } " that returns an instance of one of the above. This includes " { $link "classes.struct" } " and " { $link "specialized-arrays" } "." }
+}
+"The class of primitive C pointer types:"
+{ $subsections c-ptr }
+"A generic word for converting any object to a C pointer; user-defined types may add methods to this generic word:"
+{ $subsections >c-ptr }
+"More about the " { $link alien } " type:"
+{ $subsections "aliens" }
+{ $warning
+"The Factor garbage collector can move byte arrays around, and code passing byte arrays, or objects backed by byte arrays, must obey important guidelines. See " { $link "byte-arrays-gc" } "." } ;
+
+ARTICLE: "c-data" "Passing data between Factor and C"
+"Two defining characteristics of Factor are dynamic typing and automatic memory management, which are somewhat incompatible with the machine-level data model exposed by C. Factor's C library interface defines its own set of C data types, distinct from Factor language types, together with automatic conversion between Factor values and C types. For example, C integer types must be declared and are fixed-width, whereas Factor supports arbitrary-precision integers."
+$nl
+"Furthermore, Factor's garbage collector can move objects in memory; for a discussion of the consequences, see " { $link "byte-arrays-gc" } "."
+{ $subsections
+ "c-types-specs"
+ "c-pointers"
+ "malloc"
+ "c-strings"
+ "c-out-params"
+}
+"Important guidelines for passing data in byte arrays:"
+{ $subsections "byte-arrays-gc" }
+"C-style enumerated types are supported:"
+{ $subsections POSTPONE: C-ENUM: }
+"C types can be aliased for convenience and consitency with native library documentation:"
+{ $subsections POSTPONE: TYPEDEF: }
+"A utility for defining " { $link "destructors" } " for deallocating memory:"
+{ $subsections "alien.destructors" }
+"C struct and union types can be defined with " { $link POSTPONE: STRUCT: } " and " { $link POSTPONE: UNION: } ". See " { $link "classes.struct" } " for details. For passing arrays to and from C, use the " { $link "specialized-arrays" } " vocabulary." ;
+
+HELP: malloc-string
+{ $values { "string" string } { "encoding" "an encoding descriptor" } { "alien" c-ptr } }
+{ $description "Encodes a string together with a trailing null code point using the given encoding, and stores the resulting bytes in a freshly-allocated unmanaged memory block." }
+{ $warning "Don't forget to deallocate the memory with a call to " { $link free } "." }
+{ $errors "Throws an error if one of the following conditions occurs:"
+ { $list
+ "the string contains null code points"
+ "the string contains characters not representable using the encoding specified"
+ "memory allocation fails"
+ }
+} ;
+
+HELP: require-c-array
+{ $values { "c-type" "a C type" } }
+{ $description "Generates a specialized array of " { $snippet "c-type" } " using the " { $link <c-array> } " or " { $link <c-direct-array> } " vocabularies." }
+{ $notes "This word must be called inside a compilation unit. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence types loaded." } ;
+
+HELP: <c-direct-array>
+{ $values { "alien" c-ptr } { "len" integer } { "c-type" "a C type" } { "array" "a specialized direct array" } }
+{ $description "Constructs a new specialized array of length " { $snippet "len" } " and element type " { $snippet "c-type" } " over the range of memory referenced by " { $snippet "alien" } "." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
+
+ARTICLE: "c-strings" "C strings"
+"C string types are arrays with shape " { $snippet "{ char* encoding }" } ", where " { $snippet "encoding" } " is an encoding descriptor. The type " { $link char* } " is an alias for " { $snippet "{ char* utf8 }" } ". See " { $link "encodings-descriptors" } " for information about encoding descriptors."
+$nl
+"Passing a Factor string to a C function expecting a C string allocates a " { $link byte-array } " in the Factor heap; the string is then converted to the requested format and a raw pointer is passed to the function."
+$nl
+"If the conversion fails, for example if the string contains null bytes or characters with values higher than 255, a " { $link c-string-error. } " is thrown."
+$nl
+"Care must be taken if the C function expects a " { $link char* } " with a length in bytes, rather than a null-terminated " { $link char* } "; passing the result of calling " { $link length } " on the string object will not suffice. This is because a Factor string of " { $emphasis "n" } " characters will not necessarily encode to " { $emphasis "n" } " bytes. The correct idiom for C functions which take a string with a length is to first encode the string using " { $link encode } ", and then pass the resulting byte array together with the length of this byte array."
+$nl
+"Sometimes a C function has a parameter type of " { $link void* } ", and various data types, among them strings, can be passed in. In this case, strings are not automatically converted to aliens, and instead you must call one of these words:"
+{ $subsections
+ string>alien
+ malloc-string
+}
+"The first allocates " { $link byte-array } "s, and the latter allocates manually-managed memory which is not moved by the garbage collector and has to be explicitly freed by calling " { $link free } ". See " { $link "byte-arrays-gc" } " for a discussion of the two approaches."
+$nl
+"A word to read strings from arbitrary addresses:"
+{ $subsections alien>string }
+"For example, if a C function returns a " { $link char* } " but stipulates that the caller must deallocate the memory afterward, you must define the function as returning " { $link void* } ", and call one of the above words before passing the pointer to " { $link free } "." ;
+
--- /dev/null
+! (c)2009 Slava Pestov, Joe Groff bsd license
+USING: accessors alien alien.c-types alien.strings arrays
+byte-arrays cpu.architecture fry io io.encodings.binary
+io.files io.streams.memory kernel libc math sequences words ;
+IN: alien.data
+
+GENERIC: require-c-array ( c-type -- )
+
+M: array require-c-array first require-c-array ;
+
+GENERIC: c-array-constructor ( c-type -- word ) foldable
+
+GENERIC: c-(array)-constructor ( c-type -- word ) foldable
+
+GENERIC: c-direct-array-constructor ( c-type -- word ) foldable
+
+GENERIC: <c-array> ( len c-type -- array )
+
+M: word <c-array>
+ c-array-constructor execute( len -- array ) ; inline
+
+GENERIC: (c-array) ( len c-type -- array )
+
+M: word (c-array)
+ c-(array)-constructor execute( len -- array ) ; inline
+
+GENERIC: <c-direct-array> ( alien len c-type -- array )
+
+M: word <c-direct-array>
+ c-direct-array-constructor execute( alien len -- array ) ; inline
+
+: malloc-array ( n type -- array )
+ [ heap-size calloc ] [ <c-direct-array> ] 2bi ; inline
+
+: (malloc-array) ( n type -- alien )
+ [ heap-size * malloc ] [ <c-direct-array> ] 2bi ; inline
+
+: <c-object> ( type -- array )
+ heap-size <byte-array> ; inline
+
+: (c-object) ( type -- array )
+ heap-size (byte-array) ; inline
+
+: malloc-object ( type -- alien )
+ 1 swap heap-size calloc ; inline
+
+: (malloc-object) ( type -- alien )
+ heap-size malloc ; inline
+
+: malloc-byte-array ( byte-array -- alien )
+ dup byte-length [ nip malloc dup ] 2keep memcpy ;
+
+: memory>byte-array ( alien len -- byte-array )
+ [ nip (byte-array) dup ] 2keep memcpy ;
+
+: malloc-string ( string encoding -- alien )
+ string>alien malloc-byte-array ;
+
+: malloc-file-contents ( path -- alien len )
+ binary file-contents [ malloc-byte-array ] [ length ] bi ;
+
+M: memory-stream stream-read
+ [
+ [ index>> ] [ alien>> ] bi <displaced-alien>
+ swap memory>byte-array
+ ] [ [ + ] change-index drop ] 2bi ;
+
+: byte-array>memory ( byte-array base -- )
+ swap dup byte-length memcpy ; inline
+
+: >c-bool ( ? -- int ) 1 0 ? ; inline
+
+: c-bool> ( int -- ? ) 0 = not ; inline
+
+M: value-type c-type-rep drop int-rep ;
+
+M: value-type c-type-getter
+ drop [ swap <displaced-alien> ] ;
+
+M: value-type c-type-setter ( type -- quot )
+ [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
+ '[ @ swap @ _ memcpy ] ;
+
--- /dev/null
+Words for allocating objects and arrays of C types
ARTICLE: "alien.destructors" "Alien destructors"
"The " { $vocab-link "alien.destructors" } " vocabulary defines a utility parsing word for defining new disposable classes."
-{ $subsection POSTPONE: DESTRUCTOR: } ;
+{ $subsections POSTPONE: DESTRUCTOR: } ;
ABOUT: "alien.destructors"
\ No newline at end of file
! Copyright (C) 2009 Joe Groff
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations sequences strings words.symbol ;
+USING: help.markup help.syntax kernel quotations sequences strings words.symbol classes.struct ;
QUALIFIED-WITH: alien.syntax c
IN: alien.fortran
{ { $snippet "DOUBLE-COMPLEX" } " specifies a double-precision floating-point complex value. The alias " { $snippet "COMPLEX*16" } " is also recognized." }
{ { $snippet "CHARACTER(n)" } " specifies a character string of length " { $snippet "n" } ". The Fortran 77 syntax " { $snippet "CHARACTER*n" } " is also recognized." }
{ "Fortran arrays can be specified by suffixing a comma-separated set of dimensions in parentheses, e.g. " { $snippet "REAL(2,3,4)" } ". Arrays of unspecified length can be specified using " { $snippet "*" } " as a dimension. Arrays are passed in as flat " { $link "specialized-arrays" } "." }
- { "Fortran records defined by " { $link POSTPONE: RECORD: } " and C structs defined by " { $link POSTPONE: c:C-STRUCT: } " are also supported as parameter and return types." }
+ { "Struct classes defined by " { $link POSTPONE: STRUCT: } " are also supported as parameter and return types." }
}
"When declaring the parameters of Fortran functions, an output argument can be specified by prefixing an exclamation point to the type name. This will cause the function word to leave the final value of the parameter on the stack." ;
{ $values { "name" "a logical library name" } }
{ $description "Sets the logical library for subsequent " { $link POSTPONE: FUNCTION: } " and " { $link POSTPONE: SUBROUTINE: } " definitions. The given library name must have been opened with a previous call to " { $link add-fortran-library } "." } ;
-HELP: RECORD:
-{ $syntax "RECORD: NAME { \"TYPE\" \"SLOT\" } ... ;" }
-{ $description "Defines a Fortran record type with the given slots. The record is defined as the corresponding C struct and can be used as a type for subsequent Fortran or C function declarations." } ;
-
HELP: add-fortran-library
{ $values { "name" string } { "soname" string } { "fortran-abi" symbol } }
{ $description "Opens the shared library in the file specified by " { $snippet "soname" } " under the logical name " { $snippet "name" } " so that it may be used in subsequent " { $link POSTPONE: LIBRARY: } " and " { $link fortran-invoke } " calls. Functions and subroutines from the library will be defined using the specified " { $snippet "fortran-abi" } ", which must be one of the supported " { $link "alien.fortran-abis" } "." }
ARTICLE: "alien.fortran" "Fortran FFI"
"The " { $vocab-link "alien.fortran" } " vocabulary provides an interface to code in shared libraries written in Fortran."
-{ $subsection "alien.fortran-types" }
-{ $subsection "alien.fortran-abis" }
-{ $subsection add-fortran-library }
-{ $subsection POSTPONE: LIBRARY: }
-{ $subsection POSTPONE: FUNCTION: }
-{ $subsection POSTPONE: SUBROUTINE: }
-{ $subsection POSTPONE: RECORD: }
-{ $subsection fortran-invoke }
-;
+{ $subsections
+ "alien.fortran-types"
+ "alien.fortran-abis"
+ add-fortran-library
+ POSTPONE: LIBRARY:
+ POSTPONE: FUNCTION:
+ POSTPONE: SUBROUTINE:
+ fortran-invoke
+} ;
ABOUT: "alien.fortran"
! (c) 2009 Joe Groff, see BSD license
USING: accessors alien alien.c-types alien.complex
-alien.fortran alien.fortran.private alien.strings alien.structs
-arrays assocs byte-arrays combinators fry
+alien.data alien.fortran alien.fortran.private alien.strings
+classes.struct arrays assocs byte-arrays combinators fry
generalizations io.encodings.ascii kernel macros
macros.expander namespaces sequences shuffle tools.test ;
IN: alien.fortran.tests
<< intel-unix-abi "(alien.fortran-tests)" (add-fortran-library) >>
LIBRARY: (alien.fortran-tests)
-RECORD: FORTRAN_TEST_RECORD
- { "INTEGER" "FOO" }
- { "REAL(2)" "BAR" }
- { "CHARACTER*4" "BAS" } ;
+STRUCT: FORTRAN_TEST_RECORD
+ { FOO int }
+ { BAR double[2] }
+ { BAS char[4] } ;
intel-unix-abi fortran-abi [
[ "complex" { "character*17" "character" "integer" } fortran-sig>c-sig ]
unit-test
- ! fortran-record>c-struct
-
- [ {
- { "double" "ex" }
- { "float" "wye" }
- { "int" "zee" }
- { "char[20]" "woo" }
- } ] [
- {
- { "DOUBLE-PRECISION" "EX" }
- { "REAL" "WYE" }
- { "INTEGER" "ZEE" }
- { "CHARACTER(20)" "WOO" }
- } fortran-record>c-struct
- ] unit-test
-
- ! RECORD:
-
- [ 16 ] [ "fortran_test_record" heap-size ] unit-test
- [ 0 ] [ "foo" "fortran_test_record" offset-of ] unit-test
- [ 4 ] [ "bar" "fortran_test_record" offset-of ] unit-test
- [ 12 ] [ "bas" "fortran_test_record" offset-of ] unit-test
-
! (fortran-invoke)
[ [
! (c) 2009 Joe Groff, see BSD license
-USING: accessors alien alien.c-types alien.complex alien.parser
-alien.strings alien.structs alien.syntax arrays ascii assocs
+USING: accessors alien alien.c-types alien.complex alien.data grouping
+alien.strings alien.syntax arrays ascii assocs
byte-arrays combinators combinators.short-circuit fry generalizations
kernel lexer macros math math.parser namespaces parser sequences
splitting stack-checker vectors vocabs.parser words locals
: fortran-sig>c-sig ( fortran-return fortran-args -- c-return c-args )
[ fortran-ret-type>c-type ] [ fortran-arg-types>c-types ] bi* append ;
-: fortran-record>c-struct ( record -- struct )
- [ first2 [ fortran-type>c-type ] [ >lower ] bi* 2array ] map ;
-
-: define-fortran-record ( name vocab fields -- )
- [ >lower ] [ ] [ fortran-record>c-struct ] tri* define-struct ;
-
-SYNTAX: RECORD: scan current-vocab parse-definition define-fortran-record ;
-
: set-fortran-abi ( library -- )
library-fortran-abis get-global at fortran-abi set ;
MACRO: fortran-invoke ( return library function parameters -- )
{ [ 2drop nip set-fortran-abi ] [ (fortran-invoke) ] } 4 ncleave ;
+: parse-arglist ( parameters return -- types effect )
+ [ 2 group unzip [ "," ?tail drop ] map ]
+ [ [ { } ] [ 1array ] if-void ]
+ bi* <effect> ;
+
:: define-fortran-function ( return library function parameters -- )
function create-in dup reset-generic
return library function parameters return [ "void" ] unless* parse-arglist
ARTICLE: "loading-libs" "Loading native libraries"
"Before calling a C library, you must associate its path name on disk with a logical name which Factor uses to identify the library:"
-{ $subsection add-library }
-{ $subsection remove-library }
+{ $subsections
+ add-library
+ remove-library
+}
"Once a library has been defined, you can try loading it to see if the path name is correct:"
-{ $subsection load-library }
+{ $subsections load-library }
"If the compiler cannot load a library, or cannot resolve a symbol in a library, a linkage error is reported using the compiler error mechanism (see " { $link "compiler-errors" } "). Once you install the right library, reload the source file containing the " { $link add-library } " form to force the compiler to try loading the library again." ;
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: accessors alien.c-types alien.parser alien.syntax
+tools.test vocabs.parser parser ;
+IN: alien.parser.tests
+
+TYPEDEF: char char2
+
+SYMBOL: not-c-type
+
+[
+ "alien.parser.tests" use-vocab
+ "alien.c-types" use-vocab
+
+ [ int ] [ "int" parse-c-type ] unit-test
+ [ { int 5 } ] [ "int[5]" parse-c-type ] unit-test
+ [ { int 5 10 11 } ] [ "int[5][10][11]" parse-c-type ] unit-test
+ [ void* ] [ "int*" parse-c-type ] unit-test
+ [ void* ] [ "int**" parse-c-type ] unit-test
+ [ void* ] [ "int***" parse-c-type ] unit-test
+ [ void* ] [ "int****" parse-c-type ] unit-test
+ [ char* ] [ "char*" parse-c-type ] unit-test
+ [ void* ] [ "char**" parse-c-type ] unit-test
+ [ void* ] [ "char***" parse-c-type ] unit-test
+ [ void* ] [ "char****" parse-c-type ] unit-test
+ [ char2 ] [ "char2" parse-c-type ] unit-test
+ [ char* ] [ "char2*" parse-c-type ] unit-test
+
+ [ "not-c-type" parse-c-type ] [ no-c-type? ] must-fail-with
+ [ "not-word" parse-c-type ] [ error>> no-word-error? ] must-fail-with
+
+] with-file-vocabs
\ No newline at end of file
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays assocs effects grouping kernel
-parser sequences splitting words fry locals lexer namespaces
-summary math ;
+USING: accessors alien alien.c-types alien.parser
+alien.libraries arrays assocs classes combinators
+combinators.short-circuit compiler.units effects grouping
+kernel parser sequences splitting words fry locals lexer
+namespaces summary math vocabs.parser ;
IN: alien.parser
+: parse-c-type-name ( name -- word )
+ dup search [ nip ] [ no-word ] if* ;
+
+: parse-c-type ( string -- array )
+ {
+ { [ dup "void" = ] [ drop void ] }
+ { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
+ { [ dup search c-type-word? ] [ parse-c-type-name ] }
+ { [ "**" ?tail ] [ drop void* ] }
+ { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
+ [ parse-c-type-name no-c-type ]
+ } cond ;
+
+: scan-c-type ( -- c-type )
+ scan dup "{" =
+ [ drop \ } parse-until >array ]
+ [ parse-c-type ] if ;
+
+: reset-c-type ( word -- )
+ dup "struct-size" word-prop
+ [ dup [ forget-class ] [ { "struct-size" } reset-props ] bi ] when
+ {
+ "c-type"
+ "pointer-c-type"
+ "callback-effect"
+ "callback-library"
+ } reset-props ;
+
+: CREATE-C-TYPE ( -- word )
+ scan current-vocab create {
+ [ fake-definition ]
+ [ set-word ]
+ [ reset-c-type ]
+ [ ]
+ } cleave ;
+
: normalize-c-arg ( type name -- type' name' )
[ length ]
[
[ CHAR: * = ] trim-head
[ length - CHAR: * <array> append ] keep
- ] bi ;
+ ] bi
+ [ parse-c-type ] dip ;
: parse-arglist ( parameters return -- types effect )
[
return library function
parameters return parse-arglist [ function-quot ] dip ;
+: parse-arg-tokens ( -- tokens )
+ ";" parse-tokens [ "()" subseq? not ] filter ;
+
: (FUNCTION:) ( -- word quot effect )
- scan "c-library" get scan ";" parse-tokens
- [ "()" subseq? not ] filter
- make-function ;
+ scan "c-library" get scan parse-arg-tokens make-function ;
: define-function ( return library function parameters -- )
make-function define-declared ;
+
+: callback-quot ( return types abi -- quot )
+ [ [ ] 3curry dip alien-callback ] 3curry ;
+
+: library-abi ( lib -- abi )
+ library [ abi>> ] [ "cdecl" ] if* ;
+
+:: make-callback-type ( lib return! type-name! parameters -- word quot effect )
+ return type-name normalize-c-arg type-name! return!
+ type-name current-vocab create :> type-word
+ type-word [ reset-generic ] [ reset-c-type ] bi
+ void* type-word typedef
+ parameters return parse-arglist :> callback-effect :> types
+ type-word callback-effect "callback-effect" set-word-prop
+ type-word lib "callback-library" set-word-prop
+ type-word return types lib library-abi callback-quot (( quot -- alien )) ;
+
+: (CALLBACK:) ( -- word quot effect )
+ "c-library" get
+ scan scan parse-arg-tokens make-callback-type ;
+
+PREDICATE: alien-function-word < word
+ def>> {
+ [ length 5 = ]
+ [ last \ alien-invoke eq? ]
+ } 1&& ;
+
+PREDICATE: alien-callback-type-word < typedef-word
+ "callback-effect" word-prop ;
+
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel combinators alien alien.strings alien.syntax
-prettyprint.backend prettyprint.custom prettyprint.sections ;
+USING: accessors kernel combinators alien alien.strings alien.c-types
+alien.parser alien.syntax arrays assocs effects math.parser
+prettyprint.backend prettyprint.custom prettyprint.sections
+definitions see see.private sequences strings words ;
IN: alien.prettyprint
M: alien pprint*
{
{ [ dup expired? ] [ drop \ BAD-ALIEN pprint-word ] }
{ [ dup pinned-c-ptr? not ] [ drop "( displaced alien )" text ] }
- [ \ ALIEN: [ alien-address pprint* ] pprint-prefix ]
+ [ \ ALIEN: [ alien-address >hex text ] pprint-prefix ]
} cond ;
M: dll pprint* dll-path dup "DLL\" " "\"" pprint-string ;
+
+M: c-type-word definer drop \ C-TYPE: f ;
+M: c-type-word definition drop f ;
+M: c-type-word declarations. drop ;
+
+GENERIC: pprint-c-type ( c-type -- )
+M: word pprint-c-type pprint-word ;
+M: wrapper pprint-c-type wrapped>> pprint-word ;
+M: string pprint-c-type text ;
+M: array pprint-c-type pprint* ;
+
+M: typedef-word definer drop \ TYPEDEF: f ;
+
+M: typedef-word synopsis*
+ {
+ [ seeing-word ]
+ [ definer. ]
+ [ "c-type" word-prop pprint-c-type ]
+ [ pprint-word ]
+ } cleave ;
+
+: pprint-function-arg ( type name -- )
+ [ pprint-c-type ] [ text ] bi* ;
+
+: pprint-function-args ( types names -- )
+ zip [ ] [
+ unclip-last
+ [ [ first2 "," append pprint-function-arg ] each ] dip
+ first2 pprint-function-arg
+ ] if-empty ;
+
+: pprint-library ( library -- )
+ [ \ LIBRARY: [ text ] pprint-prefix ] when* ;
+
+M: alien-function-word definer
+ drop \ FUNCTION: \ ; ;
+M: alien-function-word definition drop f ;
+M: alien-function-word synopsis*
+ {
+ [ seeing-word ]
+ [ def>> second pprint-library ]
+ [ definer. ]
+ [ def>> first pprint-c-type ]
+ [ pprint-word ]
+ [
+ <block "(" text
+ [ def>> fourth ] [ stack-effect in>> ] bi
+ pprint-function-args
+ ")" text block>
+ ]
+ } cleave ;
+
+M: alien-callback-type-word definer
+ drop \ CALLBACK: \ ; ;
+M: alien-callback-type-word definition drop f ;
+M: alien-callback-type-word synopsis*
+ {
+ [ seeing-word ]
+ [ "callback-library" word-prop pprint-library ]
+ [ definer. ]
+ [ def>> first pprint-c-type ]
+ [ pprint-word ]
+ [
+ <block "(" text
+ [ def>> second ] [ "callback-effect" word-prop in>> ] bi
+ pprint-function-args
+ ")" text block>
+ ]
+ } cleave ;
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings parser
+USING: accessors alien alien.data alien.strings parser
threads words kernel.private kernel io.encodings.utf8 eval ;
IN: alien.remote-control
+++ /dev/null
-Slava Pestov
+++ /dev/null
-! Copyright (C) 2005, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel kernel.private math namespaces
-make sequences strings words effects combinators alien.c-types ;
-IN: alien.structs.fields
-
-TUPLE: field-spec name offset type reader writer ;
-
-: reader-word ( class name vocab -- word )
- [ "-" glue ] dip create dup make-deprecated ;
-
-: writer-word ( class name vocab -- word )
- [ [ swap "set-" % % "-" % % ] "" make ] dip create dup make-deprecated ;
-
-: <field-spec> ( struct-name vocab type field-name -- spec )
- field-spec new
- 0 >>offset
- swap >>name
- swap >>type
- 3dup name>> swap reader-word >>reader
- 3dup name>> swap writer-word >>writer
- 2nip ;
-
-: align-offset ( offset type -- offset )
- c-type-align align ;
-
-: struct-offsets ( specs -- size )
- 0 [
- [ type>> align-offset ] keep
- [ (>>offset) ] [ type>> heap-size + ] 2bi
- ] reduce ;
-
-: define-struct-slot-word ( word quot spec effect -- )
- [ offset>> prefix ] dip define-inline ;
-
-: define-getter ( spec -- )
- [ reader>> ] [ type>> c-type-getter-boxer ] [ ] tri
- (( c-ptr -- value )) define-struct-slot-word ;
-
-: define-setter ( spec -- )
- [ writer>> ] [ type>> c-setter ] [ ] tri
- (( value c-ptr -- )) define-struct-slot-word ;
-
-: define-field ( spec -- )
- [ define-getter ] [ define-setter ] bi ;
+++ /dev/null
-Struct field implementation and reflection support
+++ /dev/null
-USING: alien.c-types strings help.markup help.syntax alien.syntax
-sequences io arrays kernel words assocs namespaces ;
-IN: alien.structs
-
-ARTICLE: "c-structs" "C structure types"
-"A " { $snippet "struct" } " in C is essentially a block of memory with the value of each structure field stored at a fixed offset from the start of the block. The C library interface provides some utilities to define words which read and write structure fields given a base address."
-{ $subsection POSTPONE: C-STRUCT: }
-"Great care must be taken when working with C structures since no type or bounds checking is possible."
-$nl
-"An example:"
-{ $code
- "C-STRUCT: XVisualInfo"
- " { \"Visual*\" \"visual\" }"
- " { \"VisualID\" \"visualid\" }"
- " { \"int\" \"screen\" }"
- " { \"uint\" \"depth\" }"
- " { \"int\" \"class\" }"
- " { \"ulong\" \"red_mask\" }"
- " { \"ulong\" \"green_mask\" }"
- " { \"ulong\" \"blue_mask\" }"
- " { \"int\" \"colormap_size\" }"
- " { \"int\" \"bits_per_rgb\" } ;"
-}
-"C structure objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
-$nl
-"Arrays of C structures can be created with the " { $vocab-link "struct-arrays" } " vocabulary." ;
-
-ARTICLE: "c-unions" "C unions"
-"A " { $snippet "union" } " in C defines a type large enough to hold its largest member. This is usually used to allocate a block of memory which can hold one of several types of values."
-{ $subsection POSTPONE: C-UNION: }
-"C union objects can be allocated by calling " { $link <c-object> } " or " { $link malloc-object } "."
-$nl
-"Arrays of C unions can be created with the " { $vocab-link "struct-arrays" } " vocabulary." ;
+++ /dev/null
-USING: alien alien.syntax alien.c-types kernel tools.test
-sequences system libc words vocabs namespaces layouts ;
-IN: alien.structs.tests
-
-C-STRUCT: bar
- { "int" "x" }
- { { "int" 8 } "y" } ;
-
-[ 36 ] [ "bar" heap-size ] unit-test
-[ t ] [ \ <displaced-alien> "bar" c-type-getter memq? ] unit-test
-
-C-STRUCT: align-test
- { "int" "x" }
- { "double" "y" } ;
-
-os winnt? cpu x86? and [
- [ 16 ] [ "align-test" heap-size ] unit-test
-
- cell 4 = [
- C-STRUCT: one
- { "long" "a" } { "double" "b" } { "int" "c" } ;
-
- [ 24 ] [ "one" heap-size ] unit-test
- ] when
-] when
-
-CONSTANT: MAX_FOOS 30
-
-C-STRUCT: foox
- { { "int" MAX_FOOS } "x" } ;
-
-[ 120 ] [ "foox" heap-size ] unit-test
-
-C-UNION: barx
- { "int" MAX_FOOS }
- "float" ;
-
-[ 120 ] [ "barx" heap-size ] unit-test
-
-"help" vocab [
- "print-topic" "help" lookup "help" set
- [ ] [ \ foox-x "help" get execute ] unit-test
- [ ] [ \ set-foox-x "help" get execute ] unit-test
-] when
-
-C-STRUCT: nested
- { "int" "x" } ;
-
-C-STRUCT: nested-2
- { "nested" "y" } ;
-
-[ 4 ] [
- "nested-2" <c-object>
- "nested" <c-object>
- 4 over set-nested-x
- over set-nested-2-y
- nested-2-y
- nested-x
-] unit-test
+++ /dev/null
-! Copyright (C) 2004, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs generic hashtables kernel kernel.private
-math namespaces parser sequences strings words libc fry
-alien.c-types alien.structs.fields cpu.architecture math.order
-quotations byte-arrays ;
-IN: alien.structs
-
-TUPLE: struct-type < abstract-c-type fields return-in-registers? ;
-
-M: struct-type c-type ;
-
-M: struct-type c-type-stack-align? drop f ;
-
-: if-value-struct ( ctype true false -- )
- [ dup value-struct? ] 2dip '[ drop "void*" @ ] if ; inline
-
-M: struct-type unbox-parameter
- [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
-
-M: struct-type box-parameter
- [ %box-large-struct ] [ box-parameter ] if-value-struct ;
-
-: if-small-struct ( c-type true false -- ? )
- [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
-
-M: struct-type unbox-return
- [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
-
-M: struct-type box-return
- [ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
-
-M: struct-type stack-size
- [ heap-size ] [ stack-size ] if-value-struct ;
-
-: c-struct? ( type -- ? ) (c-type) struct-type? ;
-
-: (define-struct) ( name size align fields class -- )
- [ [ align ] keep ] 2dip new
- byte-array >>class
- byte-array >>boxed-class
- swap >>fields
- swap >>align
- swap >>size
- swap typedef ;
-
-: make-fields ( name vocab fields -- fields )
- [ first2 <field-spec> ] with with map ;
-
-: compute-struct-align ( types -- n )
- [ c-type-align ] [ max ] map-reduce ;
-
-: define-struct ( name vocab fields -- )
- [ 2drop ] [ make-fields ] 3bi
- [ struct-offsets ] keep
- [ [ type>> ] map compute-struct-align ] keep
- [ struct-type (define-struct) ] keep
- [ define-field ] each ; deprecated
-
-: define-union ( name members -- )
- [ [ heap-size ] [ max ] map-reduce ] keep
- compute-struct-align f struct-type (define-struct) ; deprecated
-
-: offset-of ( field struct -- offset )
- c-types get at fields>>
- [ name>> = ] with find nip offset>> ;
-
-USE: vocabs.loader
-"struct-arrays" require
+++ /dev/null
-C structure support
IN: alien.syntax
-USING: alien alien.c-types alien.parser alien.structs
-classes.struct help.markup help.syntax ;
+USING: alien alien.c-types alien.parser classes.struct help.markup help.syntax see ;
HELP: DLL"
{ $syntax "DLL\" path\"" }
HELP: ALIEN:
{ $syntax "ALIEN: address" }
-{ $values { "address" "a non-negative integer" } }
+{ $values { "address" "a non-negative hexadecimal integer" } }
{ $description "Creates an alien object at parse time." }
{ $notes "Alien objects are invalidated between image saves and loads, and hence source files should not contain alien literals; this word is for interactive use only. See " { $link "alien-expiry" } " for details." } ;
ARTICLE: "syntax-aliens" "Alien object literal syntax"
-{ $subsection POSTPONE: ALIEN: }
-{ $subsection POSTPONE: DLL" } ;
+{ $subsections
+ POSTPONE: ALIEN:
+ POSTPONE: DLL"
+} ;
HELP: LIBRARY:
{ $syntax "LIBRARY: name" }
{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } " if ." }
{ $notes "This word differs from " { $link typedef } " in that it runs at parse time, to ensure correct ordering of operations when loading source files. Words defined in source files are compiled before top-level forms are run, so if a source file defines C binding words and uses " { $link typedef } ", the type alias won't be available at compile time." } ;
-HELP: C-STRUCT:
-{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: STRUCT: } " word." }
-{ $syntax "C-STRUCT: name pairs... ;" }
-{ $values { "name" "a new C type name" } { "pairs" "C type / field name string pairs" } }
-{ $description "Defines a C struct layout and accessor words." }
-{ $notes "C type names are documented in " { $link "c-types-specs" } "." } ;
-
-HELP: C-UNION:
-{ $deprecated "New code should use " { $link "classes.struct" } ". See the " { $link POSTPONE: UNION-STRUCT: } " word." }
-{ $syntax "C-UNION: name members... ;" }
-{ $values { "name" "a new C type name" } { "members" "a sequence of C types" } }
-{ $description "Defines a new C type sized to fit its largest member." }
-{ $notes "C type names are documented in " { $link "c-types-specs" } "." }
-{ $examples { $code "C-UNION: event \"active-event\" \"keyboard-event\" \"mouse-event\" ;" } } ;
-
HELP: C-ENUM:
{ $syntax "C-ENUM: words... ;" }
{ $values { "words" "a sequence of word names" } }
{ $description "Creates a sequence of word definitions in the current vocabulary. Each word pushes an integer according to its index in the enumeration definition. The first word pushes 0." }
-{ $notes "This word emulates a C-style " { $snippet "enum" } " in Factor. While this feature can be used for any purpose, using integer constants is discouraged unless it is for interfacing with C libraries. Factor code should use symbolic constants instead." }
+{ $notes "This word emulates a C-style " { $snippet "enum" } " in Factor. While this feature can be used for any purpose, using integer constants is discouraged unless it is for interfacing with C libraries. Factor code should use " { $link "words.symbol" } " or " { $link "singletons" } " instead." }
+{ $examples
+ "Here is an example enumeration definition:"
+ { $code "C-ENUM: red green blue ;" }
+ "It is equivalent to the following series of definitions:"
+ { $code "CONSTANT: red 0" "CONSTANT: green 1" "CONSTANT: blue 2" }
+} ;
+
+HELP: C-TYPE:
+{ $syntax "C-TYPE: type" }
+{ $values { "type" "a new C type" } }
+{ $description "Defines a new, opaque C type. Since it is opaque, " { $snippet "type" } " will not be directly usable as a parameter or return type of a " { $link POSTPONE: FUNCTION: } " or as a slot of a " { $link POSTPONE: STRUCT: } ". However, it can be used as the type of a pointer (that is, as " { $snippet "type*" } ")." $nl
+{ $snippet "C-TYPE:" } " can also be used to forward-declare C types to enable circular dependencies. For example:"
+{ $code """C-TYPE: forward
+STRUCT: backward { x forward* } ;
+STRUCT: forward { x backward* } ; """ } }
+{ $notes "Primitive C types are also displayed using " { $snippet "C-TYPE:" } " syntax when they are displayed by " { $link see } "." } ;
+
+HELP: CALLBACK:
+{ $syntax "CALLBACK: return type ( parameters ) ;" }
+{ $values { "return" "a C return type" } { "type" "a type name" } { "parameters" "a comma-separated sequence of type/name pairs; " { $snippet "type1 arg1, type2 arg2, ..." } } }
+{ $description "Defines a new function pointer C type word " { $snippet "type" } ". The newly defined word works both as a C type and as a wrapper for " { $link alien-callback } " for callbacks that accept the given return type and parameters. The ABI of the callback is decided from the ABI of the active " { $link POSTPONE: LIBRARY: } " declaration." }
{ $examples
- "The following two lines are equivalent:"
- { $code "C-ENUM: red green blue ;" ": red 0 ; : green 1 ; : blue 2 ;" }
+ { $code
+ "CALLBACK: bool FakeCallback ( int message, void* payload ) ;"
+ ": MyFakeCallback ( -- alien )"
+ " [| message payload |"
+ " \"message #\" write"
+ " message number>string write"
+ " \" received\" write nl"
+ " t"
+ " ] FakeCallback ;"
+ }
} ;
HELP: &:
HELP: typedef
{ $values { "old" "a string" } { "new" "a string" } }
-{ $description "Alises the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
+{ $description "Aliases the C type " { $snippet "old" } " under the name " { $snippet "new" } "." }
{ $notes "Using this word in the same source file which defines C bindings can cause problems, because words are compiled before top-level forms are run. Use the " { $link POSTPONE: TYPEDEF: } " word instead." } ;
{ POSTPONE: TYPEDEF: typedef } related-words
HELP: c-struct?
-{ $values { "type" "a string" } { "?" "a boolean" } }
-{ $description "Tests if a C type is a structure defined by " { $link POSTPONE: C-STRUCT: } "." } ;
+{ $values { "c-type" "a C type name" } { "?" "a boolean" } }
+{ $description "Tests if a C type is a structure defined by " { $link POSTPONE: STRUCT: } "." } ;
HELP: define-function
{ $values { "return" "a C return type" } { "library" "a logical library name" } { "function" "a C function name" } { "parameters" "a sequence of C parameter types" } }
! Copyright (C) 2005, 2009 Slava Pestov, Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays alien alien.c-types alien.structs
+USING: accessors arrays alien alien.c-types
alien.arrays alien.strings kernel math namespaces parser
sequences words quotations math.parser splitting grouping
effects assocs combinators lexer strings.parser alien.parser
SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ;
-SYNTAX: ALIEN:
scan string>number <alien> parsed ;
+SYNTAX: ALIEN:
16 scan-base <alien> parsed ;
SYNTAX: BAD-ALIEN <bad-alien> parsed ;
SYNTAX: FUNCTION:
(FUNCTION:) define-declared ;
-SYNTAX: TYPEDEF:
- scan scan typedef ;
-
-SYNTAX: C-STRUCT:
- scan current-vocab parse-definition define-struct ; deprecated
+SYNTAX: CALLBACK:
+ (CALLBACK:) define-inline ;
-SYNTAX: C-UNION:
- scan parse-definition define-union ; deprecated
+SYNTAX: TYPEDEF:
+ scan-c-type CREATE-C-TYPE typedef ;
SYNTAX: C-ENUM:
";" parse-tokens
[ [ create-in ] dip define-constant ] each-index ;
+SYNTAX: C-TYPE:
+ void CREATE-C-TYPE typedef ;
+
ERROR: no-such-symbol name library ;
: address-of ( name library -- value )
"The " { $vocab-link "ascii" } " vocabulary implements support for the legacy ASCII character set. Most applications should use " { $link "unicode" } " instead."\r
$nl\r
"ASCII character classes:"\r
-{ $subsection blank? }\r
-{ $subsection letter? }\r
-{ $subsection LETTER? }\r
-{ $subsection digit? }\r
-{ $subsection printable? }\r
-{ $subsection control? }\r
-{ $subsection quotable? }\r
-{ $subsection ascii? }\r
+{ $subsections\r
+ blank?\r
+ letter?\r
+ LETTER?\r
+ digit?\r
+ printable?\r
+ control?\r
+ quotable?\r
+ ascii?\r
+}\r
"ASCII case conversion:"\r
-{ $subsection ch>lower }\r
-{ $subsection ch>upper }\r
-{ $subsection >lower }\r
-{ $subsection >upper } ;\r
+{ $subsections\r
+ ch>lower\r
+ ch>upper\r
+ >lower\r
+ >upper\r
+} ;\r
\r
ABOUT: "ascii"\r
ARTICLE: "base64" "Base 64 conversions"
"The " { $vocab-link "base64" } " vocabulary implements conversions of sequences to printable characters in base 64. These plain-text representations of binary data may be passed around and converted back to binary data later." $nl
"Converting to and from base64 as strings:"
-{ $subsection >base64 }
-{ $subsection >base64-lines }
-{ $subsection base64> }
+{ $subsections
+ >base64
+ >base64-lines
+ base64>
+}
"Using base64 from streams:"
-{ $subsection encode-base64 }
-{ $subsection encode-base64-lines }
-{ $subsection decode-base64 } ;
+{ $subsections
+ encode-base64
+ encode-base64-lines
+ decode-base64
+} ;
ABOUT: "base64"
"Bidirectional assocs implement the entire " { $link "assocs-protocol" } " with the exception of " { $link delete-at } ". Duplicate values are allowed, however value lookups with " { $link value-at } " only return the first key that a given value was stored with."
$nl
"The class of biassocs:"
-{ $subsection biassoc }
-{ $subsection biassoc? }
+{ $subsections
+ biassoc
+ biassoc?
+}
"Creating new biassocs:"
-{ $subsection <biassoc> }
-{ $subsection <bihash> }
+{ $subsections
+ <biassoc>
+ <bihash>
+}
"Converting existing assocs to biassocs:"
-{ $subsection >biassoc } ;
+{ $subsections >biassoc } ;
ABOUT: "biassocs"
ARTICLE: "binary-search" "Binary search"
"The " { $emphasis "binary search" } " algorithm allows elements to be located in sorted sequence in " { $snippet "O(log n)" } " time."
-{ $subsection search }
+{ $subsections search }
"Variants of sequence words optimized for sorted sequences:"
-{ $subsection sorted-index }
-{ $subsection sorted-member? }
-{ $subsection sorted-memq? }
+{ $subsections
+ sorted-index
+ sorted-member?
+ sorted-memq?
+}
{ $see-also "order-specifiers" "sequences-sorting" } ;
ABOUT: "binary-search"
$nl
"Bit array words are in the " { $vocab-link "bit-arrays" } " vocabulary."
$nl
-"Bit arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-byte-arrays" } "."
+"Bit arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-pointers" } "."
$nl
"Bit arrays form a class of objects:"
-{ $subsection bit-array }
-{ $subsection bit-array? }
+{ $subsections
+ bit-array
+ bit-array?
+}
"Creating new bit arrays:"
-{ $subsection >bit-array }
-{ $subsection <bit-array> }
+{ $subsections
+ >bit-array
+ <bit-array>
+}
"Efficiently setting and clearing all bits in a bit array:"
-{ $subsection set-bits }
-{ $subsection clear-bits }
+{ $subsections
+ set-bits
+ clear-bits
+}
"Converting between unsigned integers and their binary representation:"
-{ $subsection integer>bit-array }
-{ $subsection bit-array>integer }
+{ $subsections
+ integer>bit-array
+ bit-array>integer
+}
"Bit array literal syntax:"
-{ $subsection POSTPONE: ?{ } ;
+{ $subsections POSTPONE: ?{ } ;
ABOUT: "bit-arrays"
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types accessors math alien.accessors kernel
+USING: alien.c-types alien.data accessors math alien.accessors kernel
kernel.private sequences sequences.private byte-arrays
parser prettyprint.custom fry ;
IN: bit-arrays
"A bit vector is a resizable mutable sequence of bits. Bit vector words are found in the " { $vocab-link "bit-vectors" } " vocabulary."\r
$nl\r
"Bit vectors form a class:"\r
-{ $subsection bit-vector }\r
-{ $subsection bit-vector? }\r
+{ $subsections\r
+ bit-vector\r
+ bit-vector?\r
+}\r
"Creating bit vectors:"\r
-{ $subsection >bit-vector }\r
-{ $subsection <bit-vector> }\r
+{ $subsections\r
+ >bit-vector\r
+ <bit-vector>\r
+}\r
"Literal syntax:"\r
-{ $subsection POSTPONE: ?V{ }\r
+{ $subsections POSTPONE: ?V{ }\r
"If you don't care about initial capacity, a more elegant way to create a new bit vector is to write:"\r
{ $code "?V{ } clone" } ;\r
\r
--- /dev/null
+unportable
ARTICLE: "bootstrap.image" "Bootstrapping new images"
"A new image can be built from source; this is known as " { $emphasis "bootstrap" } ". Bootstrap is a two-step process. The first stage is the creation of a bootstrap image from a running Factor instance:"
-{ $subsection make-image }
+{ $subsections make-image }
"The second bootstrapping stage is initiated by running the resulting bootstrap image:"
{ $code "./factor -i=boot.x86.32.image" }
"This stage loads additional code, compiles all words, and dumps a final " { $snippet "factor.image" } "."
USERENV: jit-execute-word 41
USERENV: jit-execute-jump 42
USERENV: jit-execute-call 43
+USERENV: jit-declare-word 44
! PIC stubs
USERENV: pic-load 47
\ inline-cache-miss-tail \ pic-miss-tail-word set
\ mega-cache-lookup \ mega-lookup-word set
\ mega-cache-miss \ mega-miss-word set
+ \ declare jit-declare-word set
[ undefined ] undefined-quot set ;
: emit-userenvs ( -- )
\r
ARTICLE: "boxes" "Boxes"\r
"A " { $emphasis "box" } " is a container which can either be empty or hold a single value."\r
-{ $subsection box }\r
+{ $subsections box }\r
"Creating an empty box:"\r
-{ $subsection <box> }\r
+{ $subsections <box> }\r
"Storing a value and removing a value from a box:"\r
-{ $subsection >box }\r
-{ $subsection box> }\r
+{ $subsections\r
+ >box\r
+ box>\r
+}\r
"Safely removing a value:"\r
-{ $subsection ?box }\r
+{ $subsections ?box }\r
"Testing if a box is full can be done by reading the " { $snippet "occupied" } " slot." ;\r
\r
ABOUT: "boxes"\r
USING: system combinators alien alien.syntax alien.c-types
alien.destructors kernel accessors sequences arrays ui.gadgets
-alien.libraries ;
+alien.libraries classes.struct ;
IN: cairo.ffi
<< {
TYPEDEF: void* cairo_t
TYPEDEF: void* cairo_surface_t
-C-STRUCT: cairo_matrix_t
- { "double" "xx" }
- { "double" "yx" }
- { "double" "xy" }
- { "double" "yy" }
- { "double" "x0" }
- { "double" "y0" } ;
+STRUCT: cairo_matrix_t
+ { xx double }
+ { yx double }
+ { xy double }
+ { yy double }
+ { x0 double }
+ { y0 double } ;
TYPEDEF: void* cairo_pattern_t
TYPEDEF: void* cairo_destroy_func_t
: cairo-destroy-func ( quot -- callback )
- [ "void" { "void*" } "cdecl" ] dip alien-callback ; inline
+ [ void { void* } "cdecl" ] dip alien-callback ; inline
! See cairo.h for details
-C-STRUCT: cairo_user_data_key_t
- { "int" "unused" } ;
+STRUCT: cairo_user_data_key_t
+ { unused int } ;
TYPEDEF: int cairo_status_t
C-ENUM:
TYPEDEF: void* cairo_write_func_t
: cairo-write-func ( quot -- callback )
- [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { void* uchar* int } "cdecl" ] dip alien-callback ; inline
TYPEDEF: void* cairo_read_func_t
: cairo-read-func ( quot -- callback )
- [ "cairo_status_t" { "void*" "uchar*" "int" } "cdecl" ] dip alien-callback ; inline
+ [ cairo_status_t { void* uchar* int } "cdecl" ] dip alien-callback ; inline
! Functions for manipulating state objects
FUNCTION: cairo_t*
FUNCTION: void
cairo_clip_extents ( cairo_t* cr, double* x1, double* y1, double* x2, double* y2 ) ;
-C-STRUCT: cairo_rectangle_t
- { "double" "x" }
- { "double" "y" }
- { "double" "width" }
- { "double" "height" } ;
+STRUCT: cairo_rectangle_t
+ { x double }
+ { y double }
+ { width double }
+ { height double } ;
-C-STRUCT: cairo_rectangle_list_t
- { "cairo_status_t" "status" }
- { "cairo_rectangle_t*" "rectangles" }
- { "int" "num_rectangles" } ;
+STRUCT: cairo_rectangle_list_t
+ { status cairo_status_t }
+ { rectangles cairo_rectangle_t* }
+ { num_rectangles int } ;
FUNCTION: cairo_rectangle_list_t*
cairo_copy_clip_rectangle_list ( cairo_t* cr ) ;
TYPEDEF: void* cairo_font_face_t
-C-STRUCT: cairo_glyph_t
- { "ulong" "index" }
- { "double" "x" }
- { "double" "y" } ;
-
-C-STRUCT: cairo_text_extents_t
- { "double" "x_bearing" }
- { "double" "y_bearing" }
- { "double" "width" }
- { "double" "height" }
- { "double" "x_advance" }
- { "double" "y_advance" } ;
-
-C-STRUCT: cairo_font_extents_t
- { "double" "ascent" }
- { "double" "descent" }
- { "double" "height" }
- { "double" "max_x_advance" }
- { "double" "max_y_advance" } ;
+STRUCT: cairo_glyph_t
+ { index ulong }
+ { x double }
+ { y double } ;
+
+STRUCT: cairo_text_extents_t
+ { x_bearing double }
+ { y_bearing double }
+ { width double }
+ { height double }
+ { x_advance double }
+ { y_advance double } ;
+
+STRUCT: cairo_font_extents_t
+ { ascent double }
+ { descent double }
+ { height double }
+ { max_x_advance double }
+ { max_y_advance double } ;
TYPEDEF: int cairo_font_slant_t
C-ENUM:
CAIRO_PATH_CLOSE_PATH ;
! NEED TO DO UNION HERE
-C-STRUCT: cairo_path_data_t-point
- { "double" "x" }
- { "double" "y" } ;
-
-C-STRUCT: cairo_path_data_t-header
- { "cairo_path_data_type_t" "type" }
- { "int" "length" } ;
-
-C-UNION: cairo_path_data_t "cairo_path_data_t-point" "cairo_path_data_t-header" ;
-
-C-STRUCT: cairo_path_t
- { "cairo_status_t" "status" }
- { "cairo_path_data_t*" "data" }
- { "int" "num_data" } ;
+STRUCT: cairo_path_data_t-point
+ { x double }
+ { y double } ;
+
+STRUCT: cairo_path_data_t-header
+ { type cairo_path_data_type_t }
+ { length int } ;
+
+UNION-STRUCT: cairo_path_data_t
+ { point cairo_path_data_t-point }
+ { header cairo_path_data_t-header } ;
+
+STRUCT: cairo_path_t
+ { status cairo_status_t }
+ { data cairo_path_data_t* }
+ { num_data int } ;
FUNCTION: cairo_path_t*
cairo_copy_path ( cairo_t* cr ) ;
ARTICLE: "calendar" "Calendar"
"The two data types used throughout the calendar library:"
-{ $subsection timestamp }
-{ $subsection duration }
+{ $subsections
+ timestamp
+ duration
+}
"Durations represent spans of time:"
-{ $subsection "using-durations" }
+{ $subsections "using-durations" }
"Arithmetic on timestamps and durations:"
-{ $subsection "timestamp-arithmetic" }
+{ $subsections "timestamp-arithmetic" }
"Getting the current timestamp:"
-{ $subsection now }
-{ $subsection gmt }
+{ $subsections
+ now
+ gmt
+}
"Converting between timestamps:"
-{ $subsection >local-time }
-{ $subsection >gmt }
+{ $subsections
+ >local-time
+ >gmt
+}
"Converting between timezones:"
-{ $subsection convert-timezone }
+{ $subsections convert-timezone }
"Timestamps relative to each other:"
-{ $subsection "relative-timestamps" }
+{ $subsections "relative-timestamps" }
"Operations on units of time:"
-{ $subsection "years" }
-{ $subsection "months" }
-{ $subsection "days" }
+{ $subsections
+ "years"
+ "months"
+ "days"
+}
"Meta-data about the calendar:"
-{ $subsection "calendar-facts" }
+{ $subsections "calendar-facts" }
;
ARTICLE: "timestamp-arithmetic" "Timestamp arithmetic"
"Adding timestamps and durations, or durations and durations:"
-{ $subsection time+ }
+{ $subsections time+ }
"Subtracting:"
-{ $subsection time- }
+{ $subsections time- }
"Element-wise multiplication:"
-{ $subsection time* } ;
+{ $subsections time* } ;
ARTICLE: "using-durations" "Using durations"
"Creating a duration object:"
-{ $subsection years }
-{ $subsection months }
-{ $subsection weeks }
-{ $subsection days }
-{ $subsection hours }
-{ $subsection minutes }
-{ $subsection seconds }
-{ $subsection milliseconds }
-{ $subsection microseconds }
-{ $subsection nanoseconds }
-{ $subsection instant }
+{ $subsections
+ years
+ months
+ weeks
+ days
+ hours
+ minutes
+ seconds
+ milliseconds
+ microseconds
+ nanoseconds
+ instant
+}
"Converting a duration to a number:"
-{ $subsection duration>years }
-{ $subsection duration>months }
-{ $subsection duration>days }
-{ $subsection duration>hours }
-{ $subsection duration>minutes }
-{ $subsection duration>seconds }
-{ $subsection duration>milliseconds }
-{ $subsection duration>microseconds }
-{ $subsection duration>nanoseconds } ;
+{ $subsections
+ duration>years
+ duration>months
+ duration>days
+ duration>hours
+ duration>minutes
+ duration>seconds
+ duration>milliseconds
+ duration>microseconds
+ duration>nanoseconds
+} ;
ARTICLE: "relative-timestamps" "Relative timestamps"
"In the future:"
-{ $subsection hence }
+{ $subsections hence }
"In the past:"
-{ $subsection ago }
+{ $subsections ago }
"Invert a duration:"
-{ $subsection before }
+{ $subsections before }
"Days of the week relative to " { $link now } ":"
-{ $subsection sunday }
-{ $subsection monday }
-{ $subsection tuesday }
-{ $subsection wednesday }
-{ $subsection thursday }
-{ $subsection friday }
-{ $subsection saturday }
+{ $subsections
+ sunday
+ monday
+ tuesday
+ wednesday
+ thursday
+ friday
+ saturday
+}
"New timestamps relative to calendar events:"
-{ $subsection beginning-of-year }
-{ $subsection beginning-of-month }
-{ $subsection beginning-of-week }
-{ $subsection midnight }
-{ $subsection noon }
-;
+{ $subsections
+ beginning-of-year
+ beginning-of-month
+ beginning-of-week
+ midnight
+ noon
+} ;
ARTICLE: "days" "Day operations"
"Naming days:"
-{ $subsection day-abbreviation2 }
-{ $subsection day-abbreviations2 }
-{ $subsection day-abbreviation3 }
-{ $subsection day-abbreviations3 }
-{ $subsection day-name }
-{ $subsection day-names }
+{ $subsections
+ day-abbreviation2
+ day-abbreviations2
+ day-abbreviation3
+ day-abbreviations3
+ day-name
+ day-names
+}
"Calculating a Julian day number:"
-{ $subsection julian-day-number }
+{ $subsections julian-day-number }
"Calculate a timestamp:"
-{ $subsection julian-day-number>date }
-;
+{ $subsections julian-day-number>date } ;
ARTICLE: "calendar-facts" "Calendar facts"
"Calendar facts:"
-{ $subsection average-month }
-{ $subsection months-per-year }
-{ $subsection days-per-year }
-{ $subsection hours-per-year }
-{ $subsection minutes-per-year }
-{ $subsection seconds-per-year }
-{ $subsection days-in-month }
-{ $subsection day-of-year }
-{ $subsection day-of-week }
-;
+{ $subsections
+ average-month
+ months-per-year
+ days-per-year
+ hours-per-year
+ minutes-per-year
+ seconds-per-year
+ days-in-month
+ day-of-year
+ day-of-week
+} ;
ARTICLE: "years" "Year operations"
"Leap year predicate:"
-{ $subsection leap-year? }
+{ $subsections leap-year? }
"Find the number of days in a year:"
-{ $subsection days-in-year }
-;
+{ $subsections days-in-year } ;
ARTICLE: "months" "Month operations"
"Naming months:"
-{ $subsection month-name }
-{ $subsection month-names }
-{ $subsection month-abbreviation }
-{ $subsection month-abbreviations }
-;
+{ $subsections
+ month-name
+ month-names
+ month-abbreviation
+ month-abbreviations
+} ;
ABOUT: "calendar"
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax arrays calendar
-kernel math unix unix.time unix.types namespaces system ;
+kernel math unix unix.time unix.types namespaces system
+accessors classes.struct ;
IN: calendar.unix
: timeval>seconds ( timeval -- seconds )
- [ timeval-sec seconds ] [ timeval-usec microseconds ] bi
- time+ ;
+ [ sec>> seconds ] [ usec>> microseconds ] bi time+ ;
: timeval>unix-time ( timeval -- timestamp )
timeval>seconds since-1970 ;
: timespec>seconds ( timespec -- seconds )
- [ timespec-sec seconds ] [ timespec-nsec nanoseconds ] bi
- time+ ;
+ [ sec>> seconds ] [ nsec>> nanoseconds ] bi time+ ;
: timespec>unix-time ( timespec -- timestamp )
timespec>seconds since-1970 ;
: get-time ( -- alien )
- f time <time_t> localtime ;
+ f time <time_t> localtime tm memory>struct ;
: timezone-name ( -- string )
- get-time tm-zone ;
+ get-time zone>> ;
M: unix gmt-offset ( -- hours minutes seconds )
- get-time tm-gmtoff 3600 /mod 60 /mod ;
+ get-time gmtoff>> 3600 /mod 60 /mod ;
USING: calendar namespaces alien.c-types system
-windows.kernel32 kernel math combinators windows.errors ;
+windows.kernel32 kernel math combinators windows.errors
+accessors classes.struct ;
IN: calendar.windows
M: windows gmt-offset ( -- hours minutes seconds )
- "TIME_ZONE_INFORMATION" <c-object>
+ TIME_ZONE_INFORMATION <struct>
dup GetTimeZoneInformation {
{ TIME_ZONE_ID_INVALID [ win32-error-string throw ] }
- { TIME_ZONE_ID_UNKNOWN [ TIME_ZONE_INFORMATION-Bias ] }
- { TIME_ZONE_ID_STANDARD [ TIME_ZONE_INFORMATION-Bias ] }
- { TIME_ZONE_ID_DAYLIGHT [
- [ TIME_ZONE_INFORMATION-Bias ]
- [ TIME_ZONE_INFORMATION-DaylightBias ] bi +
- ] }
+ { TIME_ZONE_ID_UNKNOWN [ Bias>> ] }
+ { TIME_ZONE_ID_STANDARD [ Bias>> ] }
+ { TIME_ZONE_ID_DAYLIGHT [ [ Bias>> ] [ DaylightBias>> ] bi + ] }
} case neg 60 /mod 0 ;
ARTICLE: "channels" "Channels"
"The " { $vocab-link "channels" } " vocabulary provides a simple abstraction to send and receive objects." $nl
"Opening a channel:"
-{ $subsection <channel> }
+{ $subsections <channel> }
"Sending a message:"
-{ $subsection to }
+{ $subsections to }
"Receiving a message:"
-{ $subsection from } ;
+{ $subsections from } ;
ABOUT: "channels"
ARTICLE: "checksums.adler-32" "Adler-32 checksum"
"The Adler-32 checksum algorithm implements simple and fast checksum. It is used in zlib and rsync."
-{ $subsection adler-32 } ;
+{ $subsections adler-32 } ;
ABOUT: "checksums.adler-32"
ARTICLE: "checksums.fnv1" "Fowler-Noll-Vo checksum"
"The Fowler-Noll-Vo checksum algorithm is another simple and fast checksum. It comes in 32, 64, 128, 256, 512 and 1024-bit versions, each in 1 and 1a variants. The 1a variants tend to produce a slightly better result. See http://en.wikipedia.org/wiki/Fowler_Noll_Vo_hash for more details."
-
- { $subsection fnv1-32 }
- { $subsection fnv1a-32 }
-
- { $subsection fnv1-64 }
- { $subsection fnv1a-64 }
-
- { $subsection fnv1-128 }
- { $subsection fnv1a-128 }
-
- { $subsection fnv1-256 }
- { $subsection fnv1a-256 }
-
- { $subsection fnv1-512 }
- { $subsection fnv1a-512 }
-
- { $subsection fnv1-1024 }
- { $subsection fnv1a-1024 }
- ;
+{ $subsections
+ fnv1-32
+ fnv1a-32
+}
+{ $subsections
+ fnv1-64
+ fnv1a-64
+}
+{ $subsections
+ fnv1-128
+ fnv1a-128
+}
+{ $subsections
+ fnv1-256
+ fnv1a-256
+}
+{ $subsections
+ fnv1-512
+ fnv1a-512
+}
+{ $subsections
+ fnv1-1024
+ fnv1a-1024
+} ;
ABOUT: "checksums.fnv1"
ARTICLE: "checksums.md5" "MD5 checksum"
"The MD5 checksum algorithm implements a one-way hash function. While it is widely used, many weaknesses are known and it should not be used in new applications (" { $url "http://www.schneier.com/blog/archives/2005/03/more_hash_funct.html" } ")."
-{ $subsection md5 } ;
+{ $subsections md5 } ;
ABOUT: "checksums.md5"
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: byte-arrays checksums checksums.md5 io.encodings.binary
-io.streams.byte-array kernel math namespaces tools.test ;
+io.streams.byte-array kernel math namespaces tools.test
+sequences ;
IN: checksums.md5.tests
[ "d41d8cd98f00b204e9800998ecf8427e" ] [ "" >byte-array md5 checksum-bytes hex-string ] unit-test
<md5-state> "asdf" binary <byte-reader> add-checksum-stream
[ get-checksum ] [ get-checksum ] bi =
] unit-test
+
+[
+ t
+] [
+ { "abcd" "efg" } md5 checksum-lines length 16 =
+] unit-test
sequences byte-arrays locals sequences.private macros fry
io.encodings.binary math.bitwise checksums accessors
checksums.common checksums.stream combinators combinators.smart
-specialized-arrays.uint literals hints ;
+specialized-arrays literals hints ;
+SPECIALIZED-ARRAY: uint
IN: checksums.md5
SINGLETON: md5
ARTICLE: "checksums.openssl" "OpenSSL checksums"
"The OpenSSL library provides a large number of efficient checksum (message digest) algorithms which may be used independently of its SSL functionality."
-{ $subsection openssl-checksum }
+{ $subsections openssl-checksum }
"Constructing a checksum from a known name:"
-{ $subsection <openssl-checksum> }
+{ $subsections <openssl-checksum> }
"Two utility words:"
-{ $subsection openssl-md5 }
-{ $subsection openssl-sha1 }
+{ $subsections
+ openssl-md5
+ openssl-sha1
+}
"An error thrown if the digest name is unrecognized:"
-{ $subsection unknown-digest }
+{ $subsections unknown-digest }
"An example where we compute the SHA1 checksum of a string using the OpenSSL implementation of SHA1:"
{ $example "USING: byte-arrays checksums checksums.openssl ;" "\"hello world\" >byte-array openssl-sha1 checksum-bytes hex-string ." "\"2aae6c35c94fcfb415dbe95f408b9ce91ee846ed\"" }
"If we use the Factor implementation, we get the same result, just slightly slower:"
-! Copyright (C) 2008 Slava Pestov
+! copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors byte-arrays alien.c-types kernel continuations
-destructors sequences io openssl openssl.libcrypto checksums
-checksums.stream ;
+USING: accessors byte-arrays alien.c-types alien.data kernel
+continuations destructors sequences io openssl openssl.libcrypto
+checksums checksums.stream classes.struct ;
IN: checksums.openssl
ERROR: unknown-digest name ;
: <evp-md-context> ( -- ctx )
evp-md-context new-disposable
- "EVP_MD_CTX" <c-object> dup EVP_MD_CTX_init >>handle ;
+ EVP_MD_CTX_create >>handle ;
M: evp-md-context dispose*
- handle>> EVP_MD_CTX_cleanup drop ;
+ handle>> EVP_MD_CTX_destroy ;
: with-evp-md-context ( quot -- )
maybe-init-ssl [ <evp-md-context> ] dip with-disposal ; inline
ARTICLE: "checksums.sha" "SHA-2 checksum"
"The SHA family of checksum algorithms are one-way hashes useful for checksumming data. SHA-1 is considered insecure, while SHA-2 It is generally considered to be pretty strong." $nl
"SHA-2 checksums:"
-{ $subsection sha-224 }
-{ $subsection sha-256 }
+{ $subsections
+ sha-224
+ sha-256
+}
"SHA-1 checksum:"
-{ $subsection sha1 } ;
+{ $subsections sha1 } ;
ABOUT: "checksums.sha"
ARTICLE: "circular" "Circular sequences"
"The " { $vocab-link "circular" } " vocabulary implements the " { $link "sequence-protocol" } " to allow an arbitrary start index and wrap-around indexing." $nl
"Creating a new circular object:"
-{ $subsection <circular> }
-{ $subsection <circular-string> }
-{ $subsection <growing-circular> }
+{ $subsections
+ <circular>
+ <circular-string>
+ <growing-circular>
+}
"Changing the start index:"
-{ $subsection change-circular-start }
-{ $subsection rotate-circular }
+{ $subsections
+ change-circular-start
+ rotate-circular
+}
"Pushing new elements:"
-{ $subsection push-circular }
-{ $subsection push-growing-circular } ;
+{ $subsections
+ push-circular
+ push-growing-circular
+} ;
ABOUT: "circular"
! (c)Joe Groff bsd license
-USING: accessors assocs classes classes.struct combinators
-kernel math prettyprint.backend prettyprint.custom
-prettyprint.sections see.private sequences strings words ;
+USING: accessors alien alien.c-types alien.data alien.prettyprint arrays
+assocs classes classes.struct combinators combinators.short-circuit
+continuations fry kernel libc make math math.parser mirrors
+prettyprint.backend prettyprint.custom prettyprint.sections
+see.private sequences slots strings summary words ;
IN: classes.struct.prettyprint
<PRIVATE
[ drop \ STRUCT: ] if ;
: struct>assoc ( struct -- assoc )
- [ class struct-slots ] [ struct-slot-values ] bi zip filter-tuple-assoc ;
+ [ class struct-slots ] [ struct-slot-values ] bi zip ;
: pprint-struct-slot ( slot -- )
<flow \ { pprint-word
- {
+ f <inset {
[ name>> text ]
- [ c-type>> dup string? [ text ] [ pprint* ] if ]
+ [ type>> pprint-c-type ]
[ read-only>> [ \ read-only pprint-word ] when ]
[ initial>> [ \ initial: pprint-word pprint* ] when* ]
- } cleave
+ } cleave block>
\ } pprint-word block> ;
+: pprint-struct ( struct -- )
+ [
+ [ \ S{ ] dip
+ [ class ]
+ [ struct>assoc [ [ name>> ] dip ] assoc-map ] bi
+ \ } (pprint-tuple)
+ ] ?pprint-tuple ;
+
+: pprint-struct-pointer ( struct -- )
+ \ S@ [ [ class pprint-word ] [ >c-ptr pprint* ] bi ] pprint-prefix ;
+
PRIVATE>
M: struct-class see-class*
[ class ] [ struct-slot-values ] bi class-slot-sequence ;
M: struct pprint*
- [ [ \ S{ ] dip [ class ] [ struct>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
+ [ pprint-struct ]
+ [ pprint-struct-pointer ] pprint-c-object ;
+
+M: struct summary
+ [
+ dup class name>> %
+ " struct of " %
+ byte-length #
+ " bytes " %
+ ] "" make ;
+
+TUPLE: struct-mirror { object read-only } ;
+C: <struct-mirror> struct-mirror
+
+: get-struct-slot ( struct slot -- value present? )
+ over class struct-slots slot-named
+ [ name>> reader-word execute( struct -- value ) t ]
+ [ drop f f ] if* ;
+: set-struct-slot ( value struct slot -- )
+ over class struct-slots slot-named
+ [ name>> writer-word execute( value struct -- ) ]
+ [ 2drop ] if* ;
+: reset-struct-slot ( struct slot -- )
+ over class struct-slots slot-named
+ [ [ initial>> swap ] [ name>> writer-word ] bi execute( value struct -- ) ]
+ [ drop ] if* ;
+: reset-struct-slots ( struct -- )
+ dup class struct-prototype
+ dup byte-length memcpy ;
+
+M: struct-mirror at*
+ object>> {
+ { [ over "underlying" = ] [ nip >c-ptr t ] }
+ { [ over { [ array? ] [ length 1 >= ] } 1&& ] [ swap first get-struct-slot ] }
+ [ 2drop f f ]
+ } cond ;
+
+M: struct-mirror set-at
+ object>> {
+ { [ over "underlying" = ] [ 3drop ] }
+ { [ over array? ] [ swap first set-struct-slot ] }
+ [ 3drop ]
+ } cond ;
+
+M: struct-mirror delete-at
+ object>> {
+ { [ over "underlying" = ] [ 2drop ] }
+ { [ over array? ] [ swap first reset-struct-slot ] }
+ [ 2drop ]
+ } cond ;
+
+M: struct-mirror clear-assoc
+ object>> reset-struct-slots ;
+
+M: struct-mirror >alist ( mirror -- alist )
+ object>> [
+ [ drop "underlying" ] [ >c-ptr ] bi 2array 1array
+ ] [
+ '[
+ _ struct>assoc
+ [ [ [ name>> ] [ type>> ] bi 2array ] dip ] assoc-map
+ ] [ drop { } ] recover
+ ] bi append ;
+
+M: struct make-mirror <struct-mirror> ;
+
+INSTANCE: struct-mirror assoc
{ $values { "class" "a " { $link struct } " class word" } { "slots" "slot values" } }
{ $description "Marks the beginning of a literal struct. The syntax is identical to tuple literal syntax with " { $link POSTPONE: T{ } { $snippet " }" } "; either the assoc syntax (that is, " { $snippet "S{ class { slot value } { slot value } ... }" } ") or the simple syntax (" { $snippet "S{ class f value value ... }" } ") can be used." } ;
+HELP: S@
+{ $syntax "S@ class alien" }
+{ $values { "class" "a " { $link struct } " class word" } { "alien" "a literal alien" } }
+{ $description "Marks the beginning of a literal struct at a specific C address. The prettyprinter uses this syntax when the memory backing a struct object is invalid. This syntax should not generally be used in source code." } ;
+
+{ POSTPONE: S{ POSTPONE: S@ } related-words
+
HELP: UNION-STRUCT:
{ $syntax "UNION-STRUCT: class { slot type } { slot type } ... ;" }
{ $values { "class" "a new " { $link struct } " class to define" } { "slots" "a list of slot specifiers" } }
HELP: struct-class
{ $class-description "The metaclass of all " { $link struct } " classes." } ;
-ARTICLE: "classes.struct" "Struct classes"
-{ $link struct } " classes are similar to " { $link tuple } "s, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for structured access to C memory or Factor byte arrays and for passing struct values in and out of the FFI. Struct types are defined using a syntax similar to tuple syntax:"
-{ $subsection POSTPONE: STRUCT: }
+ARTICLE: "classes.struct.examples" "Struct class examples"
+"A struct with a variety of fields:"
+{ $code
+ "USING: alien.c-types classes.struct ;"
+ ""
+ "STRUCT: test-struct"
+ " { i int }"
+ " { chicken char[16] }"
+ " { data void* } ;"
+}
+"Creating a new instance of this struct, and printing out:"
+{ $code "test-struct <struct> ." }
+"Creating a new instance with slots initialized from the stack:"
+{ $code
+ "USING: libc specialized-arrays ;"
+ "SPECIALIZED-ARRAY: char"
+ ""
+ "42"
+ "\"Hello, chicken.\" >char-array"
+ "1024 malloc"
+ "test-struct <struct-boa> ."
+} ;
+
+ARTICLE: "classes.struct.define" "Defining struct classes"
+"Struct classes are defined using a syntax similar to the " { $link POSTPONE: TUPLE: } " syntax for defining tuple classes:"
+{ $subsections POSTPONE: STRUCT: }
+"Union structs are also supported, which behave like structs but share the same memory for all the slots."
+{ $subsections POSTPONE: UNION-STRUCT: } ;
+
+ARTICLE: "classes.struct.create" "Creating instances of structs"
"Structs can be allocated with " { $link new } "- and " { $link boa } "-like constructor words. Additional words are provided for building structs from C memory and from existing buffers:"
-{ $subsection <struct> }
-{ $subsection <struct-boa> }
-{ $subsection malloc-struct }
-{ $subsection memory>struct }
+{ $subsections
+ <struct>
+ <struct-boa>
+ malloc-struct
+ memory>struct
+}
"When the contents of a struct will be immediately reset, faster primitive words are available that will create a struct without initializing its contents:"
-{ $subsection (struct) }
-{ $subsection (malloc-struct) }
-"Structs have literal syntax like tuples:"
-{ $subsection POSTPONE: S{ }
-"Union structs are also supported, which behave like structs but share the same memory for all the type's slots."
-{ $subsection POSTPONE: UNION-STRUCT: }
-;
+{ $subsections
+ (struct)
+ (malloc-struct)
+}
+"Structs have literal syntax, similar to " { $link POSTPONE: T{ } " for tuples:"
+{ $subsections POSTPONE: S{ } ;
+
+ARTICLE: "classes.struct.c" "Passing structs to C functions"
+"Structs can be passed and returned by value, or by reference."
+$nl
+"If a parameter is declared with a struct type, the parameter is passed by value. To pass a struct by reference, declare a parameter with a pointer to struct type."
+$nl
+"If a C function is declared as returning a struct type, the struct is returned by value, and wrapped in an instance of the correct struct class automatically. If a C function is declared as returning a pointer to a struct, it will return an " { $link alien } " instance. This is because there is no way to distinguish between a pointer to a single struct and a pointer to an array of zero or more structs. It is up to the caller to wrap it in a struct, or a specialized array of structs, respectively."
+$nl
+"An example of a struct declaration:"
+{ $code
+ "USING: alien.c-types classes.struct ;"
+ ""
+ "STRUCT: Point"
+ " { x int }"
+ " { y int }"
+ " { z int } ;"
+}
+"A C function which returns a struct by value:"
+{ $code
+ "USING: alien.syntax ;"
+ "FUNCTION: Point give_me_a_point ( char* description ) ;"
+}
+"A C function which takes a struct parameter by reference:"
+{ $code
+ "FUNCTION: void print_point ( Point* p ) ;"
+} ;
+
+ARTICLE: "classes.struct" "Struct classes"
+"The " { $vocab-link "classes.struct" } " vocabulary implements " { $link struct } " classes. They are similar to " { $link tuple } " classes, but their slots exhibit value semantics, and they are backed by a contiguous structured block of memory. Structs can be used for space-efficient storage of data in the Factor heap, as well as for passing data to and from C libraries using the " { $link "alien" } "."
+{ $subsections
+ "classes.struct.examples"
+ "classes.struct.define"
+ "classes.struct.create"
+ "classes.struct.c"
+} ;
ABOUT: "classes.struct"
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.libraries
-alien.structs.fields alien.syntax ascii classes.struct combinators
-destructors io.encodings.utf8 io.pathnames io.streams.string
-kernel libc literals math multiline namespaces prettyprint
-prettyprint.config see sequences specialized-arrays.ushort
-system tools.test compiler.tree.debugger struct-arrays
-classes.tuple.private specialized-arrays.direct.int
-compiler.units ;
+USING: accessors alien alien.c-types alien.data ascii
+assocs byte-arrays classes.struct classes.tuple.private
+combinators compiler.tree.debugger compiler.units destructors
+io.encodings.utf8 io.pathnames io.streams.string kernel libc
+literals math mirrors namespaces prettyprint
+prettyprint.config see sequences specialized-arrays system
+tools.test parser lexer eval layouts ;
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: char
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: ushort
IN: classes.struct.tests
-<<
-: libfactor-ffi-tests-path ( -- string )
- "resource:" (normalize-path)
- {
- { [ os winnt? ] [ "libfactor-ffi-test.dll" ] }
- { [ os macosx? ] [ "libfactor-ffi-test.dylib" ] }
- { [ os unix? ] [ "libfactor-ffi-test.so" ] }
- } cond append-path ;
-
-"f-cdecl" libfactor-ffi-tests-path "cdecl" add-library
-
-"f-stdcall" libfactor-ffi-tests-path "stdcall" add-library
->>
-
SYMBOL: struct-test-empty
[ [ struct-test-empty { } define-struct-class ] with-compilation-unit ]
[ 7654 ] [ S{ struct-test-foo f 98 7654 f } y>> ] unit-test
[ 7654 ] [ S{ struct-test-foo { y 7654 } } y>> ] unit-test
+[ {
+ { "underlying" B{ 98 0 0 98 127 0 0 127 0 0 0 0 } }
+ { { "x" char } 98 }
+ { { "y" int } HEX: 7F00007F }
+ { { "z" bool } f }
+} ] [
+ B{ 98 0 0 98 127 0 0 127 0 0 0 0 } struct-test-foo memory>struct
+ make-mirror >alist
+] unit-test
+
+[ { { "underlying" f } } ] [
+ f struct-test-foo memory>struct
+ make-mirror >alist
+] unit-test
+
+[ 55 t ] [ S{ struct-test-foo { x 55 } } make-mirror { "x" "char" } swap at* ] unit-test
+[ 55 t ] [ S{ struct-test-foo { y 55 } } make-mirror { "y" "int" } swap at* ] unit-test
+[ t t ] [ S{ struct-test-foo { z t } } make-mirror { "z" "bool" } swap at* ] unit-test
+[ f t ] [ S{ struct-test-foo { z f } } make-mirror { "z" "bool" } swap at* ] unit-test
+[ f f ] [ S{ struct-test-foo } make-mirror { "nonexist" "bool" } swap at* ] unit-test
+[ f f ] [ S{ struct-test-foo } make-mirror "nonexist" swap at* ] unit-test
+[ f t ] [ f struct-test-foo memory>struct make-mirror "underlying" swap at* ] unit-test
+
+[ S{ struct-test-foo { x 3 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror [ 3 { "x" "char" } ] dip set-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 5 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror [ 5 { "y" "int" } ] dip set-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z t } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror [ t { "z" "bool" } ] dip set-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror [ "nonsense" "underlying" ] dip set-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror [ "nonsense" "nonexist" ] dip set-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror [ "nonsense" { "nonexist" "int" } ] dip set-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 123 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror { "y" "int" } swap delete-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 0 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror { "x" "char" } swap delete-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror { "nonexist" "char" } swap delete-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror "underlying" swap delete-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 1 } { y 2 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z f } }
+ [ make-mirror "nonsense" swap delete-at ] keep
+] unit-test
+
+[ S{ struct-test-foo { x 0 } { y 123 } { z f } } ] [
+ S{ struct-test-foo { x 1 } { y 2 } { z t } }
+ [ make-mirror clear-assoc ] keep
+] unit-test
+
UNION-STRUCT: struct-test-float-and-bits
- { f float }
+ { f c:float }
{ bits uint } ;
[ 1.0 ] [ struct-test-float-and-bits <struct> 1.0 float>bits >>bits f>> ] unit-test
] with-destructors
] unit-test
-[ "S{ struct-test-foo { y 7654 } }" ]
+[ "S{ struct-test-foo { x 0 } { y 7654 } { z f } }" ]
+[
+ [
+ boa-tuples? off
+ c-object-pointers? off
+ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
+ ] with-scope
+] unit-test
+
+[ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" ]
[
- f boa-tuples?
- [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
- with-variable
+ [
+ c-object-pointers? on
+ 12 <byte-array> struct-test-foo memory>struct [ pprint ] with-string-writer
+ ] with-scope
] unit-test
[ "S{ struct-test-foo f 0 7654 f }" ]
[
- t boa-tuples?
- [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
- with-variable
+ [
+ boa-tuples? on
+ c-object-pointers? off
+ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
+ ] with-scope
+] unit-test
+
+[ "S@ struct-test-foo f" ]
+[
+ [
+ c-object-pointers? off
+ f struct-test-foo memory>struct [ pprint ] with-string-writer
+ ] with-scope
] unit-test
-[ <" USING: classes.struct ;
+[ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
STRUCT: struct-test-foo
{ x char initial: 0 } { y int initial: 123 } { z bool } ;
-"> ]
+" ]
[ [ struct-test-foo see ] with-string-writer ] unit-test
-[ <" USING: classes.struct ;
+[ "USING: alien.c-types classes.struct ;
IN: classes.struct.tests
UNION-STRUCT: struct-test-float-and-bits
{ f float initial: 0.0 } { bits uint initial: 0 } ;
-"> ]
+" ]
[ [ struct-test-float-and-bits see ] with-string-writer ] unit-test
[ {
- T{ field-spec
+ T{ struct-slot-spec
{ name "x" }
{ offset 0 }
- { type "char" }
- { reader x>> }
- { writer (>>x) }
+ { initial 0 }
+ { class fixnum }
+ { type char }
}
- T{ field-spec
+ T{ struct-slot-spec
{ name "y" }
{ offset 4 }
- { type "int" }
- { reader y>> }
- { writer (>>y) }
+ { initial 123 }
+ { class integer }
+ { type int }
}
- T{ field-spec
+ T{ struct-slot-spec
{ name "z" }
{ offset 8 }
- { type "bool" }
- { reader z>> }
- { writer (>>z) }
+ { initial f }
+ { type bool }
+ { class object }
}
} ] [ "struct-test-foo" c-type fields>> ] unit-test
[ {
- T{ field-spec
+ T{ struct-slot-spec
{ name "f" }
{ offset 0 }
- { type "float" }
- { reader f>> }
- { writer (>>f) }
+ { type c:float }
+ { class float }
+ { initial 0.0 }
}
- T{ field-spec
+ T{ struct-slot-spec
{ name "bits" }
{ offset 0 }
- { type "uint" }
- { reader bits>> }
- { writer (>>bits) }
+ { type uint }
+ { class integer }
+ { initial 0 }
}
} ] [ "struct-test-float-and-bits" c-type fields>> ] unit-test
] with-destructors
] unit-test
-STRUCT: struct-test-ffi-foo
- { x int }
- { y int } ;
-
-LIBRARY: f-cdecl
-FUNCTION: int ffi_test_11 ( int a, struct-test-ffi-foo b, int c ) ;
-
-[ 14 ] [ 1 2 3 struct-test-ffi-foo <struct-boa> 4 ffi_test_11 ] unit-test
+[ t ] [
+ [
+ struct-test-equality-1 <struct> 5 >>x
+ struct-test-equality-1 malloc-struct &free 5 >>x
+ [ hashcode ] bi@ =
+ ] with-destructors
+] unit-test
STRUCT: struct-test-array-slots
{ x int }
] unit-test
STRUCT: struct-test-optimization
- { x { "int" 3 } } { y int } ;
+ { x { int 3 } } { y int } ;
+
+SPECIALIZED-ARRAY: struct-test-optimization
[ t ] [ [ struct-test-optimization memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
[ t ] [
- [ 3 struct-test-optimization <direct-struct-array> third y>> ]
+ [ 3 <direct-struct-test-optimization-array> third y>> ]
{ <tuple> <tuple-boa> memory>struct y>> } inlined?
] unit-test
[ f ] [ [ memory>struct y>> ] { memory>struct y>> } inlined? ] unit-test
-[ f ] [ struct-test-foo <struct> dup clone [ >c-ptr ] bi@ eq? ] unit-test
+[ t ] [
+ [ struct-test-optimization <struct> struct-test-optimization <struct> [ x>> ] bi@ ]
+ { x>> } inlined?
+] unit-test
+
+! Test cloning structs
+STRUCT: clone-test-struct { x int } { y char[3] } ;
+
+[ 1 char-array{ 9 1 1 } ] [
+ clone-test-struct <struct>
+ 1 >>x char-array{ 9 1 1 } >>y
+ clone
+ [ x>> ] [ y>> >char-array ] bi
+] unit-test
+
+[ t 1 char-array{ 9 1 1 } ] [
+ [
+ clone-test-struct malloc-struct &free
+ 1 >>x char-array{ 9 1 1 } >>y
+ clone
+ [ >c-ptr byte-array? ] [ x>> ] [ y>> >char-array ] tri
+ ] with-destructors
+] unit-test
+
+STRUCT: struct-that's-a-word { x int } ;
+
+: struct-that's-a-word ( -- ) "OOPS" throw ;
+
+[ -77 ] [ S{ struct-that's-a-word { x -77 } } clone x>> ] unit-test
+
+! Interactive parsing of struct slot definitions
+[
+ "USE: classes.struct IN: classes.struct.tests STRUCT: unexpected-eof-test" <string-reader>
+ "struct-class-test-1" parse-stream
+] [ error>> error>> unexpected-eof? ] must-fail-with
+
+! S{ with non-struct type
+[
+ "USE: classes.struct IN: classes.struct.tests TUPLE: not-a-struct ; S{ not-a-struct }"
+ eval( -- value )
+] must-fail
+
+! Subclassing a struct class should not be allowed
+[
+ "USE: classes.struct IN: classes.struct.tests STRUCT: a-struct { x int } ; TUPLE: not-a-struct < a-struct ;"
+ eval( -- )
+] must-fail
+
+! Remove c-type when struct class is forgotten
+[ ] [
+ "USE: classes.struct IN: classes.struct.tests TUPLE: a-struct ;" eval( -- )
+] unit-test
+
+[ f ] [ "a-struct" c-types get key? ] unit-test
! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.structs
-alien.structs.fields arrays byte-arrays classes classes.parser
-classes.tuple classes.tuple.parser classes.tuple.private
-combinators combinators.short-circuit combinators.smart
-functors.backend fry generalizations generic.parser kernel
-kernel.private lexer libc locals macros make math math.order parser
-quotations sequences slots slots.private struct-arrays vectors
-words compiler.tree.propagation.transforms ;
-FROM: slots => reader-word writer-word ;
+USING: accessors alien alien.c-types alien.data alien.parser arrays
+byte-arrays classes classes.parser classes.tuple classes.tuple.parser
+classes.tuple.private combinators combinators.short-circuit
+combinators.smart cpu.architecture definitions functors.backend
+fry generalizations generic.parser kernel kernel.private lexer
+libc locals macros make math math.order parser quotations
+sequences slots slots.private specialized-arrays vectors words
+summary namespaces assocs vocabs.parser ;
IN: classes.struct
-! struct class
+SPECIALIZED-ARRAY: uchar
ERROR: struct-must-have-slots ;
+M: struct-must-have-slots summary
+ drop "Struct definitions must have slots" ;
+
TUPLE: struct
{ (underlying) c-ptr read-only } ;
TUPLE: struct-slot-spec < slot-spec
- c-type ;
+ type ;
PREDICATE: struct-class < tuple-class
- { [ \ struct subclass-of? ] [ all-slots length 1 = ] } 1&& ;
+ superclass \ struct eq? ;
+
+M: struct-class valid-superclass? drop f ;
+
+SLOT: fields
-: struct-slots ( struct -- slots )
- "struct-slots" word-prop ;
+: struct-slots ( struct-class -- slots )
+ "c-type" word-prop fields>> ;
! struct allocation
{
[ [ class ] bi@ = ]
[ [ >c-ptr ] [ [ >c-ptr ] [ byte-length ] bi ] bi* memory= ]
- } 2&& ;
+ } 2&& ; inline
+
+M: struct hashcode*
+ [ >c-ptr ] [ byte-length ] bi <direct-uchar-array> hashcode* ; inline
: struct-prototype ( class -- prototype ) "prototype" word-prop ; foldable
: memory>struct ( ptr class -- struct )
- [ 1array ] dip slots>tuple ;
-
-\ memory>struct [
- dup struct-class? [ '[ _ boa ] ] [ drop f ] if
-] 1 define-partial-eval
-
-M: struct clone
- [ >c-ptr ] [ byte-length memory>byte-array ] [ class memory>struct ] tri ;
+ ! This is sub-optimal if the class is not literal, but gets
+ ! optimized down to efficient code if it is.
+ '[ _ boa ] call( ptr -- struct ) ; inline
<PRIVATE
: (init-struct) ( class with-prototype: ( prototype -- alien ) sans-prototype: ( class -- alien ) -- alien )
[ heap-size malloc ] keep memory>struct ; inline
: malloc-struct ( class -- struct )
- [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ;
+ [ >c-ptr malloc-byte-array ] [ 1 swap heap-size calloc ] (init-struct) ; inline
: (struct) ( class -- struct )
[ heap-size (byte-array) ] keep memory>struct ; inline
: <struct> ( class -- struct )
- [ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ;
+ [ >c-ptr clone ] [ heap-size <byte-array> ] (init-struct) ; inline
MACRO: <struct-boa> ( class -- quot: ( ... -- struct ) )
[
[ struct-slots [ initial>> ] map over length tail append ] keep ;
: (reader-quot) ( slot -- quot )
- [ c-type>> c-type-getter-boxer ]
+ [ type>> c-type-getter-boxer ]
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
: (writer-quot) ( slot -- quot )
- [ c-type>> c-setter ]
+ [ type>> c-setter ]
[ offset>> [ >c-ptr ] swap suffix ] bi prepend ;
: (boxer-quot) ( class -- quot )
M: struct-class boa>object
swap pad-struct-slots
- [ (struct) ] [ struct-slots ] bi
+ [ <struct> ] [ struct-slots ] bi
[ [ (writer-quot) call( value struct -- ) ] with 2each ] curry keep ;
+M: struct-class initial-value* <struct> ; inline
+
! Struct slot accessors
GENERIC: struct-slot-values ( struct -- sequence )
M: struct-class writer-quot
nip (writer-quot) ;
+: offset-of ( field struct -- offset )
+ struct-slots slot-named offset>> ; inline
+
! c-types
+TUPLE: struct-c-type < abstract-c-type
+ fields
+ return-in-registers? ;
+
+INSTANCE: struct-c-type value-type
+
+M: struct-c-type c-type ;
+
+M: struct-c-type c-type-stack-align? drop f ;
+
+: if-value-struct ( ctype true false -- )
+ [ dup value-struct? ] 2dip '[ drop void* @ ] if ; inline
+
+M: struct-c-type unbox-parameter
+ [ %unbox-large-struct ] [ unbox-parameter ] if-value-struct ;
+
+M: struct-c-type box-parameter
+ [ %box-large-struct ] [ box-parameter ] if-value-struct ;
+
+: if-small-struct ( c-type true false -- ? )
+ [ dup return-struct-in-registers? ] 2dip '[ f swap @ ] if ; inline
+
+M: struct-c-type unbox-return
+ [ %unbox-small-struct ] [ %unbox-large-struct ] if-small-struct ;
+
+M: struct-c-type box-return
+ [ %box-small-struct ] [ %box-large-struct ] if-small-struct ;
+
+M: struct-c-type stack-size
+ [ heap-size ] [ stack-size ] if-value-struct ;
+
+M: struct-c-type c-struct? drop t ;
+
<PRIVATE
: struct-slot-values-quot ( class -- quot )
struct-slots
\ cleave [ ] 2sequence
\ output>array [ ] 2sequence ;
-: (define-struct-slot-values-method) ( class -- )
- [ \ struct-slot-values create-method-in ]
- [ struct-slot-values-quot ] bi define ;
-
-: (define-byte-length-method) ( class -- )
- [ \ byte-length create-method-in ]
- [ heap-size \ drop swap [ ] 2sequence ] bi define ;
-
-: slot>field ( slot -- field )
- field-spec new swap {
- [ name>> >>name ]
- [ offset>> >>offset ]
- [ c-type>> >>type ]
- [ name>> reader-word >>reader ]
- [ name>> writer-word >>writer ]
- } cleave ;
-
-: define-struct-for-class ( class -- )
- [
- {
- [ name>> ]
- [ "struct-size" word-prop ]
- [ "struct-align" word-prop ]
- [ struct-slots [ slot>field ] map ]
- } cleave
- struct-type (define-struct)
- ] [
- {
- [ name>> c-type ]
- [ (unboxer-quot) >>unboxer-quot ]
- [ (boxer-quot) >>boxer-quot ]
- [ >>boxed-class ]
- } cleave drop
- ] bi ;
+: define-inline-method ( class generic quot -- )
+ [ create-method-in ] dip [ define ] [ drop make-inline ] 2bi ;
+: (define-struct-slot-values-method) ( class -- )
+ [ \ struct-slot-values ] [ struct-slot-values-quot ] bi
+ define-inline-method ;
+
+: clone-underlying ( struct -- byte-array )
+ [ >c-ptr ] [ byte-length ] bi memory>byte-array ; inline
+
+: (define-clone-method) ( class -- )
+ [ \ clone ]
+ [ \ clone-underlying swap literalize \ memory>struct [ ] 3sequence ] bi
+ define-inline-method ;
+
+:: c-type-for-class ( class slots size align -- c-type )
+ struct-c-type new
+ byte-array >>class
+ class >>boxed-class
+ slots >>fields
+ size >>size
+ align >>align
+ class (unboxer-quot) >>unboxer-quot
+ class (boxer-quot) >>boxer-quot ;
+
: align-offset ( offset class -- offset' )
c-type-align align ;
: struct-offsets ( slots -- size )
0 [
- [ c-type>> align-offset ] keep
- [ (>>offset) ] [ c-type>> heap-size + ] 2bi
+ [ type>> align-offset ] keep
+ [ (>>offset) ] [ type>> heap-size + ] 2bi
] reduce ;
: union-struct-offsets ( slots -- size )
- [ 0 >>offset c-type>> heap-size ] [ max ] map-reduce ;
+ [ 0 >>offset type>> heap-size ] [ max ] map-reduce ;
: struct-align ( slots -- align )
- [ c-type>> c-type-align ] [ max ] map-reduce ;
+ [ type>> c-type-align ] [ max ] map-reduce ;
PRIVATE>
-M: struct-class c-type
- name>> c-type ;
-
-M: struct-class c-type-align
- "struct-align" word-prop ;
+M: struct byte-length class "struct-size" word-prop ; foldable
-M: struct-class c-type-getter
- drop [ swap <displaced-alien> ] ;
-
-M: struct-class c-type-setter
- [ c-type-getter ] [ c-type-unboxer-quot ] [ heap-size ] tri
- '[ @ swap @ _ memcpy ] ;
-
-M: struct-class c-type-boxer-quot
- (boxer-quot) ;
+! class definition
-M: struct-class c-type-unboxer-quot
- (unboxer-quot) ;
+<PRIVATE
+GENERIC: binary-zero? ( value -- ? )
-M: struct-class heap-size
- "struct-size" word-prop ;
+M: object binary-zero? drop f ;
+M: f binary-zero? drop t ;
+M: number binary-zero? zero? ;
+M: struct binary-zero?
+ [ byte-length iota ] [ >c-ptr ] bi
+ [ <displaced-alien> *uchar zero? ] curry all? ;
-! class definition
+: struct-needs-prototype? ( class -- ? )
+ struct-slots [ initial>> binary-zero? ] all? not ;
-<PRIVATE
: make-struct-prototype ( class -- prototype )
- [ heap-size <byte-array> ]
- [ memory>struct ]
- [ struct-slots ] tri
- [
- [ initial>> ]
- [ (writer-quot) ] bi
- over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
- ] each ;
+ dup struct-needs-prototype? [
+ [ "c-type" word-prop size>> <byte-array> ]
+ [ memory>struct ]
+ [ struct-slots ] tri
+ [
+ [ initial>> ]
+ [ (writer-quot) ] bi
+ over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
+ ] each
+ ] [ drop f ] if ;
: (struct-methods) ( class -- )
[ (define-struct-slot-values-method) ]
- [ (define-byte-length-method) ] bi ;
-
-: (struct-word-props) ( class slots size align -- )
- [
- [ "struct-slots" set-word-prop ]
- [ define-accessors ] 2bi
- ]
- [ "struct-size" set-word-prop ]
- [ "struct-align" set-word-prop ] tri-curry*
- [ tri ] 3curry
- [ dup make-struct-prototype "prototype" set-word-prop ]
- [ (struct-methods) ] tri ;
+ [ (define-clone-method) ]
+ bi ;
: check-struct-slots ( slots -- )
- [ c-type>> c-type drop ] each ;
-
-: (define-struct-class) ( class slots offsets-quot -- )
- [
- [ struct-must-have-slots ]
- [ drop struct f define-tuple-class ] if-empty
- ]
- swap '[
- make-slots dup
- [ check-struct-slots ] _ [ struct-align [ align ] keep ] tri
- (struct-word-props)
- ]
- [ drop define-struct-for-class ] 2tri ; inline
+ [ type>> c-type drop ] each ;
+
+: redefine-struct-tuple-class ( class -- )
+ [ dup class? [ forget-class ] [ drop ] if ] [ struct f define-tuple-class ] bi ;
+
+:: (define-struct-class) ( class slots offsets-quot -- )
+ slots empty? [ struct-must-have-slots ] when
+ class redefine-struct-tuple-class
+ slots make-slots dup check-struct-slots :> slot-specs
+ slot-specs struct-align :> alignment
+ slot-specs offsets-quot call alignment align :> size
+
+ class slot-specs size alignment c-type-for-class :> c-type
+
+ c-type class typedef
+ class slot-specs define-accessors
+ class size "struct-size" set-word-prop
+ class dup make-struct-prototype "prototype" set-word-prop
+ class (struct-methods) ; inline
PRIVATE>
: define-struct-class ( class slots -- )
: define-union-struct-class ( class slots -- )
[ union-struct-offsets ] (define-struct-class) ;
+M: struct-class reset-class
+ [ call-next-method ] [ name>> c-types get delete-at ] bi ;
+
ERROR: invalid-struct-slot token ;
-<PRIVATE
: struct-slot-class ( c-type -- class' )
c-type c-type-boxed-class
dup \ byte-array = [ drop \ c-ptr ] when ;
-: scan-c-type ( -- c-type )
- scan dup "{" = [ drop \ } parse-until >array ] when ;
+: <struct-slot-spec> ( name c-type attributes -- slot-spec )
+ [ struct-slot-spec new ] 3dip
+ [ >>name ]
+ [ [ >>type ] [ struct-slot-class >>class ] bi ]
+ [ [ dup empty? ] [ peel-off-attributes ] until drop ] tri* ;
+<PRIVATE
: parse-struct-slot ( -- slot )
- struct-slot-spec new
- scan >>name
- scan-c-type [ >>c-type ] [ struct-slot-class >>class ] bi
- \ } parse-until [ dup empty? ] [ peel-off-attributes ] until drop ;
+ scan scan-c-type \ } parse-until <struct-slot-spec> ;
: parse-struct-slots ( slots -- slots' more? )
scan {
{ ";" [ f ] }
{ "{" [ parse-struct-slot over push t ] }
+ { f [ unexpected-eof ] }
[ invalid-struct-slot ]
} case ;
SYNTAX: S{
scan-word dup struct-slots parse-tuple-literal-slots parsed ;
+SYNTAX: S@
+ scan-word scan-object swap memory>struct parsed ;
+
! functor support
<PRIVATE
: scan-c-type` ( -- c-type/param )
- scan dup "{" = [ drop \ } parse-until >array ] [ >string-param ] if ;
-
-:: parse-struct-slot` ( accum -- accum )
- scan-string-param :> name
- scan-c-type` :> c-type
- \ } parse-until :> attributes
- accum {
- \ struct-slot-spec new
- name >>name
- c-type [ >>c-type ] [ struct-slot-class >>class ] bi
- attributes [ dup empty? ] [ peel-off-attributes ] until drop
- over push
- } over push-all ;
+ scan dup "{" = [ drop \ } parse-until >array ] [ search ] if ;
+
+: parse-struct-slot` ( accum -- accum )
+ scan-string-param scan-c-type` \ } parse-until
+ [ <struct-slot-spec> over push ] 3curry over push-all ;
: parse-struct-slots` ( accum -- accum more? )
scan {
--- /dev/null
+Tuple-like access to structured raw memory
ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
"Utilities:"
-{ $subsection NSApp }
-{ $subsection add-observer }
-{ $subsection remove-observer }
-{ $subsection install-delegate }
+{ $subsections
+ NSApp
+ add-observer
+ remove-observer
+ install-delegate
+}
"Combinators:"
-{ $subsection cocoa-app }
-{ $subsection with-autorelease-pool }
-{ $subsection with-cocoa } ;
+{ $subsections
+ cocoa-app
+ with-autorelease-pool
+ with-cocoa
+} ;
IN: cocoa.application
ABOUT: "cocoa-application-utils"
ARTICLE: "objc-calling" "Calling Objective C code"
"Before an Objective C class can be used, it must be imported; by default, a small set of common classes are imported automatically, but additional classes can be imported as needed."
-{ $subsection POSTPONE: IMPORT: }
+{ $subsections POSTPONE: IMPORT: }
"Every imported Objective C class has as corresponding class word in the " { $vocab-link "cocoa.classes" } " vocabulary. Class words push the class object in the stack, allowing class methods to be invoked."
$nl
"Messages can be sent to classes and instances using a pair of parsing words:"
-{ $subsection POSTPONE: -> }
-{ $subsection POSTPONE: SUPER-> }
+{ $subsections
+ POSTPONE: ->
+ POSTPONE: SUPER->
+}
"These parsing words are actually syntax sugar for a pair of ordinary words; they can be used instead of the parsing words if the selector name is dynamically computed:"
-{ $subsection send }
-{ $subsection super-send } ;
+{ $subsections
+ send
+ super-send
+} ;
ARTICLE: "cocoa" "Cocoa bridge"
"The " { $vocab-link "cocoa" } " vocabulary implements a Factor-Cocoa bridge for Mac OS X (GNUstep is not supported)."
"The lowest layer uses the " { $link "alien" } " to define bindings for the various functions in Apple's Objective-C runtime. This is defined in the " { $vocab-link "cocoa.runtime" } " vocabulary."
$nl
"On top of this, a dynamic message send facility is built:"
-{ $subsection "objc-calling" }
-{ $subsection "objc-subclassing" }
+{ $subsections
+ "objc-calling"
+ "objc-subclassing"
+}
"A utility library is built to faciliate the development of Cocoa applications in Factor:"
-{ $subsection "cocoa-application-utils" }
-{ $subsection "cocoa-dialogs" }
-{ $subsection "cocoa-pasteboard-utils" }
-{ $subsection "cocoa-view-utils" }
-{ $subsection "cocoa-window-utils" } ;
+{ $subsections
+ "cocoa-application-utils"
+ "cocoa-dialogs"
+ "cocoa-pasteboard-utils"
+ "cocoa-view-utils"
+ "cocoa-window-utils"
+} ;
IN: cocoa
ABOUT: "cocoa"
ARTICLE: "cocoa-dialogs" "Cocoa file dialogs"
"Open dialogs:"
-{ $subsection <NSOpenPanel> }
-{ $subsection open-panel }
+{ $subsections
+ <NSOpenPanel>
+ open-panel
+}
"Save dialogs:"
-{ $subsection <NSSavePanel> }
-{ $subsection save-panel } ;
+{ $subsections
+ <NSSavePanel>
+ save-panel
+} ;
IN: cocoa.dialogs
ABOUT: "cocoa-dialogs"
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel classes.struct cocoa cocoa.types alien.c-types
-locals math sequences vectors fry libc destructors ;
+USING: accessors kernel classes.struct cocoa cocoa.runtime cocoa.types alien.data
+locals math sequences vectors fry libc destructors specialized-arrays ;
+SPECIALIZED-ARRAY: id
IN: cocoa.enumeration
-<< "id" require-c-type-arrays >>
-
CONSTANT: NS-EACH-BUFFER-SIZE 16
: with-enumeration-buffers ( quot -- )
'[
NSFastEnumerationState malloc-struct &free
- NS-EACH-BUFFER-SIZE "id" malloc-array &free
+ NS-EACH-BUFFER-SIZE id malloc-array &free
NS-EACH-BUFFER-SIZE
@
] with-destructors ; inline
:: (NSFastEnumeration-each) ( object quot: ( elt -- ) state stackbuf count -- )
object state stackbuf count -> countByEnumeratingWithState:objects:count: :> items-count
items-count 0 = [
- state itemsPtr>> [ items-count "id" <c-type-direct-array> ] [ stackbuf ] if* :> items
+ state itemsPtr>> [ items-count id <c-direct-array> ] [ stackbuf ] if* :> items
items-count iota [ items nth quot call ] each
object quot state stackbuf count (NSFastEnumeration-each)
] unless ; inline recursive
stack-checker kernel math namespaces make quotations sequences
strings words cocoa.runtime io macros memoize io.encodings.utf8
effects libc libc.private lexer init core-foundation fry
-generalizations specialized-arrays.direct.alien ;
+generalizations specialized-arrays ;
IN: cocoa.messages
+SPECIALIZED-ARRAY: void*
+
: make-sender ( method function -- quot )
[ over first , f , , second , \ alien-invoke , ] [ ] make ;
} case
assoc-union alien>objc-types set-global
+: internal-cocoa-type? ( c-type -- ? )
+ [ "?" = ] [ first CHAR: _ = ] bi or ;
+
+: warn-c-type ( c-type -- )
+ dup internal-cocoa-type?
+ [ drop ] [ "Warning: no such C type: " write print ] if ;
+
: objc-struct-type ( i string -- ctype )
[ CHAR: = ] 2keep index-from swap subseq
- dup c-types get key? [
- "Warning: no such C type: " write dup print
- drop "void*"
- ] unless ;
+ dup c-types get key? [ warn-c-type "void*" ] unless ;
ERROR: no-objc-type name ;
{ $description "Sets the contents of the pasteboard." } ;
ARTICLE: "cocoa-pasteboard-utils" "Cocoa pasteboard utilities"
-{ $subsection pasteboard-string? }
-{ $subsection pasteboard-string }
-{ $subsection set-pasteboard-string } ;
+{ $subsections
+ pasteboard-string?
+ pasteboard-string
+ set-pasteboard-string
+} ;
IN: cocoa.pasteboard
ABOUT: "cocoa-pasteboard-utils"
USING: strings arrays hashtables assocs sequences fry macros
cocoa.messages cocoa.classes cocoa.application cocoa kernel
namespaces io.backend math cocoa.enumeration byte-arrays
-combinators alien.c-types words core-foundation quotations
-core-foundation.data core-foundation.utilities ;
+combinators alien.c-types alien.data words core-foundation
+quotations core-foundation.data core-foundation.utilities ;
IN: cocoa.plists
: >plist ( value -- plist ) >cf -> autorelease ;
! Copyright (C) 2006, 2007 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax classes.struct ;
+USING: alien.c-types alien.syntax classes.struct ;
IN: cocoa.runtime
TYPEDEF: void* SEL
ARTICLE: "objc-subclassing" "Subclassing Objective C classes"
"Objective C classes can be subclassed, with new methods defined in Factor, using a parsing word:"
-{ $subsection POSTPONE: CLASS: }
+{ $subsections POSTPONE: CLASS: }
"This word is actually syntax sugar for an ordinary word:"
-{ $subsection define-objc-class }
+{ $subsections define-objc-class }
"Objective C class definitions are saved in the image. If the image is saved and Factor is restarted with the saved image, custom class definitions are made available to the Objective C runtime when they are first accessed from within Factor." ;
IN: cocoa.subclassing
! Copyright (C) 2006, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax combinators kernel layouts
-classes.struct core-graphics.types ;
+classes.struct cocoa.runtime core-graphics.types ;
IN: cocoa.types
TYPEDEF: long NSInteger
{ $description "Outputs the current mouse location." } ;
ARTICLE: "cocoa-view-utils" "Cocoa view utilities"
-{ $subsection <GLView> }
-{ $subsection view-dim }
-{ $subsection mouse-location } ;
+{ $subsections
+ <GLView>
+ view-dim
+ mouse-location
+} ;
IN: cocoa.views
ABOUT: "cocoa-view-utils"
CONSTANT: NSOpenGLPFAPixelBuffer 90
CONSTANT: NSOpenGLPFAAllowOfflineRenderers 96
CONSTANT: NSOpenGLPFAVirtualScreenCount 128
+
CONSTANT: NSOpenGLCPSwapInterval 222
+CONSTANT: NSOpenGLCPSurfaceOpacity 236
: <GLView> ( class dim pixel-format -- view )
[ -> alloc ]
{ $description "Creates a new " { $snippet "NSWindow" } " with the specified dimensions, containing the given view." } ;
ARTICLE: "cocoa-window-utils" "Cocoa window utilities"
-{ $subsection <NSWindow> }
-{ $subsection <ViewWindow> } ;
+{ $subsections
+ <NSWindow>
+ <ViewWindow>
+} ;
IN: cocoa.windows
ABOUT: "cocoa-window-utils"
IN: cocoa.windows
! Window styles
-CONSTANT: NSBorderlessWindowMask 0
-CONSTANT: NSTitledWindowMask 1
-CONSTANT: NSClosableWindowMask 2
-CONSTANT: NSMiniaturizableWindowMask 4
-CONSTANT: NSResizableWindowMask 8
+CONSTANT: NSBorderlessWindowMask 0
+CONSTANT: NSTitledWindowMask 1
+CONSTANT: NSClosableWindowMask 2
+CONSTANT: NSMiniaturizableWindowMask 4
+CONSTANT: NSResizableWindowMask 8
+CONSTANT: NSTexturedBackgroundWindowMask 256
! Additional panel-only styles
CONSTANT: NSUtilityWindowMask 16
-> initWithContentRect:styleMask:backing:defer: ;
: class-for-style ( style -- NSWindow/NSPanel )
- HEX: 1ff0 bitand zero? NSWindow NSPanel ? ;
+ HEX: 1ef0 bitand zero? NSWindow NSPanel ? ;
: <ViewWindow> ( view rect style -- window )
dup class-for-style <NSWindow> [ swap -> setContentView: ] keep
ARTICLE: "colors.protocol" "Color protocol"
"Abstract superclass for colors:"
-{ $subsection color }
+{ $subsections color }
"All color objects must are required to implement a method on the " { $link >rgba } " generic word."
$nl
"Optionally, they can provide methods on the accessors " { $link red>> } ", " { $link green>> } ", " { $link blue>> } " and " { $link alpha>> } ", either by defining slots with the appropriate names, or with methods which calculate the color component values. The accessors should return color components which are real numbers in the range between 0 and 1."
"The " { $vocab-link "colors" } " vocabulary defines a protocol for colors, with a concrete implementation for RGBA colors. This vocabulary is used by " { $vocab-link "io.styles" } ", " { $vocab-link "ui" } " and other vocabularies, but it is independent of them."
$nl
"RGBA colors with floating point components in the range " { $snippet "[0,1]" } ":"
-{ $subsection rgba }
-{ $subsection <rgba> }
+{ $subsections
+ rgba
+ <rgba>
+}
"Converting a color to RGBA:"
-{ $subsection >rgba }
+{ $subsections >rgba }
"Extracting RGBA components of colors:"
-{ $subsection >rgba-components }
+{ $subsections >rgba-components }
"Further topics:"
-{ $subsection "colors.protocol" }
-{ $subsection "colors.constants" }
+{ $subsections
+ "colors.protocol"
+ "colors.constants"
+}
{ $vocab-subsection "Grayscale colors" "colors.gray" }
{ $vocab-subsection "HSV colors" "colors.hsv" } ;
} ;
ARTICLE: "colors.constants" "Standard color database"
-"The " { $vocab-link "colors.constants" } " vocabulary bundles the X11 " { $snippet "rgb.txt" } " database and provides words for looking up color values."
-{ $subsection named-color }
-{ $subsection named-colors }
-{ $subsection POSTPONE: COLOR: } ;
+"The " { $vocab-link "colors.constants" } " vocabulary bundles the X11 " { $snippet "rgb.txt" } " database and Factor's " { $snippet "factor-colors.txt" } " theme database to provide words for looking up color values by name."
+{ $subsections
+ named-color
+ named-colors
+ POSTPONE: COLOR:
+} ;
ABOUT: "colors.constants"
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel assocs math math.parser memoize io.encodings.utf8
-io.files lexer parser colors sequences splitting
-combinators.smart ascii ;
+io.files lexer parser colors sequences splitting ascii ;
IN: colors.constants
<PRIVATE
: parse-color ( line -- name color )
- [
- [ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
- [ blank? ] trim-head { { CHAR: \s CHAR: - } } substitute swap
- ] input<sequence ;
+ first4
+ [ [ string>number 255 /f ] tri@ 1.0 <rgba> ] dip
+ [ blank? ] trim-head { { CHAR: \s CHAR: - } } substitute swap ;
-: parse-rgb.txt ( lines -- assoc )
+: parse-colors ( lines -- assoc )
[ "!" head? not ] filter
[ 11 cut [ " \t" split harvest ] dip suffix ] map
[ parse-color ] H{ } map>assoc ;
-MEMO: rgb.txt ( -- assoc )
- "resource:basis/colors/constants/rgb.txt" utf8 file-lines parse-rgb.txt ;
+MEMO: colors ( -- assoc )
+ "resource:basis/colors/constants/rgb.txt"
+ "resource:basis/colors/constants/factor-colors.txt"
+ [ utf8 file-lines parse-colors ] bi@ assoc-union ;
PRIVATE>
-: named-colors ( -- keys ) rgb.txt keys ;
+: named-colors ( -- keys ) colors keys ;
ERROR: no-such-color name ;
: named-color ( name -- color )
- dup rgb.txt at [ ] [ no-such-color ] ?if ;
+ dup colors at [ ] [ no-such-color ] ?if ;
SYNTAX: COLOR: scan named-color parsed ;
\ No newline at end of file
--- /dev/null
+! Factor UI theme colors
+243 242 234 FactorLightTan
+227 226 219 FactorTan
+172 167 147 FactorDarkTan
+ 81 91 105 FactorLightSlateBlue
+ 55 62 72 FactorDarkSlateBlue
+ 0 51 0 FactorDarkGreen
ARTICLE: "colors.gray" "Grayscale colors"
"The " { $vocab-link "colors.gray" } " vocabulary implements grayscale colors. These colors hold a single value, and respond to " { $link red>> } ", " { $link green>> } ", " { $link blue>> } " with that value. They also have an independent alpha channel, " { $link alpha>> } "."
-{ $subsection gray }
-{ $subsection <gray> } ;
+{ $subsections
+ gray
+ <gray>
+} ;
ABOUT: "colors.gray"
\ No newline at end of file
ARTICLE: "colors.hsv" "HSV colors"
"The " { $vocab-link "colors.hsv" } " vocabulary implements colors specified by their hue, saturation, and value, together with an alpha channel."
-{ $subsection hsva }
-{ $subsection <hsva> }
+{ $subsections
+ hsva
+ <hsva>
+}
{ $see-also "colors" } ;
ABOUT: "colors.hsv"
\ No newline at end of file
ARTICLE: "columns" "Column sequences"
"A " { $emphasis "column" } " presents a column of a matrix represented as a sequence of rows:"
-{ $subsection column }
-{ $subsection <column> }
+{ $subsections
+ column
+ <column>
+}
"A utility word:"
-{ $subsection <flipped> } ;
+{ $subsections <flipped> } ;
ABOUT: "columns"
IN: combinators.short-circuit
HELP: 0&&
-{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
+{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( -- ? )" } } { "?" "the result of the last quotation, or " { $link f } } }
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
HELP: 0||
-{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( -- )" } } { "?" "the first true result, or " { $link f } } }
+{ $values { "quots" "a sequence of quotations with stack effect " { $snippet "( -- ? )" } } { "?" "the first true result, or " { $link f } } }
{ $description "If every quotation in the sequence outputs " { $link f } ", outputs " { $link f } ", otherwise outputs the result of the first quotation that did not yield " { $link f } "." } ;
HELP: 1&&
-{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
+{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj -- ? )" } } { "?" "the result of the last quotation, or " { $link f } } }
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
HELP: 1||
-{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj -- )" } } { "?" "the first true result, or " { $link f } } }
+{ $values { "obj" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj -- ? )" } } { "?" "the first true result, or " { $link f } } }
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same element from the datastack and must return a boolean." } ;
HELP: 2&&
-{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
+{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 -- ? )" } } { "?" "the result of the last quotation, or " { $link f } } }
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
HELP: 2||
-{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 -- )" } } { "?" "the first true result, or " { $link f } } }
+{ $values { "obj1" object } { "obj2" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 -- ? )" } } { "?" "the first true result, or " { $link f } } }
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same two elements from the datastack and must return a boolean." } ;
HELP: 3&&
-{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 obj3 -- )" } } { "?" "the result of the last quotation, or " { $link f } } }
+{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 obj3 -- ? )" } } { "?" "the result of the last quotation, or " { $link f } } }
{ $description "If every quotation in the sequence outputs a true value, outputs the result of the last quotation, otherwise outputs " { $link f } "." } ;
HELP: 3||
-{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 obj3 -- )" } } { "?" "the first true result, or " { $link f } } }
+{ $values { "obj1" object } { "obj2" object } { "obj3" object } { "quots" "a sequence of quotations with stack effect " { $snippet "( obj1 obj2 obj3 -- ? )" } } { "?" "the first true result, or " { $link f } } }
{ $description "Returns true if any quotation in the sequence returns true. Each quotation takes the same three elements from the datastack and must return a boolean." } ;
HELP: n&&
ARTICLE: "combinators.short-circuit" "Short-circuit combinators"
"The " { $vocab-link "combinators.short-circuit" } " vocabulary stops a computation early once a condition is met." $nl
"AND combinators:"
-{ $subsection 0&& }
-{ $subsection 1&& }
-{ $subsection 2&& }
-{ $subsection 3&& }
+{ $subsections
+ 0&&
+ 1&&
+ 2&&
+ 3&&
+}
"OR combinators:"
-{ $subsection 0|| }
-{ $subsection 1|| }
-{ $subsection 2|| }
-{ $subsection 3|| }
+{ $subsections
+ 0||
+ 1||
+ 2||
+ 3||
+}
"Generalized combinators:"
-{ $subsection n&& }
-{ $subsection n|| }
+{ $subsections
+ n&&
+ n||
+}
;
ABOUT: "combinators.short-circuit"
USING: kernel combinators quotations arrays sequences assocs
-locals generalizations macros fry ;
+generalizations macros fry ;
IN: combinators.short-circuit
-MACRO:: n&& ( quots n -- quot )
- [ f ] quots [| q |
- n
- [ q '[ drop _ ndup @ dup not ] ]
- [ '[ drop _ ndrop f ] ]
- bi 2array
- ] map
- n '[ _ nnip ] suffix 1array
+MACRO: n&& ( quots n -- quot )
+ [
+ [ [ f ] ] 2dip swap [
+ [ '[ drop _ ndup @ dup not ] ]
+ [ drop '[ drop _ ndrop f ] ]
+ 2bi 2array
+ ] with map
+ ] [ '[ _ nnip ] suffix 1array ] bi
[ cond ] 3append ;
<PRIVATE
: 2&& ( obj1 obj2 quots -- ? ) [ with with ] unoptimized-&& ;
: 3&& ( obj1 obj2 obj3 quots -- ? ) [ with with with ] unoptimized-&& ;
-MACRO:: n|| ( quots n -- quot )
- [ f ] quots [| q |
- n
- [ q '[ drop _ ndup @ dup ] ]
- [ '[ _ nnip ] ]
- bi 2array
- ] map
- n '[ drop _ ndrop t ] [ f ] 2array suffix 1array
+MACRO: n|| ( quots n -- quot )
+ [
+ [ [ f ] ] 2dip swap [
+ [ '[ drop _ ndup @ dup ] ]
+ [ drop '[ _ nnip ] ]
+ 2bi 2array
+ ] with map
+ ] [ '[ drop _ ndrop t ] [ f ] 2array suffix 1array ] bi
[ cond ] 3append ;
<PRIVATE
"The " { $vocab-link "combinators.short-circuit.smart" } " vocabulary is similar to " { $vocab-link "combinators.short-circuit" } " except the combinators here infer the number of inputs that the sequence of quotations takes."
$nl
"Generalized AND:"
-{ $subsection && }
+{ $subsections && }
"Generalized OR:"
-{ $subsection || } ;
+{ $subsections || } ;
ABOUT: "combinators.short-circuit.smart"
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel quotations math sequences
-multiline stack-checker ;
+stack-checker ;
IN: combinators.smart
HELP: input<sequence
{ $description "Infers the number or outputs from the quotation and constructs an array from those outputs." }
{ $examples
{ $example
- <" USING: combinators combinators.smart math prettyprint ;
+ "USING: combinators combinators.smart math prettyprint ;
9 [
{ [ 1 - ] [ 1 + ] [ sq ] } cleave
-] output>array .">
+] output>array ."
"{ 8 10 81 }"
}
} ;
ARTICLE: "combinators.smart" "Smart combinators"
"A " { $emphasis "smart combinator" } " is a macro which reflects on the stack effect of an input quotation. The " { $vocab-link "combinators.smart" } " vocabulary implements a few simple smart combinators which look at the static stack effects of input quotations and generate code which produces or consumes the relevant number of stack values." $nl
"Call a quotation and discard all output values or preserve all input values:"
-{ $subsection drop-outputs }
-{ $subsection keep-inputs }
+{ $subsections
+ drop-outputs
+ keep-inputs
+}
"Take all input values from a sequence:"
-{ $subsection input<sequence }
+{ $subsections input<sequence }
"Store all output values to a sequence:"
-{ $subsection output>sequence }
-{ $subsection output>array }
+{ $subsections
+ output>sequence
+ output>array
+}
"Reducing the set of output values:"
-{ $subsection reduce-outputs }
+{ $subsections reduce-outputs }
"Summing output values:"
-{ $subsection sum-outputs }
+{ $subsections sum-outputs }
"Concatenating output values:"
-{ $subsection append-outputs }
-{ $subsection append-outputs-as }
+{ $subsections
+ append-outputs
+ append-outputs-as
+}
"New smart combinators can be created by defining " { $link "macros" } " which call " { $link infer } "." ;
ABOUT: "combinators.smart"
{ $description "Outputs the command line parameters which were passed to the Factor VM on startup." } ;
HELP: command-line
-{ $var-description "The command line parameters which follow the name of the script on the command line." } ;
+{ $var-description "When Factor is run with a script, this variable contains command line parameters which follow the name of the script on the command line. In deployed applications, it contains the entire command line. In all other cases it is set to " { $link f } "." } ;
HELP: main-vocab-hook
{ $var-description "Global variable holding a quotation which outputs a vocabulary name. UI backends set this so that the UI can automatically start if the prerequisites are met (for example, " { $snippet "$DISPLAY" } " being set on X11)." } ;
"The botstrap initialization file is named " { $snippet "factor-boot-rc" } " on Windows and " { $snippet ".factor-boot-rc" } " on Unix. This file can contain " { $link require } " calls for vocabularies you use frequently, and other such long-running tasks that you do not want to perform every time Factor starts."
$nl
"A word to run this file from an existing Factor session:"
-{ $subsection run-bootstrap-init }
+{ $subsections run-bootstrap-init }
"For example, if you changed " { $snippet ".factor-boot-rc" } " and do not want to bootstrap again, you can just invoke " { $link run-bootstrap-init } " in the listener." ;
ARTICLE: "factor-rc" "Startup initialization file"
"The startup initialization file is named " { $snippet "factor-rc" } " on Windows and " { $snippet ".factor-rc" } " on Unix. If it exists, it is run every time Factor starts."
$nl
"A word to run this file from an existing Factor session:"
-{ $subsection run-user-init } ;
+{ $subsections run-user-init } ;
ARTICLE: "factor-roots" "Additional vocabulary roots file"
"The vocabulary roots file is named " { $snippet "factor-roots" } " on Windows and " { $snippet ".factor-roots" } " on Unix. If it exists, it is loaded every time Factor starts. It contains a newline-separated list of " { $link "vocabs.roots" } "."
$nl
"A word to run this file from an existing Factor session:"
-{ $subsection load-vocab-roots } ;
+{ $subsections load-vocab-roots } ;
ARTICLE: "rc-files" "Running code on startup"
"Factor looks for three optional files in your home directory."
-{ $subsection "factor-boot-rc" }
-{ $subsection "factor-rc" }
-{ $subsection "factor-roots" }
+{ $subsections
+ "factor-boot-rc"
+ "factor-rc"
+ "factor-roots"
+}
"The " { $snippet "-no-user-init" } " command line switch will inhibit loading running of these files."
$nl
"If you are unsure where the files should be located, evaluate the following code:"
"\"factor-rc\" rc-path print"
"\"factor-boot-rc\" rc-path print"
}
-"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration, adds an additional vocabulary root (see " { $link "vocabs.roots" } "), and increases the font size in the UI by setting the DPI (dots-per-inch) variable:"
+"Here is an example " { $snippet ".factor-boot-rc" } " which sets up GVIM editor integration:"
{ $code
- "USING: editors.gvim vocabs.loader ui.freetype namespaces sequences ;"
+ "USING: editors.gvim namespaces ;"
"\"/opt/local/bin\" \\ gvim-path set-global"
- "\"/home/jane/src/\" vocab-roots get push"
- "100 dpi set-global"
} ;
ARTICLE: "cli" "Command line arguments"
"Factor command line usage:"
-{ $code "factor [system switches...] [script args...]" }
-"Zero or more system switches can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup, any arguments after the script file are stored in a variable, with no further processing by Factor itself:"
-{ $subsection command-line }
+{ $code "factor [VM args...] [script] [args...]" }
+"Zero or more VM arguments can be passed in, followed by an optional script file name. If the script file is specified, it will be run on startup, any arguments after the script file are stored in the following variable, with no further processing by Factor itself:"
+{ $subsections command-line }
"Instead of running a script, it is also possible to run a vocabulary; this invokes the vocabulary's " { $link POSTPONE: MAIN: } " word:"
{ $code "factor [system switches...] -run=<vocab name>" }
"If no script file or " { $snippet "-run=" } " switch is specified, Factor will start " { $link "listener" } " or " { $link "ui-tools" } ", depending on the operating system."
{ { $snippet "-no-" { $emphasis "foo" } } " - sets the global variable " { $snippet "\"" { $emphasis "foo" } "\"" } " to " { $link f } }
{ { $snippet "-" { $emphasis "foo" } "=" { $emphasis "bar" } } " - sets the global variable " { $snippet "\"" { $emphasis "foo" } "\"" } " to " { $snippet "\"" { $emphasis "bar" } "\"" } }
}
-{ $subsection "runtime-cli-args" }
-{ $subsection "bootstrap-cli-args" }
-{ $subsection "standard-cli-args" }
+{ $subsections
+ "runtime-cli-args"
+ "bootstrap-cli-args"
+ "standard-cli-args"
+}
"The raw list of command line arguments can also be obtained and inspected directly:"
-{ $subsection (command-line) }
+{ $subsections (command-line) }
"There is a way to override the default vocabulary to run on startup, if no script name or " { $snippet "-run" } " switch is specified:"
-{ $subsection main-vocab-hook } ;
+{ $subsections main-vocab-hook } ;
ABOUT: "cli"
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel namespaces make math sequences layouts
-alien.c-types alien.structs cpu.architecture ;
+alien.c-types cpu.architecture ;
IN: compiler.alien
: large-struct? ( ctype -- ? )
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math namespaces assocs hashtables sequences arrays
-accessors vectors combinators sets classes cpu.architecture compiler.cfg
-compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.liveness ;
+accessors words vectors combinators combinators.short-circuit
+sets classes layouts cpu.architecture
+compiler.cfg
+compiler.cfg.rpo
+compiler.cfg.def-use
+compiler.cfg.liveness
+compiler.cfg.copy-prop
+compiler.cfg.registers
+compiler.cfg.comparisons
+compiler.cfg.instructions
+compiler.cfg.representations.preferred ;
IN: compiler.cfg.alias-analysis
! We try to eliminate redundant slot operations using some simple heuristics.
: ac>vregs ( ac -- vregs ) acs>vregs get at ;
-: aliases ( vreg -- vregs )
+GENERIC: aliases ( vreg -- vregs )
+
+M: integer aliases
#! All vregs which may contain the same value as vreg.
vreg>ac ac>vregs ;
+M: word aliases
+ 1array ;
+
: each-alias ( vreg quot -- )
[ aliases ] dip each ; inline
#! assigned by an ##load-immediate.
resolve constants get at ;
-! We treat slot accessors and stack traffic alike
GENERIC: insn-slot# ( insn -- slot#/f )
GENERIC: insn-object ( insn -- vreg )
M: ##set-slot insn-slot# slot>> constant ;
M: ##set-slot-imm insn-slot# slot>> ;
M: ##alien-global insn-slot# [ library>> ] [ symbol>> ] bi 2array ;
+M: ##vm-field-ptr insn-slot# field-name>> ;
M: ##slot insn-object obj>> resolve ;
M: ##slot-imm insn-object obj>> resolve ;
M: ##set-slot insn-object obj>> resolve ;
M: ##set-slot-imm insn-object obj>> resolve ;
M: ##alien-global insn-object drop \ ##alien-global ;
+M: ##vm-field-ptr insn-object drop \ ##vm-field-ptr ;
: init-alias-analysis ( insns -- insns' )
H{ } clone histories set
H{ } clone live-slots set
H{ } clone constants set
H{ } clone copies set
-
+
0 ac-counter set
next-ac heap-ac set
+ \ ##vm-field-ptr set-new-ac
+ \ ##alien-global set-new-ac
+
dup local-live-in [ set-heap-ac ] each ;
GENERIC: analyze-aliases* ( insn -- insn' )
+M: insn analyze-aliases*
+ ! If an instruction defines a value with a non-integer
+ ! representation it means that the value will be boxed
+ ! anywhere its used as a tagged pointer. Boxing allocates
+ ! a new value, except boxing instructions haven't been
+ ! inserted yet.
+ dup defs-vreg [
+ over defs-vreg-rep int-rep eq?
+ [ set-heap-ac ] [ set-new-ac ] if
+ ] when* ;
+
+M: ##phi analyze-aliases*
+ dup defs-vreg set-heap-ac ;
+
M: ##load-immediate analyze-aliases*
+ call-next-method
dup [ val>> ] [ dst>> ] bi constants get set-at ;
-M: ##flushable analyze-aliases*
- dup dst>> set-heap-ac ;
-
M: ##allocation analyze-aliases*
#! A freshly allocated object is distinct from any other
#! object.
#! vreg, since they both contain the same value.
dup record-copy ;
-M: insn analyze-aliases* ;
+: useless-compare? ( insn -- ? )
+ {
+ [ cc>> cc= eq? ]
+ [ [ src1>> ] [ src2>> ] bi [ resolve vreg>ac ] bi@ = not ]
+ } 1&& ; inline
+
+M: ##compare analyze-aliases*
+ call-next-method
+ dup useless-compare? [
+ dst>> \ f tag-number \ ##load-immediate new-insn
+ analyze-aliases*
+ ] when ;
: analyze-aliases ( insns -- insns' )
[ insn# set analyze-aliases* ] map-index sift ;
frame-required? on
stack-frame [ max-stack-frame ] change ;
-M: ##alien-invoke compute-stack-frame*
- stack-frame>> request-stack-frame ;
-
-M: ##alien-indirect compute-stack-frame*
- stack-frame>> request-stack-frame ;
+UNION: stack-frame-insn
+ ##alien-invoke
+ ##alien-indirect
+ ##alien-callback ;
-M: ##alien-callback compute-stack-frame*
+M: stack-frame-insn compute-stack-frame*
stack-frame>> request-stack-frame ;
M: ##call compute-stack-frame*
word>> sub-primitive>> [ frame-required? on ] unless ;
-M: _gc compute-stack-frame*
+M: ##gc compute-stack-frame*
frame-required? on
stack-frame new swap tagged-values>> length cells >>gc-root-size
request-stack-frame ;
] when ;
\ _spill t frame-required? set-word-prop
+\ ##unary-float-function t frame-required? set-word-prop
+\ ##binary-float-function t frame-required? set-word-prop
: compute-stack-frame ( insns -- )
frame-required? off
compiler.cfg.optimizer compiler.cfg.predecessors compiler.cfg.checker
compiler.cfg arrays locals byte-arrays kernel.private math
slots.private vectors sbufs strings math.partial-dispatch
+hashtables assocs combinators.short-circuit
strings.private accessors compiler.cfg.instructions ;
IN: compiler.cfg.builder.tests
{ pinned-c-ptr class fixnum } \ set-alien-cell '[ _ declare _ execute ] unit-test-cfg
] each
-: contains-insn? ( quot insn-check -- ? )
+: count-insns ( quot insn-check -- ? )
[ test-mr [ instructions>> ] map ] dip
- '[ _ any? ] any? ; inline
+ '[ _ count ] sigma ; inline
+
+: contains-insn? ( quot insn-check -- ? )
+ count-insns 0 > ; inline
[ t ] [ [ swap ] [ ##replace? ] contains-insn? ] unit-test
[ f t ] [
[ { fixnum simple-alien } declare <displaced-alien> 0 alien-cell ]
[ [ ##unbox-any-c-ptr? ] contains-insn? ]
- [ [ ##slot-imm? ] contains-insn? ] bi
-] unit-test
\ No newline at end of file
+ [ [ ##unbox-alien? ] contains-insn? ] bi
+] unit-test
+
+\ alien-float "intrinsic" word-prop [
+ [ f t ] [
+ [ { byte-array fixnum } declare alien-cell 4 alien-float ]
+ [ [ ##box-alien? ] contains-insn? ]
+ [ [ ##allot? ] contains-insn? ] bi
+ ] unit-test
+
+ [ f t ] [
+ [ { byte-array fixnum } declare alien-cell { simple-alien } declare 4 alien-float ]
+ [ [ ##box-alien? ] contains-insn? ]
+ [ [ ##allot? ] contains-insn? ] bi
+ ] unit-test
+
+ [ 1 ] [ [ dup float+ ] [ ##alien-double? ] count-insns ] unit-test
+] when
+
+! Regression. Make sure everything is inlined correctly
+[ f ] [ M\ hashtable set-at [ { [ ##call? ] [ word>> \ set-slot eq? ] } 1&& ] contains-insn? ] unit-test
\ No newline at end of file
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators hashtables kernel
math fry namespaces make sequences words byte-arrays
-layouts alien.c-types alien.structs
+layouts alien.c-types
stack-checker.inlining cpu.architecture
compiler.tree
compiler.tree.builder
: emit-actual-if ( #if -- )
! Inputs to the final instruction need to be copied because of
! loc>vreg sync
- ds-pop ^^copy \ f tag-number cc/= ##compare-imm-branch emit-if ;
+ ds-pop any-rep ^^copy \ f tag-number cc/= ##compare-imm-branch emit-if ;
M: #if emit-node
{
M: #phi emit-node drop ;
-M: #declare emit-node drop ;
\ No newline at end of file
+M: #declare emit-node drop ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel compiler.cfg.instructions compiler.cfg.rpo
-compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.utilities
-compiler.cfg.mr combinators.short-circuit accessors math
-sequences sets assocs ;
+USING: kernel combinators.short-circuit accessors math sequences
+sets assocs compiler.cfg.instructions compiler.cfg.rpo
+compiler.cfg.def-use compiler.cfg.linearization
+compiler.cfg.utilities compiler.cfg.mr compiler.utilities ;
IN: compiler.cfg.checker
+! Check invariants
+
ERROR: bad-kill-block bb ;
: check-kill-block ( bb -- )
- dup instructions>> first2
- swap ##epilogue? [
- { [ ##return? ] [ ##callback-return? ] [ ##jump? ] } 1||
- ] [ ##branch? ] if
+ dup instructions>> dup penultimate ##epilogue? [
+ {
+ [ length 2 = ]
+ [ last { [ ##return? ] [ ##callback-return? ] [ ##jump? ] } 1|| ]
+ } 1&&
+ ] [ last ##branch? ] if
[ drop ] [ bad-kill-block ] if ;
ERROR: last-insn-not-a-jump bb ;
dup instructions>> last {
[ ##branch? ]
[ ##dispatch? ]
- [ ##conditional-branch? ]
+ [ ##compare-branch? ]
[ ##compare-imm-branch? ]
+ [ ##compare-float-ordered-branch? ]
+ [ ##compare-float-unordered-branch? ]
[ ##fixnum-add? ]
[ ##fixnum-sub? ]
[ ##fixnum-mul? ]
USING: assocs math.order sequences ;
IN: compiler.cfg.comparisons
-SYMBOLS: cc< cc<= cc= cc> cc>= cc/= ;
+SYMBOL: +unordered+
+
+SYMBOLS:
+ cc< cc<= cc= cc> cc>= cc<> cc<>=
+ cc/< cc/<= cc/= cc/> cc/>= cc/<> cc/<>= ;
+
+SYMBOLS:
+ vcc-all vcc-notall vcc-any vcc-none ;
: negate-cc ( cc -- cc' )
H{
- { cc< cc>= }
- { cc<= cc> }
- { cc> cc<= }
- { cc>= cc< }
- { cc= cc/= }
- { cc/= cc= }
+ { cc< cc/< }
+ { cc<= cc/<= }
+ { cc> cc/> }
+ { cc>= cc/>= }
+ { cc= cc/= }
+ { cc<> cc/<> }
+ { cc<>= cc/<>= }
+ { cc/< cc< }
+ { cc/<= cc<= }
+ { cc/> cc> }
+ { cc/>= cc>= }
+ { cc/= cc= }
+ { cc/<> cc<> }
+ { cc/<>= cc<>= }
+ } at ;
+
+: negate-vcc ( cc -- cc' )
+ H{
+ { vcc-all vcc-notall }
+ { vcc-any vcc-none }
+ { vcc-none vcc-any }
+ { vcc-notall vcc-all }
} at ;
: swap-cc ( cc -- cc' )
H{
- { cc< cc> }
- { cc<= cc>= }
- { cc> cc< }
- { cc>= cc<= }
- { cc= cc= }
- { cc/= cc/= }
+ { cc< cc> }
+ { cc<= cc>= }
+ { cc> cc< }
+ { cc>= cc<= }
+ { cc= cc= }
+ { cc<> cc<> }
+ { cc<>= cc<>= }
+ { cc/< cc/> }
+ { cc/<= cc/>= }
+ { cc/> cc/< }
+ { cc/>= cc/<= }
+ { cc/= cc/= }
+ { cc/<> cc/<> }
+ { cc/<>= cc/<>= }
+ } at ;
+
+: order-cc ( cc -- cc' )
+ H{
+ { cc< cc< }
+ { cc<= cc<= }
+ { cc> cc> }
+ { cc>= cc>= }
+ { cc= cc= }
+ { cc<> cc/= }
+ { cc<>= t }
+ { cc/< cc>= }
+ { cc/<= cc> }
+ { cc/> cc<= }
+ { cc/>= cc< }
+ { cc/= cc/= }
+ { cc/<> cc= }
+ { cc/<>= f }
} at ;
: evaluate-cc ( result cc -- ? )
H{
- { cc< { +lt+ } }
- { cc<= { +lt+ +eq+ } }
- { cc= { +eq+ } }
- { cc>= { +eq+ +gt+ } }
- { cc> { +gt+ } }
- { cc/= { +lt+ +gt+ } }
- } at memq? ;
\ No newline at end of file
+ { cc< { +lt+ } }
+ { cc<= { +lt+ +eq+ } }
+ { cc= { +eq+ } }
+ { cc>= { +eq+ +gt+ } }
+ { cc> { +gt+ } }
+ { cc<> { +lt+ +gt+ } }
+ { cc<>= { +lt+ +eq+ +gt+ } }
+ { cc/< { +eq+ +gt+ +unordered+ } }
+ { cc/<= { +gt+ +unordered+ } }
+ { cc/= { +lt+ +gt+ +unordered+ } }
+ { cc/>= { +lt+ +unordered+ } }
+ { cc/> { +lt+ +eq+ +unordered+ } }
+ { cc/<> { +eq+ +unordered+ } }
+ { cc/<>= { +unordered+ } }
+ } at memq? ;
+
M: ##write-barrier build-liveness-graph
dup src>> setter-liveness-graph ;
-M: ##flushable build-liveness-graph
- dup dst>> add-edges ;
-
M: ##allot build-liveness-graph
- [ dst>> allocations get conjoin ]
- [ call-next-method ] bi ;
+ [ dst>> allocations get conjoin ] [ call-next-method ] bi ;
-M: insn build-liveness-graph drop ;
+M: insn build-liveness-graph
+ dup defs-vreg dup [ add-edges ] [ 2drop ] if ;
GENERIC: compute-live-vregs ( insn -- )
M: ##write-barrier compute-live-vregs
dup src>> setter-live-vregs ;
-M: ##flushable compute-live-vregs drop ;
+M: ##fixnum-add compute-live-vregs record-live ;
+
+M: ##fixnum-sub compute-live-vregs record-live ;
+
+M: ##fixnum-mul compute-live-vregs record-live ;
M: insn compute-live-vregs
- record-live ;
+ dup defs-vreg [ drop ] [ record-live ] if ;
GENERIC: live-insn? ( insn -- ? )
-M: ##flushable live-insn? dst>> live-vreg? ;
-
M: ##set-slot live-insn? obj>> live-vreg? ;
M: ##set-slot-imm live-insn? obj>> live-vreg? ;
M: ##write-barrier live-insn? src>> live-vreg? ;
-M: insn live-insn? drop t ;
+M: ##fixnum-add live-insn? drop t ;
+
+M: ##fixnum-sub live-insn? drop t ;
+
+M: ##fixnum-mul live-insn? drop t ;
+
+M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
: eliminate-dead-code ( cfg -- cfg' )
+ ! Even though we don't use predecessors directly, we depend
+ ! on the predecessors pass updating phi nodes to remove dead
+ ! inputs.
needs-predecessors
init-dead-code
compiler.tree.optimizer cpu.architecture compiler.cfg.builder
compiler.cfg.linearization compiler.cfg.registers
compiler.cfg.stack-frame compiler.cfg.linear-scan
-compiler.cfg.two-operand compiler.cfg.optimizer
-compiler.cfg.instructions compiler.cfg.utilities
-compiler.cfg.def-use compiler.cfg.rpo compiler.cfg.mr
-compiler.cfg.representations.preferred compiler.cfg ;
+compiler.cfg.optimizer compiler.cfg.instructions
+compiler.cfg.utilities compiler.cfg.def-use compiler.cfg.rpo
+compiler.cfg.mr compiler.cfg.representations.preferred
+compiler.cfg ;
IN: compiler.cfg.debugger
GENERIC: test-cfg ( quot -- cfgs )
nl
] each ;
+: test-mr. ( quot -- )
+ test-mr mr. ; inline
+
! Prettyprinting
: pprint-loc ( loc word -- ) <block pprint-word n>> pprint* block> ;
[ [ defs-vreg ] [ defs-vreg-rep ] bi 2dup and [ 2array ] [ 2drop f ] if ]
bi [ suffix ] when*
] map concat
- ] map concat >hashtable representations set ;
\ No newline at end of file
+ ] map concat >hashtable representations set ;
! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel assocs sequences namespaces fry
-sets compiler.cfg.rpo compiler.cfg.instructions locals ;
+USING: accessors assocs arrays classes combinators
+compiler.units fry generalizations generic kernel locals
+namespaces quotations sequences sets slots words
+compiler.cfg.instructions compiler.cfg.instructions.syntax
+compiler.cfg.rpo ;
IN: compiler.cfg.def-use
GENERIC: defs-vreg ( insn -- vreg/f )
GENERIC: temp-vregs ( insn -- seq )
GENERIC: uses-vregs ( insn -- seq )
-M: ##flushable defs-vreg dst>> ;
-M: ##fixnum-overflow defs-vreg dst>> ;
-M: _fixnum-overflow defs-vreg dst>> ;
-M: insn defs-vreg drop f ;
-
-M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
-M: ##unary/temp temp-vregs temp>> 1array ;
-M: ##allot temp-vregs temp>> 1array ;
-M: ##dispatch temp-vregs temp>> 1array ;
-M: ##slot temp-vregs temp>> 1array ;
-M: ##set-slot temp-vregs temp>> 1array ;
-M: ##string-nth temp-vregs temp>> 1array ;
-M: ##set-string-nth-fast temp-vregs temp>> 1array ;
-M: ##box-displaced-alien temp-vregs temp>> 1array ;
-M: ##compare temp-vregs temp>> 1array ;
-M: ##compare-imm temp-vregs temp>> 1array ;
-M: ##compare-float temp-vregs temp>> 1array ;
-M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
-M: _dispatch temp-vregs temp>> 1array ;
-M: insn temp-vregs drop f ;
-
-M: ##unary uses-vregs src>> 1array ;
-M: ##binary uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
-M: ##binary-imm uses-vregs src1>> 1array ;
-M: ##effect uses-vregs src>> 1array ;
-M: ##slot uses-vregs [ obj>> ] [ slot>> ] bi 2array ;
-M: ##slot-imm uses-vregs obj>> 1array ;
-M: ##set-slot uses-vregs [ src>> ] [ obj>> ] [ slot>> ] tri 3array ;
-M: ##set-slot-imm uses-vregs [ src>> ] [ obj>> ] bi 2array ;
-M: ##string-nth uses-vregs [ obj>> ] [ index>> ] bi 2array ;
-M: ##set-string-nth-fast uses-vregs [ src>> ] [ obj>> ] [ index>> ] tri 3array ;
-M: ##conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
-M: ##compare-imm-branch uses-vregs src1>> 1array ;
-M: ##dispatch uses-vregs src>> 1array ;
-M: ##alien-getter uses-vregs src>> 1array ;
-M: ##alien-setter uses-vregs [ src>> ] [ value>> ] bi 2array ;
-M: ##fixnum-overflow uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
M: ##phi uses-vregs inputs>> values ;
-M: _conditional-branch uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
-M: _compare-imm-branch uses-vregs src1>> 1array ;
-M: _dispatch uses-vregs src>> 1array ;
-M: insn uses-vregs drop f ;
+
+<PRIVATE
+
+: slot-array-quot ( slots -- quot )
+ [ reader-word 1quotation ] map dup length {
+ { 0 [ drop [ drop f ] ] }
+ { 1 [ first [ 1array ] compose ] }
+ { 2 [ first2 '[ _ _ bi 2array ] ] }
+ [ '[ _ cleave _ narray ] ]
+ } case ;
+
+: define-defs-vreg-method ( insn -- )
+ [ \ defs-vreg create-method ]
+ [ insn-def-slot [ name>> reader-word 1quotation ] [ [ drop f ] ] if* ] bi
+ define ;
+
+: define-uses-vregs-method ( insn -- )
+ [ \ uses-vregs create-method ]
+ [ insn-use-slots [ name>> ] map slot-array-quot ] bi
+ define ;
+
+: define-temp-vregs-method ( insn -- )
+ [ \ temp-vregs create-method ]
+ [ insn-temp-slots [ name>> ] map slot-array-quot ] bi
+ define ;
+
+PRIVATE>
+
+[
+ insn-classes get
+ [ [ define-defs-vreg-method ] each ]
+ [ { ##phi } diff [ define-uses-vregs-method ] each ]
+ [ [ define-temp-vregs-method ] each ]
+ tri
+] with-compilation-unit
! Computing def-use chains.
} 0 test-bb
V{
- T{ ##box-float f 0 1 }
+ T{ ##box-alien f 0 1 }
} 1 test-bb
0 1 edge
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences assocs fry
-cpu.architecture
+cpu.architecture layouts
compiler.cfg.rpo
compiler.cfg.registers
compiler.cfg.instructions
: blocks-with-gc ( cfg -- bbs )
post-order [ insert-gc-check? ] filter ;
+GENERIC: allocation-size* ( insn -- n )
+
+M: ##allot allocation-size* size>> ;
+
+M: ##box-alien allocation-size* drop 4 cells ;
+
+M: ##box-displaced-alien allocation-size* drop 4 cells ;
+
+: allocation-size ( bb -- n )
+ instructions>> [ ##allocation? ] filter [ allocation-size* ] sigma ;
+
: insert-gc-check ( bb -- )
- dup '[
+ dup dup '[
int-rep next-vreg-rep
int-rep next-vreg-rep
- f f _ uninitialized-locs \ ##gc new-insn
+ _ allocation-size
+ f
+ f
+ _ uninitialized-locs
+ \ ##gc new-insn
prefix
] change-instructions drop ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays kernel layouts math namespaces
-sequences classes.tuple cpu.architecture compiler.cfg.registers
-compiler.cfg.instructions ;
+USING: accessors arrays byte-arrays kernel layouts math
+namespaces sequences combinators splitting parser effects
+words cpu.architecture compiler.cfg.registers
+compiler.cfg.instructions compiler.cfg.instructions.syntax ;
IN: compiler.cfg.hats
-: ^^r ( -- vreg vreg ) next-vreg dup ; inline
-: ^^r1 ( obj -- vreg vreg obj ) [ ^^r ] dip ; inline
-: ^^r2 ( obj obj -- vreg vreg obj obj ) [ ^^r ] 2dip ; inline
-: ^^r3 ( obj obj obj -- vreg vreg obj obj obj ) [ ^^r ] 3dip ; inline
+<<
-: ^^load-literal ( obj -- dst ) ^^r1 ##load-literal ; inline
-: ^^copy ( src -- dst ) ^^r1 any-rep ##copy ; inline
-: ^^slot ( obj slot tag -- dst ) ^^r3 next-vreg ##slot ; inline
-: ^^slot-imm ( obj slot tag -- dst ) ^^r3 ##slot-imm ; inline
-: ^^set-slot ( src obj slot tag -- ) next-vreg ##set-slot ; inline
-: ^^string-nth ( obj index -- dst ) ^^r2 next-vreg ##string-nth ; inline
-: ^^add ( src1 src2 -- dst ) ^^r2 ##add ; inline
-: ^^add-imm ( src1 src2 -- dst ) ^^r2 ##add-imm ; inline
-: ^^sub ( src1 src2 -- dst ) ^^r2 ##sub ; inline
-: ^^sub-imm ( src1 src2 -- dst ) ^^r2 ##sub-imm ; inline
-: ^^neg ( src -- dst ) [ 0 ^^load-literal ] dip ^^sub ; inline
-: ^^mul ( src1 src2 -- dst ) ^^r2 ##mul ; inline
-: ^^mul-imm ( src1 src2 -- dst ) ^^r2 ##mul-imm ; inline
-: ^^and ( input mask -- output ) ^^r2 ##and ; inline
-: ^^and-imm ( input mask -- output ) ^^r2 ##and-imm ; inline
-: ^^or ( src1 src2 -- dst ) ^^r2 ##or ; inline
-: ^^or-imm ( src1 src2 -- dst ) ^^r2 ##or-imm ; inline
-: ^^xor ( src1 src2 -- dst ) ^^r2 ##xor ; inline
-: ^^xor-imm ( src1 src2 -- dst ) ^^r2 ##xor-imm ; inline
-: ^^shl ( src1 src2 -- dst ) ^^r2 ##shl ; inline
-: ^^shl-imm ( src1 src2 -- dst ) ^^r2 ##shl-imm ; inline
-: ^^shr ( src1 src2 -- dst ) ^^r2 ##shr ; inline
-: ^^shr-imm ( src1 src2 -- dst ) ^^r2 ##shr-imm ; inline
-: ^^sar ( src1 src2 -- dst ) ^^r2 ##sar ; inline
-: ^^sar-imm ( src1 src2 -- dst ) ^^r2 ##sar-imm ; inline
-: ^^min ( src1 src2 -- dst ) ^^r2 ##min ; inline
-: ^^max ( src1 src2 -- dst ) ^^r2 ##max ; inline
-: ^^not ( src -- dst ) ^^r1 ##not ; inline
-: ^^log2 ( src -- dst ) ^^r1 ##log2 ; inline
-: ^^bignum>integer ( src -- dst ) ^^r1 next-vreg ##bignum>integer ; inline
-: ^^integer>bignum ( src -- dst ) ^^r1 next-vreg ##integer>bignum ; inline
-: ^^add-float ( src1 src2 -- dst ) ^^r2 ##add-float ; inline
-: ^^sub-float ( src1 src2 -- dst ) ^^r2 ##sub-float ; inline
-: ^^mul-float ( src1 src2 -- dst ) ^^r2 ##mul-float ; inline
-: ^^div-float ( src1 src2 -- dst ) ^^r2 ##div-float ; inline
-: ^^max-float ( src1 src2 -- dst ) ^^r2 ##max-float ; inline
-: ^^min-float ( src1 src2 -- dst ) ^^r2 ##min-float ; inline
-: ^^sqrt ( src -- dst ) ^^r1 ##sqrt ; inline
-: ^^float>integer ( src -- dst ) ^^r1 ##float>integer ; inline
-: ^^integer>float ( src -- dst ) ^^r1 ##integer>float ; inline
-: ^^allot ( size class -- dst ) ^^r2 next-vreg ##allot ; inline
-: ^^allot-tuple ( n -- dst ) 2 + cells tuple ^^allot ; inline
-: ^^allot-array ( n -- dst ) 2 + cells array ^^allot ; inline
-: ^^allot-byte-array ( n -- dst ) 2 cells + byte-array ^^allot ; inline
-: ^^box-alien ( src -- dst ) ^^r1 next-vreg ##box-alien ; inline
-: ^^box-displaced-alien ( base displacement base-class -- dst )
- ^^r3 [ next-vreg ] dip ##box-displaced-alien ; inline
-: ^^unbox-alien ( src -- dst ) ^^r1 ##unbox-alien ; inline
-: ^^unbox-c-ptr ( src class -- dst ) ^^r2 next-vreg ##unbox-c-ptr ;
-: ^^alien-unsigned-1 ( src -- dst ) ^^r1 ##alien-unsigned-1 ; inline
-: ^^alien-unsigned-2 ( src -- dst ) ^^r1 ##alien-unsigned-2 ; inline
-: ^^alien-unsigned-4 ( src -- dst ) ^^r1 ##alien-unsigned-4 ; inline
-: ^^alien-signed-1 ( src -- dst ) ^^r1 ##alien-signed-1 ; inline
-: ^^alien-signed-2 ( src -- dst ) ^^r1 ##alien-signed-2 ; inline
-: ^^alien-signed-4 ( src -- dst ) ^^r1 ##alien-signed-4 ; inline
-: ^^alien-cell ( src -- dst ) ^^r1 ##alien-cell ; inline
-: ^^alien-float ( src -- dst ) ^^r1 ##alien-float ; inline
-: ^^alien-double ( src -- dst ) ^^r1 ##alien-double ; inline
-: ^^alien-global ( symbol library -- dst ) ^^r2 ##alien-global ; inline
-: ^^compare ( src1 src2 cc -- dst ) ^^r3 next-vreg ##compare ; inline
-: ^^compare-imm ( src1 src2 cc -- dst ) ^^r3 next-vreg ##compare-imm ; inline
-: ^^compare-float ( src1 src2 cc -- dst ) ^^r3 next-vreg ##compare-float ; inline
-: ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] [ ^^copy ] if ; inline
-: ^^tag-fixnum ( src -- dst ) ^^r1 ##tag-fixnum ; inline
-: ^^untag-fixnum ( src -- dst ) ^^r1 ##untag-fixnum ; inline
-: ^^fixnum-add ( src1 src2 -- dst ) ^^r2 ##fixnum-add ; inline
-: ^^fixnum-sub ( src1 src2 -- dst ) ^^r2 ##fixnum-sub ; inline
-: ^^fixnum-mul ( src1 src2 -- dst ) ^^r2 ##fixnum-mul ; inline
-: ^^phi ( inputs -- dst ) ^^r1 ##phi ; inline
\ No newline at end of file
+<PRIVATE
+
+: hat-name ( insn -- word )
+ name>> "##" ?head drop "^^" prepend create-in ;
+
+: hat-quot ( insn -- quot )
+ [
+ "insn-slots" word-prop [ ] [
+ type>> {
+ { def [ [ next-vreg dup ] ] }
+ { temp [ [ next-vreg ] ] }
+ [ drop [ ] ]
+ } case swap [ dip ] curry compose
+ ] reduce
+ ] keep suffix ;
+
+: hat-effect ( insn -- effect )
+ "insn-slots" word-prop
+ [ type>> { def temp } memq? not ] filter [ name>> ] map
+ { "vreg" } <effect> ;
+
+: define-hat ( insn -- )
+ [ hat-name ] [ hat-quot ] [ hat-effect ] tri define-inline ;
+
+PRIVATE>
+
+insn-classes get [
+ dup [ insn-def-slot ] [ name>> "##" head? ] bi and
+ [ define-hat ] [ drop ] if
+] each
+
+>>
+
+: ^^load-literal ( obj -- dst )
+ [ next-vreg dup ] dip {
+ { [ dup not ] [ drop \ f tag-number ##load-immediate ] }
+ { [ dup fixnum? ] [ tag-fixnum ##load-immediate ] }
+ { [ dup float? ] [ ##load-constant ] }
+ [ ##load-reference ]
+ } cond ;
+
+: ^^offset>slot ( slot -- vreg' )
+ cell 4 = [ 1 ^^shr-imm ] [ any-rep ^^copy ] if ;
+
+: ^^tag-fixnum ( src -- dst )
+ tag-bits get ^^shl-imm ;
+
+: ^^untag-fixnum ( src -- dst )
+ tag-bits get ^^sar-imm ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: assocs accessors arrays kernel sequences namespaces words
-math math.order layouts classes.algebra alien byte-arrays
-compiler.constants combinators compiler.cfg.registers
-compiler.cfg.instructions.syntax ;
+math math.order layouts classes.algebra classes.union
+compiler.units alien byte-arrays compiler.constants combinators
+compiler.cfg.registers compiler.cfg.instructions.syntax ;
IN: compiler.cfg.instructions
+<<
+SYMBOL: insn-classes
+V{ } clone insn-classes set-global
+>>
+
: new-insn ( ... class -- insn ) f swap boa ; inline
! Virtual CPU instructions, used by CFG and machine IRs
TUPLE: insn ;
-! Instruction with no side effects; if 'out' is never read, we
-! can eliminate it.
-TUPLE: ##flushable < insn dst ;
+! Instructions which are referentially transparent; used for
+! value numbering
+TUPLE: pure-insn < insn ;
-! Instruction which is referentially transparent; we can replace
-! repeated computation with a reference to a previous value
-TUPLE: ##pure < ##flushable ;
+! Stack operations
+INSN: ##load-immediate
+def: dst/int-rep
+constant: val ;
-TUPLE: ##unary < ##pure src ;
-TUPLE: ##unary/temp < ##unary temp ;
-TUPLE: ##binary < ##pure src1 src2 ;
-TUPLE: ##binary-imm < ##pure src1 { src2 integer } ;
-TUPLE: ##commutative < ##binary ;
-TUPLE: ##commutative-imm < ##binary-imm ;
+INSN: ##load-reference
+def: dst/int-rep
+constant: obj ;
-! Instruction only used for its side effect, produces no values
-TUPLE: ##effect < insn src ;
+INSN: ##load-constant
+def: dst/int-rep
+constant: obj ;
-! Read/write ops: candidates for alias analysis
-TUPLE: ##read < ##flushable ;
-TUPLE: ##write < ##effect ;
+INSN: ##peek
+def: dst/int-rep
+literal: loc ;
-TUPLE: ##alien-getter < ##flushable src ;
-TUPLE: ##alien-setter < ##effect value ;
+INSN: ##replace
+use: src/int-rep
+literal: loc ;
-! Stack operations
-INSN: ##load-immediate < ##pure { val integer } ;
-INSN: ##load-reference < ##pure obj ;
+INSN: ##inc-d
+literal: n ;
-GENERIC: ##load-literal ( dst value -- )
+INSN: ##inc-r
+literal: n ;
-M: fixnum ##load-literal tag-fixnum ##load-immediate ;
-M: f ##load-literal drop \ f tag-number ##load-immediate ;
-M: object ##load-literal ##load-reference ;
+! Subroutine calls
+INSN: ##call
+literal: word ;
-INSN: ##peek < ##flushable { loc loc } ;
-INSN: ##replace < ##effect { loc loc } ;
-INSN: ##inc-d { n integer } ;
-INSN: ##inc-r { n integer } ;
+INSN: ##jump
+literal: word ;
-! Subroutine calls
-INSN: ##call word ;
-INSN: ##jump word ;
INSN: ##return ;
! Dummy instruction that simply inhibits TCO
INSN: ##no-tco ;
! Jump tables
-INSN: ##dispatch src temp ;
+INSN: ##dispatch
+use: src/int-rep
+temp: temp/int-rep ;
! Slot access
-INSN: ##slot < ##read obj slot { tag integer } temp ;
-INSN: ##slot-imm < ##read obj { slot integer } { tag integer } ;
-INSN: ##set-slot < ##write obj slot { tag integer } temp ;
-INSN: ##set-slot-imm < ##write obj { slot integer } { tag integer } ;
+INSN: ##slot
+def: dst/int-rep
+use: obj/int-rep slot/int-rep ;
+
+INSN: ##slot-imm
+def: dst/int-rep
+use: obj/int-rep
+literal: slot tag ;
+
+INSN: ##set-slot
+use: src/int-rep obj/int-rep slot/int-rep ;
+
+INSN: ##set-slot-imm
+use: src/int-rep obj/int-rep
+literal: slot tag ;
! String element access
-INSN: ##string-nth < ##flushable obj index temp ;
-INSN: ##set-string-nth-fast < ##effect obj index temp ;
+INSN: ##string-nth
+def: dst/int-rep
+use: obj/int-rep index/int-rep
+temp: temp/int-rep ;
+
+INSN: ##set-string-nth-fast
+use: src/int-rep obj/int-rep index/int-rep
+temp: temp/int-rep ;
+
+PURE-INSN: ##copy
+def: dst
+use: src
+literal: rep ;
! Integer arithmetic
-INSN: ##add < ##commutative ;
-INSN: ##add-imm < ##commutative-imm ;
-INSN: ##sub < ##binary ;
-INSN: ##sub-imm < ##binary-imm ;
-INSN: ##mul < ##commutative ;
-INSN: ##mul-imm < ##commutative-imm ;
-INSN: ##and < ##commutative ;
-INSN: ##and-imm < ##commutative-imm ;
-INSN: ##or < ##commutative ;
-INSN: ##or-imm < ##commutative-imm ;
-INSN: ##xor < ##commutative ;
-INSN: ##xor-imm < ##commutative-imm ;
-INSN: ##shl < ##binary ;
-INSN: ##shl-imm < ##binary-imm ;
-INSN: ##shr < ##binary ;
-INSN: ##shr-imm < ##binary-imm ;
-INSN: ##sar < ##binary ;
-INSN: ##sar-imm < ##binary-imm ;
-INSN: ##min < ##binary ;
-INSN: ##max < ##binary ;
-INSN: ##not < ##unary ;
-INSN: ##log2 < ##unary ;
-
-: ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline
-: ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline
-
-! Bignum/integer conversion
-INSN: ##integer>bignum < ##unary/temp ;
-INSN: ##bignum>integer < ##unary/temp ;
+PURE-INSN: ##add
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##add-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##sub
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##sub-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##mul
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##mul-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##and
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##and-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##or
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##or-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##xor
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##xor-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##shl
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##shl-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##shr
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##shr-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##sar
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##sar-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2 ;
+
+PURE-INSN: ##min
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##max
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+PURE-INSN: ##not
+def: dst/int-rep
+use: src/int-rep ;
+
+PURE-INSN: ##neg
+def: dst/int-rep
+use: src/int-rep ;
+
+PURE-INSN: ##log2
+def: dst/int-rep
+use: src/int-rep ;
! Float arithmetic
-INSN: ##add-float < ##commutative ;
-INSN: ##sub-float < ##binary ;
-INSN: ##mul-float < ##commutative ;
-INSN: ##div-float < ##binary ;
-INSN: ##min-float < ##binary ;
-INSN: ##max-float < ##binary ;
-INSN: ##sqrt < ##unary ;
+PURE-INSN: ##add-float
+def: dst/double-rep
+use: src1/double-rep src2/double-rep ;
+
+PURE-INSN: ##sub-float
+def: dst/double-rep
+use: src1/double-rep src2/double-rep ;
+
+PURE-INSN: ##mul-float
+def: dst/double-rep
+use: src1/double-rep src2/double-rep ;
+
+PURE-INSN: ##div-float
+def: dst/double-rep
+use: src1/double-rep src2/double-rep ;
+
+PURE-INSN: ##min-float
+def: dst/double-rep
+use: src1/double-rep src2/double-rep ;
+
+PURE-INSN: ##max-float
+def: dst/double-rep
+use: src1/double-rep src2/double-rep ;
+
+PURE-INSN: ##sqrt
+def: dst/double-rep
+use: src/double-rep ;
+
+! libc intrinsics
+PURE-INSN: ##unary-float-function
+def: dst/double-rep
+use: src/double-rep
+literal: func ;
+
+PURE-INSN: ##binary-float-function
+def: dst/double-rep
+use: src1/double-rep src2/double-rep
+literal: func ;
+
+! Single/double float conversion
+PURE-INSN: ##single>double-float
+def: dst/double-rep
+use: src/float-rep ;
+
+PURE-INSN: ##double>single-float
+def: dst/float-rep
+use: src/double-rep ;
! Float/integer conversion
-INSN: ##float>integer < ##unary ;
-INSN: ##integer>float < ##unary ;
-
-! Boxing and unboxing
-INSN: ##copy < ##unary rep ;
-INSN: ##unbox-float < ##unary ;
-INSN: ##unbox-any-c-ptr < ##unary/temp ;
-INSN: ##box-float < ##unary/temp ;
-INSN: ##box-alien < ##unary/temp ;
-INSN: ##box-displaced-alien < ##binary temp base-class ;
+PURE-INSN: ##float>integer
+def: dst/int-rep
+use: src/double-rep ;
+
+PURE-INSN: ##integer>float
+def: dst/double-rep
+use: src/int-rep ;
+
+! SIMD operations
+PURE-INSN: ##zero-vector
+def: dst
+literal: rep ;
+
+PURE-INSN: ##fill-vector
+def: dst
+literal: rep ;
+
+PURE-INSN: ##gather-vector-2
+def: dst
+use: src1/scalar-rep src2/scalar-rep
+literal: rep ;
+
+PURE-INSN: ##gather-vector-4
+def: dst
+use: src1/scalar-rep src2/scalar-rep src3/scalar-rep src4/scalar-rep
+literal: rep ;
+
+PURE-INSN: ##shuffle-vector
+def: dst
+use: src
+literal: shuffle rep ;
+
+PURE-INSN: ##merge-vector-head
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##merge-vector-tail
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##compare-vector
+def: dst
+use: src1 src2
+temp: temp
+literal: rep cc ;
+
+PURE-INSN: ##test-vector
+def: dst/int-rep
+use: src1
+temp: temp/int-rep
+literal: rep vcc ;
+
+INSN: ##test-vector-branch
+use: src1
+temp: temp/int-rep
+literal: rep vcc ;
+
+INSN: _test-vector-branch
+literal: label
+use: src1
+temp: temp/int-rep
+literal: rep vcc ;
+
+PURE-INSN: ##add-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##saturated-add-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##add-sub-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##sub-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##saturated-sub-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##mul-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##saturated-mul-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##div-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##min-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##max-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##dot-vector
+def: dst/scalar-rep
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##horizontal-add-vector
+def: dst/scalar-rep
+use: src
+literal: rep ;
+
+PURE-INSN: ##horizontal-sub-vector
+def: dst/scalar-rep
+use: src
+literal: rep ;
+
+PURE-INSN: ##horizontal-shl-vector
+def: dst
+use: src1
+literal: src2 rep ;
+
+PURE-INSN: ##horizontal-shr-vector
+def: dst
+use: src1
+literal: src2 rep ;
+
+PURE-INSN: ##abs-vector
+def: dst
+use: src
+literal: rep ;
+
+PURE-INSN: ##sqrt-vector
+def: dst
+use: src
+literal: rep ;
+
+PURE-INSN: ##and-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##andn-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##or-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##xor-vector
+def: dst
+use: src1 src2
+literal: rep ;
+
+PURE-INSN: ##not-vector
+def: dst
+use: src
+literal: rep ;
+
+PURE-INSN: ##shl-vector
+def: dst
+use: src1 src2/int-scalar-rep
+literal: rep ;
+
+PURE-INSN: ##shr-vector
+def: dst
+use: src1 src2/int-scalar-rep
+literal: rep ;
+
+! Scalar/vector conversion
+PURE-INSN: ##scalar>integer
+def: dst/int-rep
+use: src
+literal: rep ;
+
+PURE-INSN: ##integer>scalar
+def: dst
+use: src/int-rep
+literal: rep ;
+
+PURE-INSN: ##vector>scalar
+def: dst/scalar-rep
+use: src
+literal: rep ;
+
+PURE-INSN: ##scalar>vector
+def: dst
+use: src/scalar-rep
+literal: rep ;
+
+! Boxing and unboxing aliens
+PURE-INSN: ##box-alien
+def: dst/int-rep
+use: src/int-rep
+temp: temp/int-rep ;
+
+PURE-INSN: ##box-displaced-alien
+def: dst/int-rep
+use: displacement/int-rep base/int-rep
+temp: temp1/int-rep temp2/int-rep
+literal: base-class ;
+
+PURE-INSN: ##unbox-any-c-ptr
+def: dst/int-rep
+use: src/int-rep
+temp: temp/int-rep ;
: ##unbox-f ( dst src -- ) drop 0 ##load-immediate ;
: ##unbox-byte-array ( dst src -- ) byte-array-offset ##add-imm ;
-: ##unbox-alien ( dst src -- ) 3 object tag-number ##slot-imm ;
+
+PURE-INSN: ##unbox-alien
+def: dst/int-rep
+use: src/int-rep ;
: ##unbox-c-ptr ( dst src class temp -- )
{
} cond ;
! Alien accessors
-INSN: ##alien-unsigned-1 < ##alien-getter ;
-INSN: ##alien-unsigned-2 < ##alien-getter ;
-INSN: ##alien-unsigned-4 < ##alien-getter ;
-INSN: ##alien-signed-1 < ##alien-getter ;
-INSN: ##alien-signed-2 < ##alien-getter ;
-INSN: ##alien-signed-4 < ##alien-getter ;
-INSN: ##alien-cell < ##alien-getter ;
-INSN: ##alien-float < ##alien-getter ;
-INSN: ##alien-double < ##alien-getter ;
-
-INSN: ##set-alien-integer-1 < ##alien-setter ;
-INSN: ##set-alien-integer-2 < ##alien-setter ;
-INSN: ##set-alien-integer-4 < ##alien-setter ;
-INSN: ##set-alien-cell < ##alien-setter ;
-INSN: ##set-alien-float < ##alien-setter ;
-INSN: ##set-alien-double < ##alien-setter ;
+INSN: ##alien-unsigned-1
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-unsigned-2
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-unsigned-4
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-signed-1
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-signed-2
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-signed-4
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-cell
+def: dst/int-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-float
+def: dst/float-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-double
+def: dst/double-rep
+use: src/int-rep
+literal: offset ;
+
+INSN: ##alien-vector
+def: dst
+use: src/int-rep
+literal: offset rep ;
+
+INSN: ##set-alien-integer-1
+use: src/int-rep
+literal: offset
+use: value/int-rep ;
+
+INSN: ##set-alien-integer-2
+use: src/int-rep
+literal: offset
+use: value/int-rep ;
+
+INSN: ##set-alien-integer-4
+use: src/int-rep
+literal: offset
+use: value/int-rep ;
+
+INSN: ##set-alien-cell
+use: src/int-rep
+literal: offset
+use: value/int-rep ;
+
+INSN: ##set-alien-float
+use: src/int-rep
+literal: offset
+use: value/float-rep ;
+
+INSN: ##set-alien-double
+use: src/int-rep
+literal: offset
+use: value/double-rep ;
+
+INSN: ##set-alien-vector
+use: src/int-rep
+literal: offset
+use: value
+literal: rep ;
! Memory allocation
-INSN: ##allot < ##flushable size class temp ;
+INSN: ##allot
+def: dst/int-rep
+literal: size class
+temp: temp/int-rep ;
-UNION: ##allocation
-##allot
-##box-float
-##box-alien
-##box-displaced-alien
-##integer>bignum ;
+INSN: ##write-barrier
+use: src/int-rep
+temp: card#/int-rep table/int-rep ;
-INSN: ##write-barrier < ##effect card# table ;
+INSN: ##alien-global
+def: dst/int-rep
+literal: symbol library ;
-INSN: ##alien-global < ##flushable symbol library ;
+INSN: ##vm-field-ptr
+def: dst/int-rep
+literal: field-name ;
! FFI
-INSN: ##alien-invoke params stack-frame ;
-INSN: ##alien-indirect params stack-frame ;
-INSN: ##alien-callback params stack-frame ;
-INSN: ##callback-return params ;
+INSN: ##alien-invoke
+literal: params stack-frame ;
+
+INSN: ##alien-indirect
+literal: params stack-frame ;
+
+INSN: ##alien-callback
+literal: params stack-frame ;
+
+INSN: ##callback-return
+literal: params ;
! Instructions used by CFG IR only.
INSN: ##prologue ;
INSN: ##branch ;
-INSN: ##phi < ##pure inputs ;
+INSN: ##phi
+def: dst
+literal: inputs ;
! Conditionals
-TUPLE: ##conditional-branch < insn src1 src2 cc ;
+INSN: ##compare-branch
+use: src1/int-rep src2/int-rep
+literal: cc ;
+
+INSN: ##compare-imm-branch
+use: src1/int-rep
+constant: src2
+literal: cc ;
+
+PURE-INSN: ##compare
+def: dst/int-rep
+use: src1/int-rep src2/int-rep
+literal: cc
+temp: temp/int-rep ;
+
+PURE-INSN: ##compare-imm
+def: dst/int-rep
+use: src1/int-rep
+constant: src2
+literal: cc
+temp: temp/int-rep ;
+
+INSN: ##compare-float-ordered-branch
+use: src1/double-rep src2/double-rep
+literal: cc ;
+
+INSN: ##compare-float-unordered-branch
+use: src1/double-rep src2/double-rep
+literal: cc ;
+
+PURE-INSN: ##compare-float-ordered
+def: dst/int-rep
+use: src1/double-rep src2/double-rep
+literal: cc
+temp: temp/int-rep ;
+
+PURE-INSN: ##compare-float-unordered
+def: dst/int-rep
+use: src1/double-rep src2/double-rep
+literal: cc
+temp: temp/int-rep ;
-INSN: ##compare-branch < ##conditional-branch ;
-INSN: ##compare-imm-branch src1 { src2 integer } cc ;
+! Overflowing arithmetic
+INSN: ##fixnum-add
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
-INSN: ##compare < ##binary cc temp ;
-INSN: ##compare-imm < ##binary-imm cc temp ;
+INSN: ##fixnum-sub
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
-INSN: ##compare-float-branch < ##conditional-branch ;
-INSN: ##compare-float < ##binary cc temp ;
+INSN: ##fixnum-mul
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
-! Overflowing arithmetic
-TUPLE: ##fixnum-overflow < insn dst src1 src2 ;
-INSN: ##fixnum-add < ##fixnum-overflow ;
-INSN: ##fixnum-sub < ##fixnum-overflow ;
-INSN: ##fixnum-mul < ##fixnum-overflow ;
+INSN: ##gc
+temp: temp1/int-rep temp2/int-rep
+literal: size data-values tagged-values uninitialized-locs ;
-INSN: ##gc temp1 temp2 data-values tagged-values uninitialized-locs ;
+INSN: ##save-context
+temp: temp1/int-rep temp2/int-rep
+literal: callback-allowed? ;
! Instructions used by machine IR only.
-INSN: _prologue stack-frame ;
-INSN: _epilogue stack-frame ;
+INSN: _prologue
+literal: stack-frame ;
+
+INSN: _epilogue
+literal: stack-frame ;
+
+INSN: _label
+literal: label ;
-INSN: _label id ;
+INSN: _branch
+literal: label ;
-INSN: _branch label ;
INSN: _loop-entry ;
-INSN: _dispatch src temp ;
-INSN: _dispatch-label label ;
+INSN: _dispatch
+use: src/int-rep
+temp: temp ;
-TUPLE: _conditional-branch < insn label src1 src2 cc ;
+INSN: _dispatch-label
+literal: label ;
-INSN: _compare-branch < _conditional-branch ;
-INSN: _compare-imm-branch label src1 { src2 integer } cc ;
+INSN: _compare-branch
+literal: label
+use: src1/int-rep src2/int-rep
+literal: cc ;
-INSN: _compare-float-branch < _conditional-branch ;
+INSN: _compare-imm-branch
+literal: label
+use: src1/int-rep
+constant: src2
+literal: cc ;
+
+INSN: _compare-float-unordered-branch
+literal: label
+use: src1/int-rep src2/int-rep
+literal: cc ;
+
+INSN: _compare-float-ordered-branch
+literal: label
+use: src1/int-rep src2/int-rep
+literal: cc ;
! Overflowing arithmetic
-TUPLE: _fixnum-overflow < insn label dst src1 src2 ;
-INSN: _fixnum-add < _fixnum-overflow ;
-INSN: _fixnum-sub < _fixnum-overflow ;
-INSN: _fixnum-mul < _fixnum-overflow ;
+INSN: _fixnum-add
+literal: label
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
-TUPLE: spill-slot n ; C: <spill-slot> spill-slot
+INSN: _fixnum-sub
+literal: label
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
-INSN: _gc temp1 temp2 data-values tagged-values uninitialized-locs ;
+INSN: _fixnum-mul
+literal: label
+def: dst/int-rep
+use: src1/int-rep src2/int-rep ;
+
+TUPLE: spill-slot { n integer } ;
+C: <spill-slot> spill-slot
! These instructions operate on machine registers and not
! virtual registers
-INSN: _spill src rep n ;
-INSN: _reload dst rep n ;
-INSN: _spill-area-size n ;
-
-! Instructions that use vregs
-UNION: vreg-insn
- ##flushable
- ##write-barrier
- ##dispatch
- ##effect
- ##fixnum-overflow
- ##conditional-branch
- ##compare-imm-branch
- ##phi
- ##gc
- _conditional-branch
- _compare-imm-branch
- _dispatch ;
+INSN: _spill
+use: src
+literal: rep dst ;
+
+INSN: _reload
+def: dst
+literal: rep src ;
+
+INSN: _spill-area-size
+literal: n ;
+
+UNION: ##allocation
+##allot
+##box-alien
+##box-displaced-alien ;
+
+! For alias analysis
+UNION: ##read ##slot ##slot-imm ##vm-field-ptr ##alien-global ;
+UNION: ##write ##set-slot ##set-slot-imm ;
+
+! Instructions that kill all live vregs but cannot trigger GC
+UNION: partial-sync-insn
+##unary-float-function
+##binary-float-function ;
! Instructions that kill all live vregs
UNION: kill-vreg-insn
- ##call
- ##prologue
- ##epilogue
- ##alien-invoke
- ##alien-indirect
- ##alien-callback ;
-
-! Instructions that output floats
-UNION: output-float-insn
- ##add-float
- ##sub-float
- ##mul-float
- ##div-float
- ##min-float
- ##max-float
- ##sqrt
- ##integer>float
- ##unbox-float
- ##alien-float
- ##alien-double ;
-
-! Instructions that take floats as inputs
-UNION: input-float-insn
- ##add-float
- ##sub-float
- ##mul-float
- ##div-float
- ##min-float
- ##max-float
- ##sqrt
- ##float>integer
- ##box-float
- ##set-alien-float
- ##set-alien-double
- ##compare-float
- ##compare-float-branch ;
-
-! Smackdown
-INTERSECTION: ##unary-float ##unary input-float-insn ;
-INTERSECTION: ##binary-float ##binary input-float-insn ;
+##call
+##prologue
+##epilogue
+##alien-invoke
+##alien-indirect
+##alien-callback ;
! Instructions that have complex expansions and require that the
! output registers are not equal to any of the input registers
UNION: def-is-use-insn
- ##integer>bignum
- ##bignum>integer
- ##unbox-any-c-ptr ;
\ No newline at end of file
+##box-alien
+##box-displaced-alien
+##compare-vector
+##not-vector
+##string-nth
+##unbox-any-c-ptr ;
+
+SYMBOL: vreg-insn
+
+[
+ vreg-insn
+ insn-classes get [
+ "insn-slots" word-prop [ type>> { def use temp } memq? ] any?
+ ] filter
+ define-union-class
+] with-compilation-unit
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: classes.tuple classes.tuple.parser kernel words
-make fry sequences parser accessors effects ;
+make fry sequences parser accessors effects namespaces
+combinators splitting classes.parser lexer quotations ;
IN: compiler.cfg.instructions.syntax
+SYMBOLS: def use temp literal constant ;
+
+SYMBOL: scalar-rep
+
+TUPLE: insn-slot-spec type name rep ;
+
+: parse-rep ( str/f -- rep )
+ {
+ { [ dup not ] [ ] }
+ { [ dup "scalar-rep" = ] [ drop scalar-rep ] }
+ [ "cpu.architecture" lookup ]
+ } cond ;
+
+: parse-insn-slot-spec ( type string -- spec )
+ over [ "Missing type" throw ] unless
+ "/" split1 parse-rep
+ insn-slot-spec boa ;
+
+: parse-insn-slot-specs ( seq -- specs )
+ [
+ f [
+ {
+ { "def:" [ drop def ] }
+ { "use:" [ drop use ] }
+ { "temp:" [ drop temp ] }
+ { "literal:" [ drop literal ] }
+ { "constant:" [ drop constant ] }
+ [ dupd parse-insn-slot-spec , ]
+ } case
+ ] reduce drop
+ ] { } make ;
+
+: insn-def-slot ( class -- slot/f )
+ "insn-slots" word-prop
+ [ type>> def eq? ] find nip ;
+
+: insn-use-slots ( class -- slots )
+ "insn-slots" word-prop
+ [ type>> use eq? ] filter ;
+
+: insn-temp-slots ( class -- slots )
+ "insn-slots" word-prop
+ [ type>> temp eq? ] filter ;
+
+! We cannot reference words in compiler.cfg.instructions directly
+! since that would create circularity.
+: insn-classes-word ( -- word )
+ "insn-classes" "compiler.cfg.instructions" lookup ;
+
: insn-word ( -- word )
- #! We want to put the insn tuple in compiler.cfg.instructions,
- #! but we cannot have circularity between that vocabulary and
- #! this one.
"insn" "compiler.cfg.instructions" lookup ;
+: pure-insn-word ( -- word )
+ "pure-insn" "compiler.cfg.instructions" lookup ;
+
: insn-effect ( word -- effect )
boa-effect in>> but-last f <effect> ;
-SYNTAX: INSN:
- parse-tuple-definition "insn#" suffix
- [ dup tuple eq? [ drop insn-word ] when ] dip
- [ define-tuple-class ]
- [ 2drop save-location ]
- [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ]
- 3tri ;
+: define-insn-tuple ( class superclass specs -- )
+ [ name>> ] map "insn#" suffix define-tuple-class ;
+
+: define-insn-ctor ( class specs -- )
+ [ dup '[ _ ] [ f ] [ boa , ] surround ] dip
+ [ name>> ] map f <effect> define-declared ;
+
+: define-insn ( class superclass specs -- )
+ parse-insn-slot-specs {
+ [ nip "insn-slots" set-word-prop ]
+ [ 2drop insn-classes-word get push ]
+ [ define-insn-tuple ]
+ [ 2drop save-location ]
+ [ nip define-insn-ctor ]
+ } 3cleave ;
+
+SYNTAX: INSN: CREATE-CLASS insn-word ";" parse-tokens define-insn ;
+
+SYNTAX: PURE-INSN: CREATE-CLASS pure-insn-word ";" parse-tokens define-insn ;
USING: accessors kernel sequences alien math classes.algebra fry
locals combinators combinators.short-circuit cpu.architecture
compiler.tree.propagation.info compiler.cfg.hats
-compiler.cfg.stacks compiler.cfg.instructions
-compiler.cfg.utilities compiler.cfg.builder.blocks ;
+compiler.cfg.registers compiler.cfg.stacks
+compiler.cfg.instructions compiler.cfg.utilities
+compiler.cfg.builder.blocks ;
IN: compiler.cfg.intrinsics.alien
: emit-<displaced-alien>? ( node -- ? )
^^box-displaced-alien ds-push
] [ emit-primitive ] if ;
-: (prepare-alien-accessor-imm) ( class offset -- offset-vreg )
- ds-drop [ ds-pop swap ^^unbox-c-ptr ] dip ^^add-imm ;
-
-: (prepare-alien-accessor) ( class -- offset-vreg )
- [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add ;
-
-: prepare-alien-accessor ( infos -- offset-vreg )
- <reversed> [ second class>> ] [ first ] bi
- dup value-info-small-fixnum? [
- literal>> (prepare-alien-accessor-imm)
- ] [ drop (prepare-alien-accessor) ] if ;
-
:: inline-alien ( node quot test -- )
[let | infos [ node node-input-infos ] |
infos test call
- [ infos prepare-alien-accessor quot call ]
+ [ infos quot call ]
[ node emit-primitive ]
if
] ; inline
[ second class>> fixnum class<= ]
bi and ;
+: ^^unbox-c-ptr ( src class -- dst )
+ [ next-vreg dup ] 2dip next-vreg ##unbox-c-ptr ;
+
+: prepare-alien-accessor ( info -- ptr-vreg offset )
+ class>> [ 2inputs ^^untag-fixnum swap ] dip ^^unbox-c-ptr ^^add 0 ;
+
+: prepare-alien-getter ( infos -- ptr-vreg offset )
+ first prepare-alien-accessor ;
+
: inline-alien-getter ( node quot -- )
- '[ @ ds-push ]
+ '[ prepare-alien-getter @ ds-push ]
[ inline-alien-getter? ] inline-alien ; inline
: inline-alien-setter? ( infos class -- ? )
[ third class>> fixnum class<= ]
tri and and ;
+: prepare-alien-setter ( infos -- ptr-vreg offset )
+ second prepare-alien-accessor ;
+
: inline-alien-integer-setter ( node quot -- )
- '[ ds-pop ^^untag-fixnum @ ]
+ '[ prepare-alien-setter ds-pop ^^untag-fixnum @ ]
[ fixnum inline-alien-setter? ]
inline-alien ; inline
: inline-alien-cell-setter ( node quot -- )
- [ dup node-input-infos first class>> ] dip
- '[ ds-pop _ ^^unbox-c-ptr @ ]
+ '[ [ prepare-alien-setter ds-pop ] [ first class>> ] bi ^^unbox-c-ptr @ ]
[ pinned-c-ptr inline-alien-setter? ]
inline-alien ; inline
: inline-alien-float-setter ( node quot -- )
- '[ ds-pop @ ]
+ '[ prepare-alien-setter ds-pop @ ]
[ float inline-alien-setter? ]
inline-alien ; inline
: emit-alien-float-getter ( node rep -- )
'[
_ {
- { single-float-rep [ ^^alien-float ] }
- { double-float-rep [ ^^alien-double ] }
+ { float-rep [ ^^alien-float ] }
+ { double-rep [ ^^alien-double ] }
} case
] inline-alien-getter ;
: emit-alien-float-setter ( node rep -- )
'[
_ {
- { single-float-rep [ ##set-alien-float ] }
- { double-float-rep [ ##set-alien-double ] }
+ { float-rep [ ##set-alien-float ] }
+ { double-rep [ ##set-alien-double ] }
} case
] inline-alien-float-setter ;
: tuple-slot-regs ( layout -- vregs )
[ second ds-load ] [ ^^load-literal ] bi prefix ;
+: ^^allot-tuple ( n -- dst )
+ 2 + cells tuple ^^allot ;
+
: emit-<tuple-boa> ( node -- )
dup node-input-infos last literal>>
dup array? [
: expand-<array>? ( obj -- ? )
dup integer? [ 0 8 between? ] [ drop f ] if ;
+: ^^allot-array ( n -- dst )
+ 2 + cells array ^^allot ;
+
:: emit-<array> ( node -- )
[let | len [ node node-input-infos first literal>> ] |
len expand-<array>? [
] [ node emit-primitive ] if
] ;
+: expand-(byte-array)? ( obj -- ? )
+ dup integer? [ 0 1024 between? ] [ drop f ] if ;
+
: expand-<byte-array>? ( obj -- ? )
dup integer? [ 0 32 between? ] [ drop f ] if ;
: bytes>cells ( m -- n ) cell align cell /i ;
+: ^^allot-byte-array ( n -- dst )
+ 2 cells + byte-array ^^allot ;
+
: emit-allot-byte-array ( len -- dst )
ds-drop
dup ^^allot-byte-array
[ byte-array store-length ] [ ds-push ] [ ] tri ;
: emit-(byte-array) ( node -- )
- dup node-input-infos first literal>> dup expand-<byte-array>?
+ dup node-input-infos first literal>> dup expand-(byte-array)?
[ nip emit-allot-byte-array drop ] [ drop emit-primitive ] if ;
:: emit-<byte-array> ( node -- )
! See http://factorcode.org/license.txt for BSD license.
USING: sequences accessors layouts kernel math math.intervals
namespaces combinators fry arrays
+cpu.architecture
compiler.tree.propagation.info
compiler.cfg.hats
compiler.cfg.stacks
: emit-fixnum-comparison ( cc -- )
'[ _ ^^compare ] emit-fixnum-op ;
-: emit-bignum>fixnum ( -- )
- ds-pop ^^bignum>integer ^^tag-fixnum ds-push ;
-
-: emit-fixnum>bignum ( -- )
- ds-pop ^^untag-fixnum ^^integer>bignum ds-push ;
-
: emit-no-overflow-case ( dst -- final-bb )
[ ds-drop ds-drop ds-push ] with-branch ;
: emit-fixnum-overflow-op ( quot word -- )
! Inputs to the final instruction need to be copied because
! of loc>vreg sync
- [ [ (2inputs) [ ^^copy ] bi@ ] dip call ] dip
+ [ [ (2inputs) [ any-rep ^^copy ] bi@ ] dip call ] dip
[ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array
emit-conditional ; inline
: emit-float-op ( insn -- )
[ 2inputs ] dip call ds-push ; inline
-: emit-float-comparison ( cc -- )
- [ 2inputs ] dip ^^compare-float ds-push ; inline
+: emit-float-ordered-comparison ( cc -- )
+ [ 2inputs ] dip ^^compare-float-ordered ds-push ; inline
+
+: emit-float-unordered-comparison ( cc -- )
+ [ 2inputs ] dip ^^compare-float-unordered ds-push ; inline
: emit-float>fixnum ( -- )
ds-pop ^^float>integer ^^tag-fixnum ds-push ;
: emit-fsqrt ( -- )
ds-pop ^^sqrt ds-push ;
+
+: emit-unary-float-function ( func -- )
+ [ ds-pop ] dip ^^unary-float-function ds-push ;
+
+: emit-binary-float-function ( func -- )
+ [ 2inputs ] dip ^^binary-float-function ds-push ;
! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: words sequences kernel combinators cpu.architecture
+USING: words sequences kernel combinators cpu.architecture assocs
compiler.cfg.hats
compiler.cfg.instructions
compiler.cfg.intrinsics.alien
compiler.cfg.intrinsics.allot
compiler.cfg.intrinsics.fixnum
compiler.cfg.intrinsics.float
+compiler.cfg.intrinsics.simd
compiler.cfg.intrinsics.slots
compiler.cfg.intrinsics.misc
compiler.cfg.comparisons ;
QUALIFIED: math.private
QUALIFIED: math.integers.private
QUALIFIED: math.floats.private
+QUALIFIED: math.vectors.simd.intrinsics
QUALIFIED: math.libm
IN: compiler.cfg.intrinsics
-: enable-intrinsics ( words -- )
- [ t "intrinsic" set-word-prop ] each ;
+: enable-intrinsics ( alist -- )
+ [ "intrinsic" set-word-prop ] assoc-each ;
{
- kernel.private:tag
- kernel.private:getenv
- math.private:both-fixnums?
- math.private:fixnum+
- math.private:fixnum-
- math.private:fixnum*
- math.private:fixnum+fast
- math.private:fixnum-fast
- math.private:fixnum-bitand
- math.private:fixnum-bitor
- math.private:fixnum-bitxor
- math.private:fixnum-shift-fast
- math.private:fixnum-bitnot
- math.private:fixnum*fast
- math.private:fixnum<
- math.private:fixnum<=
- math.private:fixnum>=
- math.private:fixnum>
- ! math.private:bignum>fixnum
- ! math.private:fixnum>bignum
- kernel:eq?
- slots.private:slot
- slots.private:set-slot
- strings.private:string-nth
- strings.private:set-string-nth-fast
- classes.tuple.private:<tuple-boa>
- arrays:<array>
- byte-arrays:<byte-array>
- byte-arrays:(byte-array)
- kernel:<wrapper>
- alien:<displaced-alien>
- alien.accessors:alien-unsigned-1
- alien.accessors:set-alien-unsigned-1
- alien.accessors:alien-signed-1
- alien.accessors:set-alien-signed-1
- alien.accessors:alien-unsigned-2
- alien.accessors:set-alien-unsigned-2
- alien.accessors:alien-signed-2
- alien.accessors:set-alien-signed-2
- alien.accessors:alien-cell
- alien.accessors:set-alien-cell
+ { kernel.private:tag [ drop emit-tag ] }
+ { kernel.private:getenv [ emit-getenv ] }
+ { math.private:both-fixnums? [ drop emit-both-fixnums? ] }
+ { math.private:fixnum+ [ drop emit-fixnum+ ] }
+ { math.private:fixnum- [ drop emit-fixnum- ] }
+ { math.private:fixnum* [ drop emit-fixnum* ] }
+ { math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
+ { math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
+ { math.private:fixnum*fast [ drop emit-fixnum*fast ] }
+ { math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
+ { math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
+ { math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
+ { math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
+ { math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
+ { math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
+ { math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
+ { math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
+ { math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
+ { kernel:eq? [ drop cc= emit-fixnum-comparison ] }
+ { slots.private:slot [ emit-slot ] }
+ { slots.private:set-slot [ emit-set-slot ] }
+ { strings.private:string-nth [ drop emit-string-nth ] }
+ { strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
+ { classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
+ { arrays:<array> [ emit-<array> ] }
+ { byte-arrays:<byte-array> [ emit-<byte-array> ] }
+ { byte-arrays:(byte-array) [ emit-(byte-array) ] }
+ { kernel:<wrapper> [ emit-simple-allot ] }
+ { alien:<displaced-alien> [ emit-<displaced-alien> ] }
+ { alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
+ { alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
+ { alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
+ { alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
+ { alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
+ { alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
+ { alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
+ { alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
+ { alien.accessors:alien-cell [ emit-alien-cell-getter ] }
+ { alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
} enable-intrinsics
: enable-alien-4-intrinsics ( -- )
{
- alien.accessors:alien-unsigned-4
- alien.accessors:set-alien-unsigned-4
- alien.accessors:alien-signed-4
- alien.accessors:set-alien-signed-4
+ { alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
+ { alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
+ { alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
+ { alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
} enable-intrinsics ;
: enable-float-intrinsics ( -- )
{
- math.private:float+
- math.private:float-
- math.private:float*
- math.private:float/f
- math.private:fixnum>float
- math.private:float>fixnum
- math.private:float<
- math.private:float<=
- math.private:float>
- math.private:float>=
- math.private:float=
- alien.accessors:alien-float
- alien.accessors:set-alien-float
- alien.accessors:alien-double
- alien.accessors:set-alien-double
+ { math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
+ { math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
+ { math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
+ { math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
+ { math.private:float< [ drop cc< emit-float-ordered-comparison ] }
+ { math.private:float<= [ drop cc<= emit-float-ordered-comparison ] }
+ { math.private:float>= [ drop cc>= emit-float-ordered-comparison ] }
+ { math.private:float> [ drop cc> emit-float-ordered-comparison ] }
+ { math.private:float-u< [ drop cc< emit-float-unordered-comparison ] }
+ { math.private:float-u<= [ drop cc<= emit-float-unordered-comparison ] }
+ { math.private:float-u>= [ drop cc>= emit-float-unordered-comparison ] }
+ { math.private:float-u> [ drop cc> emit-float-unordered-comparison ] }
+ { math.private:float= [ drop cc= emit-float-unordered-comparison ] }
+ { math.private:float>fixnum [ drop emit-float>fixnum ] }
+ { math.private:fixnum>float [ drop emit-fixnum>float ] }
+ { math.floats.private:float-unordered? [ drop cc/<>= emit-float-unordered-comparison ] }
+ { alien.accessors:alien-float [ float-rep emit-alien-float-getter ] }
+ { alien.accessors:set-alien-float [ float-rep emit-alien-float-setter ] }
+ { alien.accessors:alien-double [ double-rep emit-alien-float-getter ] }
+ { alien.accessors:set-alien-double [ double-rep emit-alien-float-setter ] }
} enable-intrinsics ;
: enable-fsqrt ( -- )
- \ math.libm:fsqrt t "intrinsic" set-word-prop ;
+ {
+ { math.libm:fsqrt [ drop emit-fsqrt ] }
+ } enable-intrinsics ;
: enable-float-min/max ( -- )
{
- math.floats.private:float-min
- math.floats.private:float-max
+ { math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
+ { math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
+ } enable-intrinsics ;
+
+: enable-float-functions ( -- )
+ {
+ { math.libm:facos [ drop "acos" emit-unary-float-function ] }
+ { math.libm:fasin [ drop "asin" emit-unary-float-function ] }
+ { math.libm:fatan [ drop "atan" emit-unary-float-function ] }
+ { math.libm:fatan2 [ drop "atan2" emit-binary-float-function ] }
+ { math.libm:fcos [ drop "cos" emit-unary-float-function ] }
+ { math.libm:fsin [ drop "sin" emit-unary-float-function ] }
+ { math.libm:ftan [ drop "tan" emit-unary-float-function ] }
+ { math.libm:fcosh [ drop "cosh" emit-unary-float-function ] }
+ { math.libm:fsinh [ drop "sinh" emit-unary-float-function ] }
+ { math.libm:ftanh [ drop "tanh" emit-unary-float-function ] }
+ { math.libm:fexp [ drop "exp" emit-unary-float-function ] }
+ { math.libm:flog [ drop "log" emit-unary-float-function ] }
+ { math.libm:flog10 [ drop "log10" emit-unary-float-function ] }
+ { math.libm:fpow [ drop "pow" emit-binary-float-function ] }
+ { math.libm:facosh [ drop "acosh" emit-unary-float-function ] }
+ { math.libm:fasinh [ drop "asinh" emit-unary-float-function ] }
+ { math.libm:fatanh [ drop "atanh" emit-unary-float-function ] }
+ { math.libm:fsqrt [ drop "sqrt" emit-unary-float-function ] }
+ { math.floats.private:float-min [ drop "fmin" emit-binary-float-function ] }
+ { math.floats.private:float-max [ drop "fmax" emit-binary-float-function ] }
+ { math.private:float-mod [ drop "fmod" emit-binary-float-function ] }
} enable-intrinsics ;
: enable-min/max ( -- )
{
- math.integers.private:fixnum-min
- math.integers.private:fixnum-max
+ { math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] }
+ { math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] }
} enable-intrinsics ;
: enable-fixnum-log2 ( -- )
- { math.integers.private:fixnum-log2 } enable-intrinsics ;
+ {
+ { math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
+ } enable-intrinsics ;
-: emit-intrinsic ( node word -- )
+: enable-simd ( -- )
{
- { \ kernel.private:tag [ drop emit-tag ] }
- { \ kernel.private:getenv [ emit-getenv ] }
- { \ math.private:both-fixnums? [ drop emit-both-fixnums? ] }
- { \ math.private:fixnum+ [ drop emit-fixnum+ ] }
- { \ math.private:fixnum- [ drop emit-fixnum- ] }
- { \ math.private:fixnum* [ drop emit-fixnum* ] }
- { \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] }
- { \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] }
- { \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] }
- { \ math.private:fixnum-bitor [ drop [ ^^or ] emit-fixnum-op ] }
- { \ math.private:fixnum-bitxor [ drop [ ^^xor ] emit-fixnum-op ] }
- { \ math.private:fixnum-shift-fast [ emit-fixnum-shift-fast ] }
- { \ math.private:fixnum-bitnot [ drop emit-fixnum-bitnot ] }
- { \ math.integers.private:fixnum-log2 [ drop emit-fixnum-log2 ] }
- { \ math.private:fixnum*fast [ drop emit-fixnum*fast ] }
- { \ math.private:fixnum< [ drop cc< emit-fixnum-comparison ] }
- { \ math.private:fixnum<= [ drop cc<= emit-fixnum-comparison ] }
- { \ math.private:fixnum>= [ drop cc>= emit-fixnum-comparison ] }
- { \ math.private:fixnum> [ drop cc> emit-fixnum-comparison ] }
- { \ kernel:eq? [ drop cc= emit-fixnum-comparison ] }
- { \ math.integers.private:fixnum-min [ drop [ ^^min ] emit-fixnum-op ] }
- { \ math.integers.private:fixnum-max [ drop [ ^^max ] emit-fixnum-op ] }
- { \ math.private:bignum>fixnum [ drop emit-bignum>fixnum ] }
- { \ math.private:fixnum>bignum [ drop emit-fixnum>bignum ] }
- { \ math.private:float+ [ drop [ ^^add-float ] emit-float-op ] }
- { \ math.private:float- [ drop [ ^^sub-float ] emit-float-op ] }
- { \ math.private:float* [ drop [ ^^mul-float ] emit-float-op ] }
- { \ math.private:float/f [ drop [ ^^div-float ] emit-float-op ] }
- { \ math.private:float< [ drop cc< emit-float-comparison ] }
- { \ math.private:float<= [ drop cc<= emit-float-comparison ] }
- { \ math.private:float>= [ drop cc>= emit-float-comparison ] }
- { \ math.private:float> [ drop cc> emit-float-comparison ] }
- { \ math.private:float= [ drop cc= emit-float-comparison ] }
- { \ math.private:float>fixnum [ drop emit-float>fixnum ] }
- { \ math.private:fixnum>float [ drop emit-fixnum>float ] }
- { \ math.floats.private:float-min [ drop [ ^^min-float ] emit-float-op ] }
- { \ math.floats.private:float-max [ drop [ ^^max-float ] emit-float-op ] }
- { \ math.libm:fsqrt [ drop emit-fsqrt ] }
- { \ slots.private:slot [ emit-slot ] }
- { \ slots.private:set-slot [ emit-set-slot ] }
- { \ strings.private:string-nth [ drop emit-string-nth ] }
- { \ strings.private:set-string-nth-fast [ drop emit-set-string-nth-fast ] }
- { \ classes.tuple.private:<tuple-boa> [ emit-<tuple-boa> ] }
- { \ arrays:<array> [ emit-<array> ] }
- { \ byte-arrays:<byte-array> [ emit-<byte-array> ] }
- { \ byte-arrays:(byte-array) [ emit-(byte-array) ] }
- { \ kernel:<wrapper> [ emit-simple-allot ] }
- { \ alien:<displaced-alien> [ emit-<displaced-alien> ] }
- { \ alien.accessors:alien-unsigned-1 [ 1 emit-alien-unsigned-getter ] }
- { \ alien.accessors:set-alien-unsigned-1 [ 1 emit-alien-integer-setter ] }
- { \ alien.accessors:alien-signed-1 [ 1 emit-alien-signed-getter ] }
- { \ alien.accessors:set-alien-signed-1 [ 1 emit-alien-integer-setter ] }
- { \ alien.accessors:alien-unsigned-2 [ 2 emit-alien-unsigned-getter ] }
- { \ alien.accessors:set-alien-unsigned-2 [ 2 emit-alien-integer-setter ] }
- { \ alien.accessors:alien-signed-2 [ 2 emit-alien-signed-getter ] }
- { \ alien.accessors:set-alien-signed-2 [ 2 emit-alien-integer-setter ] }
- { \ alien.accessors:alien-unsigned-4 [ 4 emit-alien-unsigned-getter ] }
- { \ alien.accessors:set-alien-unsigned-4 [ 4 emit-alien-integer-setter ] }
- { \ alien.accessors:alien-signed-4 [ 4 emit-alien-signed-getter ] }
- { \ alien.accessors:set-alien-signed-4 [ 4 emit-alien-integer-setter ] }
- { \ alien.accessors:alien-cell [ emit-alien-cell-getter ] }
- { \ alien.accessors:set-alien-cell [ emit-alien-cell-setter ] }
- { \ alien.accessors:alien-float [ single-float-rep emit-alien-float-getter ] }
- { \ alien.accessors:set-alien-float [ single-float-rep emit-alien-float-setter ] }
- { \ alien.accessors:alien-double [ double-float-rep emit-alien-float-getter ] }
- { \ alien.accessors:set-alien-double [ double-float-rep emit-alien-float-setter ] }
- } case ;
+ { math.vectors.simd.intrinsics:assert-positive [ drop ] }
+ { math.vectors.simd.intrinsics:(simd-v+) [ [ ^^add-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vs+) [ [ ^^saturated-add-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v+-) [ [ ^^add-sub-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v-) [ [ ^^sub-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vs-) [ [ ^^saturated-sub-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v*) [ [ ^^mul-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vs*) [ [ ^^saturated-mul-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v/) [ [ ^^div-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vmin) [ [ ^^min-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vmax) [ [ ^^max-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v.) [ [ ^^dot-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vabs) [ [ ^^abs-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vsqrt) [ [ ^^sqrt-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vbitand) [ [ ^^and-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vbitandn) [ [ ^^andn-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vbitor) [ [ ^^or-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vbitxor) [ [ ^^xor-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vbitnot) [ [ ^^not-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vand) [ [ ^^and-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vandn) [ [ ^^andn-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vor) [ [ ^^or-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vxor) [ [ ^^xor-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vnot) [ [ ^^not-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v<=) [ [ cc<= ^^compare-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v<) [ [ cc< ^^compare-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v=) [ [ cc= ^^compare-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v>) [ [ cc> ^^compare-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-v>=) [ [ cc>= ^^compare-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vunordered?) [ [ cc/<>= ^^compare-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vany?) [ [ vcc-any ^^test-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vall?) [ [ vcc-all ^^test-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vnone?) [ [ vcc-none ^^test-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vlshift) [ [ ^^shl-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-vrshift) [ [ ^^shr-vector ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-hlshift) [ [ ^^horizontal-shl-vector ] emit-horizontal-shift ] }
+ { math.vectors.simd.intrinsics:(simd-hrshift) [ [ ^^horizontal-shr-vector ] emit-horizontal-shift ] }
+ { math.vectors.simd.intrinsics:(simd-with) [ [ ^^with-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-gather-2) [ emit-gather-vector-2 ] }
+ { math.vectors.simd.intrinsics:(simd-gather-4) [ emit-gather-vector-4 ] }
+ { math.vectors.simd.intrinsics:(simd-vshuffle) [ emit-shuffle-vector ] }
+ { math.vectors.simd.intrinsics:(simd-(vmerge-head)) [ [ ^^merge-vector-head ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-(vmerge-tail)) [ [ ^^merge-vector-tail ] emit-binary-vector-op ] }
+ { math.vectors.simd.intrinsics:(simd-select) [ emit-select-vector ] }
+ { math.vectors.simd.intrinsics:(simd-sum) [ [ ^^horizontal-add-vector ] emit-unary-vector-op ] }
+ { math.vectors.simd.intrinsics:alien-vector [ emit-alien-vector ] }
+ { math.vectors.simd.intrinsics:set-alien-vector [ emit-set-alien-vector ] }
+ } enable-intrinsics ;
+
+: emit-intrinsic ( node word -- )
+ "intrinsic" word-prop call( node -- ) ;
ds-pop tag-mask get ^^and-imm ^^tag-fixnum ds-push ;
: emit-getenv ( node -- )
- "userenv" f ^^alien-global
+ "userenv" ^^vm-field-ptr
swap node-input-infos first literal>>
- [ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot 0 ^^slot ] if*
+ [ ds-drop 0 ^^slot-imm ] [ ds-pop ^^offset>slot ^^slot ] if*
ds-push ;
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays fry cpu.architecture kernel math
+sequences math.vectors.simd.intrinsics macros generalizations
+combinators combinators.short-circuit arrays
+compiler.tree.propagation.info compiler.cfg.builder.blocks
+compiler.cfg.stacks compiler.cfg.stacks.local compiler.cfg.hats
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.intrinsics.alien ;
+IN: compiler.cfg.intrinsics.simd
+
+MACRO: check-elements ( quots -- )
+ [ length '[ _ firstn ] ]
+ [ '[ _ spread ] ]
+ [ length 1 - \ and <repetition> [ ] like ]
+ tri 3append ;
+
+MACRO: if-literals-match ( quots -- )
+ [ length ] [ ] [ length ] tri
+ ! n quots n n
+ '[
+ ! node quot
+ [
+ dup node-input-infos
+ _ tail-slice* [ literal>> ] map
+ dup _ check-elements
+ ] dip
+ swap [
+ ! node literals quot
+ [ _ firstn ] dip call
+ drop
+ ] [ 2drop emit-primitive ] if
+ ] ;
+
+: emit-vector-op ( node quot: ( rep -- ) -- )
+ { [ representation? ] } if-literals-match ; inline
+
+: [binary] ( quot -- quot' )
+ '[ [ ds-drop 2inputs ] dip @ ds-push ] ; inline
+
+: emit-binary-vector-op ( node quot -- )
+ [binary] emit-vector-op ; inline
+
+: [unary] ( quot -- quot' )
+ '[ [ ds-drop ds-pop ] dip @ ds-push ] ; inline
+
+: emit-unary-vector-op ( node quot -- )
+ [unary] emit-vector-op ; inline
+
+: [unary/param] ( quot -- quot' )
+ '[ [ -2 inc-d ds-pop ] 2dip @ ds-push ] ; inline
+
+: emit-horizontal-shift ( node quot -- )
+ [unary/param]
+ { [ integer? ] [ representation? ] } if-literals-match ; inline
+
+: emit-gather-vector-2 ( node -- )
+ [ ^^gather-vector-2 ] emit-binary-vector-op ;
+
+: emit-gather-vector-4 ( node -- )
+ [
+ ds-drop
+ [
+ D 3 peek-loc
+ D 2 peek-loc
+ D 1 peek-loc
+ D 0 peek-loc
+ -4 inc-d
+ ] dip
+ ^^gather-vector-4
+ ds-push
+ ] emit-vector-op ;
+
+: shuffle? ( obj -- ? ) { [ array? ] [ [ integer? ] all? ] } 1&& ;
+
+: emit-shuffle-vector ( node -- )
+ ! Pad the permutation with zeroes if its too short, since we
+ ! can't throw an error at this point.
+ [ [ rep-components 0 pad-tail ] keep ^^shuffle-vector ] [unary/param]
+ { [ shuffle? ] [ representation? ] } if-literals-match ;
+
+: ^^broadcast-vector ( src n rep -- dst )
+ [ rep-components swap <array> ] keep
+ ^^shuffle-vector ;
+
+: emit-broadcast-vector ( node -- )
+ [ ^^broadcast-vector ] [unary/param]
+ { [ integer? ] [ representation? ] } if-literals-match ;
+
+: ^^with-vector ( src rep -- dst )
+ [ ^^scalar>vector ] keep [ 0 ] dip ^^broadcast-vector ;
+
+: ^^select-vector ( src n rep -- dst )
+ [ ^^broadcast-vector ] keep ^^vector>scalar ;
+
+: emit-select-vector ( node -- )
+ [ ^^select-vector ] [unary/param]
+ { [ integer? ] [ representation? ] } if-literals-match ; inline
+
+: emit-alien-vector ( node -- )
+ dup [
+ '[
+ ds-drop prepare-alien-getter
+ _ ^^alien-vector ds-push
+ ]
+ [ inline-alien-getter? ] inline-alien
+ ] with emit-vector-op ;
+
+: emit-set-alien-vector ( node -- )
+ dup [
+ '[
+ ds-drop prepare-alien-setter ds-pop
+ _ ##set-alien-vector
+ ]
+ [ byte-array inline-alien-setter? ]
+ inline-alien
+ ] with emit-vector-op ;
: value-tag ( info -- n ) class>> class-tag ; inline
+: ^^tag-offset>slot ( slot tag -- vreg' )
+ [ ^^offset>slot ] dip ^^sub-imm ;
+
: (emit-slot) ( infos -- dst )
- [ 2inputs ^^offset>slot ] [ first value-tag ] bi*
- ^^slot ;
+ [ 2inputs ] [ first value-tag ] bi*
+ ^^tag-offset>slot ^^slot ;
: (emit-slot-imm) ( infos -- dst )
ds-drop
] [ drop emit-primitive ] if ;
: (emit-set-slot) ( infos -- obj-reg )
- [ 3inputs ^^offset>slot ] [ second value-tag ] bi*
- pick [ ^^set-slot ] dip ;
+ [ 3inputs ] [ second value-tag ] bi*
+ ^^tag-offset>slot over [ ##set-slot ] dip ;
: (emit-set-slot-imm) ( infos -- obj-reg )
ds-drop
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs heaps kernel namespaces sequences fry math
-math.order combinators arrays sorting compiler.utilities
+math.order combinators arrays sorting compiler.utilities locals
compiler.cfg.linear-scan.live-intervals
compiler.cfg.linear-scan.allocation.spilling
compiler.cfg.linear-scan.allocation.splitting
[ drop assign-blocked-register ]
} cond ;
-: handle-interval ( live-interval -- )
- [
- start>>
+: spill-at-sync-point ( live-interval n -- ? )
+ ! If the live interval has a usage at 'n', don't spill it,
+ ! since this means its being defined by the sync point
+ ! instruction. Output t if this is the case.
+ 2dup [ uses>> ] dip swap member? [ 2drop t ] [ spill f ] if ;
+
+: handle-sync-point ( n -- )
+ [ active-intervals get values ] dip
+ '[ [ _ spill-at-sync-point ] filter-here ] each ;
+
+:: handle-progress ( n sync? -- )
+ n {
[ progress set ]
[ deactivate-intervals ]
- [ activate-intervals ] tri
- ] [ assign-register ] bi ;
+ [ sync? [ handle-sync-point ] [ drop ] if ]
+ [ activate-intervals ]
+ } cleave ;
+
+GENERIC: handle ( obj -- )
+
+M: live-interval handle ( live-interval -- )
+ [ start>> f handle-progress ] [ assign-register ] bi ;
+
+M: sync-point handle ( sync-point -- )
+ n>> t handle-progress ;
+
+: smallest-heap ( heap1 heap2 -- heap )
+ ! If heap1 and heap2 have the same key, favors heap1.
+ [ [ heap-peek nip ] bi@ <= ] most ;
: (allocate-registers) ( -- )
- unhandled-intervals get [ handle-interval ] slurp-heap ;
+ {
+ { [ unhandled-intervals get heap-empty? ] [ unhandled-sync-points get ] }
+ { [ unhandled-sync-points get heap-empty? ] [ unhandled-intervals get ] }
+ ! If a live interval begins at the same location as a sync point,
+ ! process the sync point before the live interval. This ensures that the
+ ! return value of C function calls doesn't get spilled and reloaded
+ ! unnecessarily.
+ [ unhandled-sync-points get unhandled-intervals get smallest-heap ]
+ } cond dup heap-empty? [ drop ] [ heap-pop drop handle (allocate-registers) ] if ;
: finish-allocation ( -- )
active-intervals inactive-intervals
[ get values [ handled-intervals get push-all ] each ] bi@ ;
-: allocate-registers ( live-intervals machine-registers -- live-intervals )
+: allocate-registers ( live-intervals sync-point machine-registers -- live-intervals )
init-allocator
init-unhandled
(allocate-registers)
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators fry hints kernel locals
-math sequences sets sorting splitting namespaces
+math sequences sets sorting splitting namespaces linked-assocs
combinators.short-circuit compiler.utilities
compiler.cfg.linear-scan.allocation.state
compiler.cfg.linear-scan.allocation.splitting
2bi ;
: assign-spill ( live-interval -- )
- dup vreg>> assign-spill-slot >>spill-to drop ;
+ dup vreg>> vreg-spill-slot >>spill-to drop ;
: spill-before ( before -- before/f )
! If the interval does not have any usages before the spill location,
] if ;
: assign-reload ( live-interval -- )
- dup vreg>> assign-spill-slot >>reload-from drop ;
+ dup vreg>> vreg-spill-slot >>reload-from drop ;
: spill-after ( after -- after/f )
! If the interval has no more usages after the spill location,
find-use-positions ;
: spill-status ( new -- use-pos )
- H{ } clone
+ H{ } <linked-assoc>
[ inactive-positions ] [ active-positions ] [ nip ] 2tri
>alist alist-max ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators cpu.architecture fry heaps
kernel math math.order namespaces sequences vectors
-compiler.cfg compiler.cfg.registers
-compiler.cfg.linear-scan.live-intervals ;
+linked-assocs compiler.cfg compiler.cfg.registers
+compiler.cfg.instructions compiler.cfg.linear-scan.live-intervals ;
IN: compiler.cfg.linear-scan.allocation.state
! Start index of current live interval. We ensure that all
: next-spill-slot ( rep -- n )
rep-size cfg get
- [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop ;
+ [ swap [ align dup ] [ + ] bi ] change-spill-area-size drop
+ <spill-slot> ;
+
+! Minheap of sync points which still need to be processed
+SYMBOL: unhandled-sync-points
! Mapping from vregs to spill slots
SYMBOL: spill-slots
-: assign-spill-slot ( vreg -- n )
+: vreg-spill-slot ( vreg -- spill-slot )
spill-slots get [ rep-of next-spill-slot ] cache ;
: init-allocator ( registers -- )
registers set
<min-heap> unhandled-intervals set
+ <min-heap> unhandled-sync-points set
[ V{ } clone ] reg-class-assoc active-intervals set
[ V{ } clone ] reg-class-assoc inactive-intervals set
V{ } clone handled-intervals set
H{ } clone spill-slots set
-1 progress set ;
-: init-unhandled ( live-intervals -- )
- [ [ start>> ] keep ] { } map>assoc
- unhandled-intervals get heap-push-all ;
+: init-unhandled ( live-intervals sync-points -- )
+ [ [ [ start>> ] keep ] { } map>assoc unhandled-intervals get heap-push-all ]
+ [ [ [ n>> ] keep ] { } map>assoc unhandled-sync-points get heap-push-all ]
+ bi* ;
! A utility used by register-status and spill-status words
: free-positions ( new -- assoc )
- vreg>> rep-of reg-class-of registers get at [ 1/0. ] H{ } map>assoc ;
+ vreg>> rep-of reg-class-of registers get at
+ [ 1/0. ] H{ } <linked-assoc> map>assoc ;
: add-use-position ( n reg assoc -- ) [ [ min ] when* ] change-at ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math assocs namespaces sequences heaps
fry make combinators sets locals arrays
-cpu.architecture
+cpu.architecture layouts
compiler.cfg
compiler.cfg.def-use
compiler.cfg.liveness
: remove-pending ( live-interval -- )
vreg>> pending-interval-assoc get delete-at ;
+ERROR: bad-vreg vreg ;
+
+: (vreg>reg) ( vreg pending -- reg )
+ ! If a live vreg is not in the pending set, then it must
+ ! have been spilled.
+ ?at [ spill-slots get ?at [ ] [ bad-vreg ] if ] unless ;
+
+: vreg>reg ( vreg -- reg )
+ pending-interval-assoc get (vreg>reg) ;
+
+: vregs>regs ( vregs -- assoc )
+ dup assoc-empty? [
+ pending-interval-assoc get
+ '[ _ (vreg>reg) ] assoc-map
+ ] unless ;
+
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
GENERIC: assign-registers-in-insn ( insn -- )
-: vreg>reg ( vreg -- reg ) pending-interval-assoc get at ;
-
RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ]
M: vreg-insn assign-registers-in-insn
[ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ;
-! TODO: needs tagged-rep
-
: trace-on-gc ( assoc -- assoc' )
! When a GC occurs, virtual registers which contain tagged data
! are traced by the GC. Outputs a sequence physical registers.
[
[
2dup spill-on-gc?
- [ swap [ assign-spill-slot ] [ rep-of ] bi 3array , ] [ 2drop ] if
+ [ swap [ rep-of ] [ vreg-spill-slot ] bi 3array , ] [ 2drop ] if
] assoc-each
] { } make ;
+: gc-root-offsets ( registers -- alist )
+ ! Outputs a sequence of { offset register/spill-slot } pairs
+ [ length iota [ cell * ] map ] keep zip ;
+
M: ##gc assign-registers-in-insn
! Since ##gc is always the first instruction in a block, the set of
! values live at the ##gc is just live-in.
dup call-next-method
basic-block get register-live-ins get at
- [ trace-on-gc >>tagged-values ] [ spill-on-gc >>data-values ] bi
+ [ trace-on-gc gc-root-offsets >>tagged-values ] [ spill-on-gc >>data-values ] bi
drop ;
M: insn assign-registers-in-insn drop ;
-: compute-live-values ( vregs -- assoc )
- ! If a live vreg is not in active or inactive, then it must have been
- ! spilled.
- dup assoc-empty? [
- pending-interval-assoc get
- '[ _ ?at [ ] [ spill-slots get at <spill-slot> ] if ] assoc-map
- ] unless ;
-
: begin-block ( bb -- )
dup basic-block set
dup block-from activate-new-intervals
- [ live-in compute-live-values ] keep
- register-live-ins get set-at ;
+ [ live-in vregs>regs ] keep register-live-ins get set-at ;
: end-block ( bb -- )
- [ live-out compute-live-values ] keep
- register-live-outs get set-at ;
-
-ERROR: bad-vreg vreg ;
+ [ live-out vregs>regs ] keep register-live-outs get set-at ;
: vreg-at-start ( vreg bb -- state )
register-live-ins get at ?at [ bad-vreg ] unless ;
[
[ clone ] map dup [ [ vreg>> ] keep ] H{ } map>assoc
live-intervals set
+ f
] dip
allocate-registers drop ;
H{ } spill-slots set
H{
- { 1 single-float-rep }
- { 2 single-float-rep }
- { 3 single-float-rep }
+ { 1 float-rep }
+ { 2 float-rep }
+ { 3 float-rep }
} representations set
[
{ end 2 }
{ uses V{ 0 1 } }
{ ranges V{ T{ live-range f 0 2 } } }
- { spill-to 0 }
+ { spill-to T{ spill-slot f 0 } }
}
T{ live-interval
{ vreg 1 }
{ end 5 }
{ uses V{ 5 } }
{ ranges V{ T{ live-range f 5 5 } } }
- { reload-from 0 }
+ { reload-from T{ spill-slot f 0 } }
}
] [
T{ live-interval
{ end 1 }
{ uses V{ 0 } }
{ ranges V{ T{ live-range f 0 1 } } }
- { spill-to 4 }
+ { spill-to T{ spill-slot f 4 } }
}
T{ live-interval
{ vreg 2 }
{ end 5 }
{ uses V{ 1 5 } }
{ ranges V{ T{ live-range f 1 5 } } }
- { reload-from 4 }
+ { reload-from T{ spill-slot f 4 } }
}
] [
T{ live-interval
{ end 1 }
{ uses V{ 0 } }
{ ranges V{ T{ live-range f 0 1 } } }
- { spill-to 8 }
+ { spill-to T{ spill-slot f 8 } }
}
T{ live-interval
{ vreg 3 }
{ end 30 }
{ uses V{ 20 30 } }
{ ranges V{ T{ live-range f 20 30 } } }
- { reload-from 8 }
+ { reload-from T{ spill-slot f 8 } }
}
] [
T{ live-interval
[ _spill ] [ 1 get instructions>> second class ] unit-test
[ _reload ] [ 4 get instructions>> 4 swap nth class ] unit-test
-[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ n>> cell / ] map ] unit-test
-[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ n>> cell / ] map ] unit-test
+[ V{ 3 2 1 } ] [ 8 get instructions>> [ _spill? ] filter [ dst>> n>> cell / ] map ] unit-test
+[ V{ 3 2 1 } ] [ 9 get instructions>> [ _reload? ] filter [ src>> n>> cell / ] map ] unit-test
! Resolve pass should insert this
[ _reload ] [ 5 get predecessors>> first instructions>> first class ] unit-test
[ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test
-[ { 3 } ] [ 1 get instructions>> first tagged-values>> ] unit-test
+[ { { 0 1 } } ] [ 1 get instructions>> first tagged-values>> ] unit-test
V{
T{ ##peek f 0 D 0 }
[ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test
-[ { 3 } ] [ 1 get instructions>> first tagged-values>> ] unit-test
+[ { { 0 1 } } ] [ 1 get instructions>> first tagged-values>> ] unit-test
covers?
] if ;
-ERROR: dead-value-error vreg ;
+: add-new-range ( from to live-interval -- )
+ [ <live-range> ] dip ranges>> push ;
: shorten-range ( n live-interval -- )
dup ranges>> empty?
- [ vreg>> dead-value-error ] [ ranges>> last (>>from) ] if ;
+ [ dupd add-new-range ] [ ranges>> last (>>from) ] if ;
: extend-range ( from to live-range -- )
ranges>> last
[ min ] change-from
drop ;
-: add-new-range ( from to live-interval -- )
- [ <live-range> ] dip ranges>> push ;
-
: extend-range? ( to live-interval -- ? )
ranges>> [ drop f ] [ last from>> >= ] if-empty ;
2dup extend-range?
[ extend-range ] [ add-new-range ] if ;
-: add-use ( n live-interval -- )
- uses>> push ;
+GENERIC: operands-in-registers? ( insn -- ? )
+
+M: vreg-insn operands-in-registers? drop t ;
+
+M: partial-sync-insn operands-in-registers? drop f ;
+
+: add-def ( insn live-interval -- )
+ [ insn#>> ] [ uses>> ] bi* push ;
+
+: add-use ( insn live-interval -- )
+ ! Every use is a potential def, no SSA here baby!
+ over operands-in-registers? [ add-def ] [ 2drop ] if ;
: <live-interval> ( vreg -- live-interval )
\ live-interval new
M: live-interval hashcode*
nip [ start>> ] [ end>> 1000 * ] bi + ;
-M: live-interval clone
- call-next-method [ clone ] change-uses ;
-
! Mapping from vreg to live-interval
SYMBOL: live-intervals
-: live-interval ( vreg live-intervals -- live-interval )
- [ <live-interval> ] cache ;
+: live-interval ( vreg -- live-interval )
+ live-intervals get [ <live-interval> ] cache ;
GENERIC: compute-live-intervals* ( insn -- )
M: insn compute-live-intervals* drop ;
-: handle-output ( n vreg live-intervals -- )
+: handle-output ( insn vreg -- )
live-interval
- [ add-use ] [ shorten-range ] 2bi ;
+ [ [ insn#>> ] dip shorten-range ] [ add-def ] 2bi ;
-: handle-input ( n vreg live-intervals -- )
+: handle-input ( insn vreg -- )
live-interval
- [ [ basic-block get block-from ] 2dip add-range ] [ add-use ] 2bi ;
+ [ [ [ basic-block get block-from ] dip insn#>> ] dip add-range ] [ add-use ] 2bi ;
-: handle-temp ( n vreg live-intervals -- )
+: handle-temp ( insn vreg -- )
live-interval
- [ dupd add-range ] [ add-use ] 2bi ;
+ [ [ insn#>> dup ] dip add-range ] [ add-use ] 2bi ;
M: vreg-insn compute-live-intervals*
- dup insn#>>
- live-intervals get
- [ [ defs-vreg ] 2dip '[ [ _ ] dip _ handle-output ] when* ]
- [ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ]
- [ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ]
- 3tri ;
+ [ dup defs-vreg [ handle-output ] with when* ]
+ [ dup uses-vregs [ handle-input ] with each ]
+ [ dup temp-vregs [ handle-temp ] with each ]
+ tri ;
: handle-live-out ( bb -- )
- live-out keys
- basic-block get [ block-from ] [ block-to ] bi
- live-intervals get '[
- [ _ _ ] dip _ live-interval add-range
- ] each ;
+ [ block-from ] [ block-to ] [ live-out keys ] tri
+ [ live-interval add-range ] with with each ;
+
+! A location where all registers have to be spilled
+TUPLE: sync-point n ;
+
+C: <sync-point> sync-point
+
+! Sequence of sync points
+SYMBOL: sync-points
+
+GENERIC: compute-sync-points* ( insn -- )
+
+M: partial-sync-insn compute-sync-points*
+ insn#>> <sync-point> sync-points get push ;
+
+M: insn compute-sync-points* drop ;
: compute-live-intervals-step ( bb -- )
[ basic-block set ]
[ handle-live-out ]
- [ instructions>> <reversed> [ compute-live-intervals* ] each ] tri ;
-
+ [
+ instructions>> <reversed> [
+ [ compute-live-intervals* ]
+ [ compute-sync-points* ]
+ bi
+ ] each
+ ] tri ;
+
+: init-live-intervals ( -- )
+ H{ } clone live-intervals set
+ V{ } clone sync-points set ;
+
: compute-start/end ( live-interval -- )
dup ranges>> [ first from>> ] [ last to>> ] bi
[ >>start ] [ >>end ] bi* drop ;
: check-start ( live-interval -- )
dup start>> -1 = [ bad-live-interval ] [ drop ] if ;
-: finish-live-intervals ( live-intervals -- )
+: finish-live-intervals ( live-intervals -- seq )
! Since live intervals are computed in a backward order, we have
! to reverse some sequences, and compute the start and end.
- [
+ values dup [
{
[ ranges>> reverse-here ]
[ uses>> reverse-here ]
} cleave
] each ;
-: compute-live-intervals ( cfg -- live-intervals )
- H{ } clone [
- live-intervals set
- linearization-order <reversed>
- [ compute-live-intervals-step ] each
- ] keep values dup finish-live-intervals ;
+: compute-live-intervals ( cfg -- live-intervals sync-points )
+ init-live-intervals
+ linearization-order <reversed> [ compute-live-intervals-step ] each
+ live-intervals get finish-live-intervals
+ sync-points get ;
: relevant-ranges ( interval1 interval2 -- ranges1 ranges2 )
[ [ ranges>> ] bi@ ] [ nip start>> ] 2bi '[ to>> _ >= ] filter ;
compiler.cfg.linearization.order ;
IN: compiler.cfg.linear-scan.numbering
-: number-instructions ( rpo -- )
- linearization-order 0 [
- instructions>> [
- [ (>>insn#) ] [ drop 2 + ] 2bi
- ] each
- ] reduce drop ;
+ERROR: already-numbered insn ;
+
+: number-instruction ( n insn -- n' )
+ [ nip dup insn#>> [ already-numbered ] [ drop ] if ]
+ [ (>>insn#) ]
+ [ drop 2 + ]
+ 2tri ;
+
+: number-instructions ( cfg -- )
+ linearization-order
+ 0 [ instructions>> [ number-instruction ] each ] reduce
+ drop ;
SYMBOL: check-numbering?
[
{
- T{ _reload { dst 1 } { rep int-rep } { n 0 } }
+ T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 0 } } }
}
] [
[
[
{
- T{ _spill { src 1 } { rep int-rep } { n 0 } }
+ T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 0 } } }
}
] [
[
{ { { 0 int-rep } { 1 int-rep } } { { 1 int-rep } { 0 int-rep } } }
mapping-instructions {
{
- T{ _spill { src 0 } { rep int-rep } { n 8 } }
+ T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 8 } } }
T{ ##copy { dst 0 } { src 1 } { rep int-rep } }
- T{ _reload { dst 1 } { rep int-rep } { n 8 } }
+ T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 8 } } }
}
{
- T{ _spill { src 1 } { rep int-rep } { n 8 } }
+ T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 8 } } }
T{ ##copy { dst 1 } { src 0 } { rep int-rep } }
- T{ _reload { dst 0 } { rep int-rep } { n 8 } }
+ T{ _reload { dst 0 } { rep int-rep } { src T{ spill-slot f 8 } } }
}
} member?
] unit-test
] if ;
: memory->register ( from to -- )
- swap [ first2 ] [ first n>> ] bi* _reload ;
+ swap [ first2 ] [ first ] bi* _reload ;
: register->memory ( from to -- )
- [ first2 ] [ first n>> ] bi* _spill ;
+ [ first2 ] [ first ] bi* _spill ;
: temp->register ( from to -- )
nip [ first ] [ second ] [ second spill-temp ] tri _reload ;
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math accessors sequences namespaces make
combinators assocs arrays locals layouts hashtables
-cpu.architecture
+cpu.architecture generalizations
compiler.cfg
compiler.cfg.comparisons
compiler.cfg.stack-frame
: successors ( bb -- first second ) successors>> first2 ; inline
+:: conditional ( bb insn n conditional-quot negate-cc-quot -- bb successor label ... )
+ bb insn
+ conditional-quot
+ [ drop dup successors>> second useless-branch? ] 2bi
+ [ [ swap block-number ] n ndip ]
+ [ [ block-number ] n ndip negate-cc-quot call ] if ; inline
+
: (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc )
[ dup successors ]
[ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline
: binary-conditional ( bb insn -- bb successor label2 src1 src2 cc )
- [ (binary-conditional) ]
- [ drop dup successors>> second useless-branch? ] 2bi
- [ [ swap block-number ] 3dip ] [ [ block-number ] 3dip negate-cc ] if ;
+ 3 [ (binary-conditional) ] [ negate-cc ] conditional ;
+
+: (test-vector-conditional) ( bb insn -- bb successor1 successor2 src1 temp rep vcc )
+ [ dup successors ]
+ [ { [ src1>> ] [ temp>> ] [ rep>> ] [ vcc>> ] } cleave ] bi* ; inline
+
+: test-vector-conditional ( bb insn -- bb successor label src1 temp rep vcc )
+ 4 [ (test-vector-conditional) ] [ negate-vcc ] conditional ;
M: ##compare-branch linearize-insn
binary-conditional _compare-branch emit-branch ;
M: ##compare-imm-branch linearize-insn
binary-conditional _compare-imm-branch emit-branch ;
-M: ##compare-float-branch linearize-insn
- binary-conditional _compare-float-branch emit-branch ;
+M: ##compare-float-ordered-branch linearize-insn
+ binary-conditional _compare-float-ordered-branch emit-branch ;
+
+M: ##compare-float-unordered-branch linearize-insn
+ binary-conditional _compare-float-unordered-branch emit-branch ;
+
+M: ##test-vector-branch linearize-insn
+ test-vector-conditional _test-vector-branch emit-branch ;
: overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 )
[ dup successors block-number ]
[ successors>> [ block-number _dispatch-label ] each ]
bi* ;
-: gc-root-offsets ( registers -- alist )
- ! Outputs a sequence of { offset register/spill-slot } pairs
- [ length iota [ cell * ] map ] keep zip ;
-
-M: ##gc linearize-insn
- nip
- {
- [ temp1>> ]
- [ temp2>> ]
- [ data-values>> ]
- [ tagged-values>> gc-root-offsets ]
- [ uninitialized-locs>> ]
- } cleave
- _gc ;
-
: linearize-basic-blocks ( cfg -- insns )
[
[
--- /dev/null
+USING: compiler.cfg.debugger compiler.cfg compiler.cfg.linearization.order
+kernel accessors sequences sets tools.test namespaces ;
+IN: compiler.cfg.linearization.order.tests
+
+V{ } 0 test-bb
+
+V{ } 1 test-bb
+
+V{ } 2 test-bb
+
+0 { 1 1 } edges
+1 2 edge
+
+[ t ] [ cfg new 0 get >>entry linearization-order [ id>> ] map all-unique? ] unit-test
USING: accessors assocs deques dlists kernel make sorting
namespaces sequences combinators combinators.short-circuit
fry math sets compiler.cfg.rpo compiler.cfg.utilities
-compiler.cfg.loop-detection ;
+compiler.cfg.loop-detection compiler.cfg.predecessors ;
IN: compiler.cfg.linearization.order
! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp
successors>> <reversed> [ loop-nesting-at ] sort-with ;
: process-block ( bb -- )
- [ , ]
- [ visited get conjoin ]
- [ sorted-successors [ process-successor ] each ]
- tri ;
+ dup visited? [ drop ] [
+ [ , ]
+ [ visited get conjoin ]
+ [ sorted-successors [ process-successor ] each ]
+ tri
+ ] if ;
: (linearization-order) ( cfg -- bbs )
init-linearization-order
PRIVATE>
: linearization-order ( cfg -- bbs )
- needs-post-order needs-loops
+ needs-post-order needs-loops needs-predecessors
dup linear-order>> [ ] [
dup (linearization-order)
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces accessors compiler.cfg
compiler.cfg.linearization compiler.cfg.gc-checks
-compiler.cfg.linear-scan compiler.cfg.build-stack-frame ;
+compiler.cfg.save-contexts compiler.cfg.linear-scan
+compiler.cfg.build-stack-frame ;
IN: compiler.cfg.mr
: build-mr ( cfg -- mr )
insert-gc-checks
+ insert-save-contexts
linear-scan
flatten-cfg
build-stack-frame ;
\ No newline at end of file
compiler.cfg.dce
compiler.cfg.write-barrier
compiler.cfg.representations
-compiler.cfg.two-operand
compiler.cfg.ssa.destruction
compiler.cfg.empty-blocks
compiler.cfg.checker ;
eliminate-dead-code
eliminate-write-barriers
select-representations
- convert-two-operand
destruct-ssa
delete-empty-blocks
?check ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: functors assocs kernel accessors compiler.cfg.instructions
-lexer parser ;
+USING: accessors arrays assocs fry functors generic.parser
+kernel lexer namespaces parser sequences slots words sets
+compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.instructions.syntax ;
IN: compiler.cfg.renaming.functor
+: slot-change-quot ( slots quot -- quot' )
+ '[ [ _ ] dip changer-word [ ] 2sequence ] map [ ] join
+ [ drop ] append ;
+
FUNCTOR: define-renaming ( NAME DEF-QUOT USE-QUOT TEMP-QUOT -- )
rename-insn-defs DEFINES ${NAME}-insn-defs
GENERIC: rename-insn-defs ( insn -- )
-M: ##flushable rename-insn-defs
- DEF-QUOT change-dst
- drop ;
-
-M: ##fixnum-overflow rename-insn-defs
- DEF-QUOT change-dst
- drop ;
-
-M: _fixnum-overflow rename-insn-defs
- DEF-QUOT change-dst
- drop ;
-
-M: insn rename-insn-defs drop ;
+insn-classes get [
+ [ \ rename-insn-defs create-method-in ]
+ [ insn-def-slot dup [ name>> 1array ] when DEF-QUOT slot-change-quot ] bi
+ define
+] each
GENERIC: rename-insn-uses ( insn -- )
-M: ##effect rename-insn-uses
- USE-QUOT change-src
- drop ;
-
-M: ##unary rename-insn-uses
- USE-QUOT change-src
- drop ;
-
-M: ##binary rename-insn-uses
- USE-QUOT change-src1
- USE-QUOT change-src2
- drop ;
-
-M: ##binary-imm rename-insn-uses
- USE-QUOT change-src1
- drop ;
-
-M: ##slot rename-insn-uses
- USE-QUOT change-obj
- USE-QUOT change-slot
- drop ;
-
-M: ##slot-imm rename-insn-uses
- USE-QUOT change-obj
- drop ;
-
-M: ##set-slot rename-insn-uses
- dup call-next-method
- USE-QUOT change-obj
- USE-QUOT change-slot
- drop ;
-
-M: ##string-nth rename-insn-uses
- USE-QUOT change-obj
- USE-QUOT change-index
- drop ;
-
-M: ##set-string-nth-fast rename-insn-uses
- dup call-next-method
- USE-QUOT change-obj
- USE-QUOT change-index
- drop ;
-
-M: ##set-slot-imm rename-insn-uses
- dup call-next-method
- USE-QUOT change-obj
- drop ;
-
-M: ##alien-getter rename-insn-uses
- dup call-next-method
- USE-QUOT change-src
- drop ;
-
-M: ##alien-setter rename-insn-uses
- dup call-next-method
- USE-QUOT change-value
- drop ;
-
-M: ##conditional-branch rename-insn-uses
- USE-QUOT change-src1
- USE-QUOT change-src2
- drop ;
-
-M: ##compare-imm-branch rename-insn-uses
- USE-QUOT change-src1
- drop ;
-
-M: ##dispatch rename-insn-uses
- USE-QUOT change-src
- drop ;
-
-M: ##fixnum-overflow rename-insn-uses
- USE-QUOT change-src1
- USE-QUOT change-src2
- drop ;
+insn-classes get { ##phi } diff [
+ [ \ rename-insn-uses create-method-in ]
+ [ insn-use-slots [ name>> ] map USE-QUOT slot-change-quot ] bi
+ define
+] each
M: ##phi rename-insn-uses
- [ USE-QUOT assoc-map ] change-inputs
- drop ;
-
-M: insn rename-insn-uses drop ;
+ [ USE-QUOT assoc-map ] change-inputs drop ;
GENERIC: rename-insn-temps ( insn -- )
-M: ##write-barrier rename-insn-temps
- TEMP-QUOT change-card#
- TEMP-QUOT change-table
- drop ;
-
-M: ##unary/temp rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##allot rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##dispatch rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##slot rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##set-slot rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##string-nth rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##set-string-nth-fast rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##box-displaced-alien rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##compare rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##compare-imm rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##compare-float rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: ##gc rename-insn-temps
- TEMP-QUOT change-temp1
- TEMP-QUOT change-temp2
- drop ;
-
-M: _dispatch rename-insn-temps
- TEMP-QUOT change-temp drop ;
-
-M: insn rename-insn-temps drop ;
+insn-classes get [
+ [ \ rename-insn-temps create-method-in ]
+ [ insn-temp-slots [ name>> ] map TEMP-QUOT slot-change-quot ] bi
+ define
+] each
;FUNCTOR
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences arrays fry namespaces
-cpu.architecture compiler.cfg.utilities compiler.cfg compiler.cfg.rpo
+USING: kernel accessors sequences arrays fry namespaces generic
+words sets combinators generalizations cpu.architecture compiler.units
+compiler.cfg.utilities compiler.cfg compiler.cfg.rpo
compiler.cfg.instructions compiler.cfg.def-use ;
+FROM: compiler.cfg.instructions.syntax => insn-def-slot insn-use-slots insn-temp-slots scalar-rep ;
IN: compiler.cfg.representations.preferred
GENERIC: defs-vreg-rep ( insn -- rep/f )
GENERIC: temp-vreg-reps ( insn -- reps )
GENERIC: uses-vreg-reps ( insn -- reps )
-M: ##flushable defs-vreg-rep drop int-rep ;
-M: ##copy defs-vreg-rep rep>> ;
-M: output-float-insn defs-vreg-rep drop double-float-rep ;
-M: ##fixnum-overflow defs-vreg-rep drop int-rep ;
-M: _fixnum-overflow defs-vreg-rep drop int-rep ;
-M: ##phi defs-vreg-rep drop "##phi must be special-cased" throw ;
-M: insn defs-vreg-rep drop f ;
+<PRIVATE
-M: ##write-barrier temp-vreg-reps drop { int-rep int-rep } ;
-M: ##unary/temp temp-vreg-reps drop { int-rep } ;
-M: ##allot temp-vreg-reps drop { int-rep } ;
-M: ##dispatch temp-vreg-reps drop { int-rep } ;
-M: ##slot temp-vreg-reps drop { int-rep } ;
-M: ##set-slot temp-vreg-reps drop { int-rep } ;
-M: ##string-nth temp-vreg-reps drop { int-rep } ;
-M: ##set-string-nth-fast temp-vreg-reps drop { int-rep } ;
-M: ##box-displaced-alien temp-vreg-reps drop { int-rep } ;
-M: ##compare temp-vreg-reps drop { int-rep } ;
-M: ##compare-imm temp-vreg-reps drop { int-rep } ;
-M: ##compare-float temp-vreg-reps drop { int-rep } ;
-M: ##gc temp-vreg-reps drop { int-rep int-rep } ;
-M: _dispatch temp-vreg-reps drop { int-rep } ;
-M: insn temp-vreg-reps drop f ;
+: rep-getter-quot ( rep -- quot )
+ {
+ { f [ [ rep>> ] ] }
+ { scalar-rep [ [ rep>> scalar-rep-of ] ] }
+ [ [ drop ] swap suffix ]
+ } case ;
-M: ##copy uses-vreg-reps rep>> 1array ;
-M: ##unary uses-vreg-reps drop { int-rep } ;
-M: ##unary-float uses-vreg-reps drop { double-float-rep } ;
-M: ##binary uses-vreg-reps drop { int-rep int-rep } ;
-M: ##binary-imm uses-vreg-reps drop { int-rep } ;
-M: ##binary-float uses-vreg-reps drop { double-float-rep double-float-rep } ;
-M: ##effect uses-vreg-reps drop { int-rep } ;
-M: ##slot uses-vreg-reps drop { int-rep int-rep } ;
-M: ##slot-imm uses-vreg-reps drop { int-rep } ;
-M: ##set-slot uses-vreg-reps drop { int-rep int-rep int-rep } ;
-M: ##set-slot-imm uses-vreg-reps drop { int-rep int-rep } ;
-M: ##string-nth uses-vreg-reps drop { int-rep int-rep } ;
-M: ##set-string-nth-fast uses-vreg-reps drop { int-rep int-rep int-rep } ;
-M: ##compare-branch uses-vreg-reps drop { int-rep int-rep } ;
-M: ##compare-imm-branch uses-vreg-reps drop { int-rep } ;
-M: ##compare-float-branch uses-vreg-reps drop { double-float-rep double-float-rep } ;
-M: ##dispatch uses-vreg-reps drop { int-rep } ;
-M: ##alien-getter uses-vreg-reps drop { int-rep } ;
-M: ##alien-setter uses-vreg-reps drop { int-rep int-rep } ;
-M: ##set-alien-float uses-vreg-reps drop { int-rep double-float-rep } ;
-M: ##set-alien-double uses-vreg-reps drop { int-rep double-float-rep } ;
-M: ##fixnum-overflow uses-vreg-reps drop { int-rep int-rep } ;
-M: _compare-imm-branch uses-vreg-reps drop { int-rep } ;
-M: _compare-branch uses-vreg-reps drop { int-rep int-rep } ;
-M: _compare-float-branch uses-vreg-reps drop { double-float-rep double-float-rep } ;
-M: _dispatch uses-vreg-reps drop { int-rep } ;
-M: ##phi uses-vreg-reps drop "##phi must be special-cased" throw ;
-M: insn uses-vreg-reps drop f ;
+: define-defs-vreg-rep-method ( insn -- )
+ [ \ defs-vreg-rep create-method ]
+ [ insn-def-slot [ rep>> rep-getter-quot ] [ [ drop f ] ] if* ]
+ bi define ;
+
+: reps-getter-quot ( reps -- quot )
+ dup [ rep>> { f scalar-rep } memq? not ] all? [
+ [ rep>> ] map [ drop ] swap suffix
+ ] [
+ [ rep>> rep-getter-quot ] map dup length {
+ { 0 [ drop [ drop f ] ] }
+ { 1 [ first [ 1array ] compose ] }
+ { 2 [ first2 '[ _ _ bi 2array ] ] }
+ [ '[ _ cleave _ narray ] ]
+ } case
+ ] if ;
+
+: define-uses-vreg-reps-method ( insn -- )
+ [ \ uses-vreg-reps create-method ]
+ [ insn-use-slots reps-getter-quot ]
+ bi define ;
+
+: define-temp-vreg-reps-method ( insn -- )
+ [ \ temp-vreg-reps create-method ]
+ [ insn-temp-slots reps-getter-quot ]
+ bi define ;
+
+PRIVATE>
+
+[
+ insn-classes get
+ [ [ define-defs-vreg-rep-method ] each ]
+ [ { ##phi } diff [ define-uses-vreg-reps-method ] each ]
+ [ [ define-temp-vreg-reps-method ] each ]
+ tri
+] with-compilation-unit
: each-def-rep ( insn vreg-quot: ( vreg rep -- ) -- )
[ [ defs-vreg ] [ defs-vreg-rep ] bi ] dip with when* ; inline
compiler.cfg.representations.preferred ;
IN: compiler.cfg.representations
-[ { double-float-rep double-float-rep } ] [
+[ { double-rep double-rep } ] [
T{ ##add-float
{ dst 5 }
{ src1 3 }
} uses-vreg-reps
] unit-test
-[ double-float-rep ] [
+[ double-rep ] [
T{ ##alien-double
{ dst 5 }
{ src 3 }
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: kernel fry accessors sequences assocs sets namespaces
-arrays combinators make locals deques dlists
-cpu.architecture compiler.utilities
+arrays combinators combinators.short-circuit math make locals
+deques dlists layouts byte-arrays cpu.architecture
+compiler.utilities
+compiler.constants
compiler.cfg
compiler.cfg.rpo
+compiler.cfg.hats
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.def-use
! Virtual register representation selection.
+ERROR: bad-conversion dst src dst-rep src-rep ;
+
+GENERIC: emit-box ( dst src rep -- )
+GENERIC: emit-unbox ( dst src rep -- )
+
+M:: float-rep emit-box ( dst src rep -- )
+ double-rep next-vreg-rep :> temp
+ temp src ##single>double-float
+ dst temp double-rep emit-box ;
+
+M:: float-rep emit-unbox ( dst src rep -- )
+ double-rep next-vreg-rep :> temp
+ temp src double-rep emit-unbox
+ dst temp ##double>single-float ;
+
+M: double-rep emit-box
+ drop
+ [ drop 16 float int-rep next-vreg-rep ##allot ]
+ [ float-offset swap ##set-alien-double ]
+ 2bi ;
+
+M: double-rep emit-unbox
+ drop float-offset ##alien-double ;
+
+M:: vector-rep emit-box ( dst src rep -- )
+ int-rep next-vreg-rep :> temp
+ dst 16 2 cells + byte-array int-rep next-vreg-rep ##allot
+ temp 16 tag-fixnum ##load-immediate
+ temp dst 1 byte-array tag-number ##set-slot-imm
+ dst byte-array-offset src rep ##set-alien-vector ;
+
+M: vector-rep emit-unbox
+ [ byte-array-offset ] dip ##alien-vector ;
+
+M:: scalar-rep emit-box ( dst src rep -- )
+ int-rep next-vreg-rep :> temp
+ temp src rep ##scalar>integer
+ dst temp tag-bits get ##shl-imm ;
+
+M:: scalar-rep emit-unbox ( dst src rep -- )
+ int-rep next-vreg-rep :> temp
+ temp src tag-bits get ##sar-imm
+ dst temp rep ##integer>scalar ;
+
: emit-conversion ( dst src dst-rep src-rep -- )
- 2array {
- { { int-rep int-rep } [ int-rep ##copy ] }
- { { double-float-rep double-float-rep } [ double-float-rep ##copy ] }
- { { double-float-rep int-rep } [ ##unbox-float ] }
- { { int-rep double-float-rep } [ int-rep next-vreg-rep ##box-float ] }
- } case ;
+ {
+ { [ 2dup eq? ] [ drop ##copy ] }
+ { [ dup int-rep eq? ] [ drop emit-unbox ] }
+ { [ over int-rep eq? ] [ nip emit-box ] }
+ [
+ 2dup 2array {
+ { { double-rep float-rep } [ 2drop ##single>double-float ] }
+ { { float-rep double-rep } [ 2drop ##double>single-float ] }
+ ! Punning SIMD vector types? Naughty naughty! But
+ ! it is allowed... otherwise bail out.
+ [
+ drop 2dup [ reg-class-of ] bi@ eq?
+ [ drop ##copy ] [ bad-conversion ] if
+ ]
+ } case
+ ]
+ } cond ;
<PRIVATE
H{ } clone [
'[
[
- dup ##load-reference? [ drop ] [
- [ _ (compute-always-boxed) ] each-def-rep
- ] if
+ dup [ ##load-reference? ] [ ##load-constant? ] bi or
+ [ drop ] [ [ _ (compute-always-boxed) ] each-def-rep ] if
] each-non-phi
] each-basic-block
] keep ;
! Insert conversions. This introduces new temporaries, so we need
! to rename opearands too.
+! Mapping from vreg,rep pairs to vregs
+SYMBOL: alternatives
+
:: emit-def-conversion ( dst preferred required -- new-dst' )
! If an instruction defines a register with representation 'required',
! but the register has preferred representation 'preferred', then
! but the register has preferred representation 'preferred', then
! we rename the instruction's input to a new register, which
! becomes the output of a conversion instruction.
- required next-vreg-rep [ src required preferred emit-conversion ] keep ;
+ preferred required eq? [ src ] [
+ src required alternatives get [
+ required next-vreg-rep :> new-src
+ [ new-src ] 2dip preferred emit-conversion
+ new-src
+ ] 2cache
+ ] if ;
SYMBOLS: renaming-set needs-renaming? ;
M: ##phi conversions-for-insn
[ , ] [ [ inputs>> values ] [ dst>> ] bi phi-mappings get set-at ] bi ;
+! When a literal zero vector is unboxed, we replace the ##load-reference
+! with a ##zero-vector instruction since this is more efficient.
+: convert-to-zero-vector? ( insn -- ? )
+ {
+ [ dst>> rep-of vector-rep? ]
+ [ obj>> B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } = ]
+ } 1&& ;
+
+: convert-to-zero-vector ( insn -- )
+ dst>> dup rep-of ##zero-vector ;
+
+M: ##load-reference conversions-for-insn
+ dup convert-to-zero-vector?
+ [ convert-to-zero-vector ] [ call-next-method ] if ;
+
+M: ##load-constant conversions-for-insn
+ dup convert-to-zero-vector?
+ [ convert-to-zero-vector ] [ call-next-method ] if ;
+
M: vreg-insn conversions-for-insn
[ compute-renaming-set ] [ perform-renaming ] bi ;
dup kill-block? [ drop ] [
[
[
+ H{ } clone alternatives set
[ conversions-for-insn ] each
] V{ } make
] change-instructions drop
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: accessors compiler.cfg.debugger
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.save-contexts kernel namespaces tools.test ;
+IN: compiler.cfg.save-contexts.tests
+
+0 vreg-counter set-global
+H{ } clone representations set
+
+V{
+ T{ ##unary-float-function f 2 3 "sqrt" }
+ T{ ##branch }
+} 0 test-bb
+
+0 get insert-save-context
+
+[
+ V{
+ T{ ##save-context f 1 2 f }
+ T{ ##unary-float-function f 2 3 "sqrt" }
+ T{ ##branch }
+ }
+] [
+ 0 get instructions>>
+] unit-test
+
+V{
+ T{ ##add f 1 2 3 }
+ T{ ##branch }
+} 0 test-bb
+
+0 get insert-save-context
+
+[
+ V{
+ T{ ##add f 1 2 3 }
+ T{ ##branch }
+ }
+] [
+ 0 get instructions>>
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit
+compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.rpo cpu.architecture kernel sequences vectors ;
+IN: compiler.cfg.save-contexts
+
+! Insert context saves.
+
+: needs-save-context? ( insns -- ? )
+ [
+ {
+ [ ##unary-float-function? ]
+ [ ##binary-float-function? ]
+ [ ##alien-invoke? ]
+ [ ##alien-indirect? ]
+ } 1||
+ ] any? ;
+
+: needs-callback-context? ( insns -- ? )
+ [
+ {
+ [ ##alien-invoke? ]
+ [ ##alien-indirect? ]
+ } 1||
+ ] any? ;
+
+: insert-save-context ( bb -- )
+ dup instructions>> dup needs-save-context? [
+ int-rep next-vreg-rep
+ int-rep next-vreg-rep
+ pick needs-callback-context?
+ \ ##save-context new-insn prefix
+ >>instructions drop
+ ] [ 2drop ] if ;
+
+: insert-save-contexts ( cfg -- cfg' )
+ dup [ insert-save-context ] each-basic-block ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs kernel locals fry
+USING: accessors assocs kernel locals fry sequences
cpu.architecture
compiler.cfg.rpo
+compiler.cfg.def-use
compiler.cfg.utilities
compiler.cfg.registers
compiler.cfg.instructions
! selection, so it must keep track of representations when introducing
! new values.
+: insert-copy? ( bb vreg -- ? )
+ ! If the last instruction defines a value (which means it is
+ ! ##fixnum-add, ##fixnum-sub or ##fixnum-mul) then we don't
+ ! need to insert a copy since in fact doing so will result
+ ! in incorrect code.
+ [ instructions>> last defs-vreg ] dip eq? not ;
+
:: insert-copy ( bb src rep -- bb dst )
- rep next-vreg-rep :> dst
- bb [ dst src rep src rep-of emit-conversion ] add-instructions
- bb dst ;
+ bb src insert-copy? [
+ rep next-vreg-rep :> dst
+ bb [ dst src rep src rep-of emit-conversion ] add-instructions
+ bb dst
+ ] [ bb src ] if ;
: convert-phi ( ##phi -- )
dup dst>> rep-of '[ [ _ insert-copy ] assoc-map ] change-inputs drop ;
compiler.cfg.rpo
compiler.cfg.def-use
compiler.cfg.renaming
+compiler.cfg.registers
compiler.cfg.dominance
compiler.cfg.instructions
compiler.cfg.liveness.ssa
GENERIC: prepare-insn ( insn -- )
+: try-to-coalesce ( dst src -- ) 2array copies get push ;
+
+M: insn prepare-insn
+ [ defs-vreg ] [ uses-vregs ] bi
+ 2dup empty? not and [
+ first
+ 2dup [ rep-of ] bi@ eq?
+ [ try-to-coalesce ] [ 2drop ] if
+ ] [ 2drop ] if ;
+
M: ##copy prepare-insn
- [ dst>> ] [ src>> ] bi 2array copies get push ;
+ [ dst>> ] [ src>> ] bi try-to-coalesce ;
M: ##phi prepare-insn
[ dst>> ] [ inputs>> values ] bi
[ eliminate-copy ] with each ;
-M: insn prepare-insn drop ;
-
: prepare-block ( bb -- )
instructions>> [ prepare-insn ] each ;
SYMBOLS: local-def-indices local-kill-indices ;
-: record-def ( n vreg -- )
+: record-def ( n insn -- )
! We allow multiple defs of a vreg as long as they're
! all in the same basic block
- dup [
+ defs-vreg dup [
local-def-indices get 2dup key?
[ 3drop ] [ set-at ] if
] [ 2drop ] if ;
-: record-uses ( n vregs -- )
- local-kill-indices get '[ _ set-at ] with each ;
+: record-uses ( n insn -- )
+ ! Record live intervals so that all but the first input interfere
+ ! with the output. This lets us coalesce the output with the
+ ! first input.
+ [ uses-vregs ] [ def-is-use-insn? ] bi over empty? [ 3drop ] [
+ [ [ first local-kill-indices get set-at ] [ rest-slice ] 2bi ] unless
+ [ 1 + ] dip [ local-kill-indices get set-at ] with each
+ ] if ;
: visit-insn ( insn n -- )
- ! Instructions are numbered 2 apart. If the instruction requires
- ! that outputs are in different registers than the inputs, then
- ! a use will be registered for every output immediately after
- ! this instruction and before the next one, ensuring that outputs
- ! interfere with inputs.
- 2 *
- [ swap defs-vreg record-def ]
- [ swap uses-vregs record-uses ]
- [ over def-is-use-insn? [ 1 + swap defs-vreg 1array record-uses ] [ 2drop ] if ]
- 2tri ;
+ 2 * swap [ record-def ] [ record-uses ] 2bi ;
SYMBOLS: def-indices kill-indices ;
! Consider the following sequence of instructions:
! ##inc-d 2
-! _gc
+! ##gc
! ##replace ... D 0
! ##replace ... D 1
! The GC check runs before stack locations 0 and 1 have been initialized,
+++ /dev/null
-Converting three-operand instructions into two-operand form
+++ /dev/null
-USING: kernel compiler.cfg.two-operand compiler.cfg.instructions
-compiler.cfg.registers cpu.architecture namespaces tools.test ;
-IN: compiler.cfg.two-operand.tests
-
-3 vreg-counter set-global
-
-[
- V{
- T{ ##copy f 1 2 int-rep }
- T{ ##sub f 1 1 3 }
- }
-] [
- H{
- { 1 int-rep }
- { 2 int-rep }
- { 3 int-rep }
- } clone representations set
- {
- T{ ##sub f 1 2 3 }
- } (convert-two-operand)
-] unit-test
-
-[
- V{
- T{ ##copy f 1 2 double-float-rep }
- T{ ##sub-float f 1 1 3 }
- }
-] [
- H{
- { 1 double-float-rep }
- { 2 double-float-rep }
- { 3 double-float-rep }
- } clone representations set
- {
- T{ ##sub-float f 1 2 3 }
- } (convert-two-operand)
-] unit-test
-
-[
- V{
- T{ ##copy f 1 2 double-float-rep }
- T{ ##mul-float f 1 1 1 }
- }
-] [
- H{
- { 1 double-float-rep }
- { 2 double-float-rep }
- } clone representations set
- {
- T{ ##mul-float f 1 2 2 }
- } (convert-two-operand)
-] unit-test
+++ /dev/null
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sequences make combinators
-compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.rpo cpu.architecture ;
-IN: compiler.cfg.two-operand
-
-! This pass runs before SSA coalescing and normalizes instructions
-! to fit the x86 two-address scheme. Since the input is in SSA,
-! it suffices to convert
-!
-! x = y op z
-!
-! to
-!
-! x = y
-! x = x op z
-!
-! We don't bother with ##add, ##add-imm, ##sub-imm or ##mul-imm
-! since x86 has LEA and IMUL instructions which are effectively
-! three-operand addition and multiplication, respectively.
-
-UNION: two-operand-insn
- ##sub
- ##mul
- ##and
- ##and-imm
- ##or
- ##or-imm
- ##xor
- ##xor-imm
- ##shl
- ##shl-imm
- ##shr
- ##shr-imm
- ##sar
- ##sar-imm
- ##min
- ##max
- ##fixnum-overflow
- ##add-float
- ##sub-float
- ##mul-float
- ##div-float
- ##min-float
- ##max-float ;
-
-GENERIC: convert-two-operand* ( insn -- )
-
-: emit-copy ( dst src -- )
- dup rep-of ##copy ; inline
-
-M: two-operand-insn convert-two-operand*
- [ [ dst>> ] [ src1>> ] bi emit-copy ]
- [
- dup [ src1>> ] [ src2>> ] bi = [ dup dst>> >>src2 ] when
- dup dst>> >>src1 ,
- ] bi ;
-
-M: ##not convert-two-operand*
- [ [ dst>> ] [ src>> ] bi emit-copy ]
- [ dup dst>> >>src , ]
- bi ;
-
-M: insn convert-two-operand* , ;
-
-: (convert-two-operand) ( insns -- insns' )
- dup first kill-vreg-insn? [
- [ [ convert-two-operand* ] each ] V{ } make
- ] unless ;
-
-: convert-two-operand ( cfg -- cfg' )
- two-operand? [ [ (convert-two-operand) ] local-optimization ] when ;
\ No newline at end of file
: delete-conditional? ( bb -- ? )
{
- [ instructions>> last class { ##compare-branch ##compare-imm-branch ##compare-float-branch } memq? ]
+ [
+ instructions>> last class {
+ ##compare-branch
+ ##compare-imm-branch
+ ##compare-float-ordered-branch
+ ##compare-float-unordered-branch
+ } memq?
+ ]
[ successors>> first2 [ skip-empty-blocks ] bi@ eq? ]
} 1&& ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators combinators.short-circuit
cpu.architecture kernel layouts locals make math namespaces sequences
-sets vectors fry compiler.cfg compiler.cfg.instructions
-compiler.cfg.rpo arrays ;
+sets vectors fry arrays compiler.cfg compiler.cfg.instructions
+compiler.cfg.rpo compiler.utilities ;
IN: compiler.cfg.utilities
PREDICATE: kill-block < basic-block
instructions>> {
- [ length 2 = ]
- [ first kill-vreg-insn? ]
+ [ length 2 >= ]
+ [ penultimate kill-vreg-insn? ]
} 1&& ;
: back-edge? ( from to -- ? )
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors classes kernel math namespaces combinators
-combinators.short-circuit compiler.cfg.instructions
+USING: accessors classes classes.algebra classes.parser
+classes.tuple combinators combinators.short-circuit fry
+generic.parser kernel math namespaces quotations sequences slots
+splitting words compiler.cfg.instructions
+compiler.cfg.instructions.syntax
compiler.cfg.value-numbering.graph ;
IN: compiler.cfg.value-numbering.expressions
-! Referentially-transparent expressions
-TUPLE: unary-expr < expr in ;
-TUPLE: binary-expr < expr in1 in2 ;
-TUPLE: commutative-expr < binary-expr ;
-TUPLE: compare-expr < binary-expr cc ;
TUPLE: constant-expr < expr value ;
-TUPLE: reference-expr < expr value ;
-TUPLE: box-displaced-alien-expr < expr displacement base base-class ;
-: <constant> ( constant -- expr )
- f swap constant-expr boa ; inline
+C: <constant> constant-expr
M: constant-expr equal?
over constant-expr? [
- {
- [ [ value>> class ] bi@ = ]
- [ [ value>> ] bi@ = ]
- } 2&&
+ [ value>> ] bi@
+ 2dup [ float? ] both? [ fp-bitwise= ] [
+ { [ [ class ] bi@ = ] [ = ] } 2&&
+ ] if
] [ 2drop f ] if ;
-: <reference> ( constant -- expr )
- f swap reference-expr boa ; inline
+TUPLE: reference-expr < expr value ;
+
+C: <reference> reference-expr
M: reference-expr equal?
- over reference-expr? [
- [ value>> ] bi@ {
- { [ 2dup eq? ] [ 2drop t ] }
- { [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
- [ 2drop f ]
- } cond
- ] [ 2drop f ] if ;
+ over reference-expr? [ [ value>> ] bi@ eq? ] [ 2drop f ] if ;
: constant>vn ( constant -- vn ) <constant> expr>vn ; inline
GENERIC: >expr ( insn -- expr )
+M: insn >expr drop next-input-expr ;
+
M: ##load-immediate >expr val>> <constant> ;
M: ##load-reference >expr obj>> <reference> ;
-M: ##unary >expr
- [ class ] [ src>> vreg>vn ] bi unary-expr boa ;
-
-M: ##binary >expr
- [ class ] [ src1>> vreg>vn ] [ src2>> vreg>vn ] tri
- binary-expr boa ;
-
-M: ##binary-imm >expr
- [ class ] [ src1>> vreg>vn ] [ src2>> constant>vn ] tri
- binary-expr boa ;
-
-M: ##commutative >expr
- [ class ] [ src1>> vreg>vn ] [ src2>> vreg>vn ] tri
- commutative-expr boa ;
+M: ##load-constant >expr obj>> <constant> ;
-M: ##commutative-imm >expr
- [ class ] [ src1>> vreg>vn ] [ src2>> constant>vn ] tri
- commutative-expr boa ;
+<<
-: compare>expr ( insn -- expr )
- {
- [ class ]
- [ src1>> vreg>vn ]
- [ src2>> vreg>vn ]
- [ cc>> ]
- } cleave compare-expr boa ; inline
+: input-values ( slot-specs -- slot-specs' )
+ [ type>> { use literal constant } memq? ] filter ;
-M: ##compare >expr compare>expr ;
+: expr-class ( insn -- expr )
+ name>> "##" ?head drop "-expr" append create-class-in ;
-: compare-imm>expr ( insn -- expr )
- {
- [ class ]
- [ src1>> vreg>vn ]
- [ src2>> constant>vn ]
- [ cc>> ]
- } cleave compare-expr boa ; inline
+: define-expr-class ( insn expr slot-specs -- )
+ [ nip expr ] dip [ name>> ] map define-tuple-class ;
-M: ##compare-imm >expr compare-imm>expr ;
+: >expr-quot ( expr slot-specs -- quot )
+ [
+ [ name>> reader-word 1quotation ]
+ [
+ type>> {
+ { use [ [ vreg>vn ] ] }
+ { literal [ [ ] ] }
+ { constant [ [ constant>vn ] ] }
+ } case
+ ] bi append
+ ] map cleave>quot swap suffix \ boa suffix ;
-M: ##compare-float >expr compare>expr ;
+: define->expr-method ( insn expr slot-specs -- )
+ [ 2drop \ >expr create-method-in ] [ >expr-quot nip ] 3bi define ;
-M: ##box-displaced-alien >expr
- {
- [ class ]
- [ src1>> vreg>vn ]
- [ src2>> vreg>vn ]
- [ base-class>> ]
- } cleave box-displaced-alien-expr boa ;
+: handle-pure-insn ( insn -- )
+ [ ] [ expr-class ] [ "insn-slots" word-prop input-values ] tri
+ [ define-expr-class ] [ define->expr-method ] 3bi ;
-M: ##flushable >expr drop next-input-expr ;
+insn-classes get [ pure-insn class<= ] filter [ handle-pure-insn ] each
-: init-expressions ( -- )
- 0 input-expr-counter set ;
+>>
! biassoc mapping expressions to value numbers
SYMBOL: exprs>vns
-TUPLE: expr op ;
+TUPLE: expr ;
: expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ;
SYMBOL: input-expr-counter
: next-input-expr ( -- expr )
- f input-expr-counter counter input-expr boa ;
+ input-expr-counter counter input-expr boa ;
SYMBOL: vregs>vns
: init-value-graph ( -- )
0 vn-counter set
+ 0 input-expr-counter set
<bihash> exprs>vns set
<bihash> vregs>vns set ;
! See http://factorcode.org/license.txt for BSD license.
USING: accessors combinators combinators.short-circuit arrays
fry kernel layouts math namespaces sequences cpu.architecture
-math.bitwise math.order classes vectors locals make
+math.bitwise math.order math.vectors.simd.intrinsics classes
+vectors locals make alien.c-types io.binary grouping
compiler.cfg
compiler.cfg.registers
compiler.cfg.comparisons
: vreg-small-constant? ( vreg -- ? )
vreg>expr {
[ constant-expr? ]
+ [ value>> fixnum? ]
[ value>> small-enough? ]
} 1&& ;
} 1&&
] [ drop f ] if ; inline
+: general-compare-expr? ( insn -- ? )
+ {
+ [ compare-expr? ]
+ [ compare-imm-expr? ]
+ [ compare-float-unordered-expr? ]
+ [ compare-float-ordered-expr? ]
+ [ test-vector-expr? ]
+ } 1|| ;
+
: rewrite-boolean-comparison? ( insn -- ? )
dup ##branch-t? [
- src1>> vreg>expr compare-expr?
+ src1>> vreg>expr general-compare-expr?
] [ drop f ] if ; inline
: >compare-expr< ( expr -- in1 in2 cc )
- [ in1>> vn>vreg ] [ in2>> vn>vreg ] [ cc>> ] tri ; inline
+ [ src1>> vn>vreg ] [ src2>> vn>vreg ] [ cc>> ] tri ; inline
: >compare-imm-expr< ( expr -- in1 in2 cc )
- [ in1>> vn>vreg ] [ in2>> vn>constant ] [ cc>> ] tri ; inline
+ [ src1>> vn>vreg ] [ src2>> vn>constant ] [ cc>> ] tri ; inline
+
+: >test-vector-expr< ( expr -- src1 temp rep vcc )
+ {
+ [ src1>> vn>vreg ]
+ [ drop next-vreg ]
+ [ rep>> ]
+ [ vcc>> ]
+ } cleave ; inline
: rewrite-boolean-comparison ( expr -- insn )
- src1>> vreg>expr dup op>> {
- { \ ##compare [ >compare-expr< \ ##compare-branch new-insn ] }
- { \ ##compare-imm [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
- { \ ##compare-float [ >compare-expr< \ ##compare-float-branch new-insn ] }
- } case ;
+ src1>> vreg>expr {
+ { [ dup compare-expr? ] [ >compare-expr< \ ##compare-branch new-insn ] }
+ { [ dup compare-imm-expr? ] [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
+ { [ dup compare-float-unordered-expr? ] [ >compare-expr< \ ##compare-float-unordered-branch new-insn ] }
+ { [ dup compare-float-ordered-expr? ] [ >compare-expr< \ ##compare-float-ordered-branch new-insn ] }
+ { [ dup test-vector-expr? ] [ >test-vector-expr< \ ##test-vector-branch new-insn ] }
+ } cond ;
: tag-fixnum-expr? ( expr -- ? )
- dup op>> \ ##shl-imm eq?
- [ in2>> vn>constant tag-bits get = ] [ drop f ] if ;
+ dup shl-imm-expr?
+ [ src2>> vn>constant tag-bits get = ] [ drop f ] if ;
: rewrite-tagged-comparison? ( insn -- ? )
#! Are we comparing two tagged fixnums? Then untag them.
tag-bits get neg shift ; inline
: (rewrite-tagged-comparison) ( insn -- src1 src2 cc )
- [ src1>> vreg>expr in1>> vn>vreg ]
+ [ src1>> vreg>expr src1>> vn>vreg ]
[ src2>> tagged>constant ]
[ cc>> ]
tri ; inline
: rewrite-redundant-comparison? ( insn -- ? )
{
- [ src1>> vreg>expr compare-expr? ]
+ [ src1>> vreg>expr general-compare-expr? ]
[ src2>> \ f tag-number = ]
[ cc>> { cc= cc/= } memq? ]
} 1&& ; inline
: rewrite-redundant-comparison ( insn -- insn' )
- [ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
- { \ ##compare [ >compare-expr< next-vreg \ ##compare new-insn ] }
- { \ ##compare-imm [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
- { \ ##compare-float [ >compare-expr< next-vreg \ ##compare-float new-insn ] }
- } case
+ [ cc>> ] [ dst>> ] [ src1>> vreg>expr ] tri {
+ { [ dup compare-expr? ] [ >compare-expr< next-vreg \ ##compare new-insn ] }
+ { [ dup compare-imm-expr? ] [ >compare-imm-expr< next-vreg \ ##compare-imm new-insn ] }
+ { [ dup compare-float-unordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-unordered new-insn ] }
+ { [ dup compare-float-ordered-expr? ] [ >compare-expr< next-vreg \ ##compare-float-ordered new-insn ] }
+ } cond
swap cc= eq? [ [ negate-cc ] change-cc ] when ;
ERROR: bad-comparison ;
: >boolean-insn ( insn ? -- insn' )
[ dst>> ] dip
{
- { t [ t \ ##load-reference new-insn ] }
+ { t [ t \ ##load-constant new-insn ] }
{ f [ \ f tag-number \ ##load-immediate new-insn ] }
} case ;
[ [ src1>> vreg>constant ] [ src2>> ] [ ] tri constant-fold* ] bi
\ ##load-immediate new-insn ; inline
-: reassociate? ( insn -- ? )
- [ src1>> vreg>expr op>> ] [ class ] bi = ; inline
-
: reassociate ( insn op -- insn )
[
{
[ dst>> ]
- [ src1>> vreg>expr [ in1>> vn>vreg ] [ in2>> vn>constant ] bi ]
+ [ src1>> vreg>expr [ src1>> vn>vreg ] [ src2>> vn>constant ] bi ]
[ src2>> ]
[ ]
} cleave constant-fold*
M: ##add-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
- { [ dup reassociate? ] [ \ ##add-imm reassociate ] }
+ { [ dup src1>> vreg>expr add-imm-expr? ] [ \ ##add-imm reassociate ] }
[ drop f ]
} cond ;
[ sub-imm>add-imm ]
} cond ;
-: strength-reduce-mul ( insn -- insn' )
- [ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi \ ##shl-imm new-insn ;
+: mul-to-neg? ( insn -- ? )
+ src2>> -1 = ;
+
+: mul-to-neg ( insn -- insn' )
+ [ dst>> ] [ src1>> ] bi \ ##neg new-insn ;
-: strength-reduce-mul? ( insn -- ? )
+: mul-to-shl? ( insn -- ? )
src2>> power-of-2? ;
+: mul-to-shl ( insn -- insn' )
+ [ [ dst>> ] [ src1>> ] bi ] [ src2>> log2 ] bi \ ##shl-imm new-insn ;
+
M: ##mul-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
- { [ dup strength-reduce-mul? ] [ strength-reduce-mul ] }
- { [ dup reassociate? ] [ \ ##mul-imm reassociate ] }
+ { [ dup mul-to-neg? ] [ mul-to-neg ] }
+ { [ dup mul-to-shl? ] [ mul-to-shl ] }
+ { [ dup src1>> vreg>expr mul-imm-expr? ] [ \ ##mul-imm reassociate ] }
[ drop f ]
} cond ;
M: ##and-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
- { [ dup reassociate? ] [ \ ##and-imm reassociate ] }
+ { [ dup src1>> vreg>expr and-imm-expr? ] [ \ ##and-imm reassociate ] }
[ drop f ]
} cond ;
M: ##or-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
- { [ dup reassociate? ] [ \ ##or-imm reassociate ] }
+ { [ dup src1>> vreg>expr or-imm-expr? ] [ \ ##or-imm reassociate ] }
[ drop f ]
} cond ;
M: ##xor-imm rewrite
{
{ [ dup constant-fold? ] [ constant-fold ] }
- { [ dup reassociate? ] [ \ ##xor-imm reassociate ] }
+ { [ dup src1>> vreg>expr xor-imm-expr? ] [ \ ##xor-imm reassociate ] }
[ drop f ]
} cond ;
: rewrite-subtraction-identity ( insn -- insn' )
dst>> 0 \ ##load-immediate new-insn ;
+: sub-to-neg? ( ##sub -- ? )
+ src1>> vn>expr expr-zero? ;
+
+: sub-to-neg ( ##sub -- insn )
+ [ dst>> ] [ src2>> ] bi \ ##neg new-insn ;
+
M: ##sub rewrite
{
+ { [ dup sub-to-neg? ] [ sub-to-neg ] }
{ [ dup subtraction-identity? ] [ rewrite-subtraction-identity ] }
[ \ ##sub-imm rewrite-arithmetic ]
} cond ;
M: ##sar rewrite \ ##sar-imm rewrite-arithmetic ;
-: box-displaced-alien? ( expr -- ? )
- op>> \ ##box-displaced-alien eq? ;
-
! ##box-displaced-alien f 1 2 3 <class>
! ##unbox-c-ptr 4 1 <class>
! =>
] { } make ;
M: ##unbox-any-c-ptr rewrite
- dup src>> vreg>expr dup box-displaced-alien?
+ dup src>> vreg>expr dup box-displaced-alien-expr?
[ rewrite-unbox-displaced-alien ] [ 2drop f ] if ;
+
+! More efficient addressing for alien intrinsics
+: rewrite-alien-addressing ( insn -- insn' )
+ dup src>> vreg>expr dup add-imm-expr? [
+ [ src1>> vn>vreg ] [ src2>> vn>constant ] bi
+ [ >>src ] [ '[ _ + ] change-offset ] bi*
+ ] [ 2drop f ] if ;
+
+M: ##alien-unsigned-1 rewrite rewrite-alien-addressing ;
+M: ##alien-unsigned-2 rewrite rewrite-alien-addressing ;
+M: ##alien-unsigned-4 rewrite rewrite-alien-addressing ;
+M: ##alien-signed-1 rewrite rewrite-alien-addressing ;
+M: ##alien-signed-2 rewrite rewrite-alien-addressing ;
+M: ##alien-signed-4 rewrite rewrite-alien-addressing ;
+M: ##alien-float rewrite rewrite-alien-addressing ;
+M: ##alien-double rewrite rewrite-alien-addressing ;
+M: ##alien-vector rewrite rewrite-alien-addressing ;
+M: ##set-alien-integer-1 rewrite rewrite-alien-addressing ;
+M: ##set-alien-integer-2 rewrite rewrite-alien-addressing ;
+M: ##set-alien-integer-4 rewrite rewrite-alien-addressing ;
+M: ##set-alien-float rewrite rewrite-alien-addressing ;
+M: ##set-alien-double rewrite rewrite-alien-addressing ;
+M: ##set-alien-vector rewrite rewrite-alien-addressing ;
+
+! Some lame constant folding for SIMD intrinsics. Eventually this
+! should be redone completely.
+
+: rewrite-shuffle-vector ( insn expr -- insn' )
+ 2dup [ rep>> ] bi@ eq? [
+ [ [ dst>> ] [ src>> vn>vreg ] bi* ]
+ [ [ shuffle>> ] bi@ nths ]
+ [ drop rep>> ]
+ 2tri \ ##shuffle-vector new-insn
+ ] [ 2drop f ] if ;
+
+: (fold-shuffle-vector) ( shuffle bytes -- bytes' )
+ 2dup length swap length /i group nths concat ;
+
+: fold-shuffle-vector ( insn expr -- insn' )
+ [ [ dst>> ] [ shuffle>> ] bi ] dip value>>
+ (fold-shuffle-vector) \ ##load-constant new-insn ;
+
+M: ##shuffle-vector rewrite
+ dup src>> vreg>expr {
+ { [ dup shuffle-vector-expr? ] [ rewrite-shuffle-vector ] }
+ { [ dup reference-expr? ] [ fold-shuffle-vector ] }
+ { [ dup constant-expr? ] [ fold-shuffle-vector ] }
+ [ 2drop f ]
+ } cond ;
+
+: (fold-scalar>vector) ( insn bytes -- insn' )
+ [ [ dst>> ] [ rep>> rep-components ] bi ] dip <repetition> concat
+ \ ##load-constant new-insn ;
+
+: fold-scalar>vector ( insn expr -- insn' )
+ value>> over rep>> {
+ { float-4-rep [ float>bits 4 >le (fold-scalar>vector) ] }
+ { double-2-rep [ double>bits 8 >le (fold-scalar>vector) ] }
+ [ rep-component-type heap-size >le (fold-scalar>vector) ]
+ } case ;
+
+M: ##scalar>vector rewrite
+ dup src>> vreg>expr dup constant-expr?
+ [ fold-scalar>vector ] [ 2drop f ] if ;
+
+M: ##xor-vector rewrite
+ dup [ src1>> vreg>vn ] [ src2>> vreg>vn ] bi eq?
+ [ [ dst>> ] [ rep>> ] bi \ ##zero-vector new-insn ] [ drop f ] if ;
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors combinators classes math layouts
+sequences math.vectors.simd.intrinsics
compiler.cfg.instructions
compiler.cfg.value-numbering.graph
-compiler.cfg.value-numbering.expressions locals ;
+compiler.cfg.value-numbering.expressions ;
IN: compiler.cfg.value-numbering.simplify
! Return value of f means we didn't simplify.
GENERIC: simplify* ( expr -- vn/expr/f )
-: simplify-unbox-alien ( in -- vn/expr/f )
- dup op>> \ ##box-alien eq? [ in>> ] [ drop f ] if ; inline
+M: copy-expr simplify* src>> ;
-M: unary-expr simplify*
- #! Note the copy propagation: a copy always simplifies to
- #! its source VN.
- [ in>> vn>expr ] [ op>> ] bi {
- { \ ##copy [ ] }
- { \ ##unbox-alien [ simplify-unbox-alien ] }
- { \ ##unbox-any-c-ptr [ simplify-unbox-alien ] }
- [ 2drop f ]
- } case ;
+: simplify-unbox-alien ( expr -- vn/expr/f )
+ src>> vn>expr dup box-alien-expr? [ src>> ] [ drop f ] if ;
+
+M: unbox-alien-expr simplify* simplify-unbox-alien ;
+
+M: unbox-any-c-ptr-expr simplify* simplify-unbox-alien ;
+
+: expr-zero? ( expr -- ? ) T{ constant-expr f 0 } = ; inline
+
+: expr-one? ( expr -- ? ) T{ constant-expr f 1 } = ; inline
-: expr-zero? ( expr -- ? ) T{ constant-expr f f 0 } = ; inline
+: expr-neg-one? ( expr -- ? ) T{ constant-expr f -1 } = ; inline
-: expr-one? ( expr -- ? ) T{ constant-expr f f 1 } = ; inline
+: >unary-expr< ( expr -- in ) src>> vn>expr ; inline
+
+M: neg-expr simplify*
+ >unary-expr< {
+ { [ dup neg-expr? ] [ src>> ] }
+ [ drop f ]
+ } cond ;
+
+M: not-expr simplify*
+ >unary-expr< {
+ { [ dup not-expr? ] [ src>> ] }
+ [ drop f ]
+ } cond ;
: >binary-expr< ( expr -- in1 in2 )
- [ in1>> vn>expr ] [ in2>> vn>expr ] bi ; inline
+ [ src1>> vn>expr ] [ src2>> vn>expr ] bi ; inline
: simplify-add ( expr -- vn/expr/f )
>binary-expr< {
[ 2drop f ]
} cond ; inline
+M: add-expr simplify* simplify-add ;
+M: add-imm-expr simplify* simplify-add ;
+
: simplify-sub ( expr -- vn/expr/f )
>binary-expr< {
{ [ dup expr-zero? ] [ drop ] }
[ 2drop f ]
} cond ; inline
+M: sub-expr simplify* simplify-sub ;
+M: sub-imm-expr simplify* simplify-sub ;
+
: simplify-mul ( expr -- vn/expr/f )
>binary-expr< {
{ [ over expr-one? ] [ drop ] }
[ 2drop f ]
} cond ; inline
+M: mul-expr simplify* simplify-mul ;
+M: mul-imm-expr simplify* simplify-mul ;
+
: simplify-and ( expr -- vn/expr/f )
>binary-expr< {
{ [ 2dup eq? ] [ drop ] }
[ 2drop f ]
} cond ; inline
+M: and-expr simplify* simplify-and ;
+M: and-imm-expr simplify* simplify-and ;
+
: simplify-or ( expr -- vn/expr/f )
>binary-expr< {
{ [ 2dup eq? ] [ drop ] }
[ 2drop f ]
} cond ; inline
+M: or-expr simplify* simplify-or ;
+M: or-imm-expr simplify* simplify-or ;
+
: simplify-xor ( expr -- vn/expr/f )
>binary-expr< {
{ [ over expr-zero? ] [ nip ] }
[ 2drop f ]
} cond ; inline
+M: xor-expr simplify* simplify-xor ;
+M: xor-imm-expr simplify* simplify-xor ;
+
: useless-shr? ( in1 in2 -- ? )
- over op>> \ ##shl-imm eq?
- [ [ in2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline
+ over shl-imm-expr?
+ [ [ src2>> ] [ expr>vn ] bi* = ] [ 2drop f ] if ; inline
: simplify-shr ( expr -- vn/expr/f )
>binary-expr< {
- { [ 2dup useless-shr? ] [ drop in1>> ] }
+ { [ 2dup useless-shr? ] [ drop src1>> ] }
{ [ dup expr-zero? ] [ drop ] }
[ 2drop f ]
} cond ; inline
+M: shr-expr simplify* simplify-shr ;
+M: shr-imm-expr simplify* simplify-shr ;
+
: simplify-shl ( expr -- vn/expr/f )
>binary-expr< {
{ [ dup expr-zero? ] [ drop ] }
[ 2drop f ]
} cond ; inline
-M: binary-expr simplify*
- dup op>> {
- { \ ##add [ simplify-add ] }
- { \ ##add-imm [ simplify-add ] }
- { \ ##sub [ simplify-sub ] }
- { \ ##sub-imm [ simplify-sub ] }
- { \ ##mul [ simplify-mul ] }
- { \ ##mul-imm [ simplify-mul ] }
- { \ ##and [ simplify-and ] }
- { \ ##and-imm [ simplify-and ] }
- { \ ##or [ simplify-or ] }
- { \ ##or-imm [ simplify-or ] }
- { \ ##xor [ simplify-xor ] }
- { \ ##xor-imm [ simplify-xor ] }
- { \ ##shr [ simplify-shr ] }
- { \ ##shr-imm [ simplify-shr ] }
- { \ ##sar [ simplify-shr ] }
- { \ ##sar-imm [ simplify-shr ] }
- { \ ##shl [ simplify-shl ] }
- { \ ##shl-imm [ simplify-shl ] }
- [ 2drop f ]
- } case ;
+M: shl-expr simplify* simplify-shl ;
+M: shl-imm-expr simplify* simplify-shl ;
M: box-displaced-alien-expr simplify*
[ base>> ] [ displacement>> ] bi {
[ 2drop f ]
} cond ;
+M: scalar>vector-expr simplify*
+ src>> vn>expr {
+ { [ dup vector>scalar-expr? ] [ src>> ] }
+ [ drop f ]
+ } cond ;
+
+M: shuffle-vector-expr simplify*
+ [ src>> ] [ shuffle>> ] [ rep>> rep-components iota ] tri
+ sequence= [ drop f ] unless ;
+
M: expr simplify* drop f ;
: simplify ( expr -- vn )
dup {
[ ##compare? ]
[ ##compare-imm? ]
- [ ##compare-float? ]
+ [ ##compare-float-unordered? ]
+ [ ##compare-float-ordered? ]
+ [ ##test-vector? ]
+ [ ##test-vector-branch? ]
} 1|| [ f >>temp ] when
] map ;
! Folding constants together
[
{
- T{ ##load-reference f 0 0.0 }
- T{ ##load-reference f 1 -0.0 }
+ T{ ##load-constant f 0 0.0 }
+ T{ ##load-constant f 1 -0.0 }
T{ ##replace f 0 D 0 }
T{ ##replace f 1 D 1 }
}
] [
{
- T{ ##load-reference f 0 0.0 }
- T{ ##load-reference f 1 -0.0 }
+ T{ ##load-constant f 0 0.0 }
+ T{ ##load-constant f 1 -0.0 }
T{ ##replace f 0 D 0 }
T{ ##replace f 1 D 1 }
} value-numbering-step
[
{
- T{ ##load-reference f 0 0.0 }
+ T{ ##load-constant f 0 0.0 }
T{ ##copy f 1 0 any-rep }
T{ ##replace f 0 D 0 }
T{ ##replace f 1 D 1 }
}
] [
{
- T{ ##load-reference f 0 0.0 }
- T{ ##load-reference f 1 0.0 }
+ T{ ##load-constant f 0 0.0 }
+ T{ ##load-constant f 1 0.0 }
T{ ##replace f 0 D 0 }
T{ ##replace f 1 D 1 }
} value-numbering-step
[
{
- T{ ##load-reference f 0 t }
+ T{ ##load-constant f 0 t }
T{ ##copy f 1 0 any-rep }
T{ ##replace f 0 D 0 }
T{ ##replace f 1 D 1 }
}
] [
{
- T{ ##load-reference f 0 t }
- T{ ##load-reference f 1 t }
+ T{ ##load-constant f 0 t }
+ T{ ##load-constant f 1 t }
T{ ##replace f 0 D 0 }
T{ ##replace f 1 D 1 }
} value-numbering-step
T{ ##load-reference f 1 + }
T{ ##peek f 2 D 0 }
T{ ##compare f 4 2 1 cc<= }
- T{ ##compare f 6 2 1 cc> }
+ T{ ##compare f 6 2 1 cc/<= }
T{ ##replace f 6 D 0 }
}
] [
{
T{ ##peek f 8 D 0 }
T{ ##peek f 9 D -1 }
- T{ ##unbox-float f 10 8 }
- T{ ##unbox-float f 11 9 }
- T{ ##compare-float f 12 10 11 cc< }
- T{ ##compare-float f 14 10 11 cc>= }
+ T{ ##compare-float-unordered f 12 8 9 cc< }
+ T{ ##compare-float-unordered f 14 8 9 cc/< }
T{ ##replace f 14 D 0 }
}
] [
{
T{ ##peek f 8 D 0 }
T{ ##peek f 9 D -1 }
- T{ ##unbox-float f 10 8 }
- T{ ##unbox-float f 11 9 }
- T{ ##compare-float f 12 10 11 cc< }
+ T{ ##compare-float-unordered f 12 8 9 cc< }
T{ ##compare-imm f 14 12 5 cc= }
T{ ##replace f 14 D 0 }
} value-numbering-step trim-temps
} value-numbering-step trim-temps
] unit-test
+[
+ {
+ T{ ##peek f 1 D -1 }
+ T{ ##test-vector f 2 1 f float-4-rep vcc-any }
+ T{ ##test-vector-branch f 1 f float-4-rep vcc-any }
+ }
+] [
+ {
+ T{ ##peek f 1 D -1 }
+ T{ ##test-vector f 2 1 f float-4-rep vcc-any }
+ T{ ##compare-imm-branch f 2 5 cc/= }
+ } value-numbering-step trim-temps
+] unit-test
+
! Immediate operand conversion
[
{
} value-numbering-step
] unit-test
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 -1 }
+ T{ ##neg f 2 0 }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 -1 }
+ T{ ##mul f 2 0 1 }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 -1 }
+ T{ ##neg f 2 0 }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 -1 }
+ T{ ##mul f 2 1 0 }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 0 }
+ T{ ##neg f 2 0 }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 0 }
+ T{ ##sub f 2 1 0 }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 0 }
+ T{ ##neg f 2 0 }
+ T{ ##copy f 3 0 any-rep }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-immediate f 1 0 }
+ T{ ##sub f 2 1 0 }
+ T{ ##sub f 3 1 2 }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##not f 1 0 }
+ T{ ##copy f 2 0 any-rep }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##not f 1 0 }
+ T{ ##not f 2 1 }
+ } value-numbering-step
+] unit-test
+
[
{
T{ ##peek f 0 D 0 }
} value-numbering-step trim-temps
] unit-test
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-constant f 1 3.5 }
+ T{ ##compare f 2 0 1 cc= }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-constant f 1 3.5 }
+ T{ ##compare f 2 0 1 cc= }
+ } value-numbering-step trim-temps
+] unit-test
+
[
{
T{ ##peek f 0 D 0 }
} value-numbering-step
] unit-test
+[
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-constant f 1 3.5 }
+ T{ ##compare-branch f 0 1 cc= }
+ }
+] [
+ {
+ T{ ##peek f 0 D 0 }
+ T{ ##load-constant f 1 3.5 }
+ T{ ##compare-branch f 0 1 cc= }
+ } value-numbering-step trim-temps
+] unit-test
+
[
{
T{ ##peek f 0 D 0 }
{
T{ ##load-immediate f 1 1 }
T{ ##load-immediate f 2 2 }
- T{ ##load-reference f 3 t }
+ T{ ##load-constant f 3 t }
}
] [
{
{
T{ ##load-immediate f 1 1 }
T{ ##load-immediate f 2 2 }
- T{ ##load-reference f 3 t }
+ T{ ##load-constant f 3 t }
}
] [
{
[
{
T{ ##peek f 0 D 0 }
- T{ ##load-reference f 1 t }
+ T{ ##load-constant f 1 t }
}
] [
{
[
{
T{ ##peek f 0 D 0 }
- T{ ##load-reference f 1 t }
+ T{ ##load-constant f 1 t }
}
] [
{
[
{
T{ ##peek f 0 D 0 }
- T{ ##load-reference f 1 t }
+ T{ ##load-constant f 1 t }
}
] [
{
} value-numbering-step
] unit-test
+[
+ {
+ T{ ##vector>scalar f 1 0 float-4-rep }
+ T{ ##copy f 2 0 any-rep }
+ }
+] [
+ {
+ T{ ##vector>scalar f 1 0 float-4-rep }
+ T{ ##scalar>vector f 2 1 float-4-rep }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##copy f 1 0 any-rep }
+ }
+] [
+ {
+ T{ ##shuffle-vector f 1 0 { 0 1 2 3 } float-4-rep }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+ T{ ##shuffle-vector f 2 0 { 0 2 3 1 } float-4-rep }
+ }
+] [
+ {
+ T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+ T{ ##shuffle-vector f 2 1 { 3 1 2 0 } float-4-rep }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+ T{ ##shuffle-vector f 2 1 { 1 0 } double-2-rep }
+ }
+] [
+ {
+ T{ ##shuffle-vector f 1 0 { 1 2 3 0 } float-4-rep }
+ T{ ##shuffle-vector f 2 1 { 1 0 } double-2-rep }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##load-constant f 0 1.25 }
+ T{ ##load-constant f 1 B{ 0 0 160 63 0 0 160 63 0 0 160 63 0 0 160 63 } }
+ T{ ##copy f 2 1 any-rep }
+ }
+] [
+ {
+ T{ ##load-constant f 0 1.25 }
+ T{ ##scalar>vector f 1 0 float-4-rep }
+ T{ ##shuffle-vector f 2 1 { 0 0 0 0 } float-4-rep }
+ } value-numbering-step
+] unit-test
+
+[
+ {
+ T{ ##zero-vector f 2 float-4-rep }
+ }
+] [
+ {
+ T{ ##xor-vector f 2 1 1 float-4-rep }
+ } value-numbering-step
+] unit-test
+
: test-branch-folding ( insns -- insns' n )
<basic-block>
[ V{ 0 1 } clone >>successors basic-block set value-numbering-step ] keep
[
{
T{ ##peek f 0 D 0 }
- T{ ##load-reference f 1 t }
+ T{ ##load-constant f 1 t }
T{ ##branch }
}
0
sequences.deep
compiler.cfg
compiler.cfg.rpo
+compiler.cfg.def-use
compiler.cfg.instructions
compiler.cfg.value-numbering.graph
compiler.cfg.value-numbering.expressions
! Local value numbering.
: >copy ( insn -- insn/##copy )
- dup dst>> dup vreg>vn vn>vreg
+ dup defs-vreg dup vreg>vn vn>vreg
2dup eq? [ 2drop ] [ any-rep \ ##copy new-insn nip ] if ;
-: rewrite-loop ( insn -- insn' )
- dup rewrite [ rewrite-loop ] [ ] ?if ;
-
GENERIC: process-instruction ( insn -- insn' )
-M: ##flushable process-instruction
- dup rewrite
- [ process-instruction ]
- [ dup number-values >copy ] ?if ;
-
M: insn process-instruction
dup rewrite
- [ process-instruction ] [ ] ?if ;
+ [ process-instruction ]
+ [ dup defs-vreg [ dup number-values >copy ] when ] ?if ;
M: array process-instruction
[ process-instruction ] map ;
: value-numbering-step ( insns -- insns' )
init-value-graph
- init-expressions
[ process-instruction ] map flatten ;
: value-numbering ( cfg -- cfg' )
! Anticipation of this and set-slot would help too, maybe later
FORWARD-ANALYSIS: slot
-UNION: access ##read ##write ;
+UNION: access ##slot ##slot-imm ##set-slot ##set-slot-imm ;
M: slot-analysis transfer-set
drop [ H{ } assoc-clone-like ] dip
! See http://factorcode.org/license.txt for BSD license.
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
+combinators classes.algebra alien alien.c-types
alien.strings alien.arrays alien.complex alien.libraries sets libc
-continuations.private fry cpu.architecture classes locals
-source-files.errors
+continuations.private fry cpu.architecture classes classes.struct locals
+source-files.errors slots parser generic.parser
compiler.errors
compiler.alien
compiler.constants
: lookup-label ( id -- label )
labels get [ drop <label> ] cache ;
+! Special cases
M: ##no-tco generate-insn drop ;
-M: ##load-immediate generate-insn
- [ dst>> ] [ val>> ] bi %load-immediate ;
-
-M: ##load-reference generate-insn
- [ dst>> ] [ obj>> ] bi %load-reference ;
-
-M: ##peek generate-insn
- [ dst>> ] [ loc>> ] bi %peek ;
-
-M: ##replace generate-insn
- [ src>> ] [ loc>> ] bi %replace ;
-
-M: ##inc-d generate-insn n>> %inc-d ;
-
-M: ##inc-r generate-insn n>> %inc-r ;
-
M: ##call generate-insn
word>> dup sub-primitive>>
[ first % ] [ [ add-call ] [ %call ] bi ] ?if ;
M: ##jump generate-insn word>> [ add-call ] [ %jump ] bi ;
-M: ##return generate-insn drop %return ;
-
-M: _dispatch generate-insn
- [ src>> ] [ temp>> ] bi %dispatch ;
-
M: _dispatch-label generate-insn
label>> lookup-label
cell 0 <repetition> %
rc-absolute-cell label-fixup ;
-: >slot< ( insn -- dst obj slot tag )
- { [ dst>> ] [ obj>> ] [ slot>> ] [ tag>> ] } cleave ; inline
-
-M: ##slot generate-insn
- [ >slot< ] [ temp>> ] bi %slot ;
-
-M: ##slot-imm generate-insn
- >slot< %slot-imm ;
-
-: >set-slot< ( insn -- src obj slot tag )
- { [ src>> ] [ obj>> ] [ slot>> ] [ tag>> ] } cleave ; inline
-
-M: ##set-slot generate-insn
- [ >set-slot< ] [ temp>> ] bi %set-slot ;
-
-M: ##set-slot-imm generate-insn
- >set-slot< %set-slot-imm ;
-
-M: ##string-nth generate-insn
- { [ dst>> ] [ obj>> ] [ index>> ] [ temp>> ] } cleave %string-nth ;
-
-M: ##set-string-nth-fast generate-insn
- { [ src>> ] [ obj>> ] [ index>> ] [ temp>> ] } cleave %set-string-nth-fast ;
-
-: dst/src ( insn -- dst src )
- [ dst>> ] [ src>> ] bi ; inline
-
-: dst/src1/src2 ( insn -- dst src1 src2 )
- [ dst>> ] [ src1>> ] [ src2>> ] tri ; inline
-
-M: ##add generate-insn dst/src1/src2 %add ;
-M: ##add-imm generate-insn dst/src1/src2 %add-imm ;
-M: ##sub generate-insn dst/src1/src2 %sub ;
-M: ##sub-imm generate-insn dst/src1/src2 %sub-imm ;
-M: ##mul generate-insn dst/src1/src2 %mul ;
-M: ##mul-imm generate-insn dst/src1/src2 %mul-imm ;
-M: ##and generate-insn dst/src1/src2 %and ;
-M: ##and-imm generate-insn dst/src1/src2 %and-imm ;
-M: ##or generate-insn dst/src1/src2 %or ;
-M: ##or-imm generate-insn dst/src1/src2 %or-imm ;
-M: ##xor generate-insn dst/src1/src2 %xor ;
-M: ##xor-imm generate-insn dst/src1/src2 %xor-imm ;
-M: ##shl generate-insn dst/src1/src2 %shl ;
-M: ##shl-imm generate-insn dst/src1/src2 %shl-imm ;
-M: ##shr generate-insn dst/src1/src2 %shr ;
-M: ##shr-imm generate-insn dst/src1/src2 %shr-imm ;
-M: ##sar generate-insn dst/src1/src2 %sar ;
-M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ;
-M: ##min generate-insn dst/src1/src2 %min ;
-M: ##max generate-insn dst/src1/src2 %max ;
-M: ##not generate-insn dst/src %not ;
-M: ##log2 generate-insn dst/src %log2 ;
-
-: label/dst/src1/src2 ( insn -- label dst src1 src2 )
- [ label>> lookup-label ] [ dst/src1/src2 ] bi ; inline
-
-M: _fixnum-add generate-insn label/dst/src1/src2 %fixnum-add ;
-M: _fixnum-sub generate-insn label/dst/src1/src2 %fixnum-sub ;
-M: _fixnum-mul generate-insn label/dst/src1/src2 %fixnum-mul ;
-
-: dst/src/temp ( insn -- dst src temp )
- [ dst/src ] [ temp>> ] bi ; inline
-
-M: ##integer>bignum generate-insn dst/src/temp %integer>bignum ;
-M: ##bignum>integer generate-insn dst/src/temp %bignum>integer ;
-
-M: ##add-float generate-insn dst/src1/src2 %add-float ;
-M: ##sub-float generate-insn dst/src1/src2 %sub-float ;
-M: ##mul-float generate-insn dst/src1/src2 %mul-float ;
-M: ##div-float generate-insn dst/src1/src2 %div-float ;
-M: ##min-float generate-insn dst/src1/src2 %min-float ;
-M: ##max-float generate-insn dst/src1/src2 %max-float ;
-
-M: ##sqrt generate-insn dst/src %sqrt ;
-
-M: ##integer>float generate-insn dst/src %integer>float ;
-M: ##float>integer generate-insn dst/src %float>integer ;
-
-M: ##copy generate-insn [ dst/src ] [ rep>> ] bi %copy ;
-
-M: ##unbox-float generate-insn dst/src %unbox-float ;
-M: ##unbox-any-c-ptr generate-insn dst/src/temp %unbox-any-c-ptr ;
-M: ##box-float generate-insn dst/src/temp %box-float ;
-M: ##box-alien generate-insn dst/src/temp %box-alien ;
-
-M: ##box-displaced-alien generate-insn
- [ dst/src1/src2 ] [ temp>> ] bi %box-displaced-alien ;
-
-M: ##alien-unsigned-1 generate-insn dst/src %alien-unsigned-1 ;
-M: ##alien-unsigned-2 generate-insn dst/src %alien-unsigned-2 ;
-M: ##alien-unsigned-4 generate-insn dst/src %alien-unsigned-4 ;
-M: ##alien-signed-1 generate-insn dst/src %alien-signed-1 ;
-M: ##alien-signed-2 generate-insn dst/src %alien-signed-2 ;
-M: ##alien-signed-4 generate-insn dst/src %alien-signed-4 ;
-M: ##alien-cell generate-insn dst/src %alien-cell ;
-M: ##alien-float generate-insn dst/src %alien-float ;
-M: ##alien-double generate-insn dst/src %alien-double ;
-
-: >alien-setter< ( insn -- src value )
- [ src>> ] [ value>> ] bi ; inline
-
-M: ##set-alien-integer-1 generate-insn >alien-setter< %set-alien-integer-1 ;
-M: ##set-alien-integer-2 generate-insn >alien-setter< %set-alien-integer-2 ;
-M: ##set-alien-integer-4 generate-insn >alien-setter< %set-alien-integer-4 ;
-M: ##set-alien-cell generate-insn >alien-setter< %set-alien-cell ;
-M: ##set-alien-float generate-insn >alien-setter< %set-alien-float ;
-M: ##set-alien-double generate-insn >alien-setter< %set-alien-double ;
-
-M: ##allot generate-insn
- {
- [ dst>> ]
- [ size>> ]
- [ class>> ]
- [ temp>> ]
- } cleave
- %allot ;
+M: _prologue generate-insn
+ stack-frame>> [ stack-frame set ] [ total-size>> %prologue ] bi ;
-M: ##write-barrier generate-insn
- [ src>> ]
- [ card#>> ]
- [ table>> ]
- tri %write-barrier ;
+M: _epilogue generate-insn
+ stack-frame>> total-size>> %epilogue ;
-! GC checks
+M: _spill-area-size generate-insn drop ;
+
+! Some meta-programming to generate simple code generators, where
+! the instruction is unpacked and then a %word is called
+<<
+
+: insn-slot-quot ( spec -- quot )
+ name>> [ reader-word ] [ "label" = ] bi
+ [ \ lookup-label [ ] 2sequence ] [ [ ] 1sequence ] if ;
+
+: codegen-method-body ( class word -- quot )
+ [
+ "insn-slots" word-prop
+ [ insn-slot-quot ] map cleave>quot
+ ] dip suffix ;
+
+SYNTAX: CODEGEN:
+ scan-word [ \ generate-insn create-method-in ] keep scan-word
+ codegen-method-body define ;
+>>
+
+CODEGEN: ##load-immediate %load-immediate
+CODEGEN: ##load-reference %load-reference
+CODEGEN: ##load-constant %load-reference
+CODEGEN: ##peek %peek
+CODEGEN: ##replace %replace
+CODEGEN: ##inc-d %inc-d
+CODEGEN: ##inc-r %inc-r
+CODEGEN: ##return %return
+CODEGEN: ##slot %slot
+CODEGEN: ##slot-imm %slot-imm
+CODEGEN: ##set-slot %set-slot
+CODEGEN: ##set-slot-imm %set-slot-imm
+CODEGEN: ##string-nth %string-nth
+CODEGEN: ##set-string-nth-fast %set-string-nth-fast
+CODEGEN: ##add %add
+CODEGEN: ##add-imm %add-imm
+CODEGEN: ##sub %sub
+CODEGEN: ##sub-imm %sub-imm
+CODEGEN: ##mul %mul
+CODEGEN: ##mul-imm %mul-imm
+CODEGEN: ##and %and
+CODEGEN: ##and-imm %and-imm
+CODEGEN: ##or %or
+CODEGEN: ##or-imm %or-imm
+CODEGEN: ##xor %xor
+CODEGEN: ##xor-imm %xor-imm
+CODEGEN: ##shl %shl
+CODEGEN: ##shl-imm %shl-imm
+CODEGEN: ##shr %shr
+CODEGEN: ##shr-imm %shr-imm
+CODEGEN: ##sar %sar
+CODEGEN: ##sar-imm %sar-imm
+CODEGEN: ##min %min
+CODEGEN: ##max %max
+CODEGEN: ##not %not
+CODEGEN: ##neg %neg
+CODEGEN: ##log2 %log2
+CODEGEN: ##copy %copy
+CODEGEN: ##add-float %add-float
+CODEGEN: ##sub-float %sub-float
+CODEGEN: ##mul-float %mul-float
+CODEGEN: ##div-float %div-float
+CODEGEN: ##min-float %min-float
+CODEGEN: ##max-float %max-float
+CODEGEN: ##sqrt %sqrt
+CODEGEN: ##unary-float-function %unary-float-function
+CODEGEN: ##binary-float-function %binary-float-function
+CODEGEN: ##single>double-float %single>double-float
+CODEGEN: ##double>single-float %double>single-float
+CODEGEN: ##integer>float %integer>float
+CODEGEN: ##float>integer %float>integer
+CODEGEN: ##zero-vector %zero-vector
+CODEGEN: ##gather-vector-2 %gather-vector-2
+CODEGEN: ##gather-vector-4 %gather-vector-4
+CODEGEN: ##shuffle-vector %shuffle-vector
+CODEGEN: ##merge-vector-head %merge-vector-head
+CODEGEN: ##merge-vector-tail %merge-vector-tail
+CODEGEN: ##compare-vector %compare-vector
+CODEGEN: ##test-vector %test-vector
+CODEGEN: ##add-vector %add-vector
+CODEGEN: ##saturated-add-vector %saturated-add-vector
+CODEGEN: ##add-sub-vector %add-sub-vector
+CODEGEN: ##sub-vector %sub-vector
+CODEGEN: ##saturated-sub-vector %saturated-sub-vector
+CODEGEN: ##mul-vector %mul-vector
+CODEGEN: ##saturated-mul-vector %saturated-mul-vector
+CODEGEN: ##div-vector %div-vector
+CODEGEN: ##min-vector %min-vector
+CODEGEN: ##max-vector %max-vector
+CODEGEN: ##dot-vector %dot-vector
+CODEGEN: ##sqrt-vector %sqrt-vector
+CODEGEN: ##horizontal-add-vector %horizontal-add-vector
+CODEGEN: ##horizontal-sub-vector %horizontal-sub-vector
+CODEGEN: ##horizontal-shl-vector %horizontal-shl-vector
+CODEGEN: ##horizontal-shr-vector %horizontal-shr-vector
+CODEGEN: ##abs-vector %abs-vector
+CODEGEN: ##and-vector %and-vector
+CODEGEN: ##andn-vector %andn-vector
+CODEGEN: ##or-vector %or-vector
+CODEGEN: ##xor-vector %xor-vector
+CODEGEN: ##not-vector %not-vector
+CODEGEN: ##shl-vector %shl-vector
+CODEGEN: ##shr-vector %shr-vector
+CODEGEN: ##integer>scalar %integer>scalar
+CODEGEN: ##scalar>integer %scalar>integer
+CODEGEN: ##vector>scalar %vector>scalar
+CODEGEN: ##scalar>vector %scalar>vector
+CODEGEN: ##box-alien %box-alien
+CODEGEN: ##box-displaced-alien %box-displaced-alien
+CODEGEN: ##unbox-alien %unbox-alien
+CODEGEN: ##unbox-any-c-ptr %unbox-any-c-ptr
+CODEGEN: ##alien-unsigned-1 %alien-unsigned-1
+CODEGEN: ##alien-unsigned-2 %alien-unsigned-2
+CODEGEN: ##alien-unsigned-4 %alien-unsigned-4
+CODEGEN: ##alien-signed-1 %alien-signed-1
+CODEGEN: ##alien-signed-2 %alien-signed-2
+CODEGEN: ##alien-signed-4 %alien-signed-4
+CODEGEN: ##alien-cell %alien-cell
+CODEGEN: ##alien-float %alien-float
+CODEGEN: ##alien-double %alien-double
+CODEGEN: ##alien-vector %alien-vector
+CODEGEN: ##set-alien-integer-1 %set-alien-integer-1
+CODEGEN: ##set-alien-integer-2 %set-alien-integer-2
+CODEGEN: ##set-alien-integer-4 %set-alien-integer-4
+CODEGEN: ##set-alien-cell %set-alien-cell
+CODEGEN: ##set-alien-float %set-alien-float
+CODEGEN: ##set-alien-double %set-alien-double
+CODEGEN: ##set-alien-vector %set-alien-vector
+CODEGEN: ##allot %allot
+CODEGEN: ##write-barrier %write-barrier
+CODEGEN: ##compare %compare
+CODEGEN: ##compare-imm %compare-imm
+CODEGEN: ##compare-float-ordered %compare-float-ordered
+CODEGEN: ##compare-float-unordered %compare-float-unordered
+CODEGEN: ##save-context %save-context
+CODEGEN: ##vm-field-ptr %vm-field-ptr
+
+CODEGEN: _fixnum-add %fixnum-add
+CODEGEN: _fixnum-sub %fixnum-sub
+CODEGEN: _fixnum-mul %fixnum-mul
+CODEGEN: _label resolve-label
+CODEGEN: _branch %jump-label
+CODEGEN: _compare-branch %compare-branch
+CODEGEN: _compare-imm-branch %compare-imm-branch
+CODEGEN: _compare-float-ordered-branch %compare-float-ordered-branch
+CODEGEN: _compare-float-unordered-branch %compare-float-unordered-branch
+CODEGEN: _test-vector-branch %test-vector-branch
+CODEGEN: _dispatch %dispatch
+CODEGEN: _spill %spill
+CODEGEN: _reload %reload
+
+! ##gc
: wipe-locs ( locs temp -- )
'[
_
GENERIC# save-gc-root 1 ( gc-root operand temp -- )
M:: spill-slot save-gc-root ( gc-root operand temp -- )
- temp operand n>> int-rep %reload
+ temp int-rep operand %reload
gc-root temp %save-gc-root ;
M: object save-gc-root drop %save-gc-root ;
M:: spill-slot load-gc-root ( gc-root operand temp -- )
gc-root temp %load-gc-root
- temp operand n>> int-rep %spill ;
+ temp int-rep operand %spill ;
M: object load-gc-root drop %load-gc-root ;
: load-data-regs ( data-regs -- ) [ first3 %reload ] each ;
-M: _gc generate-insn
+M: ##gc generate-insn
"no-gc" define-label
{
- [ [ "no-gc" get ] dip [ temp1>> ] [ temp2>> ] bi %check-nursery ]
+ [ [ "no-gc" get ] dip [ size>> ] [ temp1>> ] [ temp2>> ] tri %check-nursery ]
[ [ uninitialized-locs>> ] [ temp1>> ] bi wipe-locs ]
[ data-values>> save-data-regs ]
[ [ tagged-values>> ] [ temp1>> ] bi save-gc-roots ]
- [ tagged-values>> length %call-gc ]
+ [ [ temp1>> ] [ temp2>> ] bi t %save-context ]
+ [ [ tagged-values>> length ] [ temp1>> ] bi %call-gc ]
[ [ tagged-values>> ] [ temp1>> ] bi load-gc-roots ]
[ data-values>> load-data-regs ]
} cleave
M: int-rep next-fastcall-param
int-regs inc [ ?dummy-stack-params ] [ ?dummy-fp-params ] bi ;
-M: single-float-rep next-fastcall-param
+M: float-rep next-fastcall-param
float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
-M: double-float-rep next-fastcall-param
+M: double-rep next-fastcall-param
float-regs inc [ ?dummy-stack-params ] [ ?dummy-int-params ] bi ;
GENERIC: reg-class-full? ( reg-class -- ? )
M: object flatten-value-type 1array ;
-M: struct-type flatten-value-type ( type -- types )
+M: struct-c-type flatten-value-type ( type -- types )
stack-size cell align (flatten-int-type) ;
M: long-long-type flatten-value-type ( type -- types )
M: ##alien-invoke generate-insn
params>>
- ! Save registers for GC
- %prepare-alien-invoke
! Unbox parameters
dup objects>registers
%prepare-var-args
! ##alien-indirect
M: ##alien-indirect generate-insn
params>>
- ! Save registers for GC
- %prepare-alien-invoke
! Save alien at top of stack to temporary storage
%prepare-alien-indirect
! Unbox parameters
! Generate code for boxing input parameters in a callback.
[
dup \ %save-param-reg move-parameters
- "nest_stacks" f %alien-invoke
+ %nest-stacks
box-parameters
] with-param-regs ;
: callback-return-quot ( ctype -- quot )
return>> {
- { [ dup "void" = ] [ drop [ ] ] }
+ { [ dup void? ] [ drop [ ] ] }
{ [ dup large-struct? ] [ heap-size '[ _ memcpy ] ] }
[ c-type c-type-unboxer-quot ]
} cond ;
[ callback-context new do-callback ] %
] [ ] make ;
-: %unnest-stacks ( -- ) "unnest_stacks" f %alien-invoke ;
-
M: ##callback-return generate-insn
#! All the extra book-keeping for %unwind is only for x86.
#! On other platforms its an alias for %return.
[ wrap-callback-quot %alien-callback ]
[ alien-return [ %unnest-stacks ] [ %callback-value ] if-void ]
tri ;
-
-M: _prologue generate-insn
- stack-frame>> [ stack-frame set ] [ total-size>> %prologue ] bi ;
-
-M: _epilogue generate-insn
- stack-frame>> total-size>> %epilogue ;
-
-M: _label generate-insn
- id>> lookup-label resolve-label ;
-
-M: _branch generate-insn
- label>> lookup-label %jump-label ;
-
-: >compare< ( insn -- dst temp cc src1 src2 )
- {
- [ dst>> ]
- [ temp>> ]
- [ cc>> ]
- [ src1>> ]
- [ src2>> ]
- } cleave ; inline
-
-M: ##compare generate-insn >compare< %compare ;
-M: ##compare-imm generate-insn >compare< %compare-imm ;
-M: ##compare-float generate-insn >compare< %compare-float ;
-
-: >binary-branch< ( insn -- label cc src1 src2 )
- {
- [ label>> lookup-label ]
- [ cc>> ]
- [ src1>> ]
- [ src2>> ]
- } cleave ; inline
-
-M: _compare-branch generate-insn
- >binary-branch< %compare-branch ;
-
-M: _compare-imm-branch generate-insn
- >binary-branch< %compare-imm-branch ;
-
-M: _compare-float-branch generate-insn
- >binary-branch< %compare-float-branch ;
-
-M: _spill generate-insn
- [ src>> ] [ n>> ] [ rep>> ] tri %spill ;
-
-M: _reload generate-insn
- [ dst>> ] [ n>> ] [ rep>> ] tri %reload ;
-
-M: _spill-area-size generate-insn drop ;
ARTICLE: "compiler-usage" "Calling the optimizing compiler"
"Normally, new word definitions are recompiled automatically. This can be changed:"
-{ $subsection disable-optimizer }
-{ $subsection enable-optimizer }
+{ $subsections
+ disable-optimizer
+ enable-optimizer
+}
"Removing a word's optimized definition:"
-{ $subsection decompile }
+{ $subsections decompile }
"Compiling a single quotation:"
-{ $subsection compile-call }
+{ $subsections compile-call }
"Higher-level words can be found in " { $link "compilation-units" } "." ;
ARTICLE: "compiler-impl" "Compiler implementation"
"The " { $vocab-link "compiler" } "vocabulary, in addition to providing the user-visible words of the compiler, implements the main compilation loop."
$nl
"Words are added to the " { $link compile-queue } " variable as needed and compiled."
-{ $subsection compile-queue }
+{ $subsections compile-queue }
"Once compiled, a word is added to the assoc stored in the " { $link compiled } " variable. When compilation is complete, this assoc is passed to " { $link modify-code-heap } "."
$nl
"The " { $link compile-word } " word performs the actual task of compiling an individual word. The process proceeds as follows:"
"The optimizing compiler also trades off compile time for performance of generated code, so loading certain vocabularies might take a while. Saving the image after loading vocabularies can save you a lot of time that you would spend waiting for the same code to load in every coding session; see " { $link "images" } " for information."
$nl
"Most code you write will run with the optimizing compiler. Sometimes, the non-optimizing compiler is used, for example for listener interactions, or for running the quotation passed to " { $link POSTPONE: call( } "."
-{ $subsection "compiler-errors" }
-{ $subsection "hints" }
-{ $subsection "compiler-usage" }
-{ $subsection "compiler-impl" } ;
+{ $subsections
+ "compiler-errors"
+ "hints"
+ "compiler-usage"
+ "compiler-impl"
+} ;
ABOUT: "compiler"
dup recompile-callers?
[ compiled-usage keys [ queue-compile ] each ] [ drop ] if ;
+: compiler-message ( string -- )
+ "trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ;
+
: start ( word -- )
- "trace-compilation" get [ dup name>> print flush ] when
+ dup name>> compiler-message
H{ } clone dependencies set
H{ } clone generic-dependencies set
clear-compiler-error ;
compile-queue get compile-loop
compiled get >alist
] with-scope
- "trace-compilation" get [ "--- compile done" print flush ] when ;
+ "--- compile done" compiler-message ;
: with-optimizer ( quot -- )
[ optimizing-compiler compiler-impl ] dip with-variable ; inline
CONSTANT: rt-stack-chain 9
CONSTANT: rt-untagged 10
CONSTANT: rt-megamorphic-cache-hits 11
+CONSTANT: rt-vm 12
: rc-absolute? ( n -- ? )
${ rc-absolute-ppc-2/2 rc-absolute-cell rc-absolute } member? ;
compiler continuations effects io io.backend io.pathnames
io.streams.string kernel math memory namespaces
namespaces.private parser quotations sequences
-specialized-arrays.float stack-checker stack-checker.errors
-system threads tools.test words specialized-arrays.char ;
+specialized-arrays stack-checker stack-checker.errors
+system threads tools.test words alien.complex ;
+FROM: alien.c-types => float short ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: char
IN: compiler.tests.alien
<<
123 >>parents
ffi_test_48
] unit-test
+
+! Regression: calling an undefined function would raise a protection fault
+FUNCTION: void this_does_not_exist ( ) ;
+
+[ this_does_not_exist ] [ { "kernel-error" 10 f f } = ] must-fail-with
-USING: generalizations accessors arrays compiler kernel kernel.private
-math hashtables.private math.private namespaces sequences tools.test
-namespaces.private slots.private sequences.private byte-arrays alien
-alien.accessors layouts words definitions compiler.units io
-combinators vectors grouping make alien.c-types combinators.short-circuit
-math.order ;
+USING: generalizations accessors arrays compiler kernel
+kernel.private math hashtables.private math.private namespaces
+sequences tools.test namespaces.private slots.private
+sequences.private byte-arrays alien alien.accessors layouts
+words definitions compiler.units io combinators vectors grouping
+make alien.c-types combinators.short-circuit math.order
+math.libm math.parser math.functions alien.syntax ;
+FROM: math => float ;
QUALIFIED: namespaces.private
IN: compiler.tests.codegen
: missing-gc-check-1 ( a -- b ) { fixnum } declare <alien> ;
: missing-gc-check-2 ( -- ) 10000000 [ missing-gc-check-1 drop ] each-integer ;
-[ ] [ missing-gc-check-2 ] unit-test
\ No newline at end of file
+[ ] [ missing-gc-check-2 ] unit-test
+
+[ 1 "0.169967142900241" ] [ 1.4 [ 1 swap fcos ] compile-call number>string ] unit-test
+[ 1 "0.169967142900241" ] [ 1.4 1 [ swap fcos ] compile-call number>string ] unit-test
+[ "0.169967142900241" "0.9854497299884601" ] [ 1.4 [ [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
+[ 1 "0.169967142900241" "0.9854497299884601" ] [ 1.4 1 [ swap >float [ fcos ] [ fsin ] bi ] compile-call [ number>string ] bi@ ] unit-test
+
+[ 6.0 ] [ 1.0 [ >float 3.0 + [ B{ 0 0 0 0 } 0 set-alien-float ] [ 2.0 + ] bi ] compile-call ] unit-test
+
+! Bug in linearization
+[ 283686952174081 ] [
+ B{ 1 1 1 1 } [
+ { byte-array } declare
+ [ 0 2 ] dip
+ [
+ [ drop ] 2dip
+ [
+ swap 1 < [ [ ] dip ] [ [ ] dip ] if
+ 0 alien-signed-4
+ ] curry dup bi *
+ ] curry each-integer
+ ] compile-call
+] unit-test
+
+! Bug in CSSA construction
+TUPLE: myseq { underlying1 byte-array read-only } { underlying2 byte-array read-only } ;
+
+[ 2 ] [
+ little-endian?
+ T{ myseq f B{ 1 0 0 0 } B{ 1 0 0 0 } }
+ T{ myseq f B{ 0 0 0 1 } B{ 0 0 0 1 } } ?
+ [
+ { myseq } declare
+ [ 0 2 ] dip dup
+ [
+ [
+ over 1 < [ underlying1>> ] [ [ 1 - ] dip underlying2>> ] if
+ swap 4 * >fixnum alien-signed-4
+ ] bi-curry@ bi * +
+ ] 2curry each-integer
+ ] compile-call
+] unit-test
+
+! Bug in linear scan's partial sync point logic
+[ t ] [
+ [ 1.0 100 [ fsin ] times 1.0 float+ ] compile-call
+ 1.168852488727981 1.e-9 ~
+] unit-test
+
+[ 65537.0 ] [
+ [ 2.0 4 [ 2.0 fpow ] times 1.0 float+ ] compile-call
+] unit-test
+
+! ##box-displaced-alien is a def-is-use instruction
+[ ALIEN: 3e9 ] [
+ [
+ f
+ 100 [ 10 swap <displaced-alien> ] times
+ 1 swap <displaced-alien>
+ ] compile-call
+] unit-test
+
+! Forgot to two-operand shifts
+[ 2 0 ] [
+ 1 1
+ [ [ HEX: f bitand ] bi@ [ shift ] [ drop -3 shift ] 2bi ] compile-call
+] unit-test
\ No newline at end of file
[ 17.5 ] [ 17.5 -11.3 [ float-max ] compile-call ] unit-test
[ -11.3 ] [ -11.3 17.5 [ float-min ] compile-call ] unit-test
[ -11.3 ] [ 17.5 -11.3 [ float-min ] compile-call ] unit-test
+
+[ t ] [ 0/0. 0/0. [ float-unordered? ] compile-call ] unit-test
+[ t ] [ 0/0. 1.0 [ float-unordered? ] compile-call ] unit-test
+[ t ] [ 1.0 0/0. [ float-unordered? ] compile-call ] unit-test
+[ f ] [ 3.0 1.0 [ float-unordered? ] compile-call ] unit-test
+[ f ] [ 1.0 3.0 [ float-unordered? ] compile-call ] unit-test
+
+[ 1 ] [ 0/0. 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+[ 1 ] [ 0/0. 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+[ 1 ] [ 1.0 0/0. [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+[ 2 ] [ 3.0 1.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
+[ 2 ] [ 1.0 3.0 [ float-unordered? [ 1 ] [ 2 ] if ] compile-call ] unit-test
-USING: eval tools.test compiler.units vocabs multiline words
+USING: eval tools.test compiler.units vocabs words
kernel classes.mixin arrays ;
IN: compiler.tests.folding
[ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: math arrays ;
+ "USING: math arrays ;
IN: compiler.tests.folding
GENERIC: foldable-generic ( a -- b ) foldable
- M: integer foldable-generic f <array> ;
- "> eval( -- )
+ M: integer foldable-generic f <array> ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USING: math arrays ;
+ "USING: math arrays ;
IN: compiler.tests.folding
- : fold-test ( -- x ) 10 foldable-generic ;
- "> eval( -- )
+ : fold-test ( -- x ) 10 foldable-generic ;"
+ eval( -- )
] unit-test
[ t ] [
strings tools.test words continuations sequences.private
hashtables.private byte-arrays system random layouts vectors
sbufs strings.private slots.private alien math.order
-alien.accessors alien.c-types alien.syntax alien.strings
+alien.accessors alien.c-types alien.data alien.syntax alien.strings
namespaces libc io.encodings.ascii classes compiler ;
+FROM: math => float ;
IN: compiler.tests.intrinsics
! Make sure that intrinsic ops compile to correct code.
] unit-test
[ ALIEN: 123 ] [
- 123 [ <alien> ] compile-call
+
HEX: 123 [ <alien> ] compile-call
] unit-test
[ ALIEN: 123 ] [
- 123 [ { fixnum } declare <alien> ] compile-call
+
HEX: 123 [ { fixnum } declare <alien> ] compile-call
] unit-test
[ ALIEN: 123 ] [
- [ 123 <alien> ] compile-call
+ [
HEX: 123 <alien> ] compile-call
] unit-test
[ f ] [
underlying>>
] unit-test
+[ ALIEN: 1234 ALIEN: 2234 ] [
+ ALIEN: 234 [
+ { c-ptr } declare
+ [ HEX: 1000 swap <displaced-alien> ]
+ [ HEX: 2000 swap <displaced-alien> ] bi
+ ] compile-call
+] unit-test
+
[
B{ 0 0 0 0 } [ { byte-array } declare <void*> ] compile-call
] must-fail
compile-cfg ;
: compile-test-bb ( insns -- result )
- V{ T{ ##prologue } T{ ##branch } } 0 test-bb
+ V{ T{ ##prologue } T{ ##branch } } [ clone ] map 0 test-bb
V{
T{ ##inc-d f 1 }
T{ ##replace f 0 D 0 }
} compile-test-bb
] unit-test
-! ##copy on floats. We can only run this test if float intrinsics
-! are enabled.
-\ float+ "intrinsic" word-prop [
- [ 1.5 ] [
- V{
- T{ ##load-reference f 4 1.5 }
- T{ ##unbox-float f 1 4 }
- T{ ##copy f 2 1 double-float-rep }
- T{ ##box-float f 3 2 }
- T{ ##copy f 0 3 int-rep }
- } compile-test-bb
- ] unit-test
-] when
-
! make sure slot access works when the destination is
! one of the sources
[ t ] [
V{
- T{ ##load-immediate f 1 $[ 2 cell log2 shift ] }
+ T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
T{ ##load-reference f 0 { t f t } }
- T{ ##slot f 0 0 1 $[ array tag-number ] 2 }
+ T{ ##slot f 0 0 1 }
} compile-test-bb
] unit-test
[ t ] [
V{
T{ ##load-reference f 0 { t f t } }
- T{ ##slot-imm f 0 0 2 $[ array tag-number ] 2 }
+ T{ ##slot-imm f 0 0 2 $[ array tag-number ] }
} compile-test-bb
] unit-test
[ t ] [
V{
- T{ ##load-immediate f 1 $[ 2 cell log2 shift ] }
+ T{ ##load-immediate f 1 $[ 2 cell log2 shift array tag-number - ] }
T{ ##load-reference f 0 { t f t } }
- T{ ##set-slot f 0 0 1 $[ array tag-number ] 2 }
+ T{ ##set-slot f 0 0 1 }
} compile-test-bb
dup first eq?
] unit-test
T{ ##add-imm f 0 0 -8 }
} compile-test-bb
] unit-test
-
-! These are def-is-use-insns
-USE: multiline
-
-/*
-
-[ 100 ] [
- V{
- T{ ##load-immediate f 0 100 }
- T{ ##integer>bignum f 0 0 1 }
- } compile-test-bb
-] unit-test
-
-[ 1 ] [
- V{
- T{ ##load-reference f 0 ALIEN: 8 }
- T{ ##unbox-any-c-ptr f 0 0 1 }
- } compile-test-bb
-] unit-test
-
-*/
[ t ] [ \ <tuple>-regression optimized? ] unit-test
-GENERIC: foozul ( a -- b )
-M: reversed foozul ;
-M: integer foozul ;
-M: slice foozul ;
-
-[ t ] [
- reversed \ foozul specific-method
- reversed \ foozul method
- eq?
-] unit-test
-
! regression
: constant-fold-2 ( -- value ) f ; foldable
: constant-fold-3 ( -- value ) 4 ; foldable
-USING: eval tools.test compiler.units vocabs multiline words
-kernel ;
+USING: eval tools.test compiler.units vocabs words kernel ;
IN: compiler.tests.redefine10
! Mixin redefinition did not recompile all necessary words.
[ ] [ [ "compiler.tests.redefine10" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: kernel math classes ;
+ "USING: kernel math classes ;
IN: compiler.tests.redefine10
MIXIN: my-mixin
INSTANCE: fixnum my-mixin
- : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
- "> eval( -- )
+ : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USE: math
+ "USE: math
IN: compiler.tests.redefine10
- INSTANCE: float my-mixin
- "> eval( -- )
+ INSTANCE: float my-mixin"
+ eval( -- )
] unit-test
[ 2.0 ] [
-USING: eval tools.test compiler.units vocabs multiline words
+USING: eval tools.test compiler.units vocabs words
kernel classes.mixin arrays ;
IN: compiler.tests.redefine11
[ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: kernel math classes arrays ;
+ "USING: kernel math classes arrays ;
IN: compiler.tests.redefine11
MIXIN: my-mixin
INSTANCE: array my-mixin
GENERIC: my-generic ( a -- b )
M: my-mixin my-generic drop 0 ;
M: object my-generic drop 1 ;
- : my-inline ( -- b ) { } my-generic ;
- "> eval( -- )
+ : my-inline ( -- b ) { } my-generic ;"
+ eval( -- )
] unit-test
[ ] [
-USING: eval tools.test compiler.units vocabs multiline words
-kernel ;
+USING: eval tools.test compiler.units vocabs words kernel ;
IN: compiler.tests.redefine5
! Regression: if dispatch was eliminated but method was not inlined,
[ "compiler.tests.redefine5" forget-vocab ] with-compilation-unit
[ ] [
- <"
- USING: sorting kernel math.order ;
+ "USING: sorting kernel math.order ;
IN: compiler.tests.redefine5
GENERIC: my-generic ( a -- b )
M: object my-generic [ <=> ] sort ;
- : my-inline ( a -- b ) my-generic ;
- "> eval( -- )
+ : my-inline ( a -- b ) my-generic ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USE: kernel
+ "USE: kernel
IN: compiler.tests.redefine5
TUPLE: my-tuple ;
- M: my-tuple my-generic drop 0 ;
- "> eval( -- )
+ M: my-tuple my-generic drop 0 ;" eval( -- )
] unit-test
[ 0 ] [
-USING: eval tools.test compiler.units vocabs multiline words
+USING: eval tools.test compiler.units vocabs words
kernel ;
IN: compiler.tests.redefine6
[ ] [ [ "compiler.tests.redefine6" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: kernel kernel.private ;
+ "USING: kernel kernel.private ;
IN: compiler.tests.redefine6
GENERIC: my-generic ( a -- b )
MIXIN: my-mixin
M: my-mixin my-generic drop 0 ;
- : my-inline ( a -- b ) { my-mixin } declare my-generic ;
- "> eval( -- )
+ : my-inline ( a -- b ) { my-mixin } declare my-generic ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USING: kernel ;
+ "USING: kernel ;
IN: compiler.tests.redefine6
TUPLE: my-tuple ;
M: my-tuple my-generic drop 1 ;
- INSTANCE: my-tuple my-mixin
- "> eval( -- )
+ INSTANCE: my-tuple my-mixin"
+ eval( -- )
] unit-test
[ 1 ] [
-USING: eval tools.test compiler.units vocabs multiline words
+USING: eval tools.test compiler.units vocabs words
kernel ;
IN: compiler.tests.redefine7
[ ] [ [ "compiler.tests.redefine7" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: kernel math ;
+ "USING: kernel math ;
IN: compiler.tests.redefine7
MIXIN: my-mixin
INSTANCE: fixnum my-mixin
- : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;
- "> eval( -- )
+ : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USE: math
+ "USE: math
IN: compiler.tests.redefine7
- INSTANCE: float my-mixin
- "> eval( -- )
+ INSTANCE: float my-mixin"
+ eval( -- )
] unit-test
[ 2.0 ] [
-USING: eval tools.test compiler.units vocabs multiline words
+USING: eval tools.test compiler.units vocabs words
kernel ;
IN: compiler.tests.redefine8
[ ] [ [ "compiler.tests.redefine8" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: kernel math math.order sorting ;
+ "USING: kernel math math.order sorting ;
IN: compiler.tests.redefine8
MIXIN: my-mixin
INSTANCE: fixnum my-mixin
GENERIC: my-generic ( a -- b )
! We add the bogus quotation here to hinder inlining
! since otherwise we cannot trigger this bug.
- M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
- "> eval( -- )
+ M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USE: math
+ "USE: math
IN: compiler.tests.redefine8
- INSTANCE: float my-mixin
- "> eval( -- )
+ INSTANCE: float my-mixin"
+ eval( -- )
] unit-test
[ 2.0 ] [
-USING: eval tools.test compiler.units vocabs multiline words
+USING: eval tools.test compiler.units vocabs words
kernel generic.math ;
IN: compiler.tests.redefine9
[ ] [ [ "compiler.tests.redefine9" forget-vocab ] with-compilation-unit ] unit-test
[ ] [
- <"
- USING: kernel math math.order sorting ;
+ "USING: kernel math math.order sorting ;
IN: compiler.tests.redefine9
MIXIN: my-mixin
INSTANCE: fixnum my-mixin
GENERIC: my-generic ( a -- b )
! We add the bogus quotation here to hinder inlining
! since otherwise we cannot trigger this bug.
- M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
- "> eval( -- )
+ M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;"
+ eval( -- )
] unit-test
[ ] [
- <"
- USE: math
+ "USE: math
IN: compiler.tests.redefine9
TUPLE: my-tuple ;
- INSTANCE: my-tuple my-mixin
- "> eval( -- )
+ INSTANCE: my-tuple my-mixin"
+ eval( -- )
] unit-test
[
compiler.tree.propagation.info
compiler.tree.checker
compiler.tree.debugger ;
+FROM: math => float ;
IN: compiler.tree.cleanup.tests
[ t ] [ [ [ 1 ] [ 2 ] if ] cleaned-up-tree [ #if? ] contains-node? ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: math math.order math.intervals assocs combinators ;
IN: compiler.tree.comparisons
! Some utilities for working with comparison operations.
-CONSTANT: comparison-ops { < > <= >= }
+CONSTANT: comparison-ops { < > <= >= u< u> u<= u>= }
CONSTANT: generic-comparison-ops { before? after? before=? after=? }
: assumption ( i1 i2 op -- i3 )
{
- { \ < [ assume< ] }
- { \ > [ assume> ] }
- { \ <= [ assume<= ] }
- { \ >= [ assume>= ] }
+ { \ < [ assume< ] }
+ { \ > [ assume> ] }
+ { \ <= [ assume<= ] }
+ { \ >= [ assume>= ] }
+ { \ u< [ assume< ] }
+ { \ u> [ assume> ] }
+ { \ u<= [ assume<= ] }
+ { \ u>= [ assume>= ] }
} case ;
: interval-comparison ( i1 i2 op -- result )
{
- { \ < [ interval< ] }
- { \ > [ interval> ] }
- { \ <= [ interval<= ] }
- { \ >= [ interval>= ] }
+ { \ < [ interval< ] }
+ { \ > [ interval> ] }
+ { \ <= [ interval<= ] }
+ { \ >= [ interval>= ] }
+ { \ u< [ interval< ] }
+ { \ u> [ interval> ] }
+ { \ u<= [ interval<= ] }
+ { \ u>= [ interval>= ] }
} case ;
: swap-comparison ( op -- op' )
{ > < }
{ <= >= }
{ >= <= }
+ { u< u> }
+ { u> u< }
+ { u<= u>= }
+ { u>= u<= }
} at ;
: negate-comparison ( op -- op' )
{ > <= }
{ <= > }
{ >= < }
+ { u< u>= }
+ { u> u<= }
+ { u<= u> }
+ { u>= u< }
} at ;
: specific-comparison ( op -- op' )
pad-with-bottom >>phi-in-d drop ;
: live-value-indices ( values -- indices )
- [ length ] keep live-values get
+ [ length iota ] keep live-values get
'[ _ nth _ key? ] filter ; inline
: drop-indexed-values ( values indices -- node )
! See http://factorcode.org/license.txt for BSD license.
USING: fry kernel sequences assocs accessors namespaces
math.intervals arrays classes.algebra combinators columns
-stack-checker.branches
+stack-checker.branches locals
compiler.utilities
compiler.tree
compiler.tree.combinators
[ [ phi-info-d>> flip ] [ out-d>> ] bi merge-value-infos ]
bi ;
+:: update-constraints ( new old -- )
+ new [| key value | key old [ value append ] change-at ] assoc-each ;
+
+: include-child-constraints ( i -- )
+ infer-children-data get nth constraints swap at last
+ constraints get last update-constraints ;
+
: branch-phi-constraints ( output values booleans -- )
{
{
swap t-->
]
}
- ! {
- ! { { t f } { } }
- ! [ B
- ! first
- ! [ [ =t ] bi@ <--> ]
- ! [ [ =f ] bi@ <--> ] 2bi /\
- ! ]
- ! }
- ! {
- ! { { } { t f } }
- ! [
- ! second
- ! [ [ =t ] bi@ <--> ]
- ! [ [ =f ] bi@ <--> ] 2bi /\
- ! ]
- ! }
+ {
+ { { t f } { } }
+ [
+ first
+ [ [ =t ] bi@ <--> ]
+ [ [ =f ] bi@ <--> ] 2bi /\
+ 0 include-child-constraints
+ ]
+ }
+ {
+ { { } { t f } }
+ [
+ second
+ [ [ =t ] bi@ <--> ]
+ [ [ =f ] bi@ <--> ] 2bi /\
+ 1 include-child-constraints
+ ]
+ }
[ 3drop f ]
} case assume ;
] 3each
] [ drop ] if ;
-M: #phi propagate-around ( #phi -- )
- [ propagate-before ] [ propagate-after ] bi ;
-
M: #branch propagate-around
dup live-branches >>live-branches
[ infer-children ] [ annotate-node ] bi ;
[ t ] [ [ 2 '[ _ ] 1 '[ _ + ] compose ] final-info first infer-value (( -- object )) effect= ] unit-test
[ t ] [ [ 2 '[ _ + ] ] final-info first infer-value (( object -- object )) effect= ] unit-test
[ f ] [ [ [ [ ] [ 1 ] if ] ] final-info first infer-value ] unit-test
-[ f ] [ [ [ 1 ] '[ @ ] ] final-info first infer-value ] unit-test
+[ t ] [ [ [ 1 ] '[ @ ] ] final-info first infer-value (( -- object )) effect= ] unit-test
[ f ] [ [ dup drop ] final-info first infer-value ] unit-test
! This should not hang
[ ] [ [ [ dup call( quot -- ) ] dup call( quot -- ) ] final-info drop ] unit-test
-[ ] [ [ [ dup curry call( quot -- ) ] dup curry call( quot -- ) ] final-info drop ] unit-test
\ No newline at end of file
+[ ] [ [ [ dup curry call( quot -- ) ] dup curry call( quot -- ) ] final-info drop ] unit-test
+
+! This should get inlined, because the parameter to the curry is literal even though
+! [ boa ] by itself doesn't infer
+TUPLE: a-tuple x ;
+
+[ V{ a-tuple } ] [ [ a-tuple '[ _ boa ] call( x -- tuple ) ] final-classes ] unit-test
\ No newline at end of file
M: compose cached-effect
[ first>> ] [ second>> ] bi [ cached-effect ] bi@ compose-effects* ;
+: safe-infer ( quot -- effect )
+ [ infer ] [ 2drop +unknown+ ] recover ;
+
M: quotation cached-effect
dup cached-effect>>
- [ ] [
- [ [ infer ] [ 2drop +unknown+ ] recover dup ] keep
- (>>cached-effect)
- ] ?if ;
+ [ ] [ [ safe-infer dup ] keep (>>cached-effect) ] ?if ;
: call-effect-unsafe? ( quot effect -- ? )
[ cached-effect ] dip
: execute-effect>quot ( effect -- quot )
inline-cache new '[ drop _ _ execute-effect-ic ] ;
+! Some bookkeeping to make sure that crap like
+! [ dup curry call( quot -- ) ] dup curry call( quot -- ) ]
+! doesn't hang the compiler.
+GENERIC: already-inlined-quot? ( quot -- ? )
+
+M: curry already-inlined-quot? quot>> already-inlined-quot? ;
+
+M: compose already-inlined-quot?
+ [ first>> already-inlined-quot? ]
+ [ second>> already-inlined-quot? ] bi or ;
+
+M: quotation already-inlined-quot? already-inlined? ;
+
+GENERIC: add-quot-to-history ( quot -- )
+
+M: curry add-quot-to-history quot>> add-quot-to-history ;
+
+M: compose add-quot-to-history
+ [ first>> add-quot-to-history ]
+ [ second>> add-quot-to-history ] bi ;
+
+M: quotation add-quot-to-history add-to-history ;
+
: last2 ( seq -- penultimate ultimate )
2 tail* first2 ;
(( -- object )) swap compose-effects ;
: (infer-value) ( value-info -- effect )
- dup class>> {
- { \ quotation [
- literal>> [ uninferable ] unless*
- dup already-inlined? [ uninferable ] when
- cached-effect dup +unknown+ = [ uninferable ] when
- ] }
- { \ curry [
- slots>> third (infer-value)
- remove-effect-input
- ] }
- { \ compose [
- slots>> last2 [ (infer-value) ] bi@
- compose-effects
- ] }
- [ uninferable ]
- } case ;
+ dup literal?>> [
+ literal>>
+ [ callable? [ uninferable ] unless ]
+ [ already-inlined-quot? [ uninferable ] when ]
+ [ safe-infer dup +unknown+ = [ uninferable ] when ] tri
+ ] [
+ dup class>> {
+ { \ curry [ slots>> third (infer-value) remove-effect-input ] }
+ { \ compose [ slots>> last2 [ (infer-value) ] bi@ compose-effects ] }
+ [ uninferable ]
+ } case
+ ] if ;
: infer-value ( value-info -- effect/f )
[ (infer-value) ]
recover ;
: (value>quot) ( value-info -- quot )
- dup class>> {
- { \ quotation [ literal>> dup add-to-history '[ drop @ ] ] }
- { \ curry [
- slots>> third (value>quot)
- '[ [ obj>> ] [ quot>> @ ] bi ]
- ] }
- { \ compose [
- slots>> last2 [ (value>quot) ] bi@
- '[ [ first>> @ ] [ second>> @ ] bi ]
- ] }
- } case ;
+ dup literal?>> [
+ literal>> [ add-quot-to-history ] [ '[ drop @ ] ] bi
+ ] [
+ dup class>> {
+ { \ curry [
+ slots>> third (value>quot)
+ '[ [ obj>> ] [ quot>> @ ] bi ]
+ ] }
+ { \ compose [
+ slots>> last2 [ (value>quot) ] bi@
+ '[ [ first>> @ ] [ second>> @ ] bi ]
+ ] }
+ } case
+ ] if ;
: value>quot ( value-info -- quot: ( code effect -- ) )
(value>quot) '[ drop @ ] ;
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs math math.intervals kernel accessors
sequences namespaces classes classes.algebra
-combinators words
+combinators words combinators.short-circuit
compiler.tree
compiler.tree.propagation.info
compiler.tree.propagation.copy ;
! Boolean constraints
TUPLE: true-constraint value ;
-: =t ( value -- constriant ) resolve-copy true-constraint boa ;
+: =t ( value -- constraint ) resolve-copy true-constraint boa ;
+
+: follow-implications ( constraint -- )
+ constraints get assoc-stack [ assume ] when* ;
M: true-constraint assume*
[ \ f class-not <class-info> swap value>> refine-value-info ]
- [ constraints get assoc-stack [ assume ] when* ]
+ [ follow-implications ]
bi ;
M: true-constraint satisfied?
- value>> value-info class>> true-class? ;
+ value>> value-info class>>
+ { [ true-class? ] [ null-class? not ] } 1&& ;
TUPLE: false-constraint value ;
M: false-constraint assume*
[ \ f <class-info> swap value>> refine-value-info ]
- [ constraints get assoc-stack [ assume ] when* ]
+ [ follow-implications ]
bi ;
M: false-constraint satisfied?
- value>> value-info class>> false-class? ;
+ value>> value-info class>>
+ { [ false-class? ] [ null-class? not ] } 1&& ;
! Class constraints
TUPLE: class-constraint value class ;
C: --> implication
-: assume-implication ( p q -- )
+: assume-implication ( q p -- )
[ constraints get [ assoc-stack swap suffix ] 2keep last set-at ]
[ satisfied? [ assume ] [ drop ] if ] 2bi ;
: refine-value-info ( info value -- )
resolve-copy value-infos get
- [ assoc-stack value-info-intersect ] 2keep
+ [ assoc-stack [ value-info-intersect ] when* ] 2keep
last set-at ;
: value-literal ( value -- obj ? )
2dup [ in-d>> length ] [ dispatch# ] bi* <= [ 2drop f f ] [
[ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
[ swap nth value-info class>> dup ] dip
- specific-method
+ method-for-class
] if
] if ;
:: inline-word ( #call word -- ? )
word already-inlined? [ f ] [
#call word splicing-body [
- [
- word add-to-history
- dup (propagate)
- ] with-scope
- #call (>>body) t
+ word add-to-history
+ #call (>>body)
+ #call propagate-body
] [ f ] if*
] if ;
#! Note the logic here: if there's a custom inlining hook,
#! it is permitted to return f, which means that we try the
#! normal inlining heuristic.
- dup custom-inlining? [ 2dup inline-custom ] [ f ] if
- [ 2drop t ] [ (do-inlining) ] if ;
+ [
+ dup custom-inlining? [ 2dup inline-custom ] [ f ] if
+ [ 2drop t ] [ (do-inlining) ] if
+ ] with-scope ;
classes.algebra combinators generic.math splitting fry locals
classes.tuple alien.accessors classes.tuple.private
slots.private definitions strings.private vectors hashtables
-generic quotations
+generic quotations alien
stack-checker.state
compiler.tree.comparisons
compiler.tree.propagation.info
compiler.tree.propagation.simple
compiler.tree.propagation.constraints
compiler.tree.propagation.call-effect
-compiler.tree.propagation.transforms ;
+compiler.tree.propagation.transforms
+compiler.tree.propagation.simd ;
+FROM: alien.c-types => (signed-interval) (unsigned-interval) ;
IN: compiler.tree.propagation.known-words
{ + - * / }
[ { number number } "input-classes" set-word-prop ] each
-{ /f < > <= >= }
+{ /f < > <= >= u< u> u<= u>= }
[ { real real } "input-classes" set-word-prop ] each
{ /i mod /mod }
\ bitnot { integer } "input-classes" set-word-prop
-: real-op ( info quot -- quot' )
- [
- dup class>> real classes-intersect?
- [ clone ] [ drop real <class-info> ] if
- ] dip
- change-interval ; inline
-
-{ bitnot fixnum-bitnot bignum-bitnot } [
- [ [ interval-bitnot ] real-op ] "outputs" set-word-prop
-] each
-
-\ abs [ [ interval-abs ] real-op ] "outputs" set-word-prop
-
-\ absq [ [ interval-absq ] real-op ] "outputs" set-word-prop
-
: math-closure ( class -- newclass )
{ fixnum bignum integer rational float real number object }
[ class<= ] with find nip ;
: fits-in-fixnum? ( interval -- ? )
fixnum-interval interval-subset? ;
-: binary-op-class ( info1 info2 -- newclass )
- [ class>> ] bi@
- 2dup [ null-class? ] either? [ 2drop null ] [
- [ math-closure ] bi@ math-class-max
- ] if ;
-
-: binary-op-interval ( info1 info2 quot -- newinterval )
- [ [ interval>> ] bi@ ] dip call ; inline
-
: won't-overflow? ( class interval -- ? )
[ fixnum class<= ] [ fits-in-fixnum? ] bi* and ;
[ drop float ] dip
] unless ;
+: unary-op-class ( info -- newclass )
+ class>> dup null-class? [ drop null ] [ math-closure ] if ;
+
+: unary-op-interval ( info quot -- newinterval )
+ [
+ dup class>> real classes-intersect?
+ [ interval>> ] [ drop full-interval ] if
+ ] dip call ; inline
+
+: unary-op ( word interval-quot post-proc-quot -- )
+ '[
+ [ unary-op-class ] [ _ unary-op-interval ] bi
+ @
+ <class/interval-info>
+ ] "outputs" set-word-prop ;
+
+{ bitnot fixnum-bitnot bignum-bitnot } [
+ [ interval-bitnot ] [ integer-valued ] unary-op
+] each
+
+\ abs [ interval-abs ] [ may-overflow real-valued ] unary-op
+
+\ absq [ interval-absq ] [ may-overflow real-valued ] unary-op
+
+: binary-op-class ( info1 info2 -- newclass )
+ [ class>> ] bi@
+ 2dup [ null-class? ] either? [ 2drop null ] [
+ [ math-closure ] bi@ math-class-max
+ ] if ;
+
+: binary-op-interval ( info1 info2 quot -- newinterval )
+ [ [ interval>> ] bi@ ] dip call ; inline
+
: binary-op ( word interval-quot post-proc-quot -- )
'[
[ binary-op-class ] [ _ binary-op-interval ] 2bi
alien-unsigned-8
} [
dup name>> {
- {
- [ "alien-signed-" ?head ]
- [ string>number 8 * 1 - 2^ dup neg swap 1 - [a,b] ]
- }
- {
- [ "alien-unsigned-" ?head ]
- [ string>number 8 * 2^ 1 - 0 swap [a,b] ]
- }
- } cond
+ { [ "alien-signed-" ?head ] [ string>number (signed-interval) ] }
+ { [ "alien-unsigned-" ?head ] [ string>number (unsigned-interval) ] }
+ } cond [a,b]
[ fits-in-fixnum? fixnum integer ? ] keep <class/interval-info>
'[ 2drop _ ] "outputs" set-word-prop
] each
+\ alien-cell [
+ 2drop simple-alien \ f class-or <class-info>
+] "outputs" set-word-prop
+
{ <tuple> <tuple-boa> } [
[
literal>> dup array? [ first ] [ drop tuple ] if <class-info>
] "outputs" set-word-prop
! the output of clone has the same type as the input
+: cloned-value-info ( value-info -- value-info' )
+ clone f >>literal f >>literal?
+ [ [ dup [ cloned-value-info ] when ] map ] change-slots ;
+
{ clone (clone) } [
- [ clone f >>literal f >>literal? ]
- "outputs" set-word-prop
+ [ cloned-value-info ] "outputs" set-word-prop
] each
\ slot [
compiler.tree.propagation.info compiler.tree.def-use
compiler.tree.debugger compiler.tree.checker
slots.private words hashtables classes assocs locals
-specialized-arrays.double system sorting math.libm
-math.intervals quotations effects ;
+specialized-arrays system sorting math.libm
+math.intervals quotations effects alien alien.data ;
+FROM: math => float ;
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: void*
IN: compiler.tree.propagation.tests
[ V{ } ] [ [ ] final-classes ] unit-test
[ V{ 69 } ] [ [ [ 69 ] [ 69 ] if ] final-literals ] unit-test
+[ V{ integer } ] [ [ bitnot ] final-classes ] unit-test
+
[ V{ fixnum } ] [ [ { fixnum } declare bitnot ] final-classes ] unit-test
! Test type propagation for math ops
[ t ] [ [ absq ] final-info first interval>> [0,inf] = ] unit-test
+[ t ] [ [ { fixnum } declare abs ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+
+[ t ] [ [ { fixnum } declare absq ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+
+[ V{ integer } ] [ [ { fixnum } declare abs ] final-classes ] unit-test
+
+[ V{ integer } ] [ [ { fixnum } declare absq ] final-classes ] unit-test
+
+[ t ] [ [ { bignum } declare abs ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+
+[ t ] [ [ { bignum } declare absq ] final-info first interval>> [0,inf] interval-subset? ] unit-test
+
[ t ] [ [ { float } declare abs ] final-info first interval>> [0,inf] = ] unit-test
[ t ] [ [ { float } declare absq ] final-info first interval>> [0,inf] = ] unit-test
[ t ] [ [ { complex } declare absq ] final-info first interval>> [0,inf] = ] unit-test
+[ t ] [ [ { float float } declare rect> C{ 0.0 0.0 } + absq ] final-info first interval>> [0,inf] = ] unit-test
+
+[ V{ float } ] [ [ { float float } declare rect> C{ 0.0 0.0 } + absq ] final-classes ] unit-test
+
[ t ] [ [ [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
[ t ] [ [ { double-array double-array } declare [ - absq ] [ + ] 2map-reduce ] final-info first interval>> [0,inf] = ] unit-test
] final-literals
] unit-test
+[ V{ 1.5 } ] [
+ [
+ /f
+ dup 1.5 u<= [ dup 1.5 u>= [ ] [ drop 1.5 ] if ] [ drop 1.5 ] if
+ ] final-literals
+] unit-test
+
[ V{ 1.5 } ] [
[
/f
] final-literals
] unit-test
+[ V{ 1.5 } ] [
+ [
+ /f
+ dup 1.5 u<= [ dup 10 u>= [ ] [ drop 1.5 ] if ] [ drop 1.5 ] if
+ ] final-literals
+] unit-test
+
[ V{ f } ] [
[
/f
] final-literals
] unit-test
+[ V{ f } ] [
+ [
+ /f
+ dup 0.0 u<= [ dup 0.0 u>= [ drop 0.0 ] unless ] [ drop 0.0 ] if
+ ] final-literals
+] unit-test
+
[ V{ fixnum } ] [
[ 0 dup 10 > [ 100 * ] when ] final-classes
] unit-test
[ 0 dup 10 > [ drop "foo" ] when ] final-classes
] unit-test
+[ V{ fixnum } ] [
+ [ 0 dup 10 u> [ 100 * ] when ] final-classes
+] unit-test
+
+[ V{ fixnum } ] [
+ [ 0 dup 10 u> [ drop "foo" ] when ] final-classes
+] unit-test
+
[ V{ fixnum } ] [
[ { fixnum } declare 3 3 - + ] final-classes
] unit-test
[ dup 10 < [ 3 * 30 < ] [ drop t ] if ] final-literals
] unit-test
+[ V{ t } ] [
+ [ dup 10 u< [ 3 * 30 u< ] [ drop t ] if ] final-literals
+] unit-test
+
[ V{ "d" } ] [
[
3 {
[ >fixnum dup 100 < [ 1 + ] [ "Oops" throw ] if ] final-classes
] unit-test
+[ V{ fixnum } ] [
+ [ >fixnum dup 100 u< [ 1 + ] [ "Oops" throw ] if ] final-classes
+] unit-test
+
[ V{ -1 } ] [
[ 0 dup 100 < not [ 1 + ] [ 1 - ] if ] final-literals
] unit-test
+[ V{ -1 } ] [
+ [ 0 dup 100 u< not [ 1 + ] [ 1 - ] if ] final-literals
+] unit-test
+
[ V{ 2 } ] [
[ [ 1 ] [ 1 ] if 1 + ] final-literals
] unit-test
[ 0 * 10 < ] final-classes
] unit-test
+[ V{ object } ] [
+ [ 0 * 10 u< ] final-classes
+] unit-test
+
[ V{ 27 } ] [
[
123 bitand dup 10 < over 8 > and [ 3 * ] [ "B" throw ] if
] final-literals
] unit-test
+[ V{ 27 } ] [
+ [
+ 123 bitand dup 10 u< over 8 u> and [ 3 * ] [ "B" throw ] if
+ ] final-literals
+] unit-test
+
[ V{ 27 } ] [
[
dup number? over sequence? and [
[ { word object } declare equal? ] final-classes
] unit-test
-! [ V{ string } ] [
-! [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
-! ] unit-test
+[ V{ string } ] [
+ [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
+] unit-test
-! [ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
+[ t ] [ [ dup t xor or ] final-classes first true-class? ] unit-test
-! [ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
+[ t ] [ [ dup t xor swap or ] final-classes first true-class? ] unit-test
-! [ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
+[ t ] [ [ dup t xor and ] final-classes first false-class? ] unit-test
-! [ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
+[ t ] [ [ dup t xor swap and ] final-classes first false-class? ] unit-test
! generalize-counter-interval wasn't being called in all the right places.
! bug found by littledan
[ t ] [ [ (( a b c -- c b a )) shuffle ] { shuffle } inlined? ] unit-test
[ f ] [ [ { 1 2 3 } swap shuffle ] { shuffle } inlined? ] unit-test
+
+! Type function for 'clone' had a subtle issue
+TUPLE: tuple-with-read-only-slot { x read-only } ;
+
+M: tuple-with-read-only-slot clone
+ x>> clone tuple-with-read-only-slot boa ; inline
+
+[ V{ object } ] [
+ [ { 1 2 3 } dup tuple-with-read-only-slot boa clone x>> eq? ] final-classes
+] unit-test
+
+! alien-cell outputs a simple-alien or f
+[ t ] [
+ [ { byte-array fixnum } declare alien-cell dup [ "OOPS" throw ] unless ] final-classes
+ first simple-alien class=
+] unit-test
+
+! Don't crash if bad literal inputs are passed to unsafe words
+[ f ] [ [ { } 1 fixnum+fast ] final-info first literal?>> ] unit-test
+
+! Converting /i to shift
+[ t ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { /i fixnum/i fixnum/i-fast } inlined? ] unit-test
+[ f ] [ [ >fixnum dup 0 >= [ 16 /i ] when ] { fixnum-shift-fast } inlined? ] unit-test
+[ f ] [ [ >float dup 0 >= [ 16 /i ] when ] { /i float/f } inlined? ] unit-test
+
+! We want this to inline
+[ t ] [ [ void* <c-direct-array> ] { <c-direct-array> } inlined? ] unit-test
+[ V{ void*-array } ] [ [ void* <c-direct-array> ] final-classes ] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays combinators fry sequences
+compiler.tree.propagation.info cpu.architecture kernel words math
+math.intervals math.vectors.simd.intrinsics ;
+IN: compiler.tree.propagation.simd
+
+{
+ (simd-v+)
+ (simd-v-)
+ (simd-v+-)
+ (simd-v*)
+ (simd-v/)
+ (simd-vmin)
+ (simd-vmax)
+ (simd-sum)
+ (simd-vabs)
+ (simd-vsqrt)
+ (simd-vbitand)
+ (simd-vbitandn)
+ (simd-vbitor)
+ (simd-vbitxor)
+ (simd-vbitnot)
+ (simd-vand)
+ (simd-vandn)
+ (simd-vor)
+ (simd-vxor)
+ (simd-vnot)
+ (simd-vlshift)
+ (simd-vrshift)
+ (simd-hlshift)
+ (simd-hrshift)
+ (simd-vshuffle)
+ (simd-(vmerge-head))
+ (simd-(vmerge-tail))
+ (simd-v<=)
+ (simd-v<)
+ (simd-v=)
+ (simd-v>)
+ (simd-v>=)
+ (simd-vunordered?)
+ (simd-with)
+ (simd-gather-2)
+ (simd-gather-4)
+ alien-vector
+} [ { byte-array } "default-output-classes" set-word-prop ] each
+
+: scalar-output-class ( rep -- class )
+ dup literal?>> [
+ literal>> scalar-rep-of {
+ { float-rep [ float ] }
+ { double-rep [ float ] }
+ [ drop integer ]
+ } case
+ ] [ drop real ] if
+ <class-info> ;
+
+\ (simd-sum) [ nip scalar-output-class ] "outputs" set-word-prop
+
+\ (simd-v.) [ 2nip scalar-output-class ] "outputs" set-word-prop
+
+{
+ (simd-vany?)
+ (simd-vall?)
+ (simd-vnone?)
+} [ { boolean } "default-output-classes" set-word-prop ] each
+
+\ (simd-select) [ 2nip scalar-output-class ] "outputs" set-word-prop
+
+\ assert-positive [
+ real [0,inf] <class/interval-info> value-info-intersect
+] "outputs" set-word-prop
+
+! If SIMD is not available, inline alien-vector and set-alien-vector
+! to get a speedup
+: inline-unless-intrinsic ( word -- )
+ dup '[ drop _ dup "intrinsic" word-prop [ drop f ] [ def>> ] if ]
+ "custom-inlining" set-word-prop ;
+
+\ alien-vector inline-unless-intrinsic
+
+\ set-alien-vector inline-unless-intrinsic
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors kernel sequences sequences.private assocs words
-namespaces classes.algebra combinators classes classes.tuple
-classes.tuple.private continuations arrays alien.c-types
-math math.private slots generic definitions
-stack-checker.state
+USING: fry accessors kernel sequences sequences.private assocs
+words namespaces classes.algebra combinators
+combinators.short-circuit classes classes.tuple
+classes.tuple.private continuations arrays alien.c-types math
+math.private slots generic definitions stack-checker.state
compiler.tree
compiler.tree.propagation.info
compiler.tree.propagation.nodes
[ in-d>> [ value-info ] map ] [ "outputs" word-prop ] bi*
with-datastack ;
+: literal-inputs? ( #call -- ? )
+ in-d>> [ value-info literal?>> ] all? ;
+
+: input-classes-match? ( #call word -- ? )
+ [ in-d>> ] [ "input-classes" word-prop ] bi*
+ [ [ value-info literal>> ] dip instance? ] 2all? ;
+
: foldable-call? ( #call word -- ? )
- "foldable" word-prop
- [ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ;
+ {
+ [ nip "foldable" word-prop ]
+ [ drop literal-inputs? ]
+ [ input-classes-match? ]
+ } 2&& ;
: (fold-call) ( #call word -- info )
[ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ _ execute ] ] bi*
! If first input has a known type and second input is an
! object, we convert this to [ swap equal? ].
in-d>> first2 value-info class>> object class= [
- value-info class>> \ equal? specific-method
+ value-info class>> \ equal? method-for-class
[ swap equal? ] f ?
] [ drop f ] if
] "custom-inlining" set-word-prop
] [ f ] if
] "custom-inlining" set-word-prop
+{ /i fixnum/i fixnum/i-fast bignum/i } [
+ [
+ in-d>> first2 [ value-info ] bi@ {
+ [ drop class>> integer class<= ]
+ [ drop interval>> 0 [a,a] interval>= ]
+ [ nip literal>> integer? ]
+ [ nip literal>> power-of-2? ]
+ } 2&& [ [ log2 neg shift ] ] [ f ] if
+ ] "custom-inlining" set-word-prop
+] each
+
! Integrate this with generic arithmetic optimization instead?
: both-inputs? ( #call class -- ? )
[ in-d>> first2 ] dip '[ value-info class>> _ class<= ] both? ;
: alist-most ( alist quot -- pair )
[ [ ] ] dip '[ [ [ second ] bi@ @ ] most ] map-reduce ; inline
-: alist-min ( alist -- pair ) [ before? ] alist-most ;
+: alist-min ( alist -- pair ) [ before=? ] alist-most ;
-: alist-max ( alist -- pair ) [ after? ] alist-most ;
+: alist-max ( alist -- pair ) [ after=? ] alist-most ;
: penultimate ( seq -- elt ) [ length 2 - ] keep nth ;
! Copyright (C) 2009 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-arrays
-byte-vectors combinators fry grouping hashtables
-compression.huffman images io.binary kernel locals
-math math.bitwise math.order math.ranges multiline sequences
-sorting ;
+USING: accessors arrays assocs byte-vectors combinators
+compression.huffman fry hashtables io.binary kernel locals math
+math.bitwise math.order math.ranges sequences sorting ;
+QUALIFIED-WITH: bitstreams bs
IN: compression.inflate
QUALIFIED-WITH: bitstreams bs
case
]
[ produce ] keep call suffix concat ;
-
- ! [ produce ] keep dip swap suffix
-
-:: paeth ( a b c -- p )
- a b + c - { a b c } [ [ - abs ] keep 2array ] with map
- sort-keys first second ;
-
-:: png-unfilter-line ( prev curr filter -- curr' )
- prev :> c
- prev 3 tail-slice :> b
- curr :> a
- curr 3 tail-slice :> x
- x length [0,b)
- filter
- {
- { 0 [ drop ] }
- { 1 [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
- { 2 [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
- { 3 [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
- { 4 [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
-
- } case
- curr 3 tail ;
PRIVATE>
-: reverse-png-filter' ( lines -- byte-array )
- [ first ] [ 1 tail ] [ map ] bi-curry@ bi nip
- concat [ 128 + ] B{ } map-as ;
-
-: reverse-png-filter ( lines -- byte-array )
- dup first [ 0 ] replicate prefix
- [ { 0 0 } prepend ] map
- 2 clump [
- first2 dup [ third ] [ 0 2 rot set-nth ] bi png-unfilter-line
- ] map B{ } concat-as ;
-
: zlib-inflate ( bytes -- bytes )
bs:<lsb0-bit-reader>
[ check-zlib-header ] [ inflate-loop ] bi
-Doug Coleman
\ No newline at end of file
+Doug Coleman
+Keith Lazuka
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka
+! See http://factorcode.org/license.txt for BSD license.
+USING: bitstreams byte-arrays classes help.markup help.syntax
+kernel math quotations sequences ;
+IN: compression.lzw
+
+HELP: gif-lzw-uncompress
+{ $values
+ { "seq" sequence } { "code-size" integer }
+ { "byte-array" byte-array }
+}
+{ $description "Decompresses a sequence of LZW-compressed bytes obtained from a GIF file." } ;
+
+HELP: tiff-lzw-uncompress
+{ $values
+ { "seq" sequence }
+ { "byte-array" byte-array }
+}
+{ $description "Decompresses a sequence of LZW-compressed bytes obtained from a TIFF file." } ;
+
+HELP: lzw-read
+{ $values
+ { "lzw" lzw }
+ { "lzw" lzw } { "n" integer }
+}
+{ $description "Read the next LZW code." } ;
+
+HELP: lzw-process-next-code
+{ $values
+ { "lzw" lzw } { "quot" quotation }
+}
+{ $description "Read the next LZW code and, assuming that the code is neither the Clear Code nor the End of Information Code, conditionally processes it by calling " { $snippet "quot" } " with the lzw object and the LZW code. If it does read a Clear Code, this combinator will take care of handling the Clear Code for you." } ;
+
+HELP: <lzw-uncompress>
+{ $values
+ { "input" bit-reader } { "code-size" "number of bits" } { "class" class }
+ { "obj" object }
+}
+{ $description "Instantiate a new LZW decompressor." } ;
+
+HELP: code-space-full?
+{ $values
+ { "lzw" lzw }
+ { "?" boolean }
+}
+{ $description "Determines when to increment the variable length code's bit-width." } ;
+
+HELP: reset-lzw-uncompress
+{ $values
+ { "lzw" lzw }
+ { "lzw" lzw }
+}
+{ $description "Reset the LZW uncompressor state (either at initialization time or immediately after receiving a Clear Code). " } ;
+
+ARTICLE: "compression.lzw.differences" "LZW Differences between TIFF and GIF"
+{ $vocab-link "compression.lzw" }
+$nl
+"There are some subtle differences between the LZW algorithm used by TIFF and GIF images."
+{ $heading "Variable Length Codes" }
+"Both TIFF and GIF use a variation of the LZW algorithm that uses variable length codes. In both cases, the maximum code size is 12 bits. The initial code size, however, is different between the two formats. TIFF's initial code size is always 9 bits. GIF's initial code size is specified on a per-file basis at the beginning of the image descriptor block, with a minimum of 3 bits."
+$nl
+"TIFF and GIF each switch to the next code size using slightly different algorithms. GIF increments the code size as soon as the LZW string table's length is equal to 2**code-size, while TIFF increments the code size when the table's length is equal to 2**code-size - 1."
+{ $heading "Packing Bits into Bytes" }
+"TIFF and GIF LZW algorithms differ in how they pack the code bits into the byte stream. The least significant bit in a TIFF code is stored in the most significant bit of the bytestream, while the least significant bit in a GIF code is stored in the least significant bit of the bytestream."
+{ $heading "Special Codes" }
+"TIFF and GIF both add the concept of a 'Clear Code' and a 'End of Information Code' to the LZW algorithm. In both cases, the 'Clear Code' is equal to 2**(code-size - 1) and the 'End of Information Code' is equal to the Clear Code + 1. These 2 codes are reserved in the string table. So in both cases, the LZW string table is initialized to have a length equal to the End of Information Code + 1."
+;
+
+ARTICLE: "compression.lzw" "LZW Compression"
+{ $vocab-link "compression.lzw" }
+$nl
+"Implements both the TIFF and GIF variations of the LZW algorithm."
+{ $heading "Decompression" }
+{ $subsections
+ tiff-lzw-uncompress
+ gif-lzw-uncompress
+}
+{ $heading "Compression" }
+"Compression has not yet been implemented."
+$nl
+"Implementation details:"
+{ $subsections "compression.lzw.differences" }
+;
+
+ABOUT: "compression.lzw"
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.accessors assocs byte-arrays combinators
-io.encodings.binary io.streams.byte-array kernel math sequences
-vectors ;
-IN: compression.lzw
-
+USING: accessors combinators io kernel math namespaces
+prettyprint sequences vectors ;
QUALIFIED-WITH: bitstreams bs
+IN: compression.lzw
-CONSTANT: clear-code 256
-CONSTANT: end-of-information 257
-
-TUPLE: lzw input output table code old-code ;
-
-SYMBOL: table-full
-
-: lzw-bit-width ( n -- n' )
- {
- { [ dup 510 <= ] [ drop 9 ] }
- { [ dup 1022 <= ] [ drop 10 ] }
- { [ dup 2046 <= ] [ drop 11 ] }
- { [ dup 4094 <= ] [ drop 12 ] }
- [ drop table-full ]
- } cond ;
+TUPLE: lzw
+input
+output
+table
+code
+old-code
+initial-code-size
+code-size
+clear-code
+end-of-information-code ;
-: lzw-bit-width-uncompress ( lzw -- n )
- table>> length lzw-bit-width ;
+TUPLE: tiff-lzw < lzw ;
+TUPLE: gif-lzw < lzw ;
-: initial-uncompress-table ( -- seq )
- 258 iota [ 1vector ] V{ } map-as ;
+: initial-uncompress-table ( size -- seq )
+ iota [ 1vector ] V{ } map-as ;
: reset-lzw-uncompress ( lzw -- lzw )
- initial-uncompress-table >>table ;
-
-: <lzw-uncompress> ( input -- obj )
- lzw new
+ dup end-of-information-code>> 1 + initial-uncompress-table >>table
+ dup initial-code-size>> >>code-size ;
+
+: <lzw-uncompress> ( input code-size class -- obj )
+ new
+ swap >>code-size
+ dup code-size>> >>initial-code-size
+ dup code-size>> 1 - 2^ >>clear-code
+ dup clear-code>> 1 + >>end-of-information-code
swap >>input
BV{ } clone >>output
reset-lzw-uncompress ;
: write-code ( lzw -- )
[ lookup-code ] [ output>> ] bi push-all ;
-: add-to-table ( seq lzw -- ) table>> push ;
+GENERIC: code-space-full? ( lzw -- ? )
+
+: size-and-limit ( lzw -- m n ) [ table>> length ] [ code-size>> 2^ ] bi ;
+
+M: tiff-lzw code-space-full? size-and-limit 1 - = ;
+M: gif-lzw code-space-full? size-and-limit = ;
+
+: maybe-increment-code-size ( lzw -- lzw )
+ dup code-space-full? [ [ 1 + ] change-code-size ] when ;
+
+: add-to-table ( seq lzw -- )
+ [ table>> push ]
+ [ maybe-increment-code-size 2drop ] 2bi ;
: lzw-read ( lzw -- lzw n )
- [ ] [ lzw-bit-width-uncompress ] [ input>> ] tri bs:read ;
+ [ ] [ code-size>> ] [ input>> ] tri bs:read ;
+
+: end-of-information? ( lzw code -- ? ) swap end-of-information-code>> = ;
+: clear-code? ( lzw code -- ? ) swap clear-code>> = ;
+
+DEFER: handle-clear-code
+: lzw-process-next-code ( lzw quot: ( lzw code -- ) -- )
+ [ lzw-read ] dip {
+ { [ 3dup drop end-of-information? ] [ 3drop ] }
+ { [ 3dup drop clear-code? ] [ 2drop handle-clear-code ] }
+ [ call( lzw code -- ) ]
+ } cond ; inline
DEFER: lzw-uncompress-char
: handle-clear-code ( lzw -- )
reset-lzw-uncompress
- lzw-read dup end-of-information = [
- 2drop
- ] [
+ [
>>code
[ write-code ]
[ code>old-code ] bi
lzw-uncompress-char
- ] if ;
+ ] lzw-process-next-code ;
: handle-uncompress-code ( lzw -- lzw )
dup code-in-table? [
] if ;
: lzw-uncompress-char ( lzw -- )
- lzw-read [
- >>code
- dup code>> end-of-information = [
- drop
- ] [
- dup code>> clear-code = [
- handle-clear-code
- ] [
- handle-uncompress-code
- lzw-uncompress-char
- ] if
- ] if
- ] [
- drop
- ] if* ;
+ [ >>code handle-uncompress-code lzw-uncompress-char ]
+ lzw-process-next-code ;
-: lzw-uncompress ( seq -- byte-array )
- bs:<msb0-bit-reader>
+: lzw-uncompress ( bitstream code-size class -- byte-array )
<lzw-uncompress>
[ lzw-uncompress-char ] [ output>> ] bi ;
+
+: tiff-lzw-uncompress ( seq -- byte-array )
+ bs:<msb0-bit-reader> 9 tiff-lzw lzw-uncompress ;
+
+: gif-lzw-uncompress ( seq code-size -- byte-array )
+ [ bs:<lsb0-bit-reader> ] dip gif-lzw lzw-uncompress ;
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax combinators system alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators system
+alien.libraries ;
IN: compression.zlib.ffi
<< "zlib" {
"The " { $vocab-link "concurrency.combinators" } " vocabulary provides concurrent variants of various combinators."\r
$nl\r
"Concurrent sequence combinators:"\r
-{ $subsection parallel-each }\r
-{ $subsection 2parallel-each }\r
-{ $subsection parallel-map }\r
-{ $subsection 2parallel-map }\r
-{ $subsection parallel-filter }\r
+{ $subsections\r
+ parallel-each\r
+ 2parallel-each\r
+ parallel-map\r
+ 2parallel-map\r
+ parallel-filter\r
+}\r
"Concurrent cleave combinators:"\r
-{ $subsection parallel-cleave }\r
-{ $subsection parallel-spread }\r
-{ $subsection parallel-napply } ;\r
+{ $subsections\r
+ parallel-cleave\r
+ parallel-spread\r
+ parallel-napply\r
+} ;\r
\r
ABOUT: "concurrency.combinators"\r
\r
ARTICLE: "concurrency.count-downs" "Count-down latches"\r
"The " { $vocab-link "concurrency.count-downs" } " vocabulary implements the " { $emphasis "count-down latch" } " data type, whichis a wrapper for a non-negative integer value which tends towards zero. A thread can either decrement the value, or wait for it to become zero."\r
-{ $subsection <count-down> }\r
-{ $subsection count-down }\r
-{ $subsection await }\r
+{ $subsections\r
+ <count-down>\r
+ count-down\r
+ await\r
+}\r
"The vocabulary was modelled after a similar feature in Java's " { $snippet "java.util.concurrent" } " library." ;\r
\r
ABOUT: "concurrency.count-downs"\r
ARTICLE: "concurrency.distributed" "Distributed message passing"
"The " { $vocab-link "concurrency.distributed" } " implements transparent distributed message passing, inspired by Erlang and Termite."
-{ $subsection start-node }
+{ $subsections start-node }
"Instances of " { $link thread } " can be sent to remote processes, at which point they are converted to objects holding the thread ID and the current node's host name:"
-{ $subsection remote-process }
+{ $subsections remote-process }
"The " { $vocab-link "serialize" } " vocabulary is used to convert Factor objects to byte arrays for transfer over a socket." ;
ABOUT: "concurrency.distributed"
\r
ARTICLE: "concurrency.exchangers" "Object exchange points"\r
"The " { $vocab-link "concurrency.exchangers" } " vocabulary implements " { $emphasis "object exchange points" } ", which are rendezvous points where two threads can exchange objects."\r
-{ $subsection exchanger }\r
-{ $subsection <exchanger> }\r
-{ $subsection exchange }\r
+{ $subsections\r
+ exchanger\r
+ <exchanger>\r
+ exchange\r
+}\r
"One use-case is two threads, where one thread reads data into a buffer and another thread processes the data. The reader thread can begin by reading the data, then passing the buffer through an exchanger, then recursing. The processing thread can begin by creating an empty buffer, and exchanging it through the exchanger. It then processes the result and recurses."\r
$nl\r
"The vocabulary was modelled after a similar feature in Java's " { $snippet "java.util.concurrent" } " library." ;\r
"The flag can be raised at any time; raising a raised flag does nothing. Lowering a flag if it has not been raised yet will wait for another thread to raise the flag."
$nl
"Essentially, a flag can be thought of as a counting semaphore where the count never goes above one."
-{ $subsection flag }
-{ $subsection flag? }
+{ $subsections
+ flag
+ flag?
+}
"Waiting for a flag to be raised:"
-{ $subsection raise-flag }
-{ $subsection wait-for-flag }
-{ $subsection lower-flag } ;
+{ $subsections
+ raise-flag
+ wait-for-flag
+ lower-flag
+} ;
ABOUT: "concurrency.flags"
\r
ARTICLE: "concurrency.futures" "Futures"\r
"The " { $vocab-link "concurrency.futures" } " vocabulary implements " { $emphasis "futures" } ", which are deferred computations performed in a background thread. A thread may create a future, then proceed to perform other tasks, then later wait for the future to complete."\r
-{ $subsection future }\r
-{ $subsection ?future }\r
-{ $subsection ?future-timeout } ;\r
+{ $subsections\r
+ future\r
+ ?future\r
+ ?future-timeout\r
+} ;\r
\r
ABOUT: "concurrency.futures"\r
"A mutual-exclusion lock ensures that only one thread executes with the lock held at a time. They are used to protect critical sections so that certain operations appear to be atomic to other threads."\r
$nl\r
"There are two varieties of locks: non-reentrant and reentrant. The latter may be acquired recursively by the same thread. Attempting to do so with the former will deadlock."\r
-{ $subsection lock }\r
-{ $subsection <lock> }\r
-{ $subsection <reentrant-lock> }\r
-{ $subsection with-lock }\r
-{ $subsection with-lock-timeout } ;\r
+{ $subsections\r
+ lock\r
+ <lock>\r
+ <reentrant-lock>\r
+ with-lock\r
+ with-lock-timeout\r
+} ;\r
\r
HELP: rw-lock\r
{ $class-description "The class of reader/writer locks." } ;\r
"Read/write locks allow any number of threads to hold the read lock simulateneously, however attempting to acquire a write lock blocks until all other threads release read locks and write locks."\r
$nl\r
"Read/write locks are reentrant. A thread holding a write lock may acquire a read lock or a write lock without blocking. However a thread holding a read lock may not acquire a write lock recursively since that could break invariants assumed by the code executing with the read lock held."\r
-{ $subsection rw-lock }\r
-{ $subsection <rw-lock> }\r
-{ $subsection with-read-lock }\r
-{ $subsection with-write-lock }\r
+{ $subsections\r
+ rw-lock\r
+ <rw-lock>\r
+ with-read-lock\r
+ with-write-lock\r
+}\r
"Versions of the above that take a timeout duration:"\r
-{ $subsection with-read-lock-timeout }\r
-{ $subsection with-write-lock-timeout } ;\r
+{ $subsections\r
+ with-read-lock-timeout\r
+ with-write-lock-timeout\r
+} ;\r
\r
ARTICLE: "concurrency.locks" "Locks"\r
"A " { $emphasis "lock" } " is an object protecting a critical region of code, enforcing a particular mutual-exclusion policy. The " { $vocab-link "concurrency.locks" } " vocabulary implements two types of locks:"\r
-{ $subsection "concurrency.locks.mutex" }\r
-{ $subsection "concurrency.locks.rw" } ;\r
+{ $subsections\r
+ "concurrency.locks.mutex"\r
+ "concurrency.locks.rw"\r
+} ;\r
\r
ABOUT: "concurrency.locks"\r
\r
ARTICLE: "concurrency.mailboxes" "Mailboxes"\r
"A " { $emphasis "mailbox" } " is a first-in-first-out queue where the operation of removing an element blocks if the queue is empty. Mailboxes are implemented in the " { $vocab-link "concurrency.mailboxes" } " vocabulary."\r
-{ $subsection mailbox }\r
-{ $subsection <mailbox> }\r
+{ $subsections\r
+ mailbox\r
+ <mailbox>\r
+}\r
"Removing the first element:"\r
-{ $subsection mailbox-get }\r
-{ $subsection mailbox-get-timeout }\r
+{ $subsections\r
+ mailbox-get\r
+ mailbox-get-timeout\r
+}\r
"Removing the first element matching a predicate:"\r
-{ $subsection mailbox-get? }\r
-{ $subsection mailbox-get-timeout? }\r
+{ $subsections\r
+ mailbox-get?\r
+ mailbox-get-timeout?\r
+}\r
"Emptying out a mailbox:"\r
-{ $subsection mailbox-get-all }\r
+{ $subsections mailbox-get-all }\r
"Adding an element:"\r
-{ $subsection mailbox-put }\r
+{ $subsections mailbox-put }\r
"Testing if a mailbox is empty:"\r
-{ $subsection mailbox-empty? }\r
-{ $subsection while-mailbox-empty } ;\r
+{ $subsections\r
+ mailbox-empty?\r
+ while-mailbox-empty\r
+} ;\r
\r
ABOUT: "concurrency.mailboxes"\r
"The messages that are sent from thread to thread are any Factor value. Factor tuples are ideal for this sort of thing as you can send a tuple to a thread and the generic word dispatch mechanism can be used to perform actions depending on what the type of the tuple is."
$nl
"The " { $link spawn } " word pushes the newly-created thread on the calling thread's stack; this thread object can then be sent messages:"
-{ $subsection send }
+{ $subsections send }
"A thread can get a message from its queue:"
-{ $subsection receive }
-{ $subsection receive-timeout }
-{ $subsection receive-if }
-{ $subsection receive-if-timeout }
+{ $subsections
+ receive
+ receive-timeout
+ receive-if
+ receive-if-timeout
+}
{ $see-also "concurrency.mailboxes" } ;
ARTICLE: { "concurrency" "synchronous-sends" } "Synchronous sends"
"The " { $link send } " word sends a message asynchronously, and the sending thread continues immediately. It is also possible to send a message to a thread and block until a response is received:"
-{ $subsection send-synchronous }
+{ $subsections send-synchronous }
"To reply to a synchronous message:"
-{ $subsection reply-synchronous }
+{ $subsections reply-synchronous }
"An example:"
{ $example
"USING: concurrency.messaging threads ;"
"A thread can handle exceptions using the standard Factor exception handling mechanism. If an exception is uncaught the thread will terminate. For example:"
{ $code "[ 1 0 / \"This will not print\" print ] \"division-by-zero\" spawn" }
"Processes can be linked so that a parent thread can receive the exception that caused the child thread to terminate. In this way 'supervisor' threads can be created that are notified when child threads terminate and possibly restart them."
-{ $subsection spawn-linked }
+{ $subsections spawn-linked }
"This will create a unidirectional link, such that if an uncaught exception causes the child to terminate, the parent thread can catch it:"
{ $code "["
" [ 1 0 / \"This will not print\" print ] \"linked-division\" spawn-linked drop"
"A concurrency-oriented program is one in which multiple threads run simultaneously in a single Factor image or across multiple running Factor instances. The threads can communicate with each other by asynchronous message sends."
$nl
"Although threads can share data via Factor's mutable data structures it is not recommended to mix shared state with message passing as it can lead to confusing code."
-{ $subsection { "concurrency" "messaging" } }
-{ $subsection { "concurrency" "synchronous-sends" } }
-{ $subsection { "concurrency" "exceptions" } } ;
+{ $subsections
+ { "concurrency" "messaging" }
+ { "concurrency" "synchronous-sends" }
+ { "concurrency" "exceptions" }
+} ;
ABOUT: "concurrency.messaging"
\r
ARTICLE: "concurrency.promises" "Promises"\r
"The " { $vocab-link "concurrency.promises" } " vocabulary implements " { $emphasis "promises" } ", which are thread-safe write-once variables. Once a promise is created, threads may block waiting for it to be " { $emphasis "fulfilled" } "; at some point in the future, another thread may provide a value at which point all waiting threads are notified."\r
-{ $subsection promise }\r
-{ $subsection <promise> }\r
-{ $subsection fulfill }\r
-{ $subsection ?promise }\r
-{ $subsection ?promise-timeout } ;\r
+{ $subsections\r
+ promise\r
+ <promise>\r
+ fulfill\r
+ ?promise\r
+ ?promise-timeout\r
+} ;\r
\r
ABOUT: "concurrency.promises"\r
"] parallel-map"\r
}\r
"Creating semaphores:"\r
-{ $subsection semaphore }\r
-{ $subsection <semaphore> }\r
+{ $subsections\r
+ semaphore\r
+ <semaphore>\r
+}\r
"Unlike locks, where acquisition and release are always paired by a combinator, semaphores expose these operations directly and there is no requirement that they be performed in the same thread:"\r
-{ $subsection acquire }\r
-{ $subsection acquire-timeout }\r
-{ $subsection release }\r
+{ $subsections\r
+ acquire\r
+ acquire-timeout\r
+ release\r
+}\r
"Combinators which pair acquisition and release:"\r
-{ $subsection with-semaphore }\r
-{ $subsection with-semaphore-timeout } ;\r
+{ $subsections\r
+ with-semaphore\r
+ with-semaphore-timeout\r
+} ;\r
\r
ABOUT: "concurrency.semaphores"\r
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel sequences fry ;
+USING: alien.c-types alien.syntax core-foundation kernel
+sequences fry ;
IN: core-foundation.arrays
TYPEDEF: void* CFArrayRef
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel destructors core-foundation
+USING: alien.c-types alien.syntax kernel destructors
+core-foundation core-foundation.dictionaries
+core-foundation.strings
core-foundation.utilities ;
IN: core-foundation.attributed-strings
[
[ >cf &CFRelease ] bi@
[ kCFAllocatorDefault ] 2dip CFAttributedStringCreate
- ] with-destructors ;
\ No newline at end of file
+ ] with-destructors ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel sequences core-foundation
-core-foundation.urls ;
+USING: alien.c-types alien.syntax kernel sequences
+core-foundation core-foundation.urls ;
IN: core-foundation.bundles
TYPEDEF: void* CFBundleRef
TYPEDEF: void* CFAllocatorRef
CONSTANT: kCFAllocatorDefault f
-TYPEDEF: bool Boolean
-TYPEDEF: long CFIndex
-TYPEDEF: char UInt8
-TYPEDEF: int SInt32
-TYPEDEF: uint UInt32
+TYPEDEF: bool Boolean
+TYPEDEF: long CFIndex
+TYPEDEF: uchar UInt8
+TYPEDEF: ushort UInt16
+TYPEDEF: uint UInt32
+TYPEDEF: ulonglong UInt64
+TYPEDEF: char SInt8
+TYPEDEF: short SInt16
+TYPEDEF: int SInt32
+TYPEDEF: longlong SInt64
TYPEDEF: ulong CFTypeID
TYPEDEF: UInt32 CFOptionFlags
TYPEDEF: void* CFUUIDRef
FUNCTION: void CFRelease ( CFTypeRef cf ) ;
DESTRUCTOR: CFRelease
+
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax kernel math sequences ;
+USING: alien.c-types alien.syntax core-foundation kernel math
+sequences ;
IN: core-foundation.data
TYPEDEF: void* CFDataRef
FUNCTION: CFTypeID CFGetTypeID ( CFTypeRef cf ) ;
: <CFData> ( byte-array -- alien )
- [ f ] dip dup length CFDataCreate ;
\ No newline at end of file
+ [ f ] dip dup length CFDataCreate ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax core-foundation kernel assocs
-specialized-arrays.alien math sequences accessors ;
+USING: alien.c-types alien.syntax core-foundation kernel assocs
+specialized-arrays math sequences accessors ;
IN: core-foundation.dictionaries
+SPECIALIZED-ARRAY: void*
+
TYPEDEF: void* CFDictionaryRef
TYPEDEF: void* CFMutableDictionaryRef
-TYPEDEF: void* CFDictionaryKeyCallBacks*
-TYPEDEF: void* CFDictionaryValueCallBacks*
+C-TYPE: CFDictionaryKeyCallBacks
+C-TYPE: CFDictionaryValueCallBacks
FUNCTION: CFDictionaryRef CFDictionaryCreate (
CFAllocatorRef allocator,
[ [ underlying>> ] bi@ ] [ nip length ] 2bi
&: kCFTypeDictionaryKeyCallBacks
&: kCFTypeDictionaryValueCallBacks
- CFDictionaryCreate ;
\ No newline at end of file
+ CFDictionaryCreate ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel math.bitwise core-foundation ;
+USING: alien.c-types alien.syntax kernel math.bitwise core-foundation ;
IN: core-foundation.file-descriptors
TYPEDEF: void* CFFileDescriptorRef
TYPEDEF: int CFFileDescriptorNativeDescriptor
TYPEDEF: void* CFFileDescriptorCallBack
+C-TYPE: CFFileDescriptorContext
FUNCTION: CFFileDescriptorRef CFFileDescriptorCreate (
CFAllocatorRef allocator,
USING: alien alien.c-types alien.strings alien.syntax kernel
math sequences namespaces make assocs init accessors
continuations combinators io.encodings.utf8 destructors locals
-arrays specialized-arrays.direct.alien classes.struct
-specialized-arrays.direct.int specialized-arrays.direct.longlong
-core-foundation core-foundation.run-loop core-foundation.strings
-core-foundation.time ;
+arrays specialized-arrays classes.struct core-foundation
+core-foundation.arrays core-foundation.run-loop
+core-foundation.strings core-foundation.time unix.types ;
IN: core-foundation.fsevents
+SPECIALIZED-ARRAY: void*
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: longlong
+
CONSTANT: kFSEventStreamCreateFlagUseCFTypes 2
CONSTANT: kFSEventStreamCreateFlagWatchRoot 4
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax kernel math core-foundation ;
+FROM: math => float ;
IN: core-foundation.numbers
TYPEDEF: void* CFNumberRef
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.syntax kernel math namespaces
-sequences destructors combinators threads heaps deques calendar
-core-foundation core-foundation.strings
+USING: accessors alien alien.c-types alien.syntax kernel math
+namespaces sequences destructors combinators threads heaps
+deques calendar core-foundation core-foundation.strings
core-foundation.file-descriptors core-foundation.timers
core-foundation.time ;
IN: core-foundation.run-loop
CFStringRef mode
) ;
-: CFRunLoopDefaultMode ( -- alien )
- #! Ugly, but we don't have static NSStrings
- \ CFRunLoopDefaultMode [
- "kCFRunLoopDefaultMode" <CFString>
- ] initialize-alien ;
+CFSTRING: CFRunLoopDefaultMode "kCFRunLoopDefaultMode"
TUPLE: run-loop fds sources timers ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.strings io.encodings.string kernel
-sequences byte-arrays io.encodings.utf8 math core-foundation
-core-foundation.arrays destructors ;
+USING: alien.c-types alien.syntax alien.strings io.encodings.string
+kernel sequences byte-arrays io.encodings.utf8 math core-foundation
+core-foundation.arrays destructors parser fry alien words ;
IN: core-foundation.strings
TYPEDEF: void* CFStringRef
: <CFStringArray> ( seq -- alien )
[ [ <CFString> &CFRelease ] map <CFArray> ] with-destructors ;
+
+SYNTAX: CFSTRING:
+ CREATE scan-object
+ [ drop ] [ '[ _ [ _ <CFString> ] initialize-alien ] ] 2bi
+ (( -- alien )) define-declared ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: calendar alien.syntax ;
+USING: calendar alien.c-types alien.syntax ;
IN: core-foundation.time
TYPEDEF: double CFTimeInterval
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system math kernel calendar core-foundation
-core-foundation.time ;
+USING: alien.c-types alien.syntax system math kernel calendar
+core-foundation core-foundation.time ;
IN: core-foundation.timers
TYPEDEF: void* CFRunLoopTimerRef
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel core-foundation.strings
-core-foundation ;
+USING: alien.c-types alien.syntax kernel core-foundation.strings
+core-foundation core-foundation.urls ;
IN: core-foundation.urls
CONSTANT: kCFURLPOSIXPathStyle 0
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.destructors alien.syntax accessors
destructors fry kernel math math.bitwise sequences libc colors
-images images.memory core-graphics.types core-foundation.utilities ;
+images images.memory core-graphics.types core-foundation.utilities
+opengl.gl ;
IN: core-graphics
! CGImageAlphaInfo
"CGSize"
}
"Some words for working with the above:"
-{ $subsection <CGRect> }
-{ $subsection <CGPoint> }
-{ $subsection <CGSize> } ;
+{ $subsections
+ <CGRect>
+ <CGPoint>
+ <CGSize>
+} ;
IN: core-graphics.types
ABOUT: "core-graphics.types"
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax classes.struct kernel layouts
-math math.rectangles arrays ;
+math math.rectangles arrays literals ;
+FROM: alien.c-types => float ;
IN: core-graphics.types
-<< cell 4 = "float" "double" ? "CGFloat" typedef >>
+SYMBOL: CGFloat
+<< cell 4 = float double ? \ CGFloat typedef >>
: <CGFloat> ( x -- alien )
cell 4 = [ <float> ] [ <double> ] if ; inline
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.syntax assocs core-foundation
-core-foundation.strings core-text.utilities destructors init
-kernel math memoize fonts combinators ;
+USING: accessors alien.c-types alien.syntax assocs core-foundation
+core-foundation.dictionaries core-foundation.strings
+core-graphics.types core-text.utilities destructors init
+kernel math memoize fonts combinators unix.types ;
IN: core-text.fonts
TYPEDEF: void* CTFontRef
! Floating point registers can contain data with
! one of these representations
-SINGLETONS: single-float-rep double-float-rep ;
-
-UNION: representation any-rep tagged-rep int-rep single-float-rep double-float-rep ;
+SINGLETONS: float-rep double-rep ;
+
+! On x86, floating point registers are really vector registers
+SINGLETONS:
+char-16-rep
+uchar-16-rep
+short-8-rep
+ushort-8-rep
+int-4-rep
+uint-4-rep
+longlong-2-rep
+ulonglong-2-rep ;
+
+! Scalar values in the high component of a vector register
+SINGLETONS:
+char-scalar-rep
+uchar-scalar-rep
+short-scalar-rep
+ushort-scalar-rep
+int-scalar-rep
+uint-scalar-rep
+longlong-scalar-rep
+ulonglong-scalar-rep ;
+
+SINGLETONS:
+float-4-rep
+double-2-rep ;
+
+UNION: int-vector-rep
+char-16-rep
+uchar-16-rep
+short-8-rep
+ushort-8-rep
+int-4-rep
+uint-4-rep
+longlong-2-rep
+ulonglong-2-rep ;
+
+UNION: scalar-rep
+char-scalar-rep
+uchar-scalar-rep
+short-scalar-rep
+ushort-scalar-rep
+int-scalar-rep
+uint-scalar-rep
+longlong-scalar-rep
+ulonglong-scalar-rep ;
+
+UNION: float-vector-rep
+float-4-rep
+double-2-rep ;
+
+UNION: vector-rep
+int-vector-rep
+float-vector-rep ;
+
+UNION: representation
+any-rep
+tagged-rep
+int-rep
+float-rep
+double-rep
+vector-rep
+scalar-rep ;
! Register classes
SINGLETONS: int-regs float-regs ;
! A pseudo-register class for parameters spilled on the stack
SINGLETON: stack-params
-: reg-class-of ( rep -- reg-class )
- {
- { tagged-rep [ int-regs ] }
- { int-rep [ int-regs ] }
- { single-float-rep [ float-regs ] }
- { double-float-rep [ float-regs ] }
- { stack-params [ stack-params ] }
- } case ;
-
-: rep-size ( rep -- n )
- {
- { tagged-rep [ cell ] }
- { int-rep [ cell ] }
- { single-float-rep [ 4 ] }
- { double-float-rep [ 8 ] }
- { stack-params [ cell ] }
- } case ;
+! On x86, vectors and floats are stored in the same register bank
+! On PowerPC they are distinct
+HOOK: vector-regs cpu ( -- reg-class )
+
+GENERIC: reg-class-of ( rep -- reg-class )
+
+M: tagged-rep reg-class-of drop int-regs ;
+M: int-rep reg-class-of drop int-regs ;
+M: float-rep reg-class-of drop float-regs ;
+M: double-rep reg-class-of drop float-regs ;
+M: vector-rep reg-class-of drop vector-regs ;
+M: scalar-rep reg-class-of drop vector-regs ;
+M: stack-params reg-class-of drop stack-params ;
+
+GENERIC: rep-size ( rep -- n ) foldable
+
+M: tagged-rep rep-size drop cell ;
+M: int-rep rep-size drop cell ;
+M: float-rep rep-size drop 4 ;
+M: double-rep rep-size drop 8 ;
+M: stack-params rep-size drop cell ;
+M: vector-rep rep-size drop 16 ;
+M: char-scalar-rep rep-size drop 1 ;
+M: uchar-scalar-rep rep-size drop 1 ;
+M: short-scalar-rep rep-size drop 2 ;
+M: ushort-scalar-rep rep-size drop 2 ;
+M: int-scalar-rep rep-size drop 4 ;
+M: uint-scalar-rep rep-size drop 4 ;
+M: longlong-scalar-rep rep-size drop 8 ;
+M: ulonglong-scalar-rep rep-size drop 8 ;
+
+GENERIC: rep-component-type ( rep -- n )
+
+! Methods defined in alien.c-types
+
+GENERIC: scalar-rep-of ( rep -- rep' )
+
+M: float-4-rep scalar-rep-of drop float-rep ;
+M: double-2-rep scalar-rep-of drop double-rep ;
+M: char-16-rep scalar-rep-of drop char-scalar-rep ;
+M: uchar-16-rep scalar-rep-of drop uchar-scalar-rep ;
+M: short-8-rep scalar-rep-of drop short-scalar-rep ;
+M: ushort-8-rep scalar-rep-of drop ushort-scalar-rep ;
+M: int-4-rep scalar-rep-of drop int-scalar-rep ;
+M: uint-4-rep scalar-rep-of drop uint-scalar-rep ;
+M: longlong-2-rep scalar-rep-of drop longlong-scalar-rep ;
+M: ulonglong-2-rep scalar-rep-of drop ulonglong-scalar-rep ;
! Mapping from register class to machine registers
HOOK: machine-registers cpu ( -- assoc )
-HOOK: two-operand? cpu ( -- ? )
-
HOOK: %load-immediate cpu ( reg obj -- )
HOOK: %load-reference cpu ( reg obj -- )
HOOK: %dispatch cpu ( src temp -- )
-HOOK: %slot cpu ( dst obj slot tag temp -- )
+HOOK: %slot cpu ( dst obj slot -- )
HOOK: %slot-imm cpu ( dst obj slot tag -- )
-HOOK: %set-slot cpu ( src obj slot tag temp -- )
+HOOK: %set-slot cpu ( src obj slot -- )
HOOK: %set-slot-imm cpu ( src obj slot tag -- )
HOOK: %string-nth cpu ( dst obj index temp -- )
HOOK: %min cpu ( dst src1 src2 -- )
HOOK: %max cpu ( dst src1 src2 -- )
HOOK: %not cpu ( dst src -- )
+HOOK: %neg cpu ( dst src -- )
HOOK: %log2 cpu ( dst src -- )
+HOOK: %copy cpu ( dst src rep -- )
+
HOOK: %fixnum-add cpu ( label dst src1 src2 -- )
HOOK: %fixnum-sub cpu ( label dst src1 src2 -- )
HOOK: %fixnum-mul cpu ( label dst src1 src2 -- )
-HOOK: %integer>bignum cpu ( dst src temp -- )
-HOOK: %bignum>integer cpu ( dst src temp -- )
-
HOOK: %add-float cpu ( dst src1 src2 -- )
HOOK: %sub-float cpu ( dst src1 src2 -- )
HOOK: %mul-float cpu ( dst src1 src2 -- )
HOOK: %min-float cpu ( dst src1 src2 -- )
HOOK: %max-float cpu ( dst src1 src2 -- )
HOOK: %sqrt cpu ( dst src -- )
+HOOK: %unary-float-function cpu ( dst src func -- )
+HOOK: %binary-float-function cpu ( dst src1 src2 func -- )
+
+HOOK: %single>double-float cpu ( dst src -- )
+HOOK: %double>single-float cpu ( dst src -- )
HOOK: %integer>float cpu ( dst src -- )
HOOK: %float>integer cpu ( dst src -- )
-HOOK: %copy cpu ( dst src rep -- )
-HOOK: %unbox-float cpu ( dst src -- )
+HOOK: %zero-vector cpu ( dst rep -- )
+HOOK: %fill-vector cpu ( dst rep -- )
+HOOK: %gather-vector-2 cpu ( dst src1 src2 rep -- )
+HOOK: %gather-vector-4 cpu ( dst src1 src2 src3 src4 rep -- )
+HOOK: %shuffle-vector cpu ( dst src shuffle rep -- )
+HOOK: %merge-vector-head cpu ( dst src1 src2 rep -- )
+HOOK: %merge-vector-tail cpu ( dst src1 src2 rep -- )
+HOOK: %compare-vector cpu ( dst src1 src2 temp rep cc -- )
+HOOK: %test-vector cpu ( dst src1 temp rep vcc -- )
+HOOK: %test-vector-branch cpu ( label src1 temp rep vcc -- )
+HOOK: %add-vector cpu ( dst src1 src2 rep -- )
+HOOK: %saturated-add-vector cpu ( dst src1 src2 rep -- )
+HOOK: %add-sub-vector cpu ( dst src1 src2 rep -- )
+HOOK: %sub-vector cpu ( dst src1 src2 rep -- )
+HOOK: %saturated-sub-vector cpu ( dst src1 src2 rep -- )
+HOOK: %mul-vector cpu ( dst src1 src2 rep -- )
+HOOK: %saturated-mul-vector cpu ( dst src1 src2 rep -- )
+HOOK: %div-vector cpu ( dst src1 src2 rep -- )
+HOOK: %min-vector cpu ( dst src1 src2 rep -- )
+HOOK: %max-vector cpu ( dst src1 src2 rep -- )
+HOOK: %dot-vector cpu ( dst src1 src2 rep -- )
+HOOK: %sqrt-vector cpu ( dst src rep -- )
+HOOK: %horizontal-add-vector cpu ( dst src rep -- )
+HOOK: %horizontal-sub-vector cpu ( dst src rep -- )
+HOOK: %abs-vector cpu ( dst src rep -- )
+HOOK: %and-vector cpu ( dst src1 src2 rep -- )
+HOOK: %andn-vector cpu ( dst src1 src2 rep -- )
+HOOK: %or-vector cpu ( dst src1 src2 rep -- )
+HOOK: %xor-vector cpu ( dst src1 src2 rep -- )
+HOOK: %not-vector cpu ( dst src rep -- )
+HOOK: %shl-vector cpu ( dst src1 src2 rep -- )
+HOOK: %shr-vector cpu ( dst src1 src2 rep -- )
+HOOK: %horizontal-shl-vector cpu ( dst src1 src2 rep -- )
+HOOK: %horizontal-shr-vector cpu ( dst src1 src2 rep -- )
+
+HOOK: %integer>scalar cpu ( dst src rep -- )
+HOOK: %scalar>integer cpu ( dst src rep -- )
+HOOK: %vector>scalar cpu ( dst src rep -- )
+HOOK: %scalar>vector cpu ( dst src rep -- )
+
+HOOK: %zero-vector-reps cpu ( -- reps )
+HOOK: %fill-vector-reps cpu ( -- reps )
+HOOK: %gather-vector-2-reps cpu ( -- reps )
+HOOK: %gather-vector-4-reps cpu ( -- reps )
+HOOK: %shuffle-vector-reps cpu ( -- reps )
+HOOK: %merge-vector-reps cpu ( -- reps )
+HOOK: %compare-vector-reps cpu ( cc -- reps )
+HOOK: %test-vector-reps cpu ( -- reps )
+HOOK: %add-vector-reps cpu ( -- reps )
+HOOK: %saturated-add-vector-reps cpu ( -- reps )
+HOOK: %add-sub-vector-reps cpu ( -- reps )
+HOOK: %sub-vector-reps cpu ( -- reps )
+HOOK: %saturated-sub-vector-reps cpu ( -- reps )
+HOOK: %mul-vector-reps cpu ( -- reps )
+HOOK: %saturated-mul-vector-reps cpu ( -- reps )
+HOOK: %div-vector-reps cpu ( -- reps )
+HOOK: %min-vector-reps cpu ( -- reps )
+HOOK: %max-vector-reps cpu ( -- reps )
+HOOK: %dot-vector-reps cpu ( -- reps )
+HOOK: %sqrt-vector-reps cpu ( -- reps )
+HOOK: %horizontal-add-vector-reps cpu ( -- reps )
+HOOK: %horizontal-sub-vector-reps cpu ( -- reps )
+HOOK: %abs-vector-reps cpu ( -- reps )
+HOOK: %and-vector-reps cpu ( -- reps )
+HOOK: %andn-vector-reps cpu ( -- reps )
+HOOK: %or-vector-reps cpu ( -- reps )
+HOOK: %xor-vector-reps cpu ( -- reps )
+HOOK: %not-vector-reps cpu ( -- reps )
+HOOK: %shl-vector-reps cpu ( -- reps )
+HOOK: %shr-vector-reps cpu ( -- reps )
+HOOK: %horizontal-shl-vector-reps cpu ( -- reps )
+HOOK: %horizontal-shr-vector-reps cpu ( -- reps )
+
+HOOK: %unbox-alien cpu ( dst src -- )
HOOK: %unbox-any-c-ptr cpu ( dst src temp -- )
-HOOK: %box-float cpu ( dst src temp -- )
HOOK: %box-alien cpu ( dst src temp -- )
-HOOK: %box-displaced-alien cpu ( dst displacement base temp -- )
-
-HOOK: %alien-unsigned-1 cpu ( dst src -- )
-HOOK: %alien-unsigned-2 cpu ( dst src -- )
-HOOK: %alien-unsigned-4 cpu ( dst src -- )
-HOOK: %alien-signed-1 cpu ( dst src -- )
-HOOK: %alien-signed-2 cpu ( dst src -- )
-HOOK: %alien-signed-4 cpu ( dst src -- )
-HOOK: %alien-cell cpu ( dst src -- )
-HOOK: %alien-float cpu ( dst src -- )
-HOOK: %alien-double cpu ( dst src -- )
-
-HOOK: %set-alien-integer-1 cpu ( ptr value -- )
-HOOK: %set-alien-integer-2 cpu ( ptr value -- )
-HOOK: %set-alien-integer-4 cpu ( ptr value -- )
-HOOK: %set-alien-cell cpu ( ptr value -- )
-HOOK: %set-alien-float cpu ( ptr value -- )
-HOOK: %set-alien-double cpu ( ptr value -- )
+HOOK: %box-displaced-alien cpu ( dst displacement base temp1 temp2 base-class -- )
+
+HOOK: %alien-unsigned-1 cpu ( dst src offset -- )
+HOOK: %alien-unsigned-2 cpu ( dst src offset -- )
+HOOK: %alien-unsigned-4 cpu ( dst src offset -- )
+HOOK: %alien-signed-1 cpu ( dst src offset -- )
+HOOK: %alien-signed-2 cpu ( dst src offset -- )
+HOOK: %alien-signed-4 cpu ( dst src offset -- )
+HOOK: %alien-cell cpu ( dst src offset -- )
+HOOK: %alien-float cpu ( dst src offset -- )
+HOOK: %alien-double cpu ( dst src offset -- )
+HOOK: %alien-vector cpu ( dst src offset rep -- )
+
+HOOK: %set-alien-integer-1 cpu ( ptr offset value -- )
+HOOK: %set-alien-integer-2 cpu ( ptr offset value -- )
+HOOK: %set-alien-integer-4 cpu ( ptr offset value -- )
+HOOK: %set-alien-cell cpu ( ptr offset value -- )
+HOOK: %set-alien-float cpu ( ptr offset value -- )
+HOOK: %set-alien-double cpu ( ptr offset value -- )
+HOOK: %set-alien-vector cpu ( ptr offset value rep -- )
HOOK: %alien-global cpu ( dst symbol library -- )
+HOOK: %vm-field-ptr cpu ( dst fieldname -- )
HOOK: %allot cpu ( dst size class temp -- )
HOOK: %write-barrier cpu ( src card# table -- )
! GC checks
-HOOK: %check-nursery cpu ( label temp1 temp2 -- )
+HOOK: %check-nursery cpu ( label size temp1 temp2 -- )
HOOK: %save-gc-root cpu ( gc-root register -- )
HOOK: %load-gc-root cpu ( gc-root register -- )
-HOOK: %call-gc cpu ( gc-root-count -- )
+HOOK: %call-gc cpu ( gc-root-count temp1 -- )
HOOK: %prologue cpu ( n -- )
HOOK: %epilogue cpu ( n -- )
HOOK: %compare cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-imm cpu ( dst temp cc src1 src2 -- )
-HOOK: %compare-float cpu ( dst temp cc src1 src2 -- )
+HOOK: %compare-float-ordered cpu ( dst temp cc src1 src2 -- )
+HOOK: %compare-float-unordered cpu ( dst temp cc src1 src2 -- )
HOOK: %compare-branch cpu ( label cc src1 src2 -- )
HOOK: %compare-imm-branch cpu ( label cc src1 src2 -- )
-HOOK: %compare-float-branch cpu ( label cc src1 src2 -- )
+HOOK: %compare-float-ordered-branch cpu ( label cc src1 src2 -- )
+HOOK: %compare-float-unordered-branch cpu ( label cc src1 src2 -- )
-HOOK: %spill cpu ( src n rep -- )
-HOOK: %reload cpu ( dst n rep -- )
+HOOK: %spill cpu ( src rep dst -- )
+HOOK: %reload cpu ( dst rep src -- )
HOOK: %loop-entry cpu ( -- )
HOOK: %load-param-reg cpu ( stack reg rep -- )
-HOOK: %prepare-alien-invoke cpu ( -- )
+HOOK: %save-context cpu ( temp1 temp2 callback-allowed? -- )
HOOK: %prepare-var-args cpu ( -- )
HOOK: %callback-value cpu ( ctype -- )
+HOOK: %nest-stacks cpu ( -- )
+
+HOOK: %unnest-stacks cpu ( -- )
+
! Return to caller with stdcall unwinding (only for x86)
HOOK: %callback-return cpu ( params -- )
--- /dev/null
+IN: cpu.arm.assembler.tests
+USING: cpu.arm.assembler math tools.test namespaces make
+sequences kernel quotations ;
+FROM: cpu.arm.assembler => B ;
+
+: test-opcode ( expect quot -- ) [ { } make first ] curry unit-test ;
+
+[ HEX: ea000000 ] [ 0 B ] test-opcode
+[ HEX: eb000000 ] [ 0 BL ] test-opcode
+! [ HEX: e12fff30 ] [ R0 BLX ] test-opcode
+
+[ HEX: e24cc004 ] [ IP IP 4 SUB ] test-opcode
+[ HEX: e24cb004 ] [ FP IP 4 SUB ] test-opcode
+[ HEX: e087e3ac ] [ LR R7 IP 7 <LSR> ADD ] test-opcode
+[ HEX: e08c0109 ] [ R0 IP R9 2 <LSL> ADD ] test-opcode
+[ HEX: 02850004 ] [ R0 R5 4 EQ ADD ] test-opcode
+[ HEX: 00000000 ] [ R0 R0 R0 EQ AND ] test-opcode
+
+[ HEX: e1a0c00c ] [ IP IP MOV ] test-opcode
+[ HEX: e1a0c00d ] [ IP SP MOV ] test-opcode
+[ HEX: e3a03003 ] [ R3 3 MOV ] test-opcode
+[ HEX: e1a00003 ] [ R0 R3 MOV ] test-opcode
+[ HEX: e1e01c80 ] [ R1 R0 25 <LSL> MVN ] test-opcode
+[ HEX: e1e00ca1 ] [ R0 R1 25 <LSR> MVN ] test-opcode
+[ HEX: 11a021ac ] [ R2 IP 3 <LSR> NE MOV ] test-opcode
+
+[ HEX: e3530007 ] [ R3 7 CMP ] test-opcode
+
+[ HEX: e008049a ] [ R8 SL R4 MUL ] test-opcode
+
+[ HEX: e5151004 ] [ R1 R5 4 <-> LDR ] test-opcode
+[ HEX: e41c2004 ] [ R2 IP 4 <-!> LDR ] test-opcode
+[ HEX: e50e2004 ] [ R2 LR 4 <-> STR ] test-opcode
+
+[ HEX: e7910002 ] [ R0 R1 R2 <+> LDR ] test-opcode
+[ HEX: e7910102 ] [ R0 R1 R2 2 <LSL> <+> LDR ] test-opcode
+
+[ HEX: e1d310bc ] [ R1 R3 12 <+> LDRH ] test-opcode
+[ HEX: e1d310fc ] [ R1 R3 12 <+> LDRSH ] test-opcode
+[ HEX: e1d310dc ] [ R1 R3 12 <+> LDRSB ] test-opcode
+[ HEX: e1c310bc ] [ R1 R3 12 <+> STRH ] test-opcode
+[ HEX: e19310b4 ] [ R1 R3 R4 <+> LDRH ] test-opcode
+[ HEX: e1f310fc ] [ R1 R3 12 <!+> LDRSH ] test-opcode
+[ HEX: e1b310d4 ] [ R1 R3 R4 <!+> LDRSB ] test-opcode
+[ HEX: e0c317bb ] [ R1 R3 123 <+!> STRH ] test-opcode
+[ HEX: e08310b4 ] [ R1 R3 R4 <+!> STRH ] test-opcode
--- /dev/null
+! Copyright (C) 2007, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators kernel make math math.bitwise
+namespaces sequences words words.symbol parser ;
+IN: cpu.arm.assembler
+
+! Registers
+<<
+
+SYMBOL: registers
+
+V{ } registers set-global
+
+SYNTAX: REGISTER:
+ CREATE-WORD
+ [ define-symbol ]
+ [ registers get length "register" set-word-prop ]
+ [ registers get push ]
+ tri ;
+
+>>
+
+REGISTER: R0
+REGISTER: R1
+REGISTER: R2
+REGISTER: R3
+REGISTER: R4
+REGISTER: R5
+REGISTER: R6
+REGISTER: R7
+REGISTER: R8
+REGISTER: R9
+REGISTER: R10
+REGISTER: R11
+REGISTER: R12
+REGISTER: R13
+REGISTER: R14
+REGISTER: R15
+
+ALIAS: SL R10 ALIAS: FP R11 ALIAS: IP R12
+ALIAS: SP R13 ALIAS: LR R14 ALIAS: PC R15
+
+<PRIVATE
+
+PREDICATE: register < word register >boolean ;
+
+GENERIC: register ( register -- n )
+M: word register "register" word-prop ;
+M: f register drop 0 ;
+
+PRIVATE>
+
+! Condition codes
+SYMBOL: cond-code
+
+: >CC ( n -- )
+ cond-code set ;
+
+: CC> ( -- n )
+ #! Default value is BIN: 1110 AL (= always)
+ cond-code [ f ] change BIN: 1110 or ;
+
+: EQ ( -- ) BIN: 0000 >CC ;
+: NE ( -- ) BIN: 0001 >CC ;
+: CS ( -- ) BIN: 0010 >CC ;
+: CC ( -- ) BIN: 0011 >CC ;
+: LO ( -- ) BIN: 0100 >CC ;
+: PL ( -- ) BIN: 0101 >CC ;
+: VS ( -- ) BIN: 0110 >CC ;
+: VC ( -- ) BIN: 0111 >CC ;
+: HI ( -- ) BIN: 1000 >CC ;
+: LS ( -- ) BIN: 1001 >CC ;
+: GE ( -- ) BIN: 1010 >CC ;
+: LT ( -- ) BIN: 1011 >CC ;
+: GT ( -- ) BIN: 1100 >CC ;
+: LE ( -- ) BIN: 1101 >CC ;
+: AL ( -- ) BIN: 1110 >CC ;
+: NV ( -- ) BIN: 1111 >CC ;
+
+<PRIVATE
+
+: (insn) ( n -- ) CC> 28 shift bitor , ;
+
+: insn ( bitspec -- ) bitfield (insn) ; inline
+
+! Branching instructions
+GENERIC# (B) 1 ( target l -- )
+
+M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ;
+
+PRIVATE>
+
+: B ( target -- ) 0 (B) ;
+: BL ( target -- ) 1 (B) ;
+
+! Data processing instructions
+<PRIVATE
+
+SYMBOL: updates-cond-code
+
+PRIVATE>
+
+: S ( -- ) updates-cond-code on ;
+
+: S> ( -- ? ) updates-cond-code [ f ] change ;
+
+<PRIVATE
+
+: sinsn ( bitspec -- )
+ bitfield S> [ 20 2^ bitor ] when (insn) ; inline
+
+GENERIC# shift-imm/reg 2 ( shift-imm/Rs Rm shift -- n )
+
+M: integer shift-imm/reg ( shift-imm Rm shift -- n )
+ { { 0 4 } 5 { register 0 } 7 } bitfield ;
+
+M: register shift-imm/reg ( Rs Rm shift -- n )
+ {
+ { 1 4 }
+ { 0 7 }
+ 5
+ { register 8 }
+ { register 0 }
+ } bitfield ;
+
+PRIVATE>
+
+TUPLE: IMM immed rotate ;
+C: <IMM> IMM
+
+TUPLE: shifter Rm by shift ;
+C: <shifter> shifter
+
+<PRIVATE
+
+GENERIC: shifter-op ( shifter-op -- n )
+
+M: IMM shifter-op
+ [ immed>> ] [ rotate>> ] bi { { 1 25 } 8 0 } bitfield ;
+
+M: shifter shifter-op
+ [ by>> ] [ Rm>> ] [ shift>> ] tri shift-imm/reg ;
+
+PRIVATE>
+
+: <LSL> ( Rm shift-imm/Rs -- shifter-op ) BIN: 00 <shifter> ;
+: <LSR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 01 <shifter> ;
+: <ASR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 10 <shifter> ;
+: <ROR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 11 <shifter> ;
+: <RRX> ( Rm -- shifter-op ) 0 <ROR> ;
+
+M: register shifter-op 0 <LSL> shifter-op ;
+M: integer shifter-op 0 <IMM> shifter-op ;
+
+<PRIVATE
+
+: addr1 ( Rd Rn shifter-op opcode -- )
+ {
+ 21 ! opcode
+ { shifter-op 0 }
+ { register 16 } ! Rn
+ { register 12 } ! Rd
+ } sinsn ;
+
+PRIVATE>
+
+: AND ( Rd Rn shifter-op -- ) BIN: 0000 addr1 ;
+: EOR ( Rd Rn shifter-op -- ) BIN: 0001 addr1 ;
+: SUB ( Rd Rn shifter-op -- ) BIN: 0010 addr1 ;
+: RSB ( Rd Rn shifter-op -- ) BIN: 0011 addr1 ;
+: ADD ( Rd Rn shifter-op -- ) BIN: 0100 addr1 ;
+: ADC ( Rd Rn shifter-op -- ) BIN: 0101 addr1 ;
+: SBC ( Rd Rn shifter-op -- ) BIN: 0110 addr1 ;
+: RSC ( Rd Rn shifter-op -- ) BIN: 0111 addr1 ;
+: ORR ( Rd Rn shifter-op -- ) BIN: 1100 addr1 ;
+: BIC ( Rd Rn shifter-op -- ) BIN: 1110 addr1 ;
+
+: MOV ( Rd shifter-op -- ) [ f ] dip BIN: 1101 addr1 ;
+: MVN ( Rd shifter-op -- ) [ f ] dip BIN: 1111 addr1 ;
+
+! These always update the condition code flags
+<PRIVATE
+
+: (CMP) ( Rn shifter-op opcode -- ) [ f ] 3dip S addr1 ;
+
+PRIVATE>
+
+: TST ( Rn shifter-op -- ) BIN: 1000 (CMP) ;
+: TEQ ( Rn shifter-op -- ) BIN: 1001 (CMP) ;
+: CMP ( Rn shifter-op -- ) BIN: 1010 (CMP) ;
+: CMN ( Rn shifter-op -- ) BIN: 1011 (CMP) ;
+
+! Multiply instructions
+<PRIVATE
+
+: (MLA) ( Rd Rm Rs Rn a -- )
+ {
+ 21
+ { register 12 }
+ { register 8 }
+ { register 0 }
+ { register 16 }
+ { 1 7 }
+ { 1 4 }
+ } sinsn ;
+
+: (S/UMLAL) ( RdLo RdHi Rm Rs s a -- )
+ {
+ { 1 23 }
+ 22
+ 21
+ { register 8 }
+ { register 0 }
+ { register 16 }
+ { register 12 }
+ { 1 7 }
+ { 1 4 }
+ } sinsn ;
+
+PRIVATE>
+
+: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
+: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
+
+: SMLAL ( RdLo RdHi Rm Rs -- ) 1 1 (S/UMLAL) ;
+: SMULL ( RdLo RdHi Rm Rs -- ) 1 0 (S/UMLAL) ;
+: UMLAL ( RdLo RdHi Rm Rs -- ) 0 1 (S/UMLAL) ;
+: UMULL ( RdLo RdHi Rm Rs -- ) 0 0 (S/UMLAL) ;
+
+! Miscellaneous arithmetic instructions
+: CLZ ( Rd Rm -- )
+ {
+ { 1 24 }
+ { 1 22 }
+ { 1 21 }
+ { BIN: 111 16 }
+ { BIN: 1111 8 }
+ { 1 4 }
+ { register 0 }
+ { register 12 }
+ } sinsn ;
+
+! Status register acess instructions
+
+! Load and store instructions
+<PRIVATE
+
+GENERIC: addressing-mode-2 ( addressing-mode -- n )
+
+TUPLE: addressing base p u w ;
+C: <addressing> addressing
+
+M: addressing addressing-mode-2
+ { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-2 ] } cleave
+ { 0 21 23 24 } bitfield ;
+
+M: integer addressing-mode-2 ;
+
+M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
+
+: addr2 ( Rd Rn addressing-mode b l -- )
+ {
+ { 1 26 }
+ 20
+ 22
+ { addressing-mode-2 0 }
+ { register 16 }
+ { register 12 }
+ } insn ;
+
+PRIVATE>
+
+! Offset
+: <+> ( base -- addressing ) 1 1 0 <addressing> ;
+: <-> ( base -- addressing ) 1 0 0 <addressing> ;
+
+! Pre-indexed
+: <!+> ( base -- addressing ) 1 1 1 <addressing> ;
+: <!-> ( base -- addressing ) 1 0 1 <addressing> ;
+
+! Post-indexed
+: <+!> ( base -- addressing ) 0 1 0 <addressing> ;
+: <-!> ( base -- addressing ) 0 0 0 <addressing> ;
+
+: LDR ( Rd Rn addressing-mode -- ) 0 1 addr2 ;
+: LDRB ( Rd Rn addressing-mode -- ) 1 1 addr2 ;
+: STR ( Rd Rn addressing-mode -- ) 0 0 addr2 ;
+: STRB ( Rd Rn addressing-mode -- ) 1 0 addr2 ;
+
+! We might have to simulate these instructions since older ARM
+! chips don't have them.
+SYMBOL: have-BX?
+SYMBOL: have-BLX?
+
+<PRIVATE
+
+GENERIC# (BX) 1 ( Rm l -- )
+
+M: register (BX) ( Rm l -- )
+ {
+ { 1 24 }
+ { 1 21 }
+ { BIN: 1111 16 }
+ { BIN: 1111 12 }
+ { BIN: 1111 8 }
+ 5
+ { 1 4 }
+ { register 0 }
+ } insn ;
+
+PRIVATE>
+
+: BX ( Rm -- ) have-BX? get [ 0 (BX) ] [ [ PC ] dip MOV ] if ;
+
+: BLX ( Rm -- ) have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
+
+! More load and store instructions
+<PRIVATE
+
+GENERIC: addressing-mode-3 ( addressing-mode -- n )
+
+: b>n/n ( b -- n n ) [ -4 shift ] [ HEX: f bitand ] bi ;
+
+M: addressing addressing-mode-3
+ { [ p>> ] [ u>> ] [ w>> ] [ base>> addressing-mode-3 ] } cleave
+ { 0 21 23 24 } bitfield ;
+
+M: integer addressing-mode-3
+ b>n/n {
+ ! { 1 24 }
+ { 1 22 }
+ { 1 7 }
+ { 1 4 }
+ 0
+ 8
+ } bitfield ;
+
+M: object addressing-mode-3
+ shifter-op {
+ ! { 1 24 }
+ { 1 7 }
+ { 1 4 }
+ 0
+ } bitfield ;
+
+: addr3 ( Rn Rd addressing-mode h l s -- )
+ {
+ 6
+ 20
+ 5
+ { addressing-mode-3 0 }
+ { register 16 }
+ { register 12 }
+ } insn ;
+
+PRIVATE>
+
+: LDRH ( Rn Rd addressing-mode -- ) 1 1 0 addr3 ;
+: LDRSB ( Rn Rd addressing-mode -- ) 0 1 1 addr3 ;
+: LDRSH ( Rn Rd addressing-mode -- ) 1 1 1 addr3 ;
+: STRH ( Rn Rd addressing-mode -- ) 1 0 0 addr3 ;
+
+! Load and store multiple instructions
+
+! Semaphore instructions
+
+! Exception-generating instructions
--- /dev/null
+Slava Pestov
r r n HEX: ffff bitand ORI ;
: immediate? ( n -- ? ) HEX: -8000 HEX: 7fff between? ;
: LOAD ( n r -- ) over immediate? [ LI ] [ LOAD32 ] if ;
+
+! Altivec/VMX instructions
+VA: VMHADDSHS 32 4
+VA: VMHRADDSHS 33 4
+VA: VMLADDUHM 34 4
+VA: VMSUMUBM 36 4
+VA: VMSUMMBM 37 4
+VA: VMSUMUHM 38 4
+VA: VMSUMUHS 39 4
+VA: VMSUMSHM 40 4
+VA: VMSUMSHS 41 4
+VA: VSEL 42 4
+VA: VPERM 43 4
+VA: VSLDOI 44 4
+VA: VMADDFP 46 4
+VA: VNMSUBFP 47 4
+
+VX: VADDUBM 0 4
+VX: VADDUHM 64 4
+VX: VADDUWM 128 4
+VX: VADDCUW 384 4
+VX: VADDUBS 512 4
+VX: VADDUHS 576 4
+VX: VADDUWS 640 4
+VX: VADDSBS 768 4
+VX: VADDSHS 832 4
+VX: VADDSWS 896 4
+
+VX: VSUBUBM 1024 4
+VX: VSUBUHM 1088 4
+VX: VSUBUWM 1152 4
+VX: VSUBCUW 1408 4
+VX: VSUBUBS 1536 4
+VX: VSUBUHS 1600 4
+VX: VSUBUWS 1664 4
+VX: VSUBSBS 1792 4
+VX: VSUBSHS 1856 4
+VX: VSUBSWS 1920 4
+
+VX: VMAXUB 2 4
+VX: VMAXUH 66 4
+VX: VMAXUW 130 4
+VX: VMAXSB 258 4
+VX: VMAXSH 322 4
+VX: VMAXSW 386 4
+
+VX: VMINUB 514 4
+VX: VMINUH 578 4
+VX: VMINUW 642 4
+VX: VMINSB 770 4
+VX: VMINSH 834 4
+VX: VMINSW 898 4
+
+VX: VAVGUB 1026 4
+VX: VAVGUH 1090 4
+VX: VAVGUW 1154 4
+VX: VAVGSB 1282 4
+VX: VAVGSH 1346 4
+VX: VAVGSW 1410 4
+
+VX: VRLB 4 4
+VX: VRLH 68 4
+VX: VRLW 132 4
+VX: VSLB 260 4
+VX: VSLH 324 4
+VX: VSLW 388 4
+VX: VSL 452 4
+VX: VSRB 516 4
+VX: VSRH 580 4
+VX: VSRW 644 4
+VX: VSR 708 4
+VX: VSRAB 772 4
+VX: VSRAH 836 4
+VX: VSRAW 900 4
+
+VX: VAND 1028 4
+VX: VANDC 1092 4
+VX: VOR 1156 4
+VX: VNOR 1284 4
+VX: VXOR 1220 4
+
+VXD: MFVSCR 1540 4
+VXB: MTVSCR 1604 4
+
+VX: VMULOUB 8 4
+VX: VMULOUH 72 4
+VX: VMULOSB 264 4
+VX: VMULOSH 328 4
+VX: VMULEUB 520 4
+VX: VMULEUH 584 4
+VX: VMULESB 776 4
+VX: VMULESH 840 4
+VX: VSUM4UBS 1544 4
+VX: VSUM4SBS 1800 4
+VX: VSUM4SHS 1608 4
+VX: VSUM2SWS 1672 4
+VX: VSUMSWS 1928 4
+
+VX: VADDFP 10 4
+VX: VSUBFP 74 4
+
+VXDB: VREFP 266 4
+VXDB: VRSQRTEFP 330 4
+VXDB: VEXPTEFP 394 4
+VXDB: VLOGEFP 458 4
+VXDB: VRFIN 522 4
+VXDB: VRFIZ 586 4
+VXDB: VRFIP 650 4
+VXDB: VRFIM 714 4
+
+VX: VCFUX 778 4
+VX: VCFSX 842 4
+VX: VCTUXS 906 4
+VX: VCTSXS 970 4
+
+VX: VMAXFP 1034 4
+VX: VMINFP 1098 4
+
+VX: VMRGHB 12 4
+VX: VMRGHH 76 4
+VX: VMRGHW 140 4
+VX: VMRGLB 268 4
+VX: VMRGLH 332 4
+VX: VMRGLW 396 4
+
+VX: VSPLTB 524 4
+VX: VSPLTH 588 4
+VX: VSPLTW 652 4
+
+VXA: VSPLTISB 780 4
+VXA: VSPLTISH 844 4
+VXA: VSPLTISW 908 4
+
+VX: VSLO 1036 4
+VX: VSRO 1100 4
+
+VX: VPKUHUM 14 4
+VX: VPKUWUM 78 4
+VX: VPKUHUS 142 4
+VX: VPKUWUS 206 4
+VX: VPKSHUS 270 4
+VX: VPKSWUS 334 4
+VX: VPKSHSS 398 4
+VX: VPKSWSS 462 4
+VX: VPKPX 782 4
+
+VXDB: VUPKHSB 526 4
+VXDB: VUPKHSH 590 4
+VXDB: VUPKLSB 654 4
+VXDB: VUPKLSH 718 4
+VXDB: VUPKHPX 846 4
+VXDB: VUPKLPX 974 4
+
+: -T ( strm a b -- strm-t a b ) [ 16 bitor ] 2dip ;
+
+XD: DST 0 342 31
+: DSTT ( strm a b -- ) -T DST ;
+
+XD: DSTST 0 374 31
+: DSTSTT ( strm a b -- ) -T DSTST ;
+
+XD: (DSS) 0 822 31
+: DSS ( strm -- ) 0 0 (DSS) ;
+: DSSALL ( -- ) 16 0 0 (DSS) ;
+
+XD: LVEBX 0 7 31
+XD: LVEHX 0 39 31
+XD: LVEWX 0 71 31
+XD: LVSL 0 6 31
+XD: LVSR 0 38 31
+XD: LVX 0 103 31
+XD: LVXL 0 359 31
+
+XD: STVEBX 0 135 31
+XD: STVEHX 0 167 31
+XD: STVEWX 0 199 31
+XD: STVX 0 231 31
+XD: STVXL 0 487 31
+
+VXR: VCMPBFP 0 966 4
+VXR: VCMPEQFP 0 198 4
+VXR: VCMPEQUB 0 6 4
+VXR: VCMPEQUH 0 70 4
+VXR: VCMPEQUW 0 134 4
+VXR: VCMPGEFP 0 454 4
+VXR: VCMPGTFP 0 710 4
+VXR: VCMPGTSB 0 774 4
+VXR: VCMPGTSH 0 838 4
+VXR: VCMPGTSW 0 902 4
+VXR: VCMPGTUB 0 518 4
+VXR: VCMPGTUH 0 582 4
+VXR: VCMPGTUW 0 646 4
+
+VXR: VCMPBFP. 1 966 4
+VXR: VCMPEQFP. 1 198 4
+VXR: VCMPEQUB. 1 6 4
+VXR: VCMPEQUH. 1 70 4
+VXR: VCMPEQUW. 1 134 4
+VXR: VCMPGEFP. 1 454 4
+VXR: VCMPGTFP. 1 710 4
+VXR: VCMPGTSB. 1 774 4
+VXR: VCMPGTSH. 1 838 4
+VXR: VCMPGTSW. 1 902 4
+VXR: VCMPGTUB. 1 518 4
+VXR: VCMPGTUH. 1 582 4
+VXR: VCMPGTUW. 1 646 4
+
: x-insn ( a s b rc xo opcode -- )
[ { 1 0 11 21 16 } bitfield ] dip insn ;
+: xd-insn ( d a b rc xo opcode -- )
+ [ { 1 0 11 16 21 } bitfield ] dip insn ;
+
: (X) ( -- word quot )
CREATE scan-word scan-word scan-word [ x-insn ] 3curry ;
-SYNTAX: X: (X) (( a s b -- )) define-declared ;
+: (XD) ( -- word quot )
+ CREATE scan-word scan-word scan-word [ xd-insn ] 3curry ;
+
+SYNTAX: X: (X) (( a s b -- )) define-declared ;
+SYNTAX: XD: (XD) (( d a b -- )) define-declared ;
: (1) ( quot -- quot' ) [ 0 ] prepose ;
CREATE scan-word scan-word scan-word scan-word
[ xo-insn ] 2curry 2curry ;
-SYNTAX: XO: (XO) (( a s b -- )) define-declared ;
+SYNTAX: XO: (XO) (( d a b -- )) define-declared ;
-SYNTAX: XO1: (XO) (1) (( a s -- )) define-declared ;
+SYNTAX: XO1: (XO) (1) (( d a -- )) define-declared ;
GENERIC# (B) 2 ( dest aa lk -- )
M: integer (B) 18 i-insn ;
SYNTAX: B:
CREATE-B scan-word scan-word scan-word scan-word scan-word
'[ _ _ _ _ _ b-insn ] (( bo -- )) define-declared ;
+
+: va-insn ( d a b c xo opcode -- )
+ [ { 0 6 11 16 21 } bitfield ] dip insn ;
+
+: (VA) ( -- word quot )
+ CREATE scan-word scan-word [ va-insn ] 2curry ;
+
+SYNTAX: VA: (VA) (( d a b c -- )) define-declared ;
+
+: vx-insn ( d a b xo opcode -- )
+ [ { 0 11 16 21 } bitfield ] dip insn ;
+
+: (VX) ( -- word quot )
+ CREATE scan-word scan-word [ vx-insn ] 2curry ;
+: (VXD) ( -- word quot )
+ CREATE scan-word scan-word '[ 0 0 _ _ vx-insn ] ;
+: (VXA) ( -- word quot )
+ CREATE scan-word scan-word '[ [ 0 ] dip 0 _ _ vx-insn ] ;
+: (VXB) ( -- word quot )
+ CREATE scan-word scan-word '[ [ 0 0 ] dip _ _ vx-insn ] ;
+: (VXDB) ( -- word quot )
+ CREATE scan-word scan-word '[ [ 0 ] dip _ _ vx-insn ] ;
+
+SYNTAX: VX: (VX) (( d a b -- )) define-declared ;
+SYNTAX: VXD: (VXD) (( d -- )) define-declared ;
+SYNTAX: VXA: (VXA) (( a -- )) define-declared ;
+SYNTAX: VXB: (VXB) (( b -- )) define-declared ;
+SYNTAX: VXDB: (VXDB) (( d b -- )) define-declared ;
+
+: vxr-insn ( d a b rc xo opcode -- )
+ [ { 0 10 11 16 21 } bitfield ] dip insn ;
+
+: (VXR) ( -- word quot )
+ CREATE scan-word scan-word scan-word [ vxr-insn ] 3curry ;
+
+SYNTAX: VXR: (VXR) (( d a b -- )) define-declared ;
+
0 3 LOAD32 rc-absolute-ppc-2/2 rt-stack-chain jit-rel\r
4 3 0 LWZ\r
1 4 0 STW\r
- 0 3 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel\r
- 3 MTCTR\r
+ 4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel\r
+ 0 5 LOAD32 rc-absolute-ppc-2/2 rt-primitive jit-rel\r
+ 5 MTCTR\r
BCTR\r
] jit-primitive jit-define\r
\r
[\r
3 ds-reg 0 LWZ\r
ds-reg dup 4 SUBI\r
- 4 3 quot-xt-offset LWZ\r
- 4 MTCTR\r
+ 4 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm jit-rel\r
+ 5 3 quot-xt-offset LWZ\r
+ 5 MTCTR\r
BCTR\r
] \ (call) define-sub-primitive\r
\r
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs sequences kernel combinators make math
math.order math.ranges system namespaces locals layouts words
-alien alien.accessors alien.c-types literals cpu.architecture
+alien alien.accessors alien.c-types alien.data literals cpu.architecture
cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
compiler.cfg.instructions compiler.cfg.comparisons
compiler.codegen.fixup compiler.cfg.intrinsics
compiler.cfg.stack-frame compiler.cfg.build-stack-frame
-compiler.units compiler.constants compiler.codegen ;
+compiler.units compiler.constants compiler.codegen vm ;
FROM: cpu.ppc.assembler => B ;
+FROM: layouts => cell ;
+FROM: math => float ;
IN: cpu.ppc
! PowerPC register assignments:
\ ##float>integer t frame-required? set-word-prop
>>
+: %load-vm-addr ( reg -- )
+ 0 swap LOAD32 rc-absolute-ppc-2/2 rt-vm rel-fixup ;
+
+: %load-vm-field-addr ( reg symbol -- )
+ [ drop %load-vm-addr ]
+ [ [ dup ] dip vm-field-offset ADDI ] 2bi ;
+
+M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
+
M: ppc machine-registers
{
{ int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
CONSTANT: scratch-reg 30
CONSTANT: fp-scratch-reg 30
-M: ppc two-operand? f ;
-
M: ppc %load-immediate ( reg n -- ) swap LOAD ;
M: ppc %load-reference ( reg obj -- )
temp MTCTR
BCTR ;
-:: (%slot) ( obj slot tag temp -- reg offset )
- temp slot obj ADD
- temp tag neg ; inline
-
: (%slot-imm) ( obj slot tag -- reg offset )
[ cells ] dip - ; inline
-M: ppc %slot ( dst obj slot tag temp -- ) (%slot) LWZ ;
+M: ppc %slot ( dst obj slot -- ) swapd LWZX ;
M: ppc %slot-imm ( dst obj slot tag -- ) (%slot-imm) LWZ ;
-M: ppc %set-slot ( src obj slot tag temp -- ) (%slot) STW ;
+M: ppc %set-slot ( src obj slot -- ) swapd STWX ;
M: ppc %set-slot-imm ( src obj slot tag -- ) (%slot-imm) STW ;
M:: ppc %string-nth ( dst src index temp -- )
M: ppc %sar SRAW ;
M: ppc %sar-imm SRAWI ;
M: ppc %not NOT ;
+M: ppc %neg NEG ;
:: overflow-template ( label dst src1 src2 insn -- )
0 0 LI
M: ppc %fixnum-mul ( label dst src1 src2 -- )
[ MULLWO. ] overflow-template ;
-: bignum@ ( n -- offset ) cells bignum tag-number - ; inline
-
-M:: ppc %integer>bignum ( dst src temp -- )
- [
- "end" define-label
- dst 0 >bignum %load-reference
- ! Is it zero? Then just go to the end and return this zero
- 0 src 0 CMPI
- "end" get BEQ
- ! Allocate a bignum
- dst 4 cells bignum temp %allot
- ! Write length
- 2 tag-fixnum temp LI
- temp dst 1 bignum@ STW
- ! Compute sign
- temp src MR
- temp temp cell-bits 1 - SRAWI
- temp temp 1 ANDI
- ! Store sign
- temp dst 2 bignum@ STW
- ! Make negative value positive
- temp temp temp ADD
- temp temp NEG
- temp temp 1 ADDI
- temp src temp MULLW
- ! Store the bignum
- temp dst 3 bignum@ STW
- "end" resolve-label
- ] with-scope ;
-
-M:: ppc %bignum>integer ( dst src temp -- )
- [
- "end" define-label
- temp src 1 bignum@ LWZ
- ! if the length is 1, its just the sign and nothing else,
- ! so output 0
- 0 dst LI
- 0 temp 1 tag-fixnum CMPI
- "end" get BEQ
- ! load the value
- dst src 3 bignum@ LWZ
- ! load the sign
- temp src 2 bignum@ LWZ
- ! branchless arithmetic: we want to turn 0 into 1,
- ! and 1 into -1
- temp temp temp ADD
- temp temp 1 SUBI
- temp temp NEG
- ! multiply value by sign
- dst dst temp MULLW
- "end" resolve-label
- ] with-scope ;
-
M: ppc %add-float FADD ;
M: ppc %sub-float FSUB ;
M: ppc %mul-float FMUL ;
dst 1 4 scratch@ LWZ ;
M: ppc %copy ( dst src rep -- )
- {
- { int-rep [ MR ] }
- { double-float-rep [ FMR ] }
- } case ;
-
-M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
-
-M:: ppc %box-float ( dst src temp -- )
- dst 16 float temp %allot
- src dst float-offset STFD ;
+ 2over eq? [ 3drop ] [
+ {
+ { int-rep [ MR ] }
+ { double-rep [ FMR ] }
+ } case
+ ] if ;
+
+GENERIC: float-function-param* ( dst src -- )
+
+M: spill-slot float-function-param* [ 1 ] dip n>> spill@ LFD ;
+M: integer float-function-param* FMR ;
+
+: float-function-param ( i src -- )
+ [ float-regs param-regs nth ] dip float-function-param* ;
+
+: float-function-return ( reg -- )
+ float-regs return-reg double-rep %copy ;
+
+M:: ppc %unary-float-function ( dst src func -- )
+ 0 src float-function-param
+ func f %alien-invoke
+ dst float-function-return ;
+
+M:: ppc %binary-float-function ( dst src1 src2 func -- )
+ 0 src1 float-function-param
+ 1 src2 float-function-param
+ func f %alien-invoke
+ dst float-function-return ;
+
+! Internal format is always double-precision on PowerPC
+M: ppc %single>double-float double-rep %copy ;
+M: ppc %double>single-float double-rep %copy ;
+
+! VMX/AltiVec not supported yet
+M: ppc %zero-vector-reps { } ;
+M: ppc %fill-vector-reps { } ;
+M: ppc %gather-vector-2-reps { } ;
+M: ppc %gather-vector-4-reps { } ;
+M: ppc %shuffle-vector-reps { } ;
+M: ppc %merge-vector-reps { } ;
+M: ppc %compare-vector-reps drop { } ;
+M: ppc %test-vector-reps { } ;
+M: ppc %add-vector-reps { } ;
+M: ppc %saturated-add-vector-reps { } ;
+M: ppc %add-sub-vector-reps { } ;
+M: ppc %sub-vector-reps { } ;
+M: ppc %saturated-sub-vector-reps { } ;
+M: ppc %mul-vector-reps { } ;
+M: ppc %saturated-mul-vector-reps { } ;
+M: ppc %div-vector-reps { } ;
+M: ppc %min-vector-reps { } ;
+M: ppc %max-vector-reps { } ;
+M: ppc %dot-vector-reps { } ;
+M: ppc %sqrt-vector-reps { } ;
+M: ppc %horizontal-add-vector-reps { } ;
+M: ppc %horizontal-sub-vector-reps { } ;
+M: ppc %abs-vector-reps { } ;
+M: ppc %and-vector-reps { } ;
+M: ppc %andn-vector-reps { } ;
+M: ppc %or-vector-reps { } ;
+M: ppc %xor-vector-reps { } ;
+M: ppc %not-vector-reps { } ;
+M: ppc %shl-vector-reps { } ;
+M: ppc %shr-vector-reps { } ;
+M: ppc %horizontal-shl-vector-reps { } ;
+M: ppc %horizontal-shr-vector-reps { } ;
+
+M: ppc %unbox-alien ( dst src -- )
+ alien-offset LWZ ;
M:: ppc %unbox-any-c-ptr ( dst src temp -- )
[
"f" resolve-label
] with-scope ;
-M:: ppc %box-displaced-alien ( dst displacement base temp -- )
+M:: ppc %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
[
"end" define-label
- "ok" define-label
+ "alloc" define-label
+ "simple-case" define-label
! If displacement is zero, return the base
dst base MR
0 displacement 0 CMPI
"end" get BEQ
+ ! Quickly use displacement' before its needed for real, as allot temporary
+ displacement' :> temp
+ dst 4 cells alien temp %allot
! If base is already a displaced alien, unpack it
0 base \ f tag-number CMPI
- "ok" get BEQ
+ "simple-case" get BEQ
temp base header-offset LWZ
0 temp alien type-number tag-fixnum CMPI
- "ok" get BNE
+ "simple-case" get BNE
! displacement += base.displacement
temp base 3 alien@ LWZ
- displacement displacement temp ADD
+ displacement' displacement temp ADD
! base = base.base
- base base 1 alien@ LWZ
- "ok" resolve-label
- dst displacement base temp %allot-alien
+ base' base 1 alien@ LWZ
+ "alloc" get B
+ "simple-case" resolve-label
+ displacement' displacement MR
+ base' base MR
+ "alloc" resolve-label
+ ! Store underlying-alien slot
+ base' dst 1 alien@ STW
+ ! Store offset
+ displacement' dst 3 alien@ STW
+ ! Store expired slot (its ok to clobber displacement')
+ temp \ f tag-number %load-immediate
+ temp dst 2 alien@ STW
"end" resolve-label
] with-scope ;
-M: ppc %alien-unsigned-1 0 LBZ ;
-M: ppc %alien-unsigned-2 0 LHZ ;
+M: ppc %alien-unsigned-1 LBZ ;
+M: ppc %alien-unsigned-2 LHZ ;
-M: ppc %alien-signed-1 dupd 0 LBZ dup EXTSB ;
-M: ppc %alien-signed-2 0 LHA ;
+M: ppc %alien-signed-1 [ dup ] 2dip LBZ dup EXTSB ;
+M: ppc %alien-signed-2 LHA ;
-M: ppc %alien-cell 0 LWZ ;
+M: ppc %alien-cell LWZ ;
-M: ppc %alien-float 0 LFS ;
-M: ppc %alien-double 0 LFD ;
+M: ppc %alien-float LFS ;
+M: ppc %alien-double LFD ;
-M: ppc %set-alien-integer-1 swap 0 STB ;
-M: ppc %set-alien-integer-2 swap 0 STH ;
+M: ppc %set-alien-integer-1 -rot STB ;
+M: ppc %set-alien-integer-2 -rot STH ;
-M: ppc %set-alien-cell swap 0 STW ;
+M: ppc %set-alien-cell -rot STW ;
-M: ppc %set-alien-float swap 0 STFS ;
-M: ppc %set-alien-double swap 0 STFD ;
+M: ppc %set-alien-float -rot STFS ;
+M: ppc %set-alien-double -rot STFD ;
: load-zone-ptr ( reg -- )
- "nursery" f %alien-global ;
+ "nursery" %load-vm-field-addr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap 4 LWZ ] 2bi ;
dst class store-tagged ;
: load-cards-offset ( dst -- )
- [ "cards_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
+ [ "cards_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
: load-decks-offset ( dst -- )
- [ "decks_offset" f %alien-global ] [ dup 0 LWZ ] bi ;
+ [ "decks_offset" %load-vm-field-addr ] [ dup 0 LWZ ] bi ;
M:: ppc %write-barrier ( src card# table -- )
card-mark scratch-reg LI
src card# deck-bits SRWI
table scratch-reg card# STBX ;
-M:: ppc %check-nursery ( label temp1 temp2 -- )
+M:: ppc %check-nursery ( label size temp1 temp2 -- )
temp2 load-zone-ptr
temp1 temp2 cell LWZ
temp2 temp2 3 cells LWZ
- ! add ALLOT_BUFFER_ZONE to here
- temp1 temp1 1024 ADDI
+ temp1 temp1 size ADDI
! is here >= end?
temp1 0 temp2 CMP
label BLE ;
M:: ppc %load-gc-root ( gc-root register -- )
register 1 gc-root gc-root@ LWZ ;
-M:: ppc %call-gc ( gc-root-count -- )
- %prepare-alien-invoke
+M:: ppc %call-gc ( gc-root-count temp -- )
3 1 gc-root-base local@ ADDI
gc-root-count 4 LI
+ 5 %load-vm-addr
"inline_gc" f %alien-invoke ;
M: ppc %prologue ( n -- )
[ [ 1 1 ] dip ADDI ] bi
0 MTLR ;
-:: (%boolean) ( dst temp word -- )
+:: (%boolean) ( dst temp branch1 branch2 -- )
"end" define-label
dst \ f tag-number %load-immediate
- "end" get word execute
+ "end" get branch1 execute( label -- )
+ branch2 [ "end" get branch2 execute( label -- ) ] when
dst \ t %load-reference
"end" get resolve-label ; inline
-: %boolean ( dst temp cc -- )
- negate-cc {
- { cc< [ \ BLT (%boolean) ] }
- { cc<= [ \ BLE (%boolean) ] }
- { cc> [ \ BGT (%boolean) ] }
- { cc>= [ \ BGE (%boolean) ] }
- { cc= [ \ BEQ (%boolean) ] }
- { cc/= [ \ BNE (%boolean) ] }
+:: %boolean ( dst cc temp -- )
+ cc negate-cc order-cc {
+ { cc< [ dst temp \ BLT f (%boolean) ] }
+ { cc<= [ dst temp \ BLE f (%boolean) ] }
+ { cc> [ dst temp \ BGT f (%boolean) ] }
+ { cc>= [ dst temp \ BGE f (%boolean) ] }
+ { cc= [ dst temp \ BEQ f (%boolean) ] }
+ { cc/= [ dst temp \ BNE f (%boolean) ] }
} case ;
: (%compare) ( src1 src2 -- ) [ 0 ] dip CMP ; inline
: (%compare-imm) ( src1 src2 -- ) [ 0 ] 2dip CMPI ; inline
-: (%compare-float) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
+: (%compare-float-unordered) ( src1 src2 -- ) [ 0 ] dip FCMPU ; inline
+: (%compare-float-ordered) ( src1 src2 -- ) [ 0 ] dip FCMPO ; inline
+
+:: (%compare-float) ( src1 src2 cc compare -- branch1 branch2 )
+ cc {
+ { cc< [ src1 src2 \ compare execute( a b -- ) \ BLT f ] }
+ { cc<= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BEQ ] }
+ { cc> [ src1 src2 \ compare execute( a b -- ) \ BGT f ] }
+ { cc>= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BEQ ] }
+ { cc= [ src1 src2 \ compare execute( a b -- ) \ BEQ f ] }
+ { cc<> [ src1 src2 \ compare execute( a b -- ) \ BLT \ BGT ] }
+ { cc<>= [ src1 src2 \ compare execute( a b -- ) \ BNO f ] }
+ { cc/< [ src1 src2 \ compare execute( a b -- ) \ BGE f ] }
+ { cc/<= [ src1 src2 \ compare execute( a b -- ) \ BGT \ BO ] }
+ { cc/> [ src1 src2 \ compare execute( a b -- ) \ BLE f ] }
+ { cc/>= [ src1 src2 \ compare execute( a b -- ) \ BLT \ BO ] }
+ { cc/= [ src1 src2 \ compare execute( a b -- ) \ BNE f ] }
+ { cc/<> [ src1 src2 \ compare execute( a b -- ) \ BEQ \ BO ] }
+ { cc/<>= [ src1 src2 \ compare execute( a b -- ) \ BO f ] }
+ } case ; inline
+
+M: ppc %compare [ (%compare) ] 2dip %boolean ;
+
+M: ppc %compare-imm [ (%compare-imm) ] 2dip %boolean ;
+
+M:: ppc %compare-float-ordered ( dst src1 src2 cc temp -- )
+ src1 src2 cc negate-cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
+ dst temp branch1 branch2 (%boolean) ;
+
+M:: ppc %compare-float-unordered ( dst src1 src2 cc temp -- )
+ src1 src2 cc negate-cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
+ dst temp branch1 branch2 (%boolean) ;
+
+:: %branch ( label cc -- )
+ cc order-cc {
+ { cc< [ label BLT ] }
+ { cc<= [ label BLE ] }
+ { cc> [ label BGT ] }
+ { cc>= [ label BGE ] }
+ { cc= [ label BEQ ] }
+ { cc/= [ label BNE ] }
+ } case ;
-M: ppc %compare (%compare) %boolean ;
-M: ppc %compare-imm (%compare-imm) %boolean ;
-M: ppc %compare-float (%compare-float) %boolean ;
+M:: ppc %compare-branch ( label src1 src2 cc -- )
+ src1 src2 (%compare)
+ label cc %branch ;
-: %branch ( label cc -- )
- {
- { cc< [ BLT ] }
- { cc<= [ BLE ] }
- { cc> [ BGT ] }
- { cc>= [ BGE ] }
- { cc= [ BEQ ] }
- { cc/= [ BNE ] }
- } case ;
+M:: ppc %compare-imm-branch ( label src1 src2 cc -- )
+ src1 src2 (%compare-imm)
+ label cc %branch ;
+
+:: (%branch) ( label branch1 branch2 -- )
+ label branch1 execute( label -- )
+ branch2 [ label branch2 execute( label -- ) ] when ; inline
-M: ppc %compare-branch (%compare) %branch ;
-M: ppc %compare-imm-branch (%compare-imm) %branch ;
-M: ppc %compare-float-branch (%compare-float) %branch ;
+M:: ppc %compare-float-ordered-branch ( label src1 src2 cc -- )
+ src1 src2 cc \ (%compare-float-ordered) (%compare-float) :> branch2 :> branch1
+ label branch1 branch2 (%branch) ;
+
+M:: ppc %compare-float-unordered-branch ( label src1 src2 cc -- )
+ src1 src2 cc \ (%compare-float-unordered) (%compare-float) :> branch2 :> branch1
+ label branch1 branch2 (%branch) ;
: load-from-frame ( dst n rep -- )
{
{ int-rep [ [ 1 ] dip LWZ ] }
- { single-float-rep [ [ 1 ] dip LFS ] }
- { double-float-rep [ [ 1 ] dip LFD ] }
+ { float-rep [ [ 1 ] dip LFS ] }
+ { double-rep [ [ 1 ] dip LFD ] }
{ stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
} case ;
: store-to-frame ( src n rep -- )
{
{ int-rep [ [ 1 ] dip STW ] }
- { single-float-rep [ [ 1 ] dip STFS ] }
- { double-float-rep [ [ 1 ] dip STFD ] }
+ { float-rep [ [ 1 ] dip STFS ] }
+ { double-rep [ [ 1 ] dip STFD ] }
{ stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
} case ;
-M: ppc %spill ( src n rep -- )
- [ spill@ ] dip store-to-frame ;
+M: ppc %spill ( src rep dst -- )
+ swap [ n>> spill@ ] dip store-to-frame ;
-M: ppc %reload ( dst n rep -- )
- [ spill@ ] dip load-from-frame ;
+M: ppc %reload ( dst rep src -- )
+ swap [ n>> spill@ ] dip load-from-frame ;
M: ppc %loop-entry ;
M: ppc %unbox ( n rep func -- )
! Value must be in r3
+ 4 %load-vm-addr
! Call the unboxer
f %alien-invoke
! Store the return value on the C stack
over [ [ reg-class-of return-reg ] keep %save-param-reg ] [ 2drop ] if ;
M: ppc %unbox-long-long ( n func -- )
- ! Value must be in r3:r4
+ 4 %load-vm-addr
! Call the unboxer
f %alien-invoke
! Store the return value on the C stack
! Value must be in r3
! Compute destination address and load struct size
[ [ 4 1 ] dip local@ ADDI ] [ heap-size 5 LI ] bi*
+ 6 %load-vm-addr
! Call the function
"to_value_struct" f %alien-invoke ;
-M: ppc %box ( n rep func -- )
+M:: ppc %box ( n rep func -- )
! If the source is a stack location, load it into freg #0.
! If the source is f, then we assume the value is already in
! freg #0.
- [ over [ 0 over reg-class-of param-reg swap %load-param-reg ] [ 2drop ] if ] dip
- f %alien-invoke ;
+ n [ 0 rep reg-class-of param-reg rep %load-param-reg ] when*
+ rep double-rep? 5 4 ? %load-vm-addr
+ func f %alien-invoke ;
M: ppc %box-long-long ( n func -- )
[
[ [ 3 1 ] dip local@ LWZ ]
[ [ 4 1 ] dip cell + local@ LWZ ] bi
] when*
+ 5 %load-vm-addr
] dip f %alien-invoke ;
: struct-return@ ( n -- n )
! If n = f, then we're boxing a returned struct
! Compute destination address and load struct size
[ [ 3 1 ] dip struct-return@ ADDI ] [ heap-size 4 LI ] bi*
+ 5 %load-vm-addr
! Call the function
"box_value_struct" f %alien-invoke ;
-M: ppc %prepare-alien-invoke
+M:: ppc %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
- scratch-reg "stack_chain" f %alien-global
- scratch-reg scratch-reg 0 LWZ
- 1 scratch-reg 0 STW
- ds-reg scratch-reg 8 STW
- rs-reg scratch-reg 12 STW ;
+ temp1 "stack_chain" %load-vm-field-addr
+ temp1 temp1 0 LWZ
+ 1 temp1 0 STW
+ callback-allowed? [
+ ds-reg temp1 8 STW
+ rs-reg temp1 12 STW
+ ] when ;
M: ppc %alien-invoke ( symbol dll -- )
[ 11 ] 2dip %alien-global 11 MTLR BLRL ;
M: ppc %alien-callback ( quot -- )
- 3 swap %load-reference "c_to_factor" f %alien-invoke ;
+ 3 swap %load-reference
+ 4 %load-vm-addr
+ "c_to_factor" f %alien-invoke ;
M: ppc %prepare-alien-indirect ( -- )
+ 3 %load-vm-addr
"unbox_alien" f %alien-invoke
15 3 MR ;
! Save top of data stack
3 ds-reg 0 LWZ
3 1 0 local@ STW
+ 3 %load-vm-addr
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Restore top of data stack
M: ppc %box-small-struct ( c-type -- )
#! Box a <= 16-byte struct returned in r3:r4:r5:r6
heap-size 7 LI
+ 8 %load-vm-addr
"box_medium_struct" f %alien-invoke ;
: %unbox-struct-1 ( -- )
! Alien must be in r3.
+ 4 %load-vm-addr
"alien_offset" f %alien-invoke
3 3 0 LWZ ;
: %unbox-struct-2 ( -- )
! Alien must be in r3.
+ 4 %load-vm-addr
"alien_offset" f %alien-invoke
4 3 4 LWZ
3 3 0 LWZ ;
: %unbox-struct-4 ( -- )
! Alien must be in r3.
+ 4 %load-vm-addr
"alien_offset" f %alien-invoke
6 3 12 LWZ
5 3 8 LWZ
4 3 4 LWZ
3 3 0 LWZ ;
+M: ppc %nest-stacks ( -- )
+ 3 %load-vm-addr
+ "nest_stacks" f %alien-invoke ;
+
+M: ppc %unnest-stacks ( -- )
+ 3 %load-vm-addr
+ "unnest_stacks" f %alien-invoke ;
+
M: ppc %unbox-small-struct ( size -- )
#! Alien must be in EAX.
heap-size cell align cell /i {
{ 4 [ %unbox-struct-4 ] }
} case ;
+enable-float-functions
+
USE: vocabs.loader
{
4 >>align
"box_boolean" >>boxer
"to_boolean" >>unboxer
- "bool" define-primitive-type
+ bool define-primitive-type
] with-compilation-unit
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: locals alien.c-types alien.syntax arrays kernel fry math
-namespaces sequences system layouts io vocabs.loader accessors init
-combinators command-line make compiler compiler.units
-compiler.constants compiler.alien compiler.codegen
-compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder
-compiler.cfg.intrinsics compiler.cfg.stack-frame cpu.x86.assembler
-cpu.x86.assembler.operands cpu.x86 cpu.architecture ;
+USING: locals alien.c-types alien.libraries alien.syntax arrays
+kernel fry math namespaces sequences system layouts io
+vocabs.loader accessors init combinators command-line make
+compiler compiler.units compiler.constants compiler.alien
+compiler.codegen compiler.codegen.fixup
+compiler.cfg.instructions compiler.cfg.builder
+compiler.cfg.intrinsics compiler.cfg.stack-frame
+cpu.x86.assembler cpu.x86.assembler.operands cpu.x86
+cpu.architecture ;
IN: cpu.x86.32
! We implement the FFI for Linux, OS X and Windows all at once.
bi ;
! Registers for fastcall
-M: x86.32 param-reg-1 EAX ;
-M: x86.32 param-reg-2 EDX ;
+: param-reg-1 ( -- reg ) EAX ;
+: param-reg-2 ( -- reg ) EDX ;
M: x86.32 pic-tail-reg EBX ;
M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ;
+: push-vm-ptr ( -- )
+ 0 PUSH rc-absolute-cell rt-vm rel-fixup ; ! push the vm ptr as an argument
+
M: x86.32 return-struct-in-registers? ( c-type -- ? )
c-type
[ return-in-registers?>> ]
M: int-rep load-return-reg drop EAX swap next-stack@ MOV ;
M: int-rep store-return-reg drop stack@ EAX MOV ;
-M: single-float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ;
-M: single-float-rep load-return-reg drop next-stack@ FLDS ;
-M: single-float-rep store-return-reg drop stack@ FSTPS ;
+M: float-rep push-return-reg drop ESP 4 SUB ESP [] FSTPS ;
+M: float-rep load-return-reg drop next-stack@ FLDS ;
+M: float-rep store-return-reg drop stack@ FSTPS ;
-M: double-float-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ;
-M: double-float-rep load-return-reg drop next-stack@ FLDL ;
-M: double-float-rep store-return-reg drop stack@ FSTPL ;
+M: double-rep push-return-reg drop ESP 8 SUB ESP [] FSTPL ;
+M: double-rep load-return-reg drop next-stack@ FLDL ;
+M: double-rep store-return-reg drop stack@ FSTPL ;
: align-sub ( n -- )
[ align-stack ] keep - decr-stack-reg ;
#! parameter being passed to a callback from C.
over [ load-return-reg ] [ 2drop ] if ;
+CONSTANT: vm-ptr-size 4
+
M:: x86.32 %box ( n rep func -- )
n rep (%box)
- rep rep-size [
+ rep rep-size vm-ptr-size + [
+ push-vm-ptr
rep push-return-reg
func f %alien-invoke
] with-aligned-stack ;
M: x86.32 %box-long-long ( n func -- )
[ (%box-long-long) ] dip
- 8 [
+ 8 vm-ptr-size + [
+ push-vm-ptr
EDX PUSH
EAX PUSH
f %alien-invoke
M:: x86.32 %box-large-struct ( n c-type -- )
! Compute destination address
- ECX n struct-return@ LEA
- 8 [
+ EDX n struct-return@ LEA
+ 8 vm-ptr-size + [
+ push-vm-ptr
! Push struct size
c-type heap-size PUSH
! Push destination address
- ECX PUSH
+ EDX PUSH
! Copy the struct from the C stack
"box_value_struct" f %alien-invoke
] with-aligned-stack ;
M: x86.32 %box-small-struct ( c-type -- )
#! Box a <= 8-byte struct returned in EAX:EDX. OS X only.
- 12 [
+ 12 vm-ptr-size + [
+ push-vm-ptr
heap-size PUSH
EDX PUSH
EAX PUSH
ESI 4 SUB ;
: call-unbox-func ( func -- )
- 4 [
+ 8 [
+ ! push the vm ptr as an argument
+ push-vm-ptr
! Push parameter
EAX PUSH
! Call the unboxer
: %unbox-struct-1 ( -- )
#! Alien must be in EAX.
- 4 [
+ 4 vm-ptr-size + [
+ push-vm-ptr
EAX PUSH
"alien_offset" f %alien-invoke
! Load first cell
: %unbox-struct-2 ( -- )
#! Alien must be in EAX.
- 4 [
+ 4 vm-ptr-size + [
+ push-vm-ptr
EAX PUSH
"alien_offset" f %alien-invoke
! Load second cell
M:: x86.32 %unbox-large-struct ( n c-type -- )
! Alien must be in EAX.
! Compute destination address
- ECX n stack@ LEA
- 12 [
+ EDX n stack@ LEA
+ 12 vm-ptr-size + [
+ push-vm-ptr
! Push struct size
c-type heap-size PUSH
! Push destination address
- ECX PUSH
+ EDX PUSH
! Push source address
EAX PUSH
! Copy the struct to the stack
"to_value_struct" f %alien-invoke
] with-aligned-stack ;
+M: x86.32 %nest-stacks ( -- )
+ 4 [
+ push-vm-ptr
+ "nest_stacks" f %alien-invoke
+ ] with-aligned-stack ;
+
+M: x86.32 %unnest-stacks ( -- )
+ 4 [
+ push-vm-ptr
+ "unnest_stacks" f %alien-invoke
+ ] with-aligned-stack ;
+
M: x86.32 %prepare-alien-indirect ( -- )
- "unbox_alien" f %alien-invoke
+ push-vm-ptr "unbox_alien" f %alien-invoke
+ temp-reg POP
EBP EAX MOV ;
M: x86.32 %alien-indirect ( -- )
4 [
EAX swap %load-reference
EAX PUSH
+ param-reg-2 0 MOV rc-absolute-cell rt-vm rel-fixup
"c_to_factor" f %alien-invoke
] with-aligned-stack ;
! Save top of data stack in non-volatile register
%prepare-unbox
EAX PUSH
+ push-vm-ptr
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Place top of data stack in EAX
+ temp-reg POP
EAX POP
! Restore C stack
ESP 12 ADD
! Unbox EAX
unbox-return ;
+GENERIC: float-function-param ( stack-slot dst src -- )
+
+M:: spill-slot float-function-param ( stack-slot dst src -- )
+ ! We can clobber dst here since its going to contain the
+ ! final result
+ dst src double-rep %copy
+ stack-slot dst double-rep %copy ;
+
+M: register float-function-param
+ nip double-rep %copy ;
+
+: float-function-return ( reg -- )
+ ESP [] FSTPL
+ ESP [] MOVSD
+ ESP 16 ADD ;
+
+M:: x86.32 %unary-float-function ( dst src func -- )
+ ESP -16 [+] dst src float-function-param
+ ESP 16 SUB
+ func "libm" load-library %alien-invoke
+ dst float-function-return ;
+
+M:: x86.32 %binary-float-function ( dst src1 src2 func -- )
+ ESP -16 [+] dst src1 float-function-param
+ ESP -8 [+] dst src2 float-function-param
+ ESP 16 SUB
+ func "libm" load-library %alien-invoke
+ dst float-function-return ;
+
M: x86.32 %cleanup ( params -- )
#! a) If we just called an stdcall function in Windows, it
#! cleaned up the stack frame for us. But we don't want that
[ drop 0 ]
} cond RET ;
+M:: x86.32 %call-gc ( gc-root-count temp -- )
+ temp gc-root-base param@ LEA
+ 12 [
+ ! Pass the VM ptr as the third parameter
+ 0 PUSH rc-absolute-cell rt-vm rel-fixup
+ ! Pass number of roots as second parameter
+ gc-root-count PUSH
+ ! Pass pointer to start of GC roots as first parameter
+ temp PUSH
+ ! Call GC
+ "inline_gc" f %alien-invoke
+ ] with-aligned-stack ;
+
M: x86.32 dummy-stack-params? f ;
M: x86.32 dummy-int-params? f ;
4 "double" c-type (>>align)
] unless
-USING: cpu.x86.features cpu.x86.features.private ;
-
-"-no-sse2" (command-line) member? [
- [ { check_sse2 } compile ] with-optimizer
-
- "Checking if your CPU supports SSE2..." print flush
- sse2? [
- " - yes" print
- enable-sse2
- [
- sse2? [
- "This image was built to use SSE2, which your CPU does not support." print
- "You will need to bootstrap Factor again." print
- flush
- 1 exit
- ] unless
- ] "cpu.x86" add-init-hook
- ] [ " - no" print ] if
-] unless
+check-sse
: shift-arg ( -- reg ) ECX ;
: div-arg ( -- reg ) EAX ;
: mod-arg ( -- reg ) EDX ;
-: arg ( -- reg ) EAX ;
+: arg1 ( -- reg ) EAX ;
+: arg2 ( -- reg ) EDX ;
: temp0 ( -- reg ) EAX ;
: temp1 ( -- reg ) EDX ;
: temp2 ( -- reg ) ECX ;
temp0 0 [] MOV rc-absolute-cell rt-stack-chain jit-rel
! save stack pointer
temp0 [] stack-reg MOV
+ ! pass vm ptr to primitive
+ arg1 0 MOV rc-absolute-cell rt-vm jit-rel
! call the primitive
0 JMP rc-relative rt-primitive jit-rel
] jit-primitive jit-define
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays kernel math namespaces make sequences system
-layouts alien alien.c-types alien.accessors alien.structs slots
+layouts alien alien.c-types alien.accessors slots
splitting assocs combinators locals compiler.constants
compiler.codegen compiler.codegen.fixup compiler.cfg.instructions
compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame
[ align-code ]
bi ;
-M: x86.64 param-reg-1 int-regs param-regs first ;
-M: x86.64 param-reg-2 int-regs param-regs second ;
+: param-reg-1 ( -- reg ) int-regs param-regs first ; inline
+: param-reg-2 ( -- reg ) int-regs param-regs second ; inline
: param-reg-3 ( -- reg ) int-regs param-regs third ; inline
+: param-reg-4 ( -- reg ) int-regs param-regs fourth ; inline
M: x86.64 pic-tail-reg RBX ;
{ [ over integer? ] [ R11 swap MOV param@ R11 MOV ] }
} cond ;
-M: x86 %save-param-reg [ param@ ] 2dip copy-register ;
+M: x86 %save-param-reg [ param@ ] 2dip %copy ;
-M: x86 %load-param-reg [ swap param@ ] dip copy-register ;
+M: x86 %load-param-reg [ swap param@ ] dip %copy ;
: with-return-regs ( quot -- )
[
param-reg-1 R14 [] MOV
R14 cell SUB ;
+: %mov-vm-ptr ( reg -- )
+ 0 MOV rc-absolute-cell rt-vm rel-fixup ;
+
M:: x86.64 %unbox ( n rep func -- )
+ param-reg-2 %mov-vm-ptr
! Call the unboxer
func f %alien-invoke
! Store the return value on the C stack if this is an
M: x86.64 %unbox-small-struct ( c-type -- )
! Alien must be in param-reg-1.
+ param-reg-2 %mov-vm-ptr
"alien_offset" f %alien-invoke
! Move alien_offset() return value to R11 so that we don't
! clobber it.
param-reg-2 n param@ LEA
! Load structure size into param-reg-3
param-reg-3 c-type heap-size MOV
+ param-reg-4 %mov-vm-ptr
! Copy the struct to the C stack
"to_value_struct" f %alien-invoke ;
[ [ 0 ] dip reg-class-of param-reg ]
[ reg-class-of return-reg ]
[ ]
- tri copy-register ;
+ tri %copy ;
M:: x86.64 %box ( n rep func -- )
n [
] [
rep load-return-value
] if
+ rep int-rep? [ param-reg-2 ] [ param-reg-1 ] if %mov-vm-ptr
func f %alien-invoke ;
M: x86.64 %box-long-long ( n func -- )
[ param-reg-3 swap heap-size MOV ] bi
param-reg-1 0 box-struct-field@ MOV
param-reg-2 1 box-struct-field@ MOV
+ param-reg-4 %mov-vm-ptr
"box_small_struct" f %alien-invoke
] with-return-regs ;
param-reg-2 swap heap-size MOV
! Compute destination address
param-reg-1 swap struct-return@ LEA
+ param-reg-3 %mov-vm-ptr
! Copy the struct from the C stack
"box_value_struct" f %alien-invoke ;
rc-absolute-cell rel-dlsym
R11 CALL ;
+M: x86.64 %nest-stacks ( -- )
+ param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ "nest_stacks" f %alien-invoke ;
+
+M: x86.64 %unnest-stacks ( -- )
+ param-reg-1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ "unnest_stacks" f %alien-invoke ;
+
M: x86.64 %prepare-alien-indirect ( -- )
+ param-reg-1 %mov-vm-ptr
"unbox_alien" f %alien-invoke
RBP RAX MOV ;
M: x86.64 %alien-callback ( quot -- )
param-reg-1 swap %load-reference
+ param-reg-2 %mov-vm-ptr
"c_to_factor" f %alien-invoke ;
M: x86.64 %callback-value ( ctype -- )
! Save top of data stack
RSP 8 SUB
param-reg-1 PUSH
+ param-reg-1 %mov-vm-ptr
! Restore data/call/retain stacks
"unnest_stacks" f %alien-invoke
! Put former top of data stack in param-reg-1
! Unbox former top of data stack to return registers
unbox-return ;
+: float-function-param ( i src -- )
+ [ float-regs param-regs nth ] dip double-rep %copy ;
+
+: float-function-return ( reg -- )
+ float-regs return-reg double-rep %copy ;
+
+M:: x86.64 %unary-float-function ( dst src func -- )
+ 0 src float-function-param
+ func f %alien-invoke
+ dst float-function-return ;
+
+M:: x86.64 %binary-float-function ( dst src1 src2 func -- )
+ ! src1 might equal dst; otherwise it will be a spill slot
+ ! src2 is always a spill slot
+ 0 src1 float-function-param
+ 1 src2 float-function-param
+ func f %alien-invoke
+ dst float-function-return ;
+
+M:: x86.64 %call-gc ( gc-root-count temp -- )
+ ! Pass pointer to start of GC roots as first parameter
+ param-reg-1 gc-root-base param@ LEA
+ ! Pass number of roots as second parameter
+ param-reg-2 gc-root-count MOV
+ ! Pass VM ptr as third parameter
+ param-reg-3 %mov-vm-ptr
+ ! Call GC
+ "inline_gc" f %alien-invoke ;
+
! The result of reading 4 bytes from memory is a fixnum on
! x86-64.
enable-alien-4-intrinsics
-! SSE2 is always available on x86-64.
-enable-sse2
-
USE: vocabs.loader
{
{ [ os unix? ] [ "cpu.x86.64.unix" require ] }
{ [ os winnt? ] [ "cpu.x86.64.winnt" require ] }
} cond
+
+check-sse
temp0 [] stack-reg MOV
! load XT
temp1 0 MOV rc-absolute-cell rt-primitive jit-rel
+ ! load vm ptr
+ arg1 0 MOV rc-absolute-cell rt-vm jit-rel
! go
temp1 JMP
] jit-primitive jit-define
IN: bootstrap.x86
: stack-frame-size ( -- n ) 4 bootstrap-cells ;
-: arg ( -- reg ) RDI ;
+: arg1 ( -- reg ) RDI ;
+: arg2 ( -- reg ) RSI ;
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
call
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays sequences math splitting make assocs kernel
-layouts system alien.c-types alien.structs cpu.architecture
+layouts system alien.c-types classes.struct cpu.architecture
cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen
compiler.cfg.registers ;
IN: cpu.x86.64.unix
M: x86.64 reserved-area-size 0 ;
-! The ABI for passing structs by value is pretty messed up
-<< "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type (>>rep) >>
+SYMBOL: (stack-value)
+! The ABI for passing structs by value is pretty great
+<< void* c-type clone \ (stack-value) define-primitive-type
+stack-params \ (stack-value) c-type (>>rep) >>
: struct-types&offset ( struct-type -- pairs )
fields>> [
: flatten-small-struct ( c-type -- seq )
struct-types&offset split-struct [
[ c-type c-type-rep reg-class-of ] map
- int-regs swap member? "void*" "double" ? c-type
+ int-regs swap member? void* double ? c-type
] map ;
: flatten-large-struct ( c-type -- seq )
heap-size cell align
- cell /i "__stack_value" c-type <repetition> ;
+ cell /i \ (stack-value) c-type <repetition> ;
-M: struct-type flatten-value-type ( type -- seq )
+: flatten-struct ( c-type -- seq )
dup heap-size 16 > [
flatten-large-struct
] [
flatten-small-struct
] if ;
+M: struct-c-type flatten-value-type ( type -- seq )
+ flatten-struct ;
+
M: x86.64 return-struct-in-registers? ( c-type -- ? )
heap-size 2 cells <= ;
IN: bootstrap.x86
: stack-frame-size ( -- n ) 8 bootstrap-cells ;
-: arg ( -- reg ) RCX ;
+: arg1 ( -- reg ) RCX ;
+: arg2 ( -- reg ) RDX ;
<< "vocab:cpu/x86/64/bootstrap.factor" parse-file parsed >>
call
M: x86.64 temp-reg RAX ;
<<
-"longlong" "ptrdiff_t" typedef
-"longlong" "intptr_t" typedef
-"int" c-type "long" define-primitive-type
-"uint" c-type "ulong" define-primitive-type
+longlong ptrdiff_t typedef
+longlong intptr_t typedef
+int c-type long define-primitive-type
+uint c-type ulong define-primitive-type
>>
! [ { HEX: f2 HEX: 41 HEX: 0f HEX: 11 HEX: 04 HEX: 24 } ] [ [ R12 [] XMM0 MOVSD ] { } make ] unit-test
! 3-operand r-rm-imm sse instructions
-[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
-[ { HEX: 0f HEX: c6 HEX: c1 HEX: 02 } ] [ [ XMM0 XMM1 2 SHUFPS ] { } make ] unit-test
+[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ]
+[ [ XMM0 XMM1 2 PSHUFD ] { } make ] unit-test
+
+[ { HEX: 0f HEX: c6 HEX: c1 HEX: 02 } ]
+[ [ XMM0 XMM1 2 SHUFPS ] { } make ] unit-test
+
+! shufflers with arrays of indexes
+[ { HEX: 66 HEX: 0f HEX: 70 HEX: c1 HEX: 02 } ]
+[ [ XMM0 XMM1 { 2 0 0 0 } PSHUFD ] { } make ] unit-test
+
+[ { HEX: 0f HEX: c6 HEX: c1 HEX: 63 } ]
+[ [ XMM0 XMM1 { 3 0 2 1 } SHUFPS ] { } make ] unit-test
+
+[ { HEX: 66 HEX: 0f HEX: c6 HEX: c1 HEX: 2 } ]
+[ [ XMM0 XMM1 { 0 1 } SHUFPD ] { } make ] unit-test
+
+[ { HEX: 66 HEX: 0f HEX: c6 HEX: c1 HEX: 1 } ]
+[ [ XMM0 XMM1 { 1 0 } SHUFPD ] { } make ] unit-test
! scalar register insert/extract sse instructions
[ { HEX: 66 HEX: 0f HEX: c4 HEX: c1 HEX: 02 } ] [ [ XMM0 ECX 2 PINSRW ] { } make ] unit-test
! Copyright (C) 2005, 2009 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io.binary kernel combinators kernel.private math locals
-namespaces make sequences words system layouts math.order accessors
-cpu.x86.assembler.operands cpu.x86.assembler.operands.private ;
+USING: arrays io.binary kernel combinators kernel.private math
+math.bitwise locals namespaces make sequences words system
+layouts math.order accessors cpu.x86.assembler.operands
+cpu.x86.assembler.operands.private ;
QUALIFIED: sequences
IN: cpu.x86.assembler
M: operand POP { BIN: 000 f HEX: 8f } 1-operand ;
! MOV where the src is immediate.
+<PRIVATE
+
GENERIC: (MOV-I) ( src dst -- )
M: register (MOV-I) t HEX: b8 short-operand cell, ;
M: operand (MOV-I)
{ BIN: 000 t HEX: c6 }
pick byte? [ immediate-1 ] [ immediate-4 ] if ;
+PRIVATE>
+
GENERIC: MOV ( dst src -- )
M: immediate MOV swap (MOV-I) ;
M: operand MOV HEX: 88 2-operand ;
M: integer CALL HEX: e8 , 4, ;
M: operand CALL { BIN: 010 t HEX: ff } 1-operand ;
+<PRIVATE
+
GENERIC# JUMPcc 1 ( addr opcode -- )
M: integer JUMPcc extended-opcode, 4, ;
+PRIVATE>
+
: JO ( dst -- ) HEX: 80 JUMPcc ;
: JNO ( dst -- ) HEX: 81 JUMPcc ;
: JB ( dst -- ) HEX: 82 JUMPcc ;
: CDQ ( -- ) HEX: 99 , ;
: CQO ( -- ) HEX: 48 , CDQ ;
+<PRIVATE
+
: (SHIFT) ( dst src op -- )
over CL eq? [
nip t HEX: d3 3array 1-operand
swapd t HEX: c0 3array immediate-1
] if ; inline
+PRIVATE>
+
: ROL ( dst n -- ) BIN: 000 (SHIFT) ;
: ROR ( dst n -- ) BIN: 001 (SHIFT) ;
: RCL ( dst n -- ) BIN: 010 (SHIFT) ;
: MOVHPD ( dest src -- ) HEX: 16 HEX: 66 2-operand-sse ;
: MOVSHDUP ( dest src -- ) HEX: 16 HEX: f3 2-operand-rm-sse ;
+ALIAS: MOVHLPS MOVLPS
+ALIAS: MOVLHPS MOVHPS
+
: PREFETCHNTA ( mem -- ) { BIN: 000 f { HEX: 0f HEX: 18 } } 1-operand ;
: PREFETCHT0 ( mem -- ) { BIN: 001 f { HEX: 0f HEX: 18 } } 1-operand ;
: PREFETCHT1 ( mem -- ) { BIN: 010 f { HEX: 0f HEX: 18 } } 1-operand ;
: MOVDQA ( dest src -- ) { HEX: 6f HEX: 7f } HEX: 66 2-operand-rm-mr-sse ;
: MOVDQU ( dest src -- ) { HEX: 6f HEX: 7f } HEX: f3 2-operand-rm-mr-sse ;
-: PSHUFD ( dest src imm -- ) HEX: 70 HEX: 66 3-operand-rm-sse ;
-: PSHUFLW ( dest src imm -- ) HEX: 70 HEX: f2 3-operand-rm-sse ;
-: PSHUFHW ( dest src imm -- ) HEX: 70 HEX: f3 3-operand-rm-sse ;
+<PRIVATE
+
+: 2shuffler ( indexes/mask -- mask )
+ dup integer? [ first2 { 1 0 } bitfield ] unless ;
+: 4shuffler ( indexes/mask -- mask )
+ dup integer? [ first4 { 6 4 2 0 } bitfield ] unless ;
+
+PRIVATE>
+
+: PSHUFD ( dest src imm -- ) 4shuffler HEX: 70 HEX: 66 3-operand-rm-sse ;
+: PSHUFLW ( dest src imm -- ) 4shuffler HEX: 70 HEX: f2 3-operand-rm-sse ;
+: PSHUFHW ( dest src imm -- ) 4shuffler HEX: 70 HEX: f3 3-operand-rm-sse ;
<PRIVATE
: MOVNTI ( dest src -- ) { HEX: 0f HEX: c3 } (2-operand) ;
: PINSRW ( dest src imm -- ) HEX: c4 HEX: 66 3-operand-rm-sse ;
-: SHUFPS ( dest src imm -- ) HEX: c6 f 3-operand-rm-sse ;
-: SHUFPD ( dest src imm -- ) HEX: c6 HEX: 66 3-operand-rm-sse ;
+: SHUFPS ( dest src imm -- ) 4shuffler HEX: c6 f 3-operand-rm-sse ;
+: SHUFPD ( dest src imm -- ) 2shuffler HEX: c6 HEX: 66 3-operand-rm-sse ;
: ADDSUBPD ( dest src -- ) HEX: d0 HEX: 66 2-operand-rm-sse ;
: ADDSUBPS ( dest src -- ) HEX: d0 HEX: f2 2-operand-rm-sse ;
--- /dev/null
+Slava Pestov
+Joe Groff
--- /dev/null
+x86 registers and memory operands
! Quotations and words
[
! load from stack
- arg ds-reg [] MOV
+ arg1 ds-reg [] MOV
! pop stack
ds-reg bootstrap-cell SUB
+ ! pass vm pointer
+ arg2 0 MOV rc-absolute-cell rt-vm jit-rel
! call quotation
- arg quot-xt-offset [+] JMP
+ arg1 quot-xt-offset [+] JMP
] \ (call) define-sub-primitive
! Objects
-USING: cpu.x86.features tools.test kernel sequences math system ;
+USING: cpu.x86.features tools.test kernel sequences math math.order system ;
IN: cpu.x86.features.tests
cpu x86? [
- [ t ] [ sse2? { t f } member? ] unit-test
+ [ t ] [ sse-version 0 42 between? ] unit-test
[ t ] [ [ 10000 [ ] times ] count-instructions integer? ] unit-test
] when
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel math alien.syntax ;
+USING: system kernel memoize math math.order math.parser
+namespaces alien.c-types alien.syntax combinators locals init io
+compiler compiler.units accessors ;
IN: cpu.x86.features
<PRIVATE
-FUNCTION: bool check_sse2 ( ) ;
+FUNCTION: int sse_version ( ) ;
FUNCTION: longlong read_timestamp_counter ( ) ;
PRIVATE>
-HOOK: sse2? cpu ( -- ? )
-
-M: x86.32 sse2? check_sse2 ;
-
-M: x86.64 sse2? t ;
+MEMO: sse-version ( -- n )
+ sse_version
+ "sse-version" get string>number [ min ] when* ;
+
+[ \ sse-version reset-memoized ] "cpu.x86.features" add-init-hook
+
+: sse? ( -- ? ) sse-version 10 >= ;
+: sse2? ( -- ? ) sse-version 20 >= ;
+: sse3? ( -- ? ) sse-version 30 >= ;
+: ssse3? ( -- ? ) sse-version 33 >= ;
+: sse4.1? ( -- ? ) sse-version 41 >= ;
+: sse4.2? ( -- ? ) sse-version 42 >= ;
+
+: sse-string ( version -- string )
+ {
+ { 00 [ "no SSE" ] }
+ { 10 [ "SSE1" ] }
+ { 20 [ "SSE2" ] }
+ { 30 [ "SSE3" ] }
+ { 33 [ "SSSE3" ] }
+ { 41 [ "SSE4.1" ] }
+ { 42 [ "SSE4.2" ] }
+ } case ;
HOOK: instruction-count cpu ( -- n )
--- /dev/null
+unportable
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs alien alien.c-types arrays strings
cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands
-cpu.architecture kernel kernel.private math memory namespaces make
-sequences words system layouts combinators math.order fry locals
-compiler.constants
+cpu.x86.features cpu.x86.features.private cpu.architecture kernel
+kernel.private math memory namespaces make sequences words system
+layouts combinators math.order fry locals compiler.constants
+byte-arrays io macros quotations compiler compiler.units init vm
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.intrinsics
compiler.cfg.comparisons
compiler.cfg.stack-frame
-compiler.codegen
compiler.codegen.fixup ;
+FROM: layouts => cell ;
+FROM: math => float ;
IN: cpu.x86
-<< enable-fixnum-log2 >>
-
! Add some methods to the assembler to be more useful to the backend
M: label JMP 0 JMP rc-relative label-fixup ;
M: label JUMPcc [ 0 ] dip JUMPcc rc-relative label-fixup ;
-M: x86 two-operand? t ;
+M: x86 vector-regs float-regs ;
HOOK: stack-reg cpu ( -- reg )
! use in calls in and out of C
HOOK: temp-reg cpu ( -- reg )
-! Fastcall calling convention
-HOOK: param-reg-1 cpu ( -- reg )
-HOOK: param-reg-2 cpu ( -- reg )
-
HOOK: pic-tail-reg cpu ( -- reg )
M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ;
: align-code ( n -- )
0 <repetition> % ;
-:: (%slot) ( obj slot tag temp -- op )
- temp slot obj [+] LEA
- temp tag neg [+] ; inline
-
:: (%slot-imm) ( obj slot tag -- op )
obj slot cells tag - [+] ; inline
-M: x86 %slot ( dst obj slot tag temp -- ) (%slot) MOV ;
+M: x86 %slot ( dst obj slot -- ) [+] MOV ;
M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ;
-M: x86 %set-slot ( src obj slot tag temp -- ) (%slot) swap MOV ;
+M: x86 %set-slot ( src obj slot -- ) [+] swap MOV ;
M: x86 %set-slot-imm ( src obj slot tag -- ) (%slot-imm) swap MOV ;
+:: two-operand ( dst src1 src2 rep -- dst src )
+ dst src2 eq? dst src1 eq? not and [ "Cannot handle this case" throw ] when
+ dst src1 rep %copy
+ dst src2 ; inline
+
+:: one-operand ( dst src rep -- dst )
+ dst src rep %copy
+ dst ; inline
+
M: x86 %add 2over eq? [ nip ADD ] [ [+] LEA ] if ;
M: x86 %add-imm 2over eq? [ nip ADD ] [ [+] LEA ] if ;
-M: x86 %sub nip SUB ;
+M: x86 %sub int-rep two-operand SUB ;
M: x86 %sub-imm 2over eq? [ nip SUB ] [ neg [+] LEA ] if ;
-M: x86 %mul nip swap IMUL2 ;
+M: x86 %mul int-rep two-operand swap IMUL2 ;
M: x86 %mul-imm IMUL3 ;
-M: x86 %and nip AND ;
-M: x86 %and-imm nip AND ;
-M: x86 %or nip OR ;
-M: x86 %or-imm nip OR ;
-M: x86 %xor nip XOR ;
-M: x86 %xor-imm nip XOR ;
-M: x86 %shl-imm nip SHL ;
-M: x86 %shr-imm nip SHR ;
-M: x86 %sar-imm nip SAR ;
-
-M: x86 %min nip [ CMP ] [ CMOVG ] 2bi ;
-M: x86 %max nip [ CMP ] [ CMOVL ] 2bi ;
-
-M: x86 %not drop NOT ;
+M: x86 %and int-rep two-operand AND ;
+M: x86 %and-imm int-rep two-operand AND ;
+M: x86 %or int-rep two-operand OR ;
+M: x86 %or-imm int-rep two-operand OR ;
+M: x86 %xor int-rep two-operand XOR ;
+M: x86 %xor-imm int-rep two-operand XOR ;
+M: x86 %shl-imm int-rep two-operand SHL ;
+M: x86 %shr-imm int-rep two-operand SHR ;
+M: x86 %sar-imm int-rep two-operand SAR ;
+
+M: x86 %min int-rep two-operand [ CMP ] [ CMOVG ] 2bi ;
+M: x86 %max int-rep two-operand [ CMP ] [ CMOVL ] 2bi ;
+
+M: x86 %not int-rep one-operand NOT ;
+M: x86 %neg int-rep one-operand NEG ;
M: x86 %log2 BSR ;
-:: overflow-template ( label dst src1 src2 insn -- )
- src1 src2 insn call
- label JO ; inline
-
-M: x86 %fixnum-add ( label dst src1 src2 -- )
- [ ADD ] overflow-template ;
-
-M: x86 %fixnum-sub ( label dst src1 src2 -- )
- [ SUB ] overflow-template ;
-
-M: x86 %fixnum-mul ( label dst src1 src2 -- )
- [ swap IMUL2 ] overflow-template ;
-
-: bignum@ ( reg n -- op )
- cells bignum tag-number - [+] ; inline
-
-M:: x86 %integer>bignum ( dst src temp -- )
- #! on entry, inreg is a signed 32-bit quantity
- #! exits with tagged ptr to bignum in outreg
- #! 1 cell header, 1 cell length, 1 cell sign, + digits
- #! length is the # of digits + sign
- [
- "end" define-label
- ! Load cached zero value
- dst 0 >bignum %load-reference
- src 0 CMP
- ! Is it zero? Then just go to the end and return this zero
- "end" get JE
- ! Allocate a bignum
- dst 4 cells bignum temp %allot
- ! Write length
- dst 1 bignum@ 2 tag-fixnum MOV
- ! Store value
- dst 3 bignum@ src MOV
- ! Compute sign
- temp src MOV
- temp cell-bits 1 - SAR
- temp 1 AND
- ! Store sign
- dst 2 bignum@ temp MOV
- ! Make negative value positive
- temp temp ADD
- temp NEG
- temp 1 ADD
- src temp IMUL2
- ! Store the bignum
- dst 3 bignum@ temp MOV
- "end" resolve-label
- ] with-scope ;
-
-M:: x86 %bignum>integer ( dst src temp -- )
- [
- "end" define-label
- ! load length
- temp src 1 bignum@ MOV
- ! if the length is 1, its just the sign and nothing else,
- ! so output 0
- dst 0 MOV
- temp 1 tag-fixnum CMP
- "end" get JE
- ! load the value
- dst src 3 bignum@ MOV
- ! load the sign
- temp src 2 bignum@ MOV
- ! convert it into -1 or 1
- temp temp ADD
- temp NEG
- temp 1 ADD
- ! make dst signed
- temp dst IMUL2
- "end" resolve-label
- ] with-scope ;
-
-M: x86 %add-float nip ADDSD ;
-M: x86 %sub-float nip SUBSD ;
-M: x86 %mul-float nip MULSD ;
-M: x86 %div-float nip DIVSD ;
-M: x86 %min-float nip MINSD ;
-M: x86 %max-float nip MAXSD ;
-M: x86 %sqrt SQRTSD ;
-
-M: x86 %integer>float CVTSI2SD ;
-M: x86 %float>integer CVTTSD2SI ;
-
GENERIC: copy-register* ( dst src rep -- )
M: int-rep copy-register* drop MOV ;
M: tagged-rep copy-register* drop MOV ;
-M: single-float-rep copy-register* drop MOVSS ;
-M: double-float-rep copy-register* drop MOVSD ;
+M: float-rep copy-register* drop MOVSS ;
+M: double-rep copy-register* drop MOVSD ;
+M: float-4-rep copy-register* drop MOVUPS ;
+M: double-2-rep copy-register* drop MOVUPD ;
+M: vector-rep copy-register* drop MOVDQU ;
+
+M: x86 %copy ( dst src rep -- )
+ 2over eq? [ 3drop ] [
+ [ [ dup spill-slot? [ n>> spill@ ] when ] bi@ ] dip
+ copy-register*
+ ] if ;
+
+M: x86 %fixnum-add ( label dst src1 src2 -- )
+ int-rep two-operand ADD JO ;
-: copy-register ( dst src rep -- )
- 2over eq? [ 3drop ] [ copy-register* ] if ;
+M: x86 %fixnum-sub ( label dst src1 src2 -- )
+ int-rep two-operand SUB JO ;
-M: x86 %copy ( dst src rep -- ) copy-register ;
+M: x86 %fixnum-mul ( label dst src1 src2 -- )
+ int-rep two-operand swap IMUL2 JO ;
-M: x86 %unbox-float ( dst src -- )
- float-offset [+] MOVSD ;
+M: x86 %unbox-alien ( dst src -- )
+ alien-offset [+] MOV ;
M:: x86 %unbox-any-c-ptr ( dst src temp -- )
[
"end" resolve-label
] with-scope ;
-M:: x86 %box-float ( dst src temp -- )
- dst 16 float temp %allot
- dst float-offset [+] src MOVSD ;
-
: alien@ ( reg n -- op ) cells alien tag-number - [+] ;
:: %allot-alien ( dst displacement base temp -- )
"end" resolve-label
] with-scope ;
-M:: x86 %box-displaced-alien ( dst displacement base temp -- )
+M:: x86 %box-displaced-alien ( dst displacement base displacement' base' base-class -- )
[
"end" define-label
"ok" define-label
dst base MOV
displacement 0 CMP
"end" get JE
+ ! Quickly use displacement' before its needed for real, as allot temporary
+ dst 4 cells alien displacement' %allot
! If base is already a displaced alien, unpack it
+ base' base MOV
+ displacement' displacement MOV
base \ f tag-number CMP
"ok" get JE
base header-offset [+] alien type-number tag-fixnum CMP
"ok" get JNE
! displacement += base.displacement
- displacement base 3 alien@ ADD
+ displacement' base 3 alien@ ADD
! base = base.base
- base base 1 alien@ MOV
+ base' base 1 alien@ MOV
"ok" resolve-label
- dst displacement base temp %allot-alien
+ dst 1 alien@ base' MOV ! alien
+ dst 2 alien@ \ f tag-number MOV ! expired
+ dst 3 alien@ displacement' MOV ! displacement
"end" resolve-label
] with-scope ;
[ quot call ] with-save/restore
] if ; inline
-: ?MOV ( dst src -- )
- 2dup = [ 2drop ] [ MOV ] if ; inline
-
M:: x86 %string-nth ( dst src index temp -- )
! We request a small-reg of size 8 since those of size 16 are
! a superset.
! Compute code point
new-dst temp XOR
"end" resolve-label
- dst new-dst ?MOV
+ dst new-dst int-rep %copy
] with-small-register ;
M:: x86 %set-string-nth-fast ( ch str index temp -- )
ch { index str temp } 8 [| new-ch |
- new-ch ch ?MOV
+ new-ch ch int-rep %copy
temp str index [+] LEA
temp string-offset [+] new-ch 8-bit-version-of MOV
] with-small-register ;
-:: %alien-integer-getter ( dst src size quot -- )
+:: %alien-integer-getter ( dst src offset size quot -- )
dst { src } size [| new-dst |
- new-dst dup size n-bit-version-of dup src [] MOV
+ new-dst dup size n-bit-version-of dup src offset [+] MOV
quot call
- dst new-dst ?MOV
+ dst new-dst int-rep %copy
] with-small-register ; inline
-: %alien-unsigned-getter ( dst src size -- )
+: %alien-unsigned-getter ( dst src offset size -- )
[ MOVZX ] %alien-integer-getter ; inline
+: %alien-signed-getter ( dst src offset size -- )
+ [ MOVSX ] %alien-integer-getter ; inline
+
+:: %alien-integer-setter ( ptr offset value size -- )
+ value { ptr } size [| new-value |
+ new-value value int-rep %copy
+ ptr offset [+] new-value size n-bit-version-of MOV
+ ] with-small-register ; inline
+
M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ;
M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ;
M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ;
-: %alien-signed-getter ( dst src size -- )
- [ MOVSX ] %alien-integer-getter ; inline
-
M: x86 %alien-signed-1 8 %alien-signed-getter ;
M: x86 %alien-signed-2 16 %alien-signed-getter ;
M: x86 %alien-signed-4 32 %alien-signed-getter ;
-M: x86 %alien-cell [] MOV ;
-M: x86 %alien-float dupd [] MOVSS dup CVTSS2SD ;
-M: x86 %alien-double [] MOVSD ;
-
-:: %alien-integer-setter ( ptr value size -- )
- value { ptr } size [| new-value |
- new-value value ?MOV
- ptr [] new-value size n-bit-version-of MOV
- ] with-small-register ; inline
+M: x86 %alien-cell [+] MOV ;
+M: x86 %alien-float [+] MOVSS ;
+M: x86 %alien-double [+] MOVSD ;
+M: x86 %alien-vector [ [+] ] dip %copy ;
M: x86 %set-alien-integer-1 8 %alien-integer-setter ;
M: x86 %set-alien-integer-2 16 %alien-integer-setter ;
M: x86 %set-alien-integer-4 32 %alien-integer-setter ;
-M: x86 %set-alien-cell [ [] ] dip MOV ;
-M: x86 %set-alien-float dup dup CVTSD2SS [ [] ] dip MOVSS ;
-M: x86 %set-alien-double [ [] ] dip MOVSD ;
+M: x86 %set-alien-cell [ [+] ] dip MOV ;
+M: x86 %set-alien-float [ [+] ] dip MOVSS ;
+M: x86 %set-alien-double [ [+] ] dip MOVSD ;
+M: x86 %set-alien-vector [ [+] ] 2dip %copy ;
: shift-count? ( reg -- ? ) { ECX RCX } memq? ;
-:: emit-shift ( dst src1 src2 quot -- )
- src2 shift-count? [
+:: emit-shift ( dst src quot -- )
+ src shift-count? [
dst CL quot call
] [
dst shift-count? [
- dst src2 XCHG
- src2 CL quot call
- dst src2 XCHG
+ dst src XCHG
+ src CL quot call
+ dst src XCHG
] [
ECX native-version-of [
- CL src2 MOV
+ CL src MOV
drop dst CL quot call
] with-save/restore
] if
] if ; inline
-M: x86 %shl [ SHL ] emit-shift ;
-M: x86 %shr [ SHR ] emit-shift ;
-M: x86 %sar [ SAR ] emit-shift ;
+M: x86 %shl int-rep two-operand [ SHL ] emit-shift ;
+M: x86 %shr int-rep two-operand [ SHR ] emit-shift ;
+M: x86 %sar int-rep two-operand [ SAR ] emit-shift ;
+
+M: x86 %vm-field-ptr ( dst field -- )
+ [ drop 0 MOV rc-absolute-cell rt-vm rel-fixup ]
+ [ vm-field-offset ADD ] 2bi ;
: load-zone-ptr ( reg -- )
#! Load pointer to start of zone array
- 0 MOV "nursery" f rc-absolute-cell rel-dlsym ;
+ "nursery" %vm-field-ptr ;
: load-allot-ptr ( nursery-ptr allot-ptr -- )
[ drop load-zone-ptr ] [ swap cell [+] MOV ] 2bi ;
! Mark the card
card# src MOV
card# card-bits SHR
- table "cards_offset" f %alien-global
+ table "cards_offset" %vm-field-ptr
table table [] MOV
table card# [+] card-mark <byte> MOV
! Mark the card deck
card# deck-bits card-bits - SHR
- table "decks_offset" f %alien-global
+ table "decks_offset" %vm-field-ptr
table table [] MOV
table card# [+] card-mark <byte> MOV ;
-M:: x86 %check-nursery ( label temp1 temp2 -- )
+M:: x86 %check-nursery ( label size temp1 temp2 -- )
temp1 load-zone-ptr
temp2 temp1 cell [+] MOV
- temp2 1024 ADD
+ temp2 size ADD
temp1 temp1 3 cells [+] MOV
temp2 temp1 CMP
label JLE ;
M: x86 %load-gc-root ( gc-root register -- ) swap gc-root@ MOV ;
-M:: x86 %call-gc ( gc-root-count -- )
- ! Pass pointer to start of GC roots as first parameter
- param-reg-1 gc-root-base param@ LEA
- ! Pass number of roots as second parameter
- param-reg-2 gc-root-count MOV
- ! Call GC
- %prepare-alien-invoke
- "inline_gc" f %alien-invoke ;
-
-M: x86 %alien-global
- [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
+M: x86 %alien-global ( dst symbol library -- )
+ [ 0 MOV ] 2dip rc-absolute-cell rel-dlsym ;
M: x86 %epilogue ( n -- ) cell - incr-stack-reg ;
temp 0 MOV \ t rc-absolute-cell rel-immediate
dst temp word execute ; inline
-M: x86 %compare ( dst temp cc src1 src2 -- )
- CMP {
- { cc< [ \ CMOVL %boolean ] }
- { cc<= [ \ CMOVLE %boolean ] }
- { cc> [ \ CMOVG %boolean ] }
- { cc>= [ \ CMOVGE %boolean ] }
- { cc= [ \ CMOVE %boolean ] }
- { cc/= [ \ CMOVNE %boolean ] }
+M:: x86 %compare ( dst src1 src2 cc temp -- )
+ src1 src2 CMP
+ cc order-cc {
+ { cc< [ dst temp \ CMOVL %boolean ] }
+ { cc<= [ dst temp \ CMOVLE %boolean ] }
+ { cc> [ dst temp \ CMOVG %boolean ] }
+ { cc>= [ dst temp \ CMOVGE %boolean ] }
+ { cc= [ dst temp \ CMOVE %boolean ] }
+ { cc/= [ dst temp \ CMOVNE %boolean ] }
} case ;
-M: x86 %compare-imm ( dst temp cc src1 src2 -- )
+M: x86 %compare-imm ( dst src1 src2 cc temp -- )
%compare ;
-M: x86 %compare-float ( dst temp cc src1 src2 -- )
- UCOMISD {
- { cc< [ \ CMOVB %boolean ] }
- { cc<= [ \ CMOVBE %boolean ] }
- { cc> [ \ CMOVA %boolean ] }
- { cc>= [ \ CMOVAE %boolean ] }
- { cc= [ \ CMOVE %boolean ] }
- { cc/= [ \ CMOVNE %boolean ] }
- } case ;
-
-M: x86 %compare-branch ( label cc src1 src2 -- )
- CMP {
- { cc< [ JL ] }
- { cc<= [ JLE ] }
- { cc> [ JG ] }
- { cc>= [ JGE ] }
- { cc= [ JE ] }
- { cc/= [ JNE ] }
+M:: x86 %compare-branch ( label src1 src2 cc -- )
+ src1 src2 CMP
+ cc order-cc {
+ { cc< [ label JL ] }
+ { cc<= [ label JLE ] }
+ { cc> [ label JG ] }
+ { cc>= [ label JGE ] }
+ { cc= [ label JE ] }
+ { cc/= [ label JNE ] }
} case ;
M: x86 %compare-imm-branch ( label src1 src2 cc -- )
%compare-branch ;
-M: x86 %compare-float-branch ( label cc src1 src2 -- )
- UCOMISD {
- { cc< [ JB ] }
- { cc<= [ JBE ] }
- { cc> [ JA ] }
- { cc>= [ JAE ] }
- { cc= [ JE ] }
- { cc/= [ JNE ] }
+M: x86 %add-float double-rep two-operand ADDSD ;
+M: x86 %sub-float double-rep two-operand SUBSD ;
+M: x86 %mul-float double-rep two-operand MULSD ;
+M: x86 %div-float double-rep two-operand DIVSD ;
+M: x86 %min-float double-rep two-operand MINSD ;
+M: x86 %max-float double-rep two-operand MAXSD ;
+M: x86 %sqrt SQRTSD ;
+
+M: x86 %single>double-float CVTSS2SD ;
+M: x86 %double>single-float CVTSD2SS ;
+
+M: x86 %integer>float CVTSI2SD ;
+M: x86 %float>integer CVTTSD2SI ;
+
+: %cmov-float= ( dst src -- )
+ [
+ "no-move" define-label
+
+ "no-move" get [ JNE ] [ JP ] bi
+ MOV
+ "no-move" resolve-label
+ ] with-scope ;
+
+: %cmov-float/= ( dst src -- )
+ [
+ "no-move" define-label
+ "move" define-label
+
+ "move" get JP
+ "no-move" get JE
+ "move" resolve-label
+ MOV
+ "no-move" resolve-label
+ ] with-scope ;
+
+:: (%compare-float) ( dst src1 src2 cc temp compare -- )
+ cc {
+ { cc< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
+ { cc<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
+ { cc> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVA %boolean ] }
+ { cc>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVAE %boolean ] }
+ { cc= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float= %boolean ] }
+ { cc<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNE %boolean ] }
+ { cc<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVNP %boolean ] }
+ { cc/< [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
+ { cc/<= [ src2 src1 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
+ { cc/> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVBE %boolean ] }
+ { cc/>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVB %boolean ] }
+ { cc/= [ src1 src2 \ compare execute( a b -- ) dst temp \ %cmov-float/= %boolean ] }
+ { cc/<> [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVE %boolean ] }
+ { cc/<>= [ src1 src2 \ compare execute( a b -- ) dst temp \ CMOVP %boolean ] }
+ } case ; inline
+
+M: x86 %compare-float-ordered ( dst src1 src2 cc temp -- )
+ \ COMISD (%compare-float) ;
+
+M: x86 %compare-float-unordered ( dst src1 src2 cc temp -- )
+ \ UCOMISD (%compare-float) ;
+
+: %jump-float= ( label -- )
+ [
+ "no-jump" define-label
+ "no-jump" get JP
+ JE
+ "no-jump" resolve-label
+ ] with-scope ;
+
+: %jump-float/= ( label -- )
+ [ JNE ] [ JP ] bi ;
+
+:: (%compare-float-branch) ( label src1 src2 cc compare -- )
+ cc {
+ { cc< [ src2 src1 \ compare execute( a b -- ) label JA ] }
+ { cc<= [ src2 src1 \ compare execute( a b -- ) label JAE ] }
+ { cc> [ src1 src2 \ compare execute( a b -- ) label JA ] }
+ { cc>= [ src1 src2 \ compare execute( a b -- ) label JAE ] }
+ { cc= [ src1 src2 \ compare execute( a b -- ) label %jump-float= ] }
+ { cc<> [ src1 src2 \ compare execute( a b -- ) label JNE ] }
+ { cc<>= [ src1 src2 \ compare execute( a b -- ) label JNP ] }
+ { cc/< [ src2 src1 \ compare execute( a b -- ) label JBE ] }
+ { cc/<= [ src2 src1 \ compare execute( a b -- ) label JB ] }
+ { cc/> [ src1 src2 \ compare execute( a b -- ) label JBE ] }
+ { cc/>= [ src1 src2 \ compare execute( a b -- ) label JB ] }
+ { cc/= [ src1 src2 \ compare execute( a b -- ) label %jump-float/= ] }
+ { cc/<> [ src1 src2 \ compare execute( a b -- ) label JE ] }
+ { cc/<>= [ src1 src2 \ compare execute( a b -- ) label JP ] }
+ } case ;
+
+M: x86 %compare-float-ordered-branch ( label src1 src2 cc -- )
+ \ COMISD (%compare-float-branch) ;
+
+M: x86 %compare-float-unordered-branch ( label src1 src2 cc -- )
+ \ UCOMISD (%compare-float-branch) ;
+
+MACRO: available-reps ( alist -- )
+ ! Each SSE version adds new representations and supports
+ ! all old ones
+ unzip { } [ append ] accumulate rest swap suffix
+ [ [ 1quotation ] map ] bi@ zip
+ reverse [ { } ] suffix
+ '[ _ cond ] ;
+
+M: x86 %zero-vector
+ {
+ { double-2-rep [ dup XORPD ] }
+ { float-4-rep [ dup XORPS ] }
+ [ drop dup PXOR ]
} case ;
-M: x86 %spill ( src n rep -- ) [ spill@ swap ] dip copy-register ;
-M: x86 %reload ( dst n rep -- ) [ spill@ ] dip copy-register ;
+M: x86 %zero-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %fill-vector
+ {
+ { double-2-rep [ dup [ XORPD ] [ CMPEQPD ] 2bi ] }
+ { float-4-rep [ dup [ XORPS ] [ CMPEQPS ] 2bi ] }
+ [ drop dup PCMPEQB ]
+ } case ;
+
+M: x86 %fill-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+: unsign-rep ( rep -- rep' )
+ {
+ { uint-4-rep int-4-rep }
+ { ulonglong-2-rep longlong-2-rep }
+ { ushort-8-rep short-8-rep }
+ { uchar-16-rep char-16-rep }
+ } ?at drop ;
+
+! M:: x86 %broadcast-vector ( dst src rep -- )
+! rep unsign-rep {
+! { float-4-rep [
+! dst src float-4-rep %copy
+! dst dst { 0 0 0 0 } SHUFPS
+! ] }
+! { double-2-rep [
+! dst src MOVDDUP
+! ] }
+! { longlong-2-rep [
+! dst src =
+! [ dst dst PUNPCKLQDQ ]
+! [ dst src { 0 1 0 1 } PSHUFD ]
+! if
+! ] }
+! { int-4-rep [
+! dst src { 0 0 0 0 } PSHUFD
+! ] }
+! { short-8-rep [
+! dst src { 0 0 0 0 } PSHUFLW
+! dst dst PUNPCKLQDQ
+! ] }
+! { char-16-rep [
+! dst src char-16-rep %copy
+! dst dst PUNPCKLBW
+! dst dst { 0 0 0 0 } PSHUFLW
+! dst dst PUNPCKLQDQ
+! ] }
+! } case ;
+!
+! M: x86 %broadcast-vector-reps
+! {
+! ! Can't do this with sse1 since it will want to unbox
+! ! a double-precision float and convert to single precision
+! { sse2? { float-4-rep double-2-rep longlong-2-rep ulonglong-2-rep int-4-rep uint-4-rep short-8-rep ushort-8-rep char-16-rep uchar-16-rep } }
+! } available-reps ;
+
+M:: x86 %gather-vector-4 ( dst src1 src2 src3 src4 rep -- )
+ rep unsign-rep {
+ { float-4-rep [
+ dst src1 float-4-rep %copy
+ dst src2 UNPCKLPS
+ src3 src4 UNPCKLPS
+ dst src3 MOVLHPS
+ ] }
+ { int-4-rep [
+ dst src1 int-4-rep %copy
+ dst src2 PUNPCKLDQ
+ src3 src4 PUNPCKLDQ
+ dst src3 PUNPCKLQDQ
+ ] }
+ } case ;
+
+M: x86 %gather-vector-4-reps
+ {
+ ! Can't do this with sse1 since it will want to unbox
+ ! double-precision floats and convert to single precision
+ { sse2? { float-4-rep int-4-rep uint-4-rep } }
+ } available-reps ;
+
+M:: x86 %gather-vector-2 ( dst src1 src2 rep -- )
+ rep unsign-rep {
+ { double-2-rep [
+ dst src1 double-2-rep %copy
+ dst src2 UNPCKLPD
+ ] }
+ { longlong-2-rep [
+ dst src1 longlong-2-rep %copy
+ dst src2 PUNPCKLQDQ
+ ] }
+ } case ;
+
+M: x86 %gather-vector-2-reps
+ {
+ { sse2? { double-2-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+: double-2-shuffle ( dst shuffle -- )
+ {
+ { { 0 1 } [ drop ] }
+ { { 0 0 } [ dup UNPCKLPD ] }
+ { { 1 1 } [ dup UNPCKHPD ] }
+ [ dupd SHUFPD ]
+ } case ;
+
+: float-4-shuffle ( dst shuffle -- )
+ {
+ { { 0 1 2 3 } [ drop ] }
+ { { 0 0 2 2 } [ dup MOVSLDUP ] }
+ { { 1 1 3 3 } [ dup MOVSHDUP ] }
+ { { 0 1 0 1 } [ dup MOVLHPS ] }
+ { { 2 3 2 3 } [ dup MOVHLPS ] }
+ { { 0 0 1 1 } [ dup UNPCKLPS ] }
+ { { 2 2 3 3 } [ dup UNPCKHPS ] }
+ [ dupd SHUFPS ]
+ } case ;
+
+: int-4-shuffle ( dst shuffle -- )
+ {
+ { { 0 1 2 3 } [ drop ] }
+ { { 0 0 1 1 } [ dup PUNPCKLDQ ] }
+ { { 2 2 3 3 } [ dup PUNPCKHDQ ] }
+ { { 0 1 0 1 } [ dup PUNPCKLQDQ ] }
+ { { 2 3 2 3 } [ dup PUNPCKHQDQ ] }
+ [ dupd PSHUFD ]
+ } case ;
+
+: longlong-2-shuffle ( dst shuffle -- )
+ first2 [ 2 * dup 1 + ] bi@ 4array int-4-shuffle ;
+
+M:: x86 %shuffle-vector ( dst src shuffle rep -- )
+ dst src rep %copy
+ dst shuffle rep unsign-rep {
+ { double-2-rep [ double-2-shuffle ] }
+ { float-4-rep [ float-4-shuffle ] }
+ { int-4-rep [ int-4-shuffle ] }
+ { longlong-2-rep [ longlong-2-shuffle ] }
+ } case ;
+
+M: x86 %shuffle-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %merge-vector-head
+ [ two-operand ] keep
+ unsign-rep {
+ { double-2-rep [ UNPCKLPD ] }
+ { float-4-rep [ UNPCKLPS ] }
+ { longlong-2-rep [ PUNPCKLQDQ ] }
+ { int-4-rep [ PUNPCKLDQ ] }
+ { short-8-rep [ PUNPCKLWD ] }
+ { char-16-rep [ PUNPCKLBW ] }
+ } case ;
+
+M: x86 %merge-vector-tail
+ [ two-operand ] keep
+ unsign-rep {
+ { double-2-rep [ UNPCKHPD ] }
+ { float-4-rep [ UNPCKHPS ] }
+ { longlong-2-rep [ PUNPCKHQDQ ] }
+ { int-4-rep [ PUNPCKHDQ ] }
+ { short-8-rep [ PUNPCKHWD ] }
+ { char-16-rep [ PUNPCKHBW ] }
+ } case ;
+
+M: x86 %merge-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+:: compare-float-v-operands ( dst src1 src2 temp rep cc -- dst' src' rep cc' )
+ cc { cc> cc>= cc/> cc/>= } member?
+ [ dst src2 src1 rep two-operand rep cc swap-cc ]
+ [ dst src1 src2 rep two-operand rep cc ] if ;
+: (%compare-float-vector) ( dst src rep double single -- )
+ [ double-2-rep eq? ] 2dip if ; inline
+: %compare-float-vector ( dst src1 src2 temp rep cc -- )
+ compare-float-v-operands {
+ { cc< [ [ CMPLTPD ] [ CMPLTPS ] (%compare-float-vector) ] }
+ { cc<= [ [ CMPLEPD ] [ CMPLEPS ] (%compare-float-vector) ] }
+ { cc= [ [ CMPEQPD ] [ CMPEQPS ] (%compare-float-vector) ] }
+ { cc<>= [ [ CMPORDPD ] [ CMPORDPS ] (%compare-float-vector) ] }
+ { cc/< [ [ CMPNLTPD ] [ CMPNLTPS ] (%compare-float-vector) ] }
+ { cc/<= [ [ CMPNLEPD ] [ CMPNLEPS ] (%compare-float-vector) ] }
+ { cc/= [ [ CMPNEQPD ] [ CMPNEQPS ] (%compare-float-vector) ] }
+ { cc/<>= [ [ CMPUNORDPD ] [ CMPUNORDPS ] (%compare-float-vector) ] }
+ } case ;
+
+:: compare-int-v-operands ( dst src1 src2 temp rep cc -- not-dst/f cmp-dst src' rep cc' )
+ cc order-cc :> occ
+ occ {
+ { cc= [ f dst src1 src2 rep two-operand rep cc= ] }
+ { cc/= [ dst temp src1 src2 rep two-operand rep cc= ] }
+ { cc<= [ dst temp src1 src2 rep two-operand rep cc> ] }
+ { cc< [ f dst src2 src1 rep two-operand rep cc> ] }
+ { cc> [ f dst src1 src2 rep two-operand rep cc> ] }
+ { cc>= [ dst temp src2 src1 rep two-operand rep cc> ] }
+ } case ;
+:: (%compare-int-vector) ( dst src rep int64 int32 int16 int8 -- )
+ rep unsign-rep :> rep'
+ dst src rep' {
+ { longlong-2-rep [ int64 call ] }
+ { int-4-rep [ int32 call ] }
+ { short-8-rep [ int16 call ] }
+ { char-16-rep [ int8 call ] }
+ } case ; inline
+:: %compare-int-vector ( dst src1 src2 temp rep cc -- )
+ dst src1 src2 temp rep cc compare-int-v-operands :> cc' :> rep :> src' :> cmp-dst :> not-dst
+ cmp-dst src' rep cc' {
+ { cc= [ [ PCMPEQQ ] [ PCMPEQD ] [ PCMPEQW ] [ PCMPEQB ] (%compare-int-vector) ] }
+ { cc> [ [ PCMPGTQ ] [ PCMPGTD ] [ PCMPGTW ] [ PCMPGTB ] (%compare-int-vector) ] }
+ } case
+ not-dst [ cmp-dst rep %not-vector ] when* ;
+
+M: x86 %compare-vector ( dst src1 src2 temp rep cc -- )
+ over float-vector-rep?
+ [ %compare-float-vector ]
+ [ %compare-int-vector ] if ;
+
+: %compare-vector-eq-reps ( -- reps )
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep } }
+ { sse4.1? { longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+: %compare-vector-unord-reps ( -- reps )
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep } }
+ } available-reps ;
+: %compare-vector-ord-reps ( -- reps )
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep short-8-rep int-4-rep } }
+ { sse4.1? { longlong-2-rep } }
+ } available-reps ;
+
+M: x86 %compare-vector-reps
+ {
+ { [ dup { cc= cc/= } memq? ] [ drop %compare-vector-eq-reps ] }
+ { [ dup { cc<>= cc/<>= } memq? ] [ drop %compare-vector-unord-reps ] }
+ [ drop %compare-vector-ord-reps ]
+ } cond ;
+
+:: %test-vector-mask ( dst temp mask vcc -- )
+ vcc {
+ { vcc-any [ dst dst TEST dst temp \ CMOVNE %boolean ] }
+ { vcc-none [ dst dst TEST dst temp \ CMOVE %boolean ] }
+ { vcc-all [ dst mask CMP dst temp \ CMOVE %boolean ] }
+ { vcc-notall [ dst mask CMP dst temp \ CMOVNE %boolean ] }
+ } case ;
+
+: %move-vector-mask ( dst src rep -- mask )
+ {
+ { double-2-rep [ MOVMSKPD HEX: 3 ] }
+ { float-4-rep [ MOVMSKPS HEX: f ] }
+ [ drop PMOVMSKB HEX: ffff ]
+ } case ;
+
+M:: x86 %test-vector ( dst src temp rep vcc -- )
+ dst src rep %move-vector-mask :> mask
+ dst temp mask vcc %test-vector-mask ;
+
+:: %test-vector-mask-branch ( label temp mask vcc -- )
+ vcc {
+ { vcc-any [ temp temp TEST label JNE ] }
+ { vcc-none [ temp temp TEST label JE ] }
+ { vcc-all [ temp mask CMP label JE ] }
+ { vcc-notall [ temp mask CMP label JNE ] }
+ } case ;
+
+M:: x86 %test-vector-branch ( label src temp rep vcc -- )
+ temp src rep %move-vector-mask :> mask
+ label temp mask vcc %test-vector-mask-branch ;
+
+M: x86 %test-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %add-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ ADDPS ] }
+ { double-2-rep [ ADDPD ] }
+ { char-16-rep [ PADDB ] }
+ { uchar-16-rep [ PADDB ] }
+ { short-8-rep [ PADDW ] }
+ { ushort-8-rep [ PADDW ] }
+ { int-4-rep [ PADDD ] }
+ { uint-4-rep [ PADDD ] }
+ { longlong-2-rep [ PADDQ ] }
+ { ulonglong-2-rep [ PADDQ ] }
+ } case ;
+
+M: x86 %add-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %saturated-add-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { char-16-rep [ PADDSB ] }
+ { uchar-16-rep [ PADDUSB ] }
+ { short-8-rep [ PADDSW ] }
+ { ushort-8-rep [ PADDUSW ] }
+ } case ;
+
+M: x86 %saturated-add-vector-reps
+ {
+ { sse2? { char-16-rep uchar-16-rep short-8-rep ushort-8-rep } }
+ } available-reps ;
+
+M: x86 %add-sub-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ ADDSUBPS ] }
+ { double-2-rep [ ADDSUBPD ] }
+ } case ;
+
+M: x86 %add-sub-vector-reps
+ {
+ { sse3? { float-4-rep double-2-rep } }
+ } available-reps ;
+
+M: x86 %sub-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ SUBPS ] }
+ { double-2-rep [ SUBPD ] }
+ { char-16-rep [ PSUBB ] }
+ { uchar-16-rep [ PSUBB ] }
+ { short-8-rep [ PSUBW ] }
+ { ushort-8-rep [ PSUBW ] }
+ { int-4-rep [ PSUBD ] }
+ { uint-4-rep [ PSUBD ] }
+ { longlong-2-rep [ PSUBQ ] }
+ { ulonglong-2-rep [ PSUBQ ] }
+ } case ;
+
+M: x86 %sub-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %saturated-sub-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { char-16-rep [ PSUBSB ] }
+ { uchar-16-rep [ PSUBUSB ] }
+ { short-8-rep [ PSUBSW ] }
+ { ushort-8-rep [ PSUBUSW ] }
+ } case ;
+
+M: x86 %saturated-sub-vector-reps
+ {
+ { sse2? { char-16-rep uchar-16-rep short-8-rep ushort-8-rep } }
+ } available-reps ;
+
+M: x86 %mul-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ MULPS ] }
+ { double-2-rep [ MULPD ] }
+ { short-8-rep [ PMULLW ] }
+ { ushort-8-rep [ PMULLW ] }
+ { int-4-rep [ PMULLD ] }
+ { uint-4-rep [ PMULLD ] }
+ } case ;
+
+M: x86 %mul-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep short-8-rep ushort-8-rep } }
+ { sse4.1? { int-4-rep uint-4-rep } }
+ } available-reps ;
+
+M: x86 %saturated-mul-vector-reps
+ ! No multiplication with saturation on x86
+ { } ;
+
+M: x86 %div-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ DIVPS ] }
+ { double-2-rep [ DIVPD ] }
+ } case ;
+
+M: x86 %div-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep } }
+ } available-reps ;
+
+M: x86 %min-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { char-16-rep [ PMINSB ] }
+ { uchar-16-rep [ PMINUB ] }
+ { short-8-rep [ PMINSW ] }
+ { ushort-8-rep [ PMINUW ] }
+ { int-4-rep [ PMINSD ] }
+ { uint-4-rep [ PMINUD ] }
+ { float-4-rep [ MINPS ] }
+ { double-2-rep [ MINPD ] }
+ } case ;
+
+M: x86 %min-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { uchar-16-rep short-8-rep double-2-rep short-8-rep uchar-16-rep } }
+ { sse4.1? { char-16-rep ushort-8-rep int-4-rep uint-4-rep } }
+ } available-reps ;
+
+M: x86 %max-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { char-16-rep [ PMAXSB ] }
+ { uchar-16-rep [ PMAXUB ] }
+ { short-8-rep [ PMAXSW ] }
+ { ushort-8-rep [ PMAXUW ] }
+ { int-4-rep [ PMAXSD ] }
+ { uint-4-rep [ PMAXUD ] }
+ { float-4-rep [ MAXPS ] }
+ { double-2-rep [ MAXPD ] }
+ } case ;
+
+M: x86 %max-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { uchar-16-rep short-8-rep double-2-rep short-8-rep uchar-16-rep } }
+ { sse4.1? { char-16-rep ushort-8-rep int-4-rep uint-4-rep } }
+ } available-reps ;
+
+M: x86 %dot-vector
+ [ two-operand ] keep
+ {
+ { float-4-rep [
+ sse4.1?
+ [ HEX: ff DPPS ]
+ [ [ MULPS ] [ drop dup float-4-rep %horizontal-add-vector ] 2bi ]
+ if
+ ] }
+ { double-2-rep [
+ sse4.1?
+ [ HEX: ff DPPD ]
+ [ [ MULPD ] [ drop dup double-2-rep %horizontal-add-vector ] 2bi ]
+ if
+ ] }
+ } case ;
+
+M: x86 %dot-vector-reps
+ {
+ { sse3? { float-4-rep double-2-rep } }
+ } available-reps ;
+
+M: x86 %horizontal-add-vector ( dst src rep -- )
+ {
+ { float-4-rep [ [ float-4-rep %copy ] [ HADDPS ] [ HADDPS ] 2tri ] }
+ { double-2-rep [ [ double-2-rep %copy ] [ HADDPD ] 2bi ] }
+ } case ;
+
+M: x86 %horizontal-add-vector-reps
+ {
+ { sse3? { float-4-rep double-2-rep } }
+ } available-reps ;
+
+M: x86 %horizontal-shl-vector ( dst src1 src2 rep -- )
+ two-operand PSLLDQ ;
+
+M: x86 %horizontal-shl-vector-reps
+ {
+ { sse2? { char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %horizontal-shr-vector ( dst src1 src2 rep -- )
+ two-operand PSRLDQ ;
+
+M: x86 %horizontal-shr-vector-reps
+ {
+ { sse2? { char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %abs-vector ( dst src rep -- )
+ {
+ { char-16-rep [ PABSB ] }
+ { short-8-rep [ PABSW ] }
+ { int-4-rep [ PABSD ] }
+ } case ;
+
+M: x86 %abs-vector-reps
+ {
+ { ssse3? { char-16-rep short-8-rep int-4-rep } }
+ } available-reps ;
+
+M: x86 %sqrt-vector ( dst src rep -- )
+ {
+ { float-4-rep [ SQRTPS ] }
+ { double-2-rep [ SQRTPD ] }
+ } case ;
+
+M: x86 %sqrt-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep } }
+ } available-reps ;
+
+M: x86 %and-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ ANDPS ] }
+ { double-2-rep [ ANDPD ] }
+ [ drop PAND ]
+ } case ;
+
+M: x86 %and-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %andn-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ ANDNPS ] }
+ { double-2-rep [ ANDNPD ] }
+ [ drop PANDN ]
+ } case ;
+
+M: x86 %andn-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %or-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ ORPS ] }
+ { double-2-rep [ ORPD ] }
+ [ drop POR ]
+ } case ;
+
+M: x86 %or-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %xor-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { float-4-rep [ XORPS ] }
+ { double-2-rep [ XORPD ] }
+ [ drop PXOR ]
+ } case ;
+
+M: x86 %xor-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M:: x86 %not-vector ( dst src rep -- )
+ dst rep %fill-vector
+ dst dst src rep %xor-vector ;
+
+M: x86 %not-vector-reps
+ {
+ { sse? { float-4-rep } }
+ { sse2? { double-2-rep char-16-rep uchar-16-rep short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %shl-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { short-8-rep [ PSLLW ] }
+ { ushort-8-rep [ PSLLW ] }
+ { int-4-rep [ PSLLD ] }
+ { uint-4-rep [ PSLLD ] }
+ { longlong-2-rep [ PSLLQ ] }
+ { ulonglong-2-rep [ PSLLQ ] }
+ } case ;
+
+M: x86 %shl-vector-reps
+ {
+ { sse2? { short-8-rep ushort-8-rep int-4-rep uint-4-rep longlong-2-rep ulonglong-2-rep } }
+ } available-reps ;
+
+M: x86 %shr-vector ( dst src1 src2 rep -- )
+ [ two-operand ] keep
+ {
+ { short-8-rep [ PSRAW ] }
+ { ushort-8-rep [ PSRLW ] }
+ { int-4-rep [ PSRAD ] }
+ { uint-4-rep [ PSRLD ] }
+ { ulonglong-2-rep [ PSRLQ ] }
+ } case ;
+
+M: x86 %shr-vector-reps
+ {
+ { sse2? { short-8-rep ushort-8-rep int-4-rep uint-4-rep ulonglong-2-rep } }
+ } available-reps ;
+
+: scalar-sized-reg ( reg rep -- reg' )
+ rep-size 8 * n-bit-version-of ;
+
+M: x86 %integer>scalar drop MOVD ;
+
+M:: x86 %scalar>integer ( dst src rep -- )
+ rep {
+ { int-scalar-rep [
+ dst 32-bit-version-of src MOVD
+ dst dst 32-bit-version-of
+ 2dup eq? [ 2drop ] [ MOVSX ] if
+ ] }
+ { uint-scalar-rep [
+ dst 32-bit-version-of src MOVD
+ ] }
+ } case ;
+
+M: x86 %vector>scalar %copy ;
+M: x86 %scalar>vector %copy ;
+
+M:: x86 %spill ( src rep dst -- ) dst src rep %copy ;
+M:: x86 %reload ( dst rep src -- ) dst src rep %copy ;
M: x86 %loop-entry 16 code-alignment [ NOP ] times ;
-M: x86 %prepare-alien-invoke
+M:: x86 %save-context ( temp1 temp2 callback-allowed? -- )
#! Save Factor stack pointers in case the C code calls a
#! callback which does a GC, which must reliably trace
#! all roots.
- temp-reg "stack_chain" f %alien-global
- temp-reg temp-reg [] MOV
- temp-reg [] stack-reg MOV
- temp-reg [] cell SUB
- temp-reg 2 cells [+] ds-reg MOV
- temp-reg 3 cells [+] rs-reg MOV ;
+ temp1 0 MOV rc-absolute-cell rt-vm rel-fixup
+ temp1 temp1 "stack_chain" vm-field-offset [+] MOV
+ temp2 stack-reg cell neg [+] LEA
+ temp1 [] temp2 MOV
+ callback-allowed? [
+ temp1 2 cells [+] ds-reg MOV
+ temp1 3 cells [+] rs-reg MOV
+ ] when ;
M: x86 value-struct? drop t ;
#! set up by the caller.
stack-frame get total-size>> + stack@ ;
-: enable-sse2 ( -- )
- enable-float-intrinsics
- enable-fsqrt
- enable-float-min/max ;
-
+enable-simd
enable-min/max
+enable-fixnum-log2
+
+:: install-sse2-check ( -- )
+ [
+ sse-version 20 < [
+ "This image was built to use SSE2 but your CPU does not support it." print
+ "You will need to bootstrap Factor again." print
+ flush
+ 1 exit
+ ] when
+ ] "cpu.x86" add-init-hook ;
+
+: enable-sse2 ( version -- )
+ 20 >= [
+ enable-float-intrinsics
+ enable-float-functions
+ enable-float-min/max
+ enable-fsqrt
+ install-sse2-check
+ ] when ;
+
+: check-sse ( -- )
+ [ { sse_version } compile ] with-optimizer
+ "Checking for multimedia extensions: " write sse-version
+ [ sse-string write " detected" print ] [ enable-sse2 ] bi ;
ARTICLE: "csv" "Comma-separated-values parsing and writing"
"The " { $vocab-link "csv" } " vocabulary can read and write CSV (comma-separated-value) files." $nl
"Reading a csv file:"
-{ $subsection file>csv }
+{ $subsections file>csv }
"Writing a csv file:"
-{ $subsection csv>file }
+{ $subsections csv>file }
"Changing the delimiter from a comma:"
-{ $subsection with-delimiter }
+{ $subsections with-delimiter }
"Reading from a stream:"
-{ $subsection csv }
+{ $subsections csv }
"Writing to a stream:"
-{ $subsection write-csv } ;
+{ $subsections write-csv } ;
ABOUT: "csv"
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: classes kernel help.markup help.syntax sequences
-alien assocs strings math multiline quotations db.private ;
+alien assocs strings math quotations db.private ;
IN: db
HELP: db-connection
HELP: result-set
{ $description "An object encapsulating a raw SQL result object. There are two ways in which a result set can be accessed, but they are specific to the database backend in use."
- { $subsection "db-random-access-result-set" }
- { $subsection "db-sequential-result-set" }
+{ $subsections
+ "db-random-access-result-set"
+ "db-sequential-result-set"
+}
} ;
HELP: new-result-set
ARTICLE: "db" "Database library"
"Accessing a database:"
-{ $subsection "db-custom-database-combinators" }
+{ $subsections "db-custom-database-combinators" }
"Higher-level database help:"
{ $vocab-subsection "Database types" "db.types" }
{ $vocab-subsection "High-level tuple/database integration" "db.tuples" }
"Low-level database help:"
-{ $subsection "db-protocol" }
-{ $subsection "db-result-sets" }
-{ $subsection "db-lowlevel-tutorial" }
+{ $subsections
+ "db-protocol"
+ "db-result-sets"
+ "db-lowlevel-tutorial"
+}
"Supported database backends:"
{ $vocab-subsection "SQLite" "db.sqlite" }
{ $vocab-subsection "PostgreSQL" "db.postgresql" } ;
"Random-access result sets do not have to be traversed in order. For instance, PostgreSQL's result set object can be accessed as a matrix with i,j coordinates."
$nl
"Databases which work in this way must provide methods for the following traversal words:"
-{ $subsection #rows }
-{ $subsection #columns }
-{ $subsection row-column }
-{ $subsection row-column-typed } ;
+{ $subsections
+ #rows
+ #columns
+ row-column
+ row-column-typed
+} ;
ARTICLE: "db-sequential-result-set" "Sequential result sets"
"Sequential result sets can be iterated one element after the next. SQLite's result sets offer this method of traversal."
$nl
"Databases which work in this way must provide methods for the following traversal words:"
-{ $subsection more-rows? }
-{ $subsection advance-row }
-{ $subsection row-column }
-{ $subsection row-column-typed } ;
+{ $subsections
+ more-rows?
+ advance-row
+ row-column
+ row-column-typed
+} ;
ARTICLE: "db-result-sets" "Result sets"
"Result sets are the encapsulated, database-specific results from a SQL query."
$nl
"Two possible protocols for iterating over result sets exist:"
-{ $subsection "db-random-access-result-set" }
-{ $subsection "db-sequential-result-set" }
+{ $subsections
+ "db-random-access-result-set"
+ "db-sequential-result-set"
+}
"Query the number of rows or columns:"
-{ $subsection #rows }
-{ $subsection #columns }
+{ $subsections
+ #rows
+ #columns
+}
"Traversing a result set:"
-{ $subsection advance-row }
-{ $subsection more-rows? }
+{ $subsections
+ advance-row
+ more-rows?
+}
"Pulling out a single row of results:"
-{ $subsection row-column }
-{ $subsection row-column-typed } ;
+{ $subsections
+ row-column
+ row-column-typed
+} ;
ARTICLE: "db-protocol" "Low-level database protocol"
"The high-level protocol (see " { $vocab-link "db.tuples" } ") uses this low-level protocol for executing statements and queries." $nl
"Opening a database:"
-{ $subsection db-open }
+{ $subsections db-open }
"Closing a database:"
-{ $subsection db-close }
+{ $subsections db-close }
"Creating statements:"
-{ $subsection <simple-statement> }
-{ $subsection <prepared-statement> }
+{ $subsections
+ <simple-statement>
+ <prepared-statement>
+}
"Using statements with the database:"
-{ $subsection prepare-statement }
-{ $subsection bind-statement* }
-{ $subsection low-level-bind }
+{ $subsections
+ prepare-statement
+ bind-statement*
+ low-level-bind
+}
"Performing a query:"
-{ $subsection query-results }
+{ $subsections query-results }
"Handling query results:"
-{ $subsection "db-result-sets" }
+{ $subsections "db-result-sets" }
;
! { $subsection bind-tuple }
ARTICLE: "db-lowlevel-tutorial" "Low-level database tutorial"
"Although Factor makes integrating a database with its object system easy (see " { $vocab-link "db.tuples" } "), sometimes you may want to write SQL directly and get the results back as arrays of strings, for instance, when interfacing with a legacy database that doesn't easily map to " { $snippet "tuples" } "." $nl
"Executing a SQL command:"
-{ $subsection sql-command }
+{ $subsections sql-command }
"Executing a query directly:"
-{ $subsection sql-query }
+{ $subsections sql-query }
"Here's an example usage where we'll make a book table, insert some objects, and query them." $nl
"First, let's set up a custom combinator for using our database. See " { $link "db-custom-database-combinators" } " for more details."
-{ $code <"
-USING: db.sqlite db io.files ;
+{ $code """
+USING: db.sqlite db io.files io.files.temp ;
: with-book-db ( quot -- )
- "book.db" temp-file <sqlite-db> swap with-db ;"> }
+ "book.db" temp-file <sqlite-db> swap with-db ; inline" }
"Now let's create the table manually:"
-{ $code <" "create table books
+{ $code " "create table books
(id integer primary key, title text, author text, date_published timestamp,
edition integer, cover_price double, condition text)"
- [ sql-command ] with-book-db" "> }
+ [ sql-command ] with-book-db""" }
"Time to insert some books:"
-{ $code <"
+{ $code """
"insert into books
(title, author, date_published, edition, cover_price, condition)
values('Factor for Sheeple', 'Mister Stacky Pants', date('now'), 1, 13.37, 'mint')"
-[ sql-command ] with-book-db"> }
+[ sql-command ] with-book-db""" }
"Now let's select the book:"
-{ $code <"
-"select id, title, cover_price from books;" [ sql-query ] with-book-db "> }
+{ $code """
+"select id, title, cover_price from books;" [ sql-query ] with-book-db""" }
"Notice that the result of this query is a Factor array containing the database rows as arrays of strings. We would have to convert the " { $snippet "cover_price" } " from a string to a number in order to use it in a calculation." $nl
"In conclusion, this method of accessing a database is supported, but it is fairly low-level and generally specific to a single database. The " { $vocab-link "db.tuples" } " vocabulary is a good alternative to writing SQL by hand." ;
"Make a " { $snippet "with-" } " combinator to open and close a database so that resources are not leaked." $nl
"SQLite example combinator:"
-{ $code <"
+{ $code """
USING: db.sqlite db io.files io.files.temp ;
: with-sqlite-db ( quot -- )
- "my-database.db" temp-file <sqlite-db> swap with-db ; inline"> }
+ "my-database.db" temp-file <sqlite-db> swap with-db ; inline""" }
"PostgreSQL example combinator:"
-{ $code <" USING: db.postgresql db ;
+{ $code """USING: db.postgresql db ;
: with-postgresql-db ( quot -- )
<postgresql-db>
"localhost" >>host
"erg" >>username
"secrets?" >>password
"factor-test" >>database
- swap with-db ; inline">
+ swap with-db ; inline"""
} ;
ABOUT: "db"
! Copyright (C) 2007, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
! tested on debian linux with postgresql 8.1
-USING: alien alien.syntax combinators system alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators system
+alien.libraries ;
IN: db.postgresql.ffi
<< "postgresql" {
TYPEDEF: int PGTransactionStatusType
TYPEDEF: int PGVerbosity
-TYPEDEF: void* PGconn*
-TYPEDEF: void* PGresult*
-TYPEDEF: void* PGcancel*
+C-TYPE: PGconn
+C-TYPE: PGresult
+C-TYPE: PGcancel
TYPEDEF: uint Oid
TYPEDEF: uint* Oid*
TYPEDEF: char pqbool
-TYPEDEF: void* PQconninfoOption*
-TYPEDEF: void* PGnotify*
-TYPEDEF: void* PQArgBlock*
-TYPEDEF: void* PQprintOpt*
-TYPEDEF: void* FILE*
-TYPEDEF: void* SSL*
+C-TYPE: PQconninfoOption
+C-TYPE: PGnotify
+C-TYPE: PQArgBlock
+C-TYPE: PQprintOpt
+C-TYPE: SSL
+C-TYPE: FILE
LIBRARY: postgresql
! See http://factorcode.org/license.txt for BSD license.
USING: arrays continuations db io kernel math namespaces
quotations sequences db.postgresql.ffi alien alien.c-types
-db.types tools.walker ascii splitting math.parser combinators
-libc calendar.format byte-arrays destructors prettyprint
-accessors strings serialize io.encodings.binary io.encodings.utf8
-alien.strings io.streams.byte-array summary present urls
-specialized-arrays.uint specialized-arrays.alien db.private ;
+alien.data db.types tools.walker ascii splitting math.parser
+combinators libc calendar.format byte-arrays destructors
+prettyprint accessors strings serialize io.encodings.binary
+io.encodings.utf8 alien.strings io.streams.byte-array summary
+present urls specialized-arrays db.private ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: void*
IN: db.postgresql.lib
: postgresql-result-error-message ( res -- str/f )
! Copyright (C) 2008 Chris Double, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types arrays assocs kernel math math.parser
+USING: alien.c-types alien.data arrays assocs kernel math math.parser
namespaces sequences db.sqlite.ffi db combinators
continuations db.types calendar.format serialize
io.streams.byte-array byte-arrays io.encodings.binary
db.sqlite.lib db.sqlite.ffi db.tuples words db.types combinators
math.intervals io nmake accessors vectors math.ranges random
math.bitwise db.queries destructors db.tuples.private interpolate
-io.streams.string multiline make db.private sequences.deep
+io.streams.string make db.private sequences.deep
db.errors.sqlite ;
IN: db.sqlite
: insert-trigger ( -- string )
[
- <"
+ """
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- "> interpolate
+ """ interpolate
] with-string-writer ;
: insert-trigger-not-null ( -- string )
[
- <"
+ """
CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN
WHERE NEW.${table-id} IS NOT NULL
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- "> interpolate
+ """ interpolate
] with-string-writer ;
: update-trigger ( -- string )
[
- <"
+ """
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- "> interpolate
+ """ interpolate
] with-string-writer ;
: update-trigger-not-null ( -- string )
[
- <"
+ """
CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN
WHERE NEW.${table-id} IS NOT NULL
AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END;
- "> interpolate
+ """ interpolate
] with-string-writer ;
: delete-trigger-restrict ( -- string )
[
- <"
+ """
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fkd_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
END;
- "> interpolate
+ """ interpolate
] with-string-writer ;
: delete-trigger-cascade ( -- string )
[
- <"
+ """
CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN
DELETE from ${table-name} WHERE ${table-id} = OLD.${foreign-table-id};
END;
- "> interpolate
+ """ interpolate
] with-string-writer ;
: can-be-null? ( -- ? )
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: classes help.markup help.syntax io.streams.string kernel
-quotations sequences strings multiline math db.types
-db.tuples.private db ;
+quotations sequences strings math db.types db.tuples.private db ;
IN: db.tuples
HELP: random-id-generator
ARTICLE: "db-tuples" "High-level tuple/database integration"
"Start with a tutorial:"
-{ $subsection "db-tuples-tutorial" }
+{ $subsections "db-tuples-tutorial" }
"Database types supported:"
-{ $subsection "db.types" }
+{ $subsections "db.types" }
"Useful words:"
-{ $subsection "db-tuples-words" }
+{ $subsections "db-tuples-words" }
"For porting db.tuples to other databases:"
-{ $subsection "db-tuples-protocol" }
+{ $subsections "db-tuples-protocol" }
;
ARTICLE: "db-tuples-words" "High-level tuple/database words"
"Making tuples work with a database:"
-{ $subsection define-persistent }
+{ $subsections define-persistent }
"Creating tables:"
-{ $subsection create-table }
-{ $subsection ensure-table }
-{ $subsection ensure-tables }
-{ $subsection recreate-table }
+{ $subsections
+ create-table
+ ensure-table
+ ensure-tables
+ recreate-table
+}
"Dropping tables:"
-{ $subsection drop-table }
+{ $subsections drop-table }
"Inserting a tuple:"
-{ $subsection insert-tuple }
+{ $subsections insert-tuple }
"Updating a tuple:"
-{ $subsection update-tuple }
+{ $subsections update-tuple }
"Deleting tuples:"
-{ $subsection delete-tuples }
+{ $subsections delete-tuples }
"Querying tuples:"
-{ $subsection select-tuple }
-{ $subsection select-tuples }
-{ $subsection count-tuples } ;
+{ $subsections
+ select-tuple
+ select-tuples
+ count-tuples
+} ;
ARTICLE: "db-tuples-protocol" "Tuple database protocol"
"Creating a table:"
-{ $subsection create-sql-statement }
+{ $subsections create-sql-statement }
"Dropping a table:"
-{ $subsection drop-sql-statement }
+{ $subsections drop-sql-statement }
"Inserting a tuple:"
-{ $subsection <insert-db-assigned-statement> }
-{ $subsection <insert-user-assigned-statement> }
+{ $subsections
+ <insert-db-assigned-statement>
+ <insert-user-assigned-statement>
+}
"Updating a tuple:"
-{ $subsection <update-tuple-statement> }
+{ $subsections <update-tuple-statement> }
"Deleting tuples:"
-{ $subsection <delete-tuples-statement> }
+{ $subsections <delete-tuples-statement> }
"Selecting tuples:"
-{ $subsection <select-by-slots-statement> }
+{ $subsections <select-by-slots-statement> }
"Counting tuples:"
-{ $subsection <count-statement> } ;
+{ $subsections <count-statement> } ;
ARTICLE: "db-tuples-tutorial" "Tuple database tutorial"
"Let's make a tuple and store it in a database. To follow along, click on each code example and run it in the listener. If you forget to run an example, just start at the top and run them all again in order." $nl
"The title, author, and publisher should be strings; the date-published a timestamp; the edition an integer; the cover-price a float. These are the Factor types for which we will need to look up the corresponding " { $link "db.types" } ". " $nl
"To actually bind the tuple slots to the database types, we'll use " { $link define-persistent } "."
{ $code
-<" USING: db.tuples db.types ;
+"""USING: db.tuples db.types ;
book "BOOK"
{
{ "id" "ID" +db-assigned-id+ }
{ "edition" "EDITION" INTEGER }
{ "cover-price" "COVER_PRICE" DOUBLE }
{ "condition" "CONDITION" VARCHAR }
-} define-persistent "> }
+} define-persistent""" }
"That's all we'll have to do with the database for this tutorial. Now let's make a book."
-{ $code <" USING: calendar namespaces ;
+{ $code """USING: calendar namespaces ;
T{ book
{ title "Factor for Sheeple" }
{ author "Mister Stacky Pants" }
{ edition 1 }
{ cover-price 13.37 }
} book set
-"> }
+""" }
"Now we've created a book. Let's save it to the database."
-{ $code <" USING: db db.sqlite fry io.files ;
+{ $code """USING: db db.sqlite fry io.files.temp ;
: with-book-tutorial ( quot -- )
- '[ "book-tutorial.db" temp-file <sqlite-db> _ with-db ] call ;
+ '[ "book-tutorial.db" temp-file <sqlite-db> _ with-db ] call ; inline
[
book recreate-table
book get insert-tuple
] with-book-tutorial
-"> }
+""" }
"Is it really there?"
-{ $code <" [
+{ $code """[
T{ book { title "Factor for Sheeple" } } select-tuples .
-] with-book-tutorial "> }
+] with-book-tutorial""" }
"Oops, we spilled some orange juice on the book cover."
-{ $code <" book get "Small orange juice stain on cover" >>condition "> }
+{ $code """book get "Small orange juice stain on cover" >>condition""" }
"Now let's save the modified book."
-{ $code <" [
+{ $code """[
book get update-tuple
-] with-book-tutorial "> }
+] with-book-tutorial""" }
"And select it again. You can query the database by any field -- just set it in the exemplar tuple you pass to " { $link select-tuples } "."
-{ $code <" [
+{ $code """[
T{ book { title "Factor for Sheeple" } } select-tuples
-] with-book-tutorial "> }
+] with-book-tutorial""" }
"Let's drop the table because we're done."
-{ $code <" [
+{ $code """[
book drop-table
-] with-book-tutorial "> }
+] with-book-tutorial""" }
"To summarize, the steps for using Factor's tuple database are:"
{ $list
"Make a new tuple to represent your data"
ARTICLE: "db.types" "Database types"
"The " { $vocab-link "db.types" } " vocabulary maps Factor types to database types." $nl
"Primary keys:"
-{ $subsection +db-assigned-id+ }
-{ $subsection +user-assigned-id+ }
-{ $subsection +random-id+ }
+{ $subsections
+ +db-assigned-id+
+ +user-assigned-id+
+ +random-id+
+}
"Null and boolean types:"
-{ $subsection NULL }
-{ $subsection BOOLEAN }
+{ $subsections
+ NULL
+ BOOLEAN
+}
"Text types:"
-{ $subsection VARCHAR }
-{ $subsection TEXT }
+{ $subsections
+ VARCHAR
+ TEXT
+}
"Number types:"
-{ $subsection INTEGER }
-{ $subsection BIG-INTEGER }
-{ $subsection SIGNED-BIG-INTEGER }
-{ $subsection UNSIGNED-BIG-INTEGER }
-{ $subsection DOUBLE }
-{ $subsection REAL }
+{ $subsections
+ INTEGER
+ BIG-INTEGER
+ SIGNED-BIG-INTEGER
+ UNSIGNED-BIG-INTEGER
+ DOUBLE
+ REAL
+}
"Calendar types:"
-{ $subsection DATE }
-{ $subsection DATETIME }
-{ $subsection TIME }
-{ $subsection TIMESTAMP }
+{ $subsections
+ DATE
+ DATETIME
+ TIME
+ TIMESTAMP
+}
"Factor byte-arrays:"
-{ $subsection BLOB }
+{ $subsections BLOB }
"Arbitrary Factor objects:"
-{ $subsection FACTOR-BLOB }
+{ $subsections FACTOR-BLOB }
"Factor URLs:"
-{ $subsection URL } ;
+{ $subsections URL } ;
ABOUT: "db.types"
ARTICLE: "debugger" "The debugger"
"Caught errors can be logged in human-readable form:"
-{ $subsection print-error }
-{ $subsection try }
+{ $subsections
+ print-error
+ try
+}
"User-defined errors can have customized printed representation by implementing a generic word:"
-{ $subsection error. }
+{ $subsections error. }
"A number of words facilitate interactive debugging of errors:"
-{ $subsection :s }
-{ $subsection :r }
-{ $subsection :c }
-{ $subsection :get }
+{ $subsections
+ :error
+ :s
+ :r
+ :c
+ :get
+}
"Most types of errors are documented, and the documentation is instantly accessible:"
-{ $subsection :help }
+{ $subsections :help }
"If the error was restartable, a list of restarts is also printed, and a numbered restart can be invoked:"
-{ $subsection :1 }
-{ $subsection :2 }
-{ $subsection :3 }
-{ $subsection :res }
-"You can read more about error handling in " { $link "errors" } "." ;
+{ $subsections
+ :1
+ :2
+ :3
+ :res
+}
+"You can read more about error handling in " { $link "errors" } "."
+$nl
+"Note that in Factor, the debugger is a tool for printing and inspecting errors, not for walking through code. For the latter, see " { $link "ui-walker" } "." ;
ABOUT: "debugger"
+HELP: :error
+{ $description "Prints the most recent error. Used for interactive debugging." } ;
+
HELP: :s
{ $description "Prints the data stack at the time of the most recent error. Used for interactive debugging." } ;
: primitive-error. ( error -- )
"Unimplemented primitive" print drop ;
+: fp-trap-error. ( error -- )
+ "Floating point trap" print drop ;
+
PREDICATE: vm-error < array
{
{ [ dup empty? ] [ drop f ] }
{ [ dup first "kernel-error" = not ] [ drop f ] }
- [ second 0 15 between? ]
+ [ second 0 16 between? ]
} cond ;
: vm-errors ( error -- n errors )
{ 13 [ retainstack-underflow. ] }
{ 14 [ retainstack-overflow. ] }
{ 15 [ memory-error. ] }
+ { 16 [ fp-trap-error. ] }
} ; inline
M: vm-error summary drop "VM error" ;
M: bad-slot-value summary drop "Bad store to specialized slot" ;
+M: bad-slot-name summary drop "Bad slot name in object literal" ;
+
M: no-math-method summary
drop "No suitable arithmetic method" ;
M: bad-effect summary
drop "Bad stack effect declaration" ;
-M: bad-escape summary drop "Bad escape code" ;
+M: bad-escape error.
+ "Bad escape code: \\" write
+ char>> 1string print ;
M: bad-literal-tuple summary drop "Bad literal tuple" ;
"The " { $vocab-link "definitions.icons" } " vocabulary associates common definition types with icons."
{ $definition-icons }
"Looking up the icon associated with a definition:"
-{ $subsection definition-icon }
+{ $subsections definition-icon }
"Defining new icons:"
-{ $subsection POSTPONE: ICON: } ;
+{ $subsections POSTPONE: ICON: } ;
ABOUT: "definitions.icons"
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs classes.predicate fry generic io.pathnames kernel
-macros sequences vocabs words words.symbol words.constant
-lexer parser help.topics help.markup namespaces sorting ;
+USING: assocs classes.predicate fry generic help.topics
+io.pathnames kernel lexer macros namespaces parser sequences
+vocabs words words.constant words.symbol ;
IN: definitions.icons
GENERIC: definition-icon ( definition -- path )
: definition-icon-path ( string -- string' )
- "vocab:definitions/icons/" prepend-path ".tiff" append ;
+ "vocab:definitions/icons/" prepend-path ".png" append ;
<<
ICON: constant constant-word
ICON: word normal-word
ICON: word-link word-help-article
-ICON: link help-article
+ICON: topic help-article
ICON: runnable-vocab runnable-vocab
ICON: vocab open-vocab
ICON: vocab-link unopen-vocab
-
-: $definition-icons ( element -- )
- drop
- icons get >alist sort-keys
- [ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
- { "" "Definition class" } prefix
- $table ;
\ No newline at end of file
"Unlike " { $link "tuple-subclassing" } ", which expresses " { $emphasis "is-a" } " relationships by statically including the methods and slots of the superclass in all subclasses, consultation forwards generic word calls to another distinct object."
$nl
"Defining new protocols:"
-{ $subsection POSTPONE: PROTOCOL: }
-{ $subsection define-protocol }
+{ $subsections
+ POSTPONE: PROTOCOL:
+ define-protocol
+}
"Defining new protocols consisting of slot accessors:"
-{ $subsection POSTPONE: SLOT-PROTOCOL: }
+{ $subsections POSTPONE: SLOT-PROTOCOL: }
"Defining consultation:"
-{ $subsection POSTPONE: CONSULT: }
-{ $subsection define-consult }
+{ $subsections
+ POSTPONE: CONSULT:
+ define-consult
+}
"Every tuple class has an associated protocol consisting of all of its slot accessor methods. The " { $vocab-link "delegate.protocols" } " vocabulary defines formal protocols for the various informal protocols used in the Factor core, such as " { $link "sequence-protocol" } ", " { $link "assocs-protocol" } " or " { $link "stream-protocol" } ;
ABOUT: "delegate"
! Replacing a method definition with a consultation would cause problems
[ [ ] ] [
- <" IN: delegate.tests
+ "IN: delegate.tests
USE: kernel
- M: a-tuple do-me drop ; "> <string-reader> "delegate-test" parse-stream
+ M: a-tuple do-me drop ;" <string-reader> "delegate-test" parse-stream
] unit-test
[ ] [ T{ a-tuple } do-me ] unit-test
! Change method definition to consultation
[ [ ] ] [
- <" IN: delegate.tests
+ "IN: delegate.tests
USE: kernel
USE: delegate
- CONSULT: silly-protocol a-tuple drop f ; "> <string-reader> "delegate-test" parse-stream
+ CONSULT: silly-protocol a-tuple drop f ; " <string-reader> "delegate-test" parse-stream
] unit-test
! Method should be there
! Now try removing the consulation
[ [ ] ] [
- <" IN: delegate.tests "> <string-reader> "delegate-test" parse-stream
+ "IN: delegate.tests" <string-reader> "delegate-test" parse-stream
] unit-test
! Method should be gone
[ f ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test
[ [ ] ] [
- <" IN: delegate.tests
+ "IN: delegate.tests
USING: accessors delegate ;
TUPLE: slot-protocol-test-3 x ;
-CONSULT: y>> slot-protocol-test-3 x>> ;">
+CONSULT: y>> slot-protocol-test-3 x>> ;"
<string-reader> "delegate-test-1" parse-stream
] unit-test
[ t ] [ \ slot-protocol-test-3 \ y>> method >boolean ] unit-test
[ [ ] ] [
- <" IN: delegate.tests
-TUPLE: slot-protocol-test-3 x y ;">
+ "IN: delegate.tests
+TUPLE: slot-protocol-test-3 x y ;"
<string-reader> "delegate-test-1" parse-stream
] unit-test
! We want to be able to override methods after consultation
[ [ ] ] [
- <" IN: delegate.tests
+ "IN: delegate.tests
USING: delegate kernel sequences delegate.protocols accessors ;
TUPLE: override-method-test seq ;
CONSULT: sequence-protocol override-method-test seq>> ;
- M: override-method-test like drop ; ">
+ M: override-method-test like drop ; "
<string-reader> "delegate-test-2" parse-stream
] unit-test
! See if removing a consultation updates protocol-consult word prop
[ [ ] ] [
- <" IN: delegate.tests
+ "IN: delegate.tests
USING: accessors delegate delegate.protocols ;
TUPLE: seq-delegate seq ;
- CONSULT: sequence-protocol seq-delegate seq>> ;">
+ CONSULT: sequence-protocol seq-delegate seq>> ;"
<string-reader> "remove-consult-test" parse-stream
] unit-test
] unit-test
[ [ ] ] [
- <" IN: delegate.tests
+ "IN: delegate.tests
USING: delegate delegate.protocols ;
- TUPLE: seq-delegate seq ;">
+ TUPLE: seq-delegate seq ;"
<string-reader> "remove-consult-test" parse-stream
] unit-test
"The " { $vocab-link "deques" } " vocabulary implements the deque data structure which has constant-time insertion and removal of elements at both ends."
$nl
"Deques must be instances of a mixin class:"
-{ $subsection deque }
+{ $subsections deque }
"Deques must implement a protocol."
$nl
"Querying the deque:"
-{ $subsection peek-front }
-{ $subsection peek-back }
-{ $subsection deque-empty? }
-{ $subsection deque-member? }
+{ $subsections
+ peek-front
+ peek-back
+ deque-empty?
+ deque-member?
+}
"Adding and removing elements:"
-{ $subsection push-front* }
-{ $subsection push-back* }
-{ $subsection pop-front* }
-{ $subsection pop-back* }
-{ $subsection clear-deque }
+{ $subsections
+ push-front*
+ push-back*
+ pop-front*
+ pop-back*
+ clear-deque
+}
"Working with node objects output by " { $link push-front* } " and " { $link push-back* } ":"
-{ $subsection delete-node }
-{ $subsection node-value }
+{ $subsections
+ delete-node
+ node-value
+}
"Utility operations built in terms of the above:"
-{ $subsection push-front }
-{ $subsection push-all-front }
-{ $subsection push-back }
-{ $subsection push-all-back }
-{ $subsection pop-front }
-{ $subsection pop-back }
-{ $subsection slurp-deque }
+{ $subsections
+ push-front
+ push-all-front
+ push-back
+ push-all-back
+ pop-front
+ pop-back
+ slurp-deque
+}
"When using a deque as a queue, the convention is to queue elements with " { $link push-front } " and deque them with " { $link pop-back } "." ;
ABOUT: "deques"
"The two main supported operations are equating two elements, which joins their equivalence classes, and checking if two elements belong to the same equivalence class. Both operations have the time complexity of the inverse Ackermann function, which for all intents and purposes is constant time."
$nl
"The class of disjoint sets:"
-{ $subsection disjoint-set }
+{ $subsections disjoint-set }
"Creating new disjoint sets:"
-{ $subsection <disjoint-set> }
-{ $subsection assoc>disjoint-set }
+{ $subsections
+ <disjoint-set>
+ assoc>disjoint-set
+}
"Queries:"
-{ $subsection equiv? }
-{ $subsection equiv-set-size }
+{ $subsections
+ equiv?
+ equiv-set-size
+}
"Adding elements:"
-{ $subsection add-atom }
+{ $subsections add-atom }
"Equating elements:"
-{ $subsection equate }
+{ $subsections equate }
"Additionally, disjoint sets implement the " { $link clone } " generic word." ;
ABOUT: "disjoint-sets"
"A double-linked list is the canonical implementation of a " { $link deque } "."
$nl
"Double-linked lists form a class:"
-{ $subsection dlist }
-{ $subsection dlist? }
+{ $subsections
+ dlist
+ dlist?
+}
"Constructing a double-linked list:"
-{ $subsection <dlist> }
+{ $subsection
s <dlist> }
"Double-linked lists support all the operations of the deque protocol (" { $link "deques" } ") as well as the following."
$nl
"Iterating over elements:"
-{ $subsection dlist-each }
-{ $subsection dlist-find }
-{ $subsection dlist-filter }
-{ $subsection dlist-any? }
+{ $subsections
+ dlist-each
+ dlist-find
+ dlist-filter
+ dlist-any?
+}
"Deleting a node matching a predicate:"
-{ $subsection delete-node-if* }
-{ $subsection delete-node-if }
+{ $subsections
+ delete-node-if*
+ delete-node-if
+}
"Search deque implementation:"
-{ $subsection <hashed-dlist> } ;
+{ $subsections <hashed-dlist> } ;
ABOUT: "dlists"
ARTICLE: "documents" "Documents"
"The " { $vocab-link "documents" } " vocabulary implements " { $emphasis "documents" } ", which are models storing a passage of text as a sequence of lines. Operations are defined for operating on subranges of the text, and " { $link "ui.gadgets.editors" } " can display these models."
-{ $subsection document }
-{ $subsection <document> }
+{ $subsections
+ document
+ <document>
+}
"Getting and setting the contents of the entire document:"
-{ $subsection doc-string }
-{ $subsection set-doc-string }
-{ $subsection clear-doc }
+{ $subsections
+ doc-string
+ set-doc-string
+ clear-doc
+}
"Getting and setting subranges:"
-{ $subsection doc-line }
-{ $subsection doc-lines }
-{ $subsection doc-range }
-{ $subsection set-doc-range }
-{ $subsection remove-doc-range }
+{ $subsections
+ doc-line
+ doc-lines
+ doc-range
+ set-doc-range
+ remove-doc-range
+}
"A combinator:"
-{ $subsection each-line }
-{ $subsection "document-locs" }
-{ $subsection "documents.elements" }
+{ $subsections each-line }
+"More info:"
+{ $subsections
+ "document-locs"
+ "documents.elements"
+}
{ $see-also "ui.gadgets.editors" } ;
ARTICLE: "document-locs" "Document locations"
"Locations in the document are represented as a line/column number pair, with both indices being zero-based. There are some words for manipulating locations:"
-{ $subsection +col }
-{ $subsection +line }
-{ $subsection =col }
-{ $subsection =line }
+{ $subsections
+ +col
+ +line
+ =col
+ =line
+}
"Miscellaneous words for working with locations:"
-{ $subsection lines-equal? }
-{ $subsection validate-loc } ;
+{ $subsections
+ lines-equal?
+ validate-loc
+} ;
ABOUT: "documents"
"Document elements, defined in the " { $vocab-link "documents.elements" } " vocabulary, overlay a hierarchy of structure on top of the flat sequence of characters presented by the document."
$nl
"The different types of document elements correspond to the standard editing taxonomy:"
-{ $subsection char-elt }
-{ $subsection one-word-elt }
-{ $subsection word-elt }
-{ $subsection one-line-elt }
-{ $subsection line-elt }
-{ $subsection doc-elt }
+{ $subsections
+ char-elt
+ one-word-elt
+ word-elt
+ one-line-elt
+ line-elt
+ doc-elt
+}
"New locations can be created out of existing ones by finding the start or end of a document element nearest to a given location."
-{ $subsection prev-elt }
-{ $subsection next-elt } ;
+{ $subsections
+ prev-elt
+ next-elt
+} ;
ABOUT: "documents.elements"
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test namespaces documents documents.elements multiline ;
+USING: tools.test namespaces documents documents.elements ;
IN: document.elements.tests
SYMBOL: doc
! page-elt
<document> doc set
-<" First line
+"First line
Second line
Third line
Fourth line
Fifth line
-Sixth line"> doc get set-doc-string
+Sixth line" doc get set-doc-string
[ { 0 0 } ] [ { 3 3 } doc get 4 <page-elt> prev-elt ] unit-test
[ { 1 2 } ] [ { 5 2 } doc get 4 <page-elt> prev-elt ] unit-test
ARTICLE: "editor" "Editor integration"
"Factor development is best done with one of the supported editors; this allows you to quickly jump to definitions from the Factor environment."
-{ $subsection edit }
+{ $subsections edit }
"Depending on the editor you are using, you must load one of the child vocabularies of the " { $vocab-link "editors" } " vocabulary, for example " { $vocab-link "editors.emacs" } ":"
{ $code "USE: editors.emacs" }
"If you intend to always use the same editor, it helps to have it load during stage 2 bootstrap. Place the code to load and possibly configure it in the " { $link "factor-boot-rc" } "."
$nl
"Editor integration vocabularies store a quotation in a global variable when loaded:"
-{ $subsection edit-hook }
+{ $subsections edit-hook }
"If a syntax error was thrown while loading a source file, you can jump to the location of the error in your editor:"
-{ $subsection :edit } ;
+{ $subsections :edit } ;
ABOUT: "editor"
"The " { $vocab-link "environment" } " vocabulary interfaces to the platform-dependent mechanism for setting environment variables." $nl
"Windows CE has no concept of environment variables, so these words are undefined on that platform." $nl
"Reading environment variables:"
-{ $subsection os-env }
-{ $subsection os-envs }
+{ $subsections
+ os-env
+ os-envs
+}
"Writing environment variables:"
-{ $subsection set-os-env }
-{ $subsection unset-os-env }
-{ $subsection set-os-envs } ;
+{ $subsections
+ set-os-env
+ unset-os-env
+ set-os-envs
+} ;
ABOUT: "environment"
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system environment.unix ;
+USING: alien.c-types alien.syntax system environment.unix ;
IN: environment.unix.macosx
FUNCTION: void* _NSGetEnviron ( ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax kernel
-layouts sequences system unix environment io.encodings.utf8
-unix.utilities vocabs.loader combinators alien.accessors ;
+USING: alien alien.c-types alien.data alien.strings
+alien.syntax kernel layouts sequences system unix
+environment io.encodings.utf8 unix.utilities vocabs.loader
+combinators alien.accessors ;
IN: environment.unix
HOOK: environ os ( -- void* )
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.strings fry io.encodings.utf16n kernel
-splitting windows windows.kernel32 system environment
-alien.c-types sequences windows.errors io.streams.memory
-io.encodings io ;
+splitting windows windows.kernel32 windows.types system
+environment alien.data sequences windows.errors
+io.streams.memory io.encodings io specialized-arrays ;
+SPECIALIZED-ARRAY: TCHAR
IN: environment.winnt
M: winnt os-env ( key -- value )
- MAX_UNICODE_PATH "TCHAR" <c-array>
+ MAX_UNICODE_PATH TCHAR <c-array>
[ dup length GetEnvironmentVariable ] keep over 0 = [
2drop f
] [
ARTICLE: "eval" "Evaluating strings at runtime"
"The " { $vocab-link "eval" } " vocabulary implements support for evaluating strings at runtime."
-{ $subsection POSTPONE: eval( }
-{ $subsection eval>string } ;
+{ $subsections
+ POSTPONE: eval(
+ eval>string
+} ;
ABOUT: "eval"
ARTICLE: "farkup-ast" "Farkup syntax tree nodes"
"The " { $link parse-farkup } " word outputs a tree of nodes corresponding to the Farkup syntax of the input string. This tree can be programatically traversed and mutated before being passed on to " { $link write-farkup } "."
-{ $subsection heading1 }
-{ $subsection heading2 }
-{ $subsection heading3 }
-{ $subsection heading4 }
-{ $subsection strong }
-{ $subsection emphasis }
-{ $subsection superscript }
-{ $subsection subscript }
-{ $subsection inline-code }
-{ $subsection paragraph }
-{ $subsection list-item }
-{ $subsection unordered-list }
-{ $subsection ordered-list }
-{ $subsection table }
-{ $subsection table-row }
-{ $subsection link }
-{ $subsection image }
-{ $subsection code } ;
+{ $subsections
+ heading1
+ heading2
+ heading3
+ heading4
+ strong
+ emphasis
+ superscript
+ subscript
+ inline-code
+ paragraph
+ list-item
+ unordered-list
+ ordered-list
+ table
+ table-row
+ link
+ image
+ code
+} ;
ARTICLE: "farkup" "Farkup"
"The " { $vocab-link "farkup" } " vocabulary implements Farkup (Factor mARKUP), a simple markup language. Farkup was loosely based on the markup languages employed by MediaWiki and " { $url "http://reddit.com" } "."
$nl
"The main entry points for converting Farkup to HTML:"
-{ $subsection convert-farkup }
-{ $subsection write-farkup }
+{ $subsections
+ convert-farkup
+ write-farkup
+}
"The syntax tree of a piece of Farkup can also be inspected and modified:"
-{ $subsection parse-farkup }
-{ $subsection (write-farkup) }
-{ $subsection "farkup-ast" } ;
+{ $subsections
+ parse-farkup
+ (write-farkup)
+ "farkup-ast"
+} ;
ABOUT: "farkup"
ARTICLE: "fonts" "Fonts"
"The " { $vocab-link "fonts" } " vocabulary implements a data type for fonts that other vocabularies, for example " { $link "ui" } ", can use. A font combines a font name, size, style, and color information into a single object."
-{ $subsection font }
-{ $subsection <font> }
+{ $subsections
+ font
+ <font>
+}
"Modifying fonts:"
-{ $subsection font-with-foreground }
-{ $subsection font-with-background }
+{ $subsections
+ font-with-foreground
+ font-with-background
+}
"Useful constants:"
-{ $subsection monospace-font }
-{ $subsection sans-serif-font }
-{ $subsection serif-font }
+{ $subsections
+ monospace-font
+ sans-serif-font
+ serif-font
+}
"A data type for font metrics. The " { $vocab-link "fonts" } " vocabulary does not provide any means of computing font metrics, it simply defines a common data type that other vocabularies, such as " { $vocab-link "ui.text" } " may use:"
-{ $subsection metrics } ;
+{ $subsections metrics } ;
ABOUT: "fonts"
ARTICLE: "formatting" "Formatted printing"
"The " { $vocab-link "formatting" } " vocabulary is used for formatted printing."
-{ $subsection printf }
-{ $subsection sprintf }
-{ $subsection strftime }
-;
+{ $subsections
+ printf
+ sprintf
+ strftime
+} ;
ABOUT: "formatting"
"The " { $vocab-link "fry" } " vocabulary implements " { $emphasis "fried quotation" } ". Conceptually, fried quotations are quotations with “holes” (more formally, " { $emphasis "fry specifiers" } "), and the holes are filled in when the fried quotation is pushed on the stack."\r
$nl\r
"Fried quotations are started by a special parsing word:"\r
-{ $subsection POSTPONE: '[ }\r
+{ $subsections POSTPONE: '[ }\r
"There are two types of fry specifiers; the first can hold a value, and the second “splices” a quotation, as if it were inserted without surrounding brackets:"\r
-{ $subsection _ }\r
-{ $subsection @ }\r
+{ $subsections\r
+ _\r
+ @\r
+}\r
"The holes are filled in with the top of stack going in the rightmost hole, the second item on the stack going in the second hole from the right, and so on."\r
-{ $subsection "fry.examples" }\r
-{ $subsection "fry.philosophy" }\r
+{ $subsections\r
+ "fry.examples"\r
+ "fry.philosophy"\r
+}\r
"Fry is implemented as a parsing word which reads a quotation and scans for occurrences of " { $link _ } " and " { $link @ } "; these words are not actually executed, and doing so raises an error (this can happen if they're accidentally used outside of a fry)."\r
$nl\r
"Fried quotations can also be constructed without using a parsing word; this is useful when meta-programming:"\r
-{ $subsection fry }\r
+{ $subsections fry }\r
"Fried quotations are an abstraction on top of the " { $link "compositional-combinators" } "; their use is encouraged over the combinators, because often the fry form is shorter and clearer than the combinator form." ;\r
\r
ABOUT: "fry"\r
USING: classes.struct functors tools.test math words kernel
multiline parser io.streams.string generic ;
+QUALIFIED-WITH: alien.c-types c
IN: functors.tests
<<
! Does replacing an ordinary word with a functor-generated one work?
[ [ ] ] [
- <" IN: functors.tests
+ "IN: functors.tests
TUPLE: some-tuple ;
: some-word ( -- ) ;
GENERIC: some-generic ( a -- b )
M: some-tuple some-generic ;
- SYMBOL: some-symbol
- "> <string-reader> "functors-test" parse-stream
+ SYMBOL: some-symbol" <string-reader> "functors-test" parse-stream
] unit-test
: test-redefinition ( -- )
;FUNCTOR
[ [ ] ] [
- <" IN: functors.tests
- << "some" redefine-test >>
- "> <string-reader> "functors-test" parse-stream
+ """IN: functors.tests
+ << "some" redefine-test >>""" <string-reader> "functors-test" parse-stream
] unit-test
test-redefinition
WHERE
STRUCT: T-class
- { NAME int }
+ { NAME c:int }
{ x { TYPE 4 } }
- { y { "short" N } }
+ { y { c:short N } }
{ z TYPE initial: 5 }
- { float { "float" 2 } } ;
+ { float { c:float 2 } } ;
;FUNCTOR
-"a-struct" "nemo" "char" 2 define-a-struct
+"a-struct" "nemo" c:char 2 define-a-struct
>>
{ offset 0 }
{ class integer }
{ initial 0 }
- { c-type "int" }
+ { type c:int }
}
T{ struct-slot-spec
{ name "x" }
{ offset 4 }
{ class object }
{ initial f }
- { c-type { "char" 4 } }
+ { type { c:char 4 } }
}
T{ struct-slot-spec
{ name "y" }
{ offset 8 }
{ class object }
{ initial f }
- { c-type { "short" 2 } }
+ { type { c:short 2 } }
}
T{ struct-slot-spec
{ name "z" }
{ offset 12 }
{ class fixnum }
{ initial 5 }
- { c-type "char" }
+ { type c:char }
}
T{ struct-slot-spec
{ name "float" }
{ offset 16 }
{ class object }
{ initial f }
- { c-type { "float" 2 } }
+ { type { c:float 2 } }
}
}
] [ a-struct struct-slots ] unit-test
SYNTAX: DEFINES [ create-in ] (INTERPOLATE) ;
+SYNTAX: DEFINES-PRIVATE [ begin-private create-in end-private ] (INTERPOLATE) ;
+
SYNTAX: DEFINES-CLASS [ create-class-in ] (INTERPOLATE) ;
DEFER: ;FUNCTOR delimiter
USING: assocs classes help.markup help.syntax io.streams.string
http http.server.dispatchers http.server.responses
-furnace.redirection strings multiline html.forms ;
+furnace.redirection strings html.forms ;
IN: furnace.actions
HELP: <action>
{ $examples
"A simple validator from " { $vocab-link "webapps.todo" } "; this word is invoked from the " { $slot "validate" } " quotation of action for editing a todo list item:"
{ $code
- <" : validate-todo ( -- )
+ """: validate-todo ( -- )
{
{ "summary" [ v-one-line ] }
{ "priority" [ v-integer 0 v-min-value 10 v-max-value ] }
{ "description" [ v-required ] }
- } validate-params ;">
+ } validate-params ;"""
}
} ;
ARTICLE: "furnace.actions.page" "Furnace page actions"
"Page actions implement the common case of an action that simply serves a Chloe template in response to a GET request."
-{ $subsection page-action }
-{ $subsection <page-action> }
+{ $subsections
+ page-action
+ <page-action>
+}
"When using a page action, instead of setting the " { $slot "display" } " slot, the " { $slot "template" } " slot is set instead. The " { $slot "init" } ", " { $slot "authorize" } ", " { $slot "validate" } " and " { $slot "submit" } " slots can still be set as usual."
$nl
"The " { $slot "template" } " slot of a " { $link page-action } " contains a pair with shape " { $snippet "{ responder name }" } ", where " { $snippet "responder" } " is a responder class, usually a subclass of " { $link dispatcher } ", and " { $snippet "name" } " is the name of a template file, without the " { $snippet ".xml" } " extension, relative to the directory containing the responder's vocabulary source file."
-{ $subsection "furnace.actions.page.example" } ;
+{ $subsections "furnace.actions.page.example" } ;
ARTICLE: "furnace.actions.config" "Furnace action configuration"
"Actions have the following slots:"
"The action code is set up so that the " { $slot "init" } " quotation can validate query parameters, and the " { $slot "validate" } " quotation can validate POST parameters."
$nl
"A word to validate parameters and make them available as HTML form values (see " { $link "html.forms.values" } "); typically this word is invoked from the " { $slot "init" } " and " { $slot "validate" } " quotations:"
-{ $subsection validate-params }
+{ $subsections validate-params }
"The above word expects an association list mapping parameter names to validator quotations; validator quotations can use the words in the "
"Custom validation logic can invoke a word when validation fails; " { $link validate-params } " invokes this word for you:"
-{ $subsection validation-failed }
+{ $subsections validation-failed }
"If validation fails, no more action code is executed, and the client is redirected back to the originating page, where validation errors can be displayed. Note that validation errors are rendered automatically by the " { $link "html.components" } " words, and in particular, " { $link "html.templates.chloe" } " use these words." ;
ARTICLE: "furnace.actions.lifecycle" "Furnace action lifecycle"
ARTICLE: "furnace.actions.impl" "Furnace actions implementation"
"The following parametrized constructor should be called from constructors for subclasses of " { $link action } ":"
-{ $subsection new-action } ;
+{ $subsections new-action } ;
ARTICLE: "furnace.actions" "Furnace actions"
"The " { $vocab-link "furnace.actions" } " vocabulary implements a type of responder, called an " { $emphasis "action" } ", which handles the form validation lifecycle."
"Other than form validation capability, actions are also often simpler to use than implementing new responders directly, since creating a new class is not required, and the action dispatches on the request type (GET, HEAD, or POST)."
$nl
"The class of actions:"
-{ $subsection action }
+{ $subsections action }
"Creating a new action:"
-{ $subsection <action> }
+{ $subsection
s <action> }
"Once created, an action needs to be configured; typically the creation and configuration of an action is encapsulated into a single word:"
-{ $subsection "furnace.actions.config" }
+{ $subsections "furnace.actions.config" }
"Validating forms with actions:"
-{ $subsection "furnace.actions.validation" }
+{ $subsections "furnace.actions.validation" }
"More about the form validation lifecycle:"
-{ $subsection "furnace.actions.lifecycle" }
+{ $subsections "furnace.actions.lifecycle" }
"A convenience class:"
-{ $subsection "furnace.actions.page" }
+{ $subsections "furnace.actions.page" }
"Low-level features:"
-{ $subsection "furnace.actions.impl" } ;
+{ $subsections "furnace.actions.impl" } ;
ABOUT: "furnace.actions"
+USING: help.markup help.syntax db ;
IN: furnace.alloy
-USING: help.markup help.syntax db multiline ;
HELP: init-furnace-tables
{ $description "Initializes database tables used by asides, conversations and session management. This word must be invoked inside a " { $link with-db } " scope." } ;
{ $examples
"The " { $vocab-link "webapps.counter" } " vocabulary uses an alloy to configure the counter:"
{ $code
- <" : counter-db ( -- db ) "counter.db" <sqlite-db> ;
+ """: counter-db ( -- db ) "counter.db" <sqlite-db> ;
: run-counter ( -- )
<counter-app>
counter-db <alloy>
main-responder set-global
- 8080 httpd ;">
+ 8080 httpd ;"""
}
} ;
{ $link "furnace.db" }
}
"A word to wrap a responder in an alloy:"
-{ $subsection <alloy> }
+{ $subsection
s <alloy> }
"Initializing database tables for asides, conversations and sessions:"
-{ $subsection init-furnace-tables }
+{ $subsections init-furnace-tables }
"Start a timer to expire asides, conversations and sessions:"
-{ $subsection start-expiring } ;
+{ $subsections start-expiring } ;
ABOUT: "furnace.alloy"
"The " { $vocab-link "furnace.asides" } " vocabulary provides support for sending a user to a page which can then return to the former location."
$nl
"To use asides, wrap your responder in an aside responder:"
-{ $subsection <asides> }
+{ $subsection
s <asides> }
"The asides responder must be wrapped inside a session responder (" { $link <sessions> } "), which in turn must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one."
$nl
"Saving the current page in an aside which propagates through " { $link <redirect> } " responses:"
-{ $subsection begin-aside }
+{ $subsections begin-aside }
"Returning from an aside:"
-{ $subsection end-aside }
+{ $subsections end-aside }
"Asides are used by " { $vocab-link "furnace.auth.login" } "; when the client requests a protected page, an aside begins and the client is redirected to a login page. Upon a successful login, the aside ends and the client returns to the protected page. If the client directly visits the login page and logs in, there is no current aside, so the client is sent to the default URL passed to " { $link end-aside } ", which in the case of login is the root URL." ;
ABOUT: "furnace.asides"
USING: assocs classes help.markup help.syntax kernel
quotations strings words words.symbol furnace.auth.providers.db
checksums.sha furnace.auth.providers math byte-arrays
-http multiline ;
+http ;
IN: furnace.auth
HELP: <protected>
"Every user in the authentication framework has a set of associated capabilities."
$nl
"Defining new capabilities:"
-{ $subsection define-capability }
+{ $subsections define-capability }
"Capabilities are stored in a global variable:"
-{ $subsection capabilities }
+{ $subsections capabilities }
"Protected resources can be restricted to users possessing certain capabilities only by storing a sequence of capabilities in the " { $slot "capabilities" } " slot of a " { $link protected } " instance." ;
ARTICLE: "furnace.auth.protected" "Protected resources"
"To restrict access to authenticated clients only, wrap a responder in a protected responder."
-{ $subsection protected }
-{ $subsection <protected> }
+{ $subsections
+ protected
+ <protected>
+}
"Protected responders have the following two slots which may be set:"
{ $table
{ { $slot "description" } "A string identifying the protected resource for user interface purposes" }
"The " { $vocab-link "furnace.auth" } " framework looks up users using an authentication provider. Different authentication providers can be swapped in to implement various authentication strategies."
$nl
"Each authentication realm has a provider stored in the " { $slot "users" } " slot. The default provider is " { $link users-in-db } "."
-{ $subsection "furnace.auth.providers.protocol" }
-{ $subsection "furnace.auth.providers.null" }
-{ $subsection "furnace.auth.providers.assoc" }
-{ $subsection "furnace.auth.providers.db" } ;
+{ $subsections
+ "furnace.auth.providers.protocol"
+ "furnace.auth.providers.null"
+ "furnace.auth.providers.assoc"
+ "furnace.auth.providers.db"
+} ;
ARTICLE: "furnace.auth.features" "Optional authentication features"
"Vocabularies having names prefixed by " { $code "furnace.auth.features" } " implement optional features which can be enabled by calling special words. These words define new actions on an authentication realm."
-{ $subsection "furnace.auth.features.deactivate-user" }
-{ $subsection "furnace.auth.features.edit-profile" }
-{ $subsection "furnace.auth.features.recover-password" }
-{ $subsection "furnace.auth.features.registration" } ;
+{ $subsections
+ "furnace.auth.features.deactivate-user"
+ "furnace.auth.features.edit-profile"
+ "furnace.auth.features.recover-password"
+ "furnace.auth.features.registration"
+} ;
ARTICLE: "furnace.auth.realms" "Authentication realms"
"The superclass of authentication realms:"
-{ $subsection realm }
+{ $subsections realm }
"There are two concrete implementations:"
-{ $subsection "furnace.auth.basic" }
-{ $subsection "furnace.auth.login" }
+{ $subsections
+ "furnace.auth.basic"
+ "furnace.auth.login"
+}
"Authentication realms need to be configured after construction."
-{ $subsection "furnace.auth.realm-config" } ;
+{ $subsections "furnace.auth.realm-config" } ;
ARTICLE: "furnace.auth.users" "User profiles"
"A responder wrapped in an authentication realm may access the currently logged-in user,"
-{ $subsection logged-in-user }
+{ $subsections logged-in-user }
"as well as the logged-in username:"
-{ $subsection username }
+{ $subsections username }
"Values can also be stored in user profile variables:"
-{ $subsection uget }
-{ $subsection uset }
-{ $subsection uchange }
+{ $subsections
+ uget
+ uset
+ uchange
+}
"User profile variables have the same restrictions on their values as session variables; see " { $link "furnace.sessions.serialize" } " for a discussion." ;
ARTICLE: "furnace.auth.example" "Furnace authentication example"
"The " { $vocab-link "webapps.todo" } " vocabulary wraps all of its responders in a protected responder. The " { $slot "description" } " slot is set so that the login page contains the message “You must log in to view your todo list”:"
{ $code
- "view your todo list" >>description">
+ "view your todo list" >>description"""
}
"The " { $vocab-link "webapps.wiki" } " vocabulary defines a mix of protected and unprotected actions. One example of a protected action is that for deleting wiki pages, an action normally reserved for administrators. This action is protected with the following code:"
{ $code
"delete wiki articles" >>description
- { can-delete-wiki-articles? } >>capabilities">
+ { can-delete-wiki-articles? } >>capabilities"""
}
"The " { $vocab-link "websites.concatenative" } " vocabulary wraps all of its responders, including the wiki, in a login authentication realm:"
{ $code
-<" : <login-config> ( responder -- responder' )
+""": <login-config> ( responder -- responder' )
"Factor website" <login-realm>
"Factor website" >>name
allow-registration
allow-password-recovery
allow-edit-profile
- allow-deactivation ;">
+ allow-deactivation ;"""
} ;
ARTICLE: "furnace.auth" "Furnace authentication"
"The " { $vocab-link "furnace.auth" } " vocabulary implements a pluggable authentication framework."
$nl
"Usernames and passwords are verified using an " { $emphasis "authentication provider" } "."
-{ $subsection "furnace.auth.providers" }
+{ $subsections "furnace.auth.providers" }
"Users have capabilities assigned to them."
-{ $subsection "furnace.auth.capabilities" }
+{ $subsections "furnace.auth.capabilities" }
"An " { $emphasis "authentication realm" } " is a responder which manages access to protected resources."
-{ $subsection "furnace.auth.realms" }
+{ $subsections "furnace.auth.realms" }
"Actions contained inside an authentication realm can be protected by wrapping them with a responder."
-{ $subsection "furnace.auth.protected" }
+{ $subsections "furnace.auth.protected" }
"Actions contained inside an authentication realm can access the currently logged-in user profile."
-{ $subsection "furnace.auth.users" }
+{ $subsections "furnace.auth.users" }
"Authentication realms can be adorned with additional functionality."
-{ $subsection "furnace.auth.features" }
+{ $subsections "furnace.auth.features" }
"An administration tool."
-{ $subsection "furnace.auth.user-admin" }
+{ $subsections "furnace.auth.user-admin" }
"A concrete example."
-{ $subsection "furnace.auth.example" } ;
+{ $subsections "furnace.auth.example" } ;
ABOUT: "furnace.auth"
ARTICLE: "furnace.auth.basic" "Basic authentication"
"The " { $vocab-link "furnace.auth.basic" } " vocabulary implements HTTP basic authentication."
-{ $subsection basic-auth-realm }
-{ $subsection <basic-auth-realm> } ;
+{ $subsections
+ basic-auth-realm
+ <basic-auth-realm>
+} ;
ABOUT: "furnace.auth.basic"
"The " { $vocab-link "furnace.auth.features.deactivate-user" } " vocabulary implements an authentication feature for user profile deactivation, allowing users to voluntarily deactivate their account."
$nl
"To enable this feature, call the following word on an authentication realm:"
-{ $subsection allow-deactivation }
+{ $subsections allow-deactivation }
"To check if deactivation is enabled:"
-{ $subsection allow-deactivation? }
+{ $subsections allow-deactivation? }
"This feature adds a " { $snippet "deactivate-user" } " action to the realm, and a link to this action can be inserted in Chloe templates using the following XML snippet:"
{ $code
"<t:if t:code=\"furnace.auth.features.deactivate-user:allow-deactivation?\">"
"The " { $vocab-link "furnace.auth.features.edit-profile" } " vocabulary implements an authentication feature for user profile editing, allowing users to change some details of their account."
$nl
"To enable this feature, call the following word on an authentication realm:"
-{ $subsection allow-edit-profile }
+{ $subsections allow-edit-profile }
"To check if profile editing is enabled:"
-{ $subsection allow-edit-profile? }
+{ $subsections allow-edit-profile? }
"This feature adds an " { $snippet "edit-profile" } " action to the realm, and a link to this action can be inserted in Chloe templates using the following XML snippet:"
{ $code
"<t:if t:code=\"furnace.auth.features.edit-profile:allow-edit-profile?\">"
" vocabulary implements an authentication feature for user password recovery, allowing users to get a new password e-mailed to them in the event they forget their current one."
$nl
"To enable this feature, first call the following word on an authentication realm,"
-{ $subsection allow-password-recovery }
+{ $subsections allow-password-recovery }
"Then set a global configuration variable:"
-{ $subsection lost-password-from }
+{ $subsections lost-password-from }
"In addition, the " { $link "smtp" } " may need to be configured as well."
$nl
"To check if password recovery is enabled:"
-{ $subsection allow-password-recovery? }
+{ $subsections allow-password-recovery? }
"This feature adds a " { $snippet "recover-password" } " action to the realm, and a link to this action can be inserted in Chloe templates using the following XML snippet:"
{ $code
"<t:if t:code=\"furnace.auth.features.recover-password:allow-password-recovery?\">"
"The " { $vocab-link "furnace.auth.features.registration" } " vocabulary implements an authentication feature for user registration, allowing new users to create accounts."
$nl
"To enable this feature, call the following word on an authentication realm:"
-{ $subsection allow-registration }
+{ $subsections allow-registration }
"To check if user registration is enabled:"
-{ $subsection allow-registration? }
+{ $subsections allow-registration? }
"This feature adds a " { $snippet "register" } " action to the realm. A link to this action is inserted on the login page if the " { $vocab-link "furnace.auth.login" } " authentication realm is used. Links to this action can be inserted from other pages using the following Chloe XML snippet:"
{ $code
"<t:if t:code=\"furnace.auth.features.registration:allow-registration?\">"
ARTICLE: "furnace.auth.login" "Login authentication"
"The " { $vocab-link "furnace.auth.login" } " vocabulary implements an authentication realm which displays a login page with a username and password field."
-{ $subsection login-realm }
-{ $subsection <login-realm> }
+{ $subsections
+ login-realm
+ <login-realm>
+}
"The " { $snippet "logout" } " action logs the user out of the realm, and a link to this action can be inserted in Chloe templates using the following XML snippet:"
{ $code
"<t:button t:action=\"$login-realm/logout\">Logout</t:button>"
ARTICLE: "furnace.auth.providers.assoc" "In-memory authentication provider"
"The " { $vocab-link "furnace.auth.providers.assoc" } " vocabulary implements an authentication provider which looks up usernames and passwords in an associative mapping."
-{ $subsection users-in-memory }
-{ $subsection <users-in-memory> }
+{ $subsections
+ users-in-memory
+ <users-in-memory>
+}
"The " { $slot "assoc" } " slot of the " { $link users-in-memory } " tuple maps usernames to checksums of passwords." ;
ABOUT: "furnace.auth.providers.assoc"
"The " { $vocab-link "furnace.auth.providers.db" } " vocabulary implements an authentication provider which looks up authentication requests in the " { $snippet "USERS" } " table of the current database. The database schema is Factor-specific, and the table should be initialized by calling"
{ $code "users create-table" }
"The authentication provider class:"
-{ $subsection users-in-db } ;
+{ $subsections users-in-db } ;
ABOUT: "furnace.auth.providers.db"
"The " { $vocab-link "furnace.auth.providers" } " vocabulary implements a protocol for persistence and authentication of users."
$nl
"The class of users:"
-{ $subsection user }
+{ $subsections user }
"Generic protocol:"
-{ $subsection get-user }
-{ $subsection new-user }
-{ $subsection update-user } ;
+{ $subsections
+ get-user
+ new-user
+ update-user
+} ;
ABOUT: "furnace.auth.providers.protocol"
ARTICLE: "furnace.boilerplate" "Furnace boilerplate support"
"The " { $vocab-link "furnace.boilerplate" } " vocabulary implements a facility for sharing a common header and footer between different pages on a web site. It builds on top of " { $link "html.templates.boilerplate" } "."
-{ $subsection <boilerplate> }
-{ $subsection "furnace.boilerplate.config" }
-{ $subsection "furnace.boilerplate.example" }
+{ $subsections
+ <boilerplate>
+ "furnace.boilerplate.config"
+ "furnace.boilerplate.example"
+}
{ $see-also "html.templates.chloe.tags.boilerplate" } ;
ABOUT: "furnace.boilerplate"
"Conversation scope is used by form validation to pass validation errors between requests."
$nl
"To use conversation scope, wrap your responder in an conversation responder:"
-{ $subsection <conversations> }
+{ $subsections <conversations> }
"The conversations responder must be wrapped inside a session responder (" { $link <sessions> } "), which in turn must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one."
$nl
"Managing conversation scopes:"
-{ $subsection begin-conversation }
-{ $subsection end-conversation }
-{ $subsection <continue-conversation> }
+{ $subsections
+ begin-conversation
+ end-conversation
+ <continue-conversation>
+}
"Reading and writing conversation variables:"
-{ $subsection cget }
-{ $subsection cset }
-{ $subsection cchange }
+{ $subsections
+ cget
+ cset
+ cchange
+}
"Note that conversation scope is serialized as part of the session, which means that only serializable objects can be stored there. See " { $link "furnace.sessions.serialize" } " for details." ;
ABOUT: "furnace.conversations"
ARTICLE: "furnace.db" "Furnace database support"
"The " { $vocab-link "furnace.db" } " vocabulary implements a responder which maintains a database connection pool and runs each request in a " { $link with-db } " scope."
-{ $subsection <db-persistence> }
+{ $subsections <db-persistence> }
"The " { $vocab-link "furnace.alloy" } " vocabulary combines database persistence with several other features." ;
ABOUT: "furnace.db"
IN: furnace
ARTICLE: "furnace.persistence" "Furnace persistence layer"
-{ $subsection "furnace.db" }
+{ $subsections "furnace.db" }
"Server-side state:"
-{ $subsection "furnace.sessions" }
-{ $subsection "furnace.conversations" }
-{ $subsection "furnace.asides" }
-{ $subsection "furnace.presentation" } ;
+{ $subsections
+ "furnace.sessions"
+ "furnace.conversations"
+ "furnace.asides"
+ "furnace.presentation"
+} ;
ARTICLE: "furnace.presentation" "Furnace presentation layer"
"HTML components:"
-{ $subsection "html.components" }
-{ $subsection "html.forms" }
+{ $subsections
+ "html.components"
+ "html.forms"
+}
"Content templates:"
-{ $subsection "html.templates" }
-{ $subsection "html.templates.chloe" }
-{ $subsection "html.templates.fhtml" }
-{ $subsection "furnace.boilerplate" }
+{ $subsections
+ "html.templates"
+ "html.templates.chloe"
+ "html.templates.fhtml"
+ "furnace.boilerplate"
+}
"Other types of content:"
-{ $subsection "furnace.syndication" }
-{ $subsection "furnace.json" } ;
+{ $subsections
+ "furnace.syndication"
+ "furnace.json"
+} ;
ARTICLE: "furnace.load-balancing" "Load balancing and fail-over with Furnace"
"The Furnace session manager persists sessions to a database. This means that HTTP requests can be transparently distributed between multiple Factor HTTP server instances, running the same web app on top of the same database, as long as the web applications do not use mutable global state, such as global variables. The Furnace framework itself does not use any mutable global state." ;
"Conversation scope and asides for complex page flow"
}
"Major functionality:"
-{ $subsection "furnace.actions" }
-{ $subsection "furnace.alloy" }
-{ $subsection "furnace.persistence" }
-{ $subsection "furnace.presentation" }
-{ $subsection "furnace.auth" }
-{ $subsection "furnace.load-balancing" }
+{ $subsections
+ "furnace.actions"
+ "furnace.alloy"
+ "furnace.persistence"
+ "furnace.presentation"
+ "furnace.auth"
+ "furnace.load-balancing"
+}
"Utilities:"
-{ $subsection "furnace.referrer" }
-{ $subsection "furnace.redirection" }
-{ $subsection "furnace.extension-points" }
-{ $subsection "furnace.misc" }
+{ $subsections
+ "furnace.referrer"
+ "furnace.redirection"
+ "furnace.extension-points"
+ "furnace.misc"
+}
"Related frameworks:"
-{ $subsection "db" }
-{ $subsection "xml" }
-{ $subsection "http.server" }
-{ $subsection "logging" }
-{ $subsection "urls" } ;
+{ $subsections
+ "db"
+ "xml"
+ "http.server"
+ "logging"
+ "urls"
+} ;
ABOUT: "furnace"
ARTICLE: "furnace.json" "Furnace JSON support"
"The " { $vocab-link "furnace.json" } " vocabulary provides a utility word for serving HTTP responses with JSON content."
-{ $subsection <json-content> } ;
+{ $subsections <json-content> } ;
ABOUT: "furnace.json"
--- /dev/null
+Doug Coleman
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors db.sqlite furnace.actions furnace.alloy
+furnace.conversations furnace.recaptcha furnace.redirection
+html.templates.chloe.compiler http.server
+http.server.dispatchers http.server.responses io.streams.string
+kernel urls xml.syntax ;
+IN: furnace.recaptcha.example
+
+TUPLE: recaptcha-app < dispatcher recaptcha ;
+
+: recaptcha-db ( -- obj ) "recaptcha-example" <sqlite-db> ;
+
+: <recaptcha-challenge> ( -- obj )
+ <page-action>
+ [
+ begin-conversation
+ validate-recaptcha
+ recaptcha-valid? cget
+ "?good" "?bad" ? >url <continue-conversation>
+ ] >>submit
+ { recaptcha-app "example" } >>template ;
+
+: <recaptcha-app> ( -- obj )
+ \ recaptcha-app new-dispatcher
+ <recaptcha-challenge> "" add-responder
+ <recaptcha>
+ "concatenative.org" >>domain
+ "6LeJWQgAAAAAAFlYV7SuBClE9uSpGtV_ZS-qVON7" >>public-key
+ "6LeJWQgAAAAAALh-XJgSSQ6xKygRgJ8-029Ip2Xv" >>private-key
+ recaptcha-db <alloy> ;
--- /dev/null
+<?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html><body><form submit="" method="post"><t:recaptcha/></form></body></html>
+</t:chloe>
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax http.server.filters kernel
+multiline furnace.actions furnace.alloy furnace.conversations ;
+IN: furnace.recaptcha
+
+HELP: <recaptcha>
+{ $values
+ { "responder" "a responder" }
+ { "obj" object }
+}
+{ $description "A " { $link filter-responder } " wrapping another responder. Set the domain, public, and private keys using the key you get by registering with Recaptcha." } ;
+
+HELP: recaptcha-error
+{ $var-description "Set to the error string returned by the Recaptcha server." } ;
+
+HELP: recaptcha-valid?
+{ $var-description "Set to " { $link t } " if the user solved the last Recaptcha correctly." } ;
+
+HELP: validate-recaptcha
+{ $description "Validates a Recaptcha using the Recaptcha web service API." } ;
+
+ARTICLE: "recaptcha-example" "Recaptcha example"
+"There are several steps to using the Recaptcha library."
+{ $list
+ { "Wrap the responder in a " { $link <recaptcha> } }
+ { "Wrap the responder in a " { $link <conversations> } " if it is not already" }
+ { "Ensure that there is a database connected, with the " { $link <alloy> } " word" }
+ { "Start a conversation to move values between requests" }
+ { "Add a handler calling " { $link validate-recaptcha } " in the " { $slot "submit" } " of the " { $link page-action } }
+ { "Pass the conversation from your submit action using " { $link <continue-conversation> } }
+ { "Put the chloe tag " { $snippet "<recaptcha/>" } " inside a form tag in the template for your " { $link page-action } }
+}
+$nl
+"Run this example vocabulary:"
+{ $code
+ "USE: furnace.recaptcha.example"
+ "<recaptcha-app> main-responder set-global"
+} ;
+
+ARTICLE: "furnace.recaptcha" "Recaptcha"
+"The " { $vocab-link "furnace.recaptcha" } " vocabulary implements support for the Recaptcha. Recaptcha is a web service that provides the user with a captcha, a test that is easy to solve by visual inspection, but hard to solve by writing a computer program. Use a captcha to protect forms from abusive users." $nl
+
+"The recaptcha responder is a " { $link filter-responder } " that wraps another responder. Set the " { $slot "domain" } ", " { $slot "public-key" } ", and " { $slot "private-key" } " slots of this responder to your Recaptcha account information." $nl
+
+"Wrapping a responder with Recaptcha:"
+{ $subsections <recaptcha> }
+"Validating recaptcha:"
+{ $subsections validate-recaptcha }
+"Symbols set after validation:"
+{ $subsections
+ recaptcha-valid?
+ recaptcha-error
+ "recaptcha-example"
+} ;
+
+ABOUT: "furnace.recaptcha"
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors furnace.actions furnace.redirection html.forms
+html.templates.chloe.compiler html.templates.chloe.syntax
+http.client http.server http.server.filters io.sockets kernel
+locals namespaces sequences splitting urls validators
+xml.syntax furnace.conversations ;
+IN: furnace.recaptcha
+
+TUPLE: recaptcha < filter-responder domain public-key private-key ;
+
+SYMBOLS: recaptcha-valid? recaptcha-error ;
+
+: <recaptcha> ( responder -- obj )
+ recaptcha new
+ swap >>responder ;
+
+M: recaptcha call-responder*
+ dup \ recaptcha set
+ responder>> call-responder ;
+
+<PRIVATE
+
+: (render-recaptcha) ( private-key -- xml )
+ dup
+[XML <script type="text/javascript"
+ src=<->>
+</script>
+
+<noscript>
+ <iframe src=<->
+ height="300" width="500" frameborder="0"></iframe><br/>
+ <textarea name="recaptcha_challenge_field" rows="3" cols="40">
+ </textarea>
+ <input type="hidden" name="recaptcha_response_field"
+ value="manual_challenge"/>
+</noscript>
+XML] ;
+
+: recaptcha-url ( secure? -- ? )
+ [ "https://api.recaptcha.net/challenge" ]
+ [ "http://api.recaptcha.net/challenge" ] if
+ recaptcha-error cget [ "?error=" glue ] when* >url ;
+
+: render-recaptcha ( -- xml )
+ secure-connection? recaptcha-url
+ recaptcha get public-key>> "k" set-query-param (render-recaptcha) ;
+
+: parse-recaptcha-response ( string -- valid? error )
+ "\n" split first2 [ "true" = ] dip ;
+
+:: (validate-recaptcha) ( challenge response recaptcha -- valid? error )
+ recaptcha private-key>> :> private-key
+ remote-address get host>> :> remote-ip
+ H{
+ { "challenge" challenge }
+ { "response" response }
+ { "privatekey" private-key }
+ { "remoteip" remote-ip }
+ } URL" http://api-verify.recaptcha.net/verify"
+ <post-request> http-request nip parse-recaptcha-response ;
+
+CHLOE: recaptcha
+ drop [ render-recaptcha ] [xml-code] ;
+
+PRIVATE>
+
+: validate-recaptcha ( -- )
+ {
+ { "recaptcha_challenge_field" [ v-required ] }
+ { "recaptcha_response_field" [ v-required ] }
+ } validate-params
+ "recaptcha_challenge_field" value
+ "recaptcha_response_field" value
+ \ recaptcha get (validate-recaptcha)
+ [ recaptcha-valid? cset ] [ recaptcha-error cset ] bi* ;
--- /dev/null
+<?xml version='1.0' ?>
+<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
+<html>
+ <body><t:recaptcha/>
+ </body>
+</html>
+</t:chloe>
--- /dev/null
+Recaptcha library
"The words in this section help with implementing sites which require SSL/TLS for additional security."
$nl
"Converting a HTTP URL into an HTTPS URL:"
-{ $subsection >secure-url }
+{ $subsections >secure-url }
"Redirecting the client to an HTTPS URL:"
-{ $subsection <secure-redirect> }
+{ $subsections <secure-redirect> }
"Tools for writing responders which require SSL/TLS connections:"
-{ $subsection if-secure }
-{ $subsection <secure-only> } ;
+{ $subsections
+ if-secure
+ <secure-only>
+} ;
ARTICLE: "furnace.redirection" "Furnace redirection support"
"The " { $vocab-link "furnace.redirection" } " vocabulary builds additional functionality on top of " { $vocab-link "http.server.redirection" } ", and integrates with various Furnace features such as " { $link "furnace.asides" } " and " { $link "furnace.conversations" } "."
$nl
"A redirection response which takes asides and conversations into account:"
-{ $subsection <redirect> }
+{ $subsections <redirect> }
"A responder which unconditionally redirects the client to another URL:"
-{ $subsection <redirect-responder> }
-{ $subsection "furnace.redirection.secure" } ;
+{ $subsections
+ <redirect-responder>
+ "furnace.redirection.secure"
+} ;
ABOUT: "furnace.redirection"
ARTICLE: "furnace.referrer" "Form submission referrer checking"
"The " { $vocab-link "furnace.referrer" } " implements a simple security measure which can be used to thwart cross-site scripting attacks."
-{ $subsection <check-form-submissions> }
+{ $subsections <check-form-submissions> }
"Explicit referrer checking:"
-{ $subsection referrer }
-{ $subsection same-host? } ;
+{ $subsections
+ referrer
+ same-host?
+} ;
ABOUT: "furnace.referrer"
"The " { $vocab-link "furnace.sessions" } " vocabulary implements session management, which allows state to be maintained between HTTP requests. The session state is stored on the server; the client receives an opaque ID which is saved in a cookie (for GET requests) or a hidden form field (for POST requests)."
$nl
"To use session management, wrap your responder in an session manager:"
-{ $subsection <sessions> }
+{ $subsections <sessions> }
"The sessions responder must be wrapped inside a database persistence responder (" { $link <db-persistence> } "). The " { $vocab-link "furnace.alloy" } " vocabulary combines all of these responders into one."
$nl
"Reading and writing session variables from a request:"
-{ $subsection sget }
-{ $subsection sset }
-{ $subsection schange }
+{ $subsections
+ sget
+ sset
+ schange
+}
"Additional topics:"
-{ $subsection "furnace.sessions.config" }
-{ $subsection "furnace.sessions.serialize" } ;
+{ $subsections
+ "furnace.sessions.config"
+ "furnace.sessions.serialize"
+} ;
ABOUT: "furnace.sessions"
ARTICLE: "furnace.syndication.protocol" "Atom feed entry protocol"
"An Atom feed action takes a sequence of objects and converts them into Atom feed entries. The objects must implement a protocol consisting of either a single generic word:"
-{ $subsection >entry }
+{ $subsections >entry }
"Or a series of generic words, called by the default implementation of " { $link >entry } ":"
-{ $subsection feed-entry-title }
-{ $subsection feed-entry-description }
-{ $subsection feed-entry-date }
-{ $subsection feed-entry-url } ;
+{ $subsections
+ feed-entry-title
+ feed-entry-description
+ feed-entry-date
+ feed-entry-url
+} ;
ARTICLE: "furnace.syndication" "Furnace Atom syndication support"
"The " { $vocab-link "furnace.syndication" } " vocabulary builds on the " { $link "syndication" } " library by providing easy support for generating Atom feeds from " { $link "furnace.actions" } "."
-{ $subsection <feed-action> }
-{ $subsection "furnace.syndication.config" }
-{ $subsection "furnace.syndication.protocol" } ;
+{ $subsections
+ <feed-action>
+ "furnace.syndication.config"
+ "furnace.syndication.protocol"
+} ;
ABOUT: "furnace.syndication"
"Furnace features such as session management, conversation scope and asides need to modify URLs in links and redirects, and insert hidden form fields, to implement state on top of the stateless HTTP protocol. In order to decouple the server-side state management code from the HTML templating code, a series of hooks are used."
$nl
"Responders can implement methods on the following generic words:"
-{ $subsection modify-query }
-{ $subsection modify-redirect-query }
-{ $subsection link-attr }
-{ $subsection modify-form }
+{ $subsections
+ modify-query
+ modify-redirect-query
+ link-attr
+ modify-form
+}
"Presentation-level code can call the following words:"
-{ $subsection adjust-url }
-{ $subsection adjust-redirect-url } ;
+{ $subsections
+ adjust-url
+ adjust-redirect-url
+} ;
ARTICLE: "furnace.misc" "Miscellaneous Furnace features"
"Inspecting the chain of responders handling the current request:"
-{ $subsection nested-responders }
-{ $subsection each-responder }
-{ $subsection resolve-base-path }
+{ $subsections
+ nested-responders
+ each-responder
+ resolve-base-path
+}
"Vocabulary root-relative resources:"
-{ $subsection vocab-path }
-{ $subsection resolve-template-path }
+{ $subsections
+ vocab-path
+ resolve-template-path
+}
"Early return from a responder:"
-{ $subsection with-exit-continuation }
-{ $subsection exit-with }
+{ $subsections
+ with-exit-continuation
+ exit-with
+}
"Other useful words:"
-{ $subsection hidden-form-field }
-{ $subsection client-state }
-{ $subsection user-agent } ;
+{ $subsections
+ hidden-form-field
+ client-state
+ user-agent
+} ;
USING: accessors alien alien.c-types alien.strings arrays
-assocs byte-arrays combinators continuations game-input
-game-input.dinput.keys-array io.encodings.utf16
-io.encodings.utf16n kernel locals math math.bitwise
-math.rectangles namespaces parser sequences shuffle
-struct-arrays ui.backend.windows vectors windows.com
-windows.dinput windows.dinput.constants windows.errors
-windows.kernel32 windows.messages windows.ole32
-windows.user32 ;
+assocs byte-arrays combinators combinators.short-circuit
+continuations game-input game-input.dinput.keys-array
+io.encodings.utf16 io.encodings.utf16n kernel locals math
+math.bitwise math.rectangles namespaces parser sequences
+shuffle specialized-arrays ui.backend.windows vectors
+windows.com windows.dinput windows.dinput.constants
+windows.errors windows.kernel32 windows.messages
+windows.ole32 windows.user32 classes.struct alien.data ;
+SPECIALIZED-ARRAY: DIDEVICEOBJECTDATA
IN: game-input.dinput
+
CONSTANT: MOUSE-BUFFER-SIZE 16
SINGLETON: dinput-game-input-backend
get IDirectInputDevice8W::SetDataFormat ole32-error ;
: <buffer-size-diprop> ( size -- DIPROPDWORD )
- "DIPROPDWORD" <c-object>
- "DIPROPDWORD" heap-size over set-DIPROPHEADER-dwSize
- "DIPROPHEADER" heap-size over set-DIPROPHEADER-dwHeaderSize
- 0 over set-DIPROPHEADER-dwObj
- DIPH_DEVICE over set-DIPROPHEADER-dwHow
- swap over set-DIPROPDWORD-dwData ;
+ DIPROPDWORD <struct> [
+ diph>>
+ DIPROPDWORD heap-size >>dwSize
+ DIPROPHEADER heap-size >>dwHeaderSize
+ 0 >>dwObj
+ DIPH_DEVICE >>dwHow
+ drop
+ ] keep swap >>dwData ;
: set-buffer-size ( device size -- )
DIPROP_BUFFERSIZE swap <buffer-size-diprop>
GUID_SysKeyboard device-for-guid
[ configure-keyboard ]
[ +keyboard-device+ set-global ] bi
- 256 <byte-array> <keys-array> keyboard-state boa
+ 256 <byte-array> 256 <keys-array> keyboard-state boa
+keyboard-state+ set-global ;
: find-mouse ( -- )
GUID_SysMouse device-for-guid
- [ configure-mouse ]
- [ +mouse-device+ set-global ] bi
- 0 0 0 0 8 f <array> mouse-state boa
- +mouse-state+ set-global
- MOUSE-BUFFER-SIZE "DIDEVICEOBJECTDATA" <c-array>
- +mouse-buffer+ set-global ;
+ [ configure-mouse ] [ +mouse-device+ set-global ] bi
+ 0 0 0 0 8 f <array> mouse-state boa +mouse-state+ set-global
+ MOUSE-BUFFER-SIZE <DIDEVICEOBJECTDATA-array> +mouse-buffer+ set-global ;
: device-info ( device -- DIDEVICEIMAGEINFOW )
- "DIDEVICEINSTANCEW" <c-object>
- "DIDEVICEINSTANCEW" heap-size over set-DIDEVICEINSTANCEW-dwSize
- [ IDirectInputDevice8W::GetDeviceInfo ole32-error ] keep ;
+ DIDEVICEINSTANCEW <struct>
+ DIDEVICEINSTANCEW heap-size >>dwSize
+ [ IDirectInputDevice8W::GetDeviceInfo ole32-error ] keep ; inline
: device-caps ( device -- DIDEVCAPS )
- "DIDEVCAPS" <c-object>
- "DIDEVCAPS" heap-size over set-DIDEVCAPS-dwSize
- [ IDirectInputDevice8W::GetCapabilities ole32-error ] keep ;
-
-: <guid> ( memory -- byte-array )
- "GUID" heap-size memory>byte-array ;
+ DIDEVCAPS <struct>
+ DIDEVCAPS heap-size >>dwSize
+ [ IDirectInputDevice8W::GetCapabilities ole32-error ] keep ; inline
: device-guid ( device -- guid )
- device-info DIDEVICEINSTANCEW-guidInstance <guid> ;
+ device-info guidInstance>> ; inline
: device-attached? ( device -- ? )
+dinput+ get swap device-guid
: find-device-axes-callback ( -- alien )
[ ! ( lpddoi pvRef -- BOOL )
+ [ DIDEVICEOBJECTINSTANCEW memory>struct ] dip
+controller-devices+ get at
- swap DIDEVICEOBJECTINSTANCEW-guidType <guid> {
+ swap guidType>> {
{ [ dup GUID_XAxis = ] [ drop 0.0 >>x ] }
{ [ dup GUID_YAxis = ] [ drop 0.0 >>y ] }
{ [ dup GUID_ZAxis = ] [ drop 0.0 >>z ] }
: controller-state-template ( device -- controller-state )
controller-state new
over device-caps
- [
DIDEVCAPS-dwButtons f <array> >>buttons ]
- [ DIDEVCAPS-dwPOVs zero? f pov-neutral ? >>pov ] bi
+ [
dwButtons>> f <array> >>buttons ]
+ [ dwPOVs>> zero? f pov-neutral ? >>pov ] bi
find-device-axes ;
: device-known? ( guid -- ? )
device-for-guid {
[ configure-controller ]
[ controller-state-template ]
- [ dup device-guid +controller-guids+ get set-at ]
+ [ dup device-guid clone +controller-guids+ get set-at ]
[ +controller-devices+ get set-at ]
} cleave ;
: add-controller ( guid -- )
- dup <guid> device-known? [ drop ] [ (add-controller) ] if ;
+ dup device-known? [ drop ] [ (add-controller) ] if ;
: remove-controller ( device -- )
[ +controller-devices+ get delete-at ]
: find-controller-callback ( -- alien )
[ ! ( lpddi pvRef -- BOOL )
- drop DIDEVICEINSTANCEW-guidInstance add-controller
+ drop DIDEVICEINSTANCEW memory>struct guidInstance>> add-controller
DIENUM_CONTINUE
- ] LPDIENUMDEVICESCALLBACKW ;
+ ] LPDIENUMDEVICESCALLBACKW ; inline
: find-controllers ( -- )
+dinput+ get DI8DEVCLASS_GAMECTRL find-controller-callback
[ device-attached? not ] filter
[ remove-controller ] each ;
-: device-interface? ( dbt-broadcast-hdr -- ? )
- DEV_BROADCAST_HDR-dbch_devicetype DBT_DEVTYP_DEVICEINTERFACE = ;
+: ?device-interface ( dbt-broadcast-hdr -- ? )
+ dup dbch_devicetype>> DBT_DEVTYP_DEVICEINTERFACE =
+ [ >c-ptr DEV_BROADCAST_DEVICEW memory>struct ]
+ [ drop f ] if ; inline
: device-arrived ( dbt-broadcast-hdr -- )
- device-interface? [ find-controllers ] when ;
+ ?device-interface [ find-controllers ] when ; inline
: device-removed ( dbt-broadcast-hdr -- )
- device-interface? [ find-and-remove-detached-devices ] when ;
+ ?device-interface [ find-and-remove-detached-devices ] when ; inline
+
+: <DEV_BROADCAST_HDR> ( wParam -- struct )
+ <alien> DEV_BROADCAST_HDR memory>struct ;
: handle-wm-devicechange ( hWnd uMsg wParam lParam -- )
[ 2drop ] 2dip swap {
- { [ dup DBT_DEVICEARRIVAL = ] [ drop <alien> device-arrived ] }
- { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop <alien> device-removed ] }
+ { [ dup DBT_DEVICEARRIVAL = ] [ drop <DEV_BROADCAST_HDR> device-arrived ] }
+ { [ dup DBT_DEVICEREMOVECOMPLETE = ] [ drop <DEV_BROADCAST_HDR> device-removed ] }
[ 2drop ]
} cond ;
{ 0 0 } >>dim ;
: (device-notification-filter) ( -- DEV_BROADCAST_DEVICEW )
- "DEV_BROADCAST_DEVICEW" <c-object>
- "DEV_BROADCAST_DEVICEW" heap-size over set-DEV_BROADCAST_DEVICEW-dbcc_size
- DBT_DEVTYP_DEVICEINTERFACE over set-DEV_BROADCAST_DEVICEW-dbcc_devicetype ;
+ DEV_BROADCAST_DEVICEW <struct>
+ DEV_BROADCAST_DEVICEW heap-size >>dbcc_size
+ DBT_DEVTYP_DEVICEINTERFACE >>dbcc_devicetype ;
: create-device-change-window ( -- )
<zero-window-rect> WS_OVERLAPPEDWINDOW 0 create-window
delete-dinput ;
M: dinput-game-input-backend (reset-game-input)
- {
- +dinput+ +keyboard-device+ +keyboard-state+
- +controller-devices+ +controller-guids+
- +device-change-window+ +device-change-handle+
- } [ f swap set-global ] each ;
+ global [
+ {
+ +dinput+ +keyboard-device+ +keyboard-state+
+ +controller-devices+ +controller-guids+
+ +device-change-window+ +device-change-handle+
+ } [ off ] each
+ ] bind ;
M: dinput-game-input-backend get-controllers
+controller-devices+ get
[ drop controller boa ] { } assoc>map ;
M: dinput-game-input-backend product-string
- handle>> device-info DIDEVICEINSTANCEW-tszProductName
+ handle>> device-info tszProductName>>
utf16n alien>string ;
M: dinput-game-input-backend product-id
- handle>> device-info DIDEVICEINSTANCEW-guidProduct <guid> ;
+ handle>> device-info guidProduct>> ;
M: dinput-game-input-backend instance-id
handle>> device-guid ;
:: with-acquisition ( device acquired-quot succeeded-quot failed-quot -- result/f )
- device IDirectInputDevice8W::Acquire succeeded? [
+ device { [ ] [ IDirectInputDevice8W::Acquire succeeded? ] } 1&& [
device acquired-quot call
succeeded-quot call
] failed-quot if ; inline
}
: >axis ( long -- float )
- 32767 - 32767.0 /f ;
+ 32767 - 32767.0 /f ; inline
: >slider ( long -- float )
- 65535.0 /f ;
+ 65535.0 /f ; inline
: >pov ( long -- symbol )
dup HEX: FFFF bitand HEX: FFFF =
[ drop pov-neutral ]
- [ 2750 + 4500 /i pov-values nth ] if ;
-: >buttons ( alien length -- array )
- memory>byte-array <keys-array> ;
+ [ 2750 + 4500 /i pov-values nth ] if ; inline
: (fill-if) ( controller-state DIJOYSTATE2 ? quot -- )
[ drop ] compose [ 2drop ] if ; inline
: fill-controller-state ( controller-state DIJOYSTATE2 -- controller-state )
{
- [ over x>> [ DIJOYSTATE2-lX >axis >>x ] (fill-if) ]
- [ over y>> [ DIJOYSTATE2-lY >axis >>y ] (fill-if) ]
- [ over z>> [ DIJOYSTATE2-lZ >axis >>z ] (fill-if) ]
- [ over rx>> [ DIJOYSTATE2-lRx >axis >>rx ] (fill-if) ]
- [ over ry>> [ DIJOYSTATE2-lRy >axis >>ry ] (fill-if) ]
- [ over rz>> [ DIJOYSTATE2-lRz >axis >>rz ] (fill-if) ]
- [ over slider>> [ DIJOYSTATE2-rglSlider *long >slider >>slider ] (fill-if) ]
- [ over pov>> [ DIJOYSTATE2-rgdwPOV *uint >pov >>pov ] (fill-if) ]
- [ DIJOYSTATE2-rgbButtons over buttons>> length >buttons >>buttons ]
+ [ over x>> [ lX>> >axis >>x ] (fill-if) ]
+ [ over y>> [ lY>> >axis >>y ] (fill-if) ]
+ [ over z>> [ lZ>> >axis >>z ] (fill-if) ]
+ [ over rx>> [ lRx>> >axis >>rx ] (fill-if) ]
+ [ over ry>> [ lRy>> >axis >>ry ] (fill-if) ]
+ [ over rz>> [ lRz>> >axis >>rz ] (fill-if) ]
+ [ over slider>> [ rglSlider>> first >slider >>slider ] (fill-if) ]
+ [ over pov>> [ rgdwPOV>> first >pov >>pov ] (fill-if) ]
+ [ rgbButtons>> over buttons>> length <keys-array> >>buttons ]
} 2cleave ;
: read-device-buffer ( device buffer count -- buffer count' )
- [ "DIDEVICEOBJECTDATA" heap-size ] 2dip <uint>
+ [ DIDEVICEOBJECTDATA heap-size ] 2dip <uint>
[ 0 IDirectInputDevice8W::GetDeviceData ole32-error ] 2keep *uint ;
: (fill-mouse-state) ( state DIDEVICEOBJECTDATA -- state )
- [ DIDEVICEOBJECTDATA-dwData 32 >signed ] [ DIDEVICEOBJECTDATA-dwOfs ] bi {
+ [ dwData>> 32 >signed ] [ dwOfs>> ] bi {
{ DIMOFS_X [ [ + ] curry change-dx ] }
{ DIMOFS_Y [ [ + ] curry change-dy ] }
{ DIMOFS_Z [ [ + ] curry change-scroll-dy ] }
} case ;
: fill-mouse-state ( buffer count -- state )
- [ +mouse-state+ get ] 2dip swap
- [ "DIDEVICEOBJECTDATA" byte-array>struct-array nth (fill-mouse-state) ] curry each ;
+ [ +mouse-state+ get ] 2dip swap [ nth (fill-mouse-state) ] curry each ;
-: get-device-state ( device byte-array -- )
+: get-device-state ( device DIJOYSTATE2 -- )
[ dup IDirectInputDevice8W::Poll ole32-error ] dip
- [ length ] keep
+ [ byte-length ] keep
IDirectInputDevice8W::GetDeviceState ole32-error ;
: (read-controller) ( handle template -- state )
- swap [ "DIJOYSTATE2" heap-size <byte-array> [ get-device-state ] keep ]
+ swap [ DIJOYSTATE2 <struct> [ get-device-state ] keep ]
[ fill-controller-state ] [ drop f ] with-acquisition ;
M: dinput-game-input-backend read-controller
-USING: sequences sequences.private math alien.c-types
-accessors ;
+USING: sequences sequences.private math
+accessors alien.data ;
IN: game-input.dinput.keys-array
-TUPLE: keys-array underlying ;
+TUPLE: keys-array
+ { underlying sequence read-only }
+ { length integer read-only } ;
C: <keys-array> keys-array
: >key ( byte -- ? )
HEX: 80 bitand c-bool> ;
-M: keys-array length underlying>> length ;
+M: keys-array length length>> ;
M: keys-array nth-unsafe underlying>> nth-unsafe >key ;
INSTANCE: keys-array sequence
ARTICLE: "game-input" "Game controller input"
"The " { $vocab-link "game-input" } " vocabulary provides cross-platform access to game controller devices such as joysticks and gamepads. It also provides an interface for polling raw keyboard and mouse input." $nl
"The game input interface must be initialized before being used:"
-{ $subsection open-game-input }
-{ $subsection close-game-input }
-{ $subsection with-game-input }
+{ $subsections
+ open-game-input
+ close-game-input
+ with-game-input
+}
"Once the game input interface is open, connected controller devices can be enumerated:"
-{ $subsection get-controllers }
-{ $subsection find-controller-products }
-{ $subsection find-controller-instance }
+{ $subsections
+ get-controllers
+ find-controller-products
+ find-controller-instance
+}
"These " { $link controller } " objects can be queried of their identity:"
-{ $subsection product-string }
-{ $subsection product-id }
-{ $subsection instance-id }
+{ $subsections
+ product-string
+ product-id
+ instance-id
+}
"A hook is provided for invoking the system calibration tool:"
-{ $subsection calibrate-controller }
+{ $subsections calibrate-controller }
"The current state of a controller, the keyboard, and the mouse can be read:"
-{ $subsection read-controller }
-{ $subsection read-keyboard }
-{ $subsection read-mouse }
-{ $subsection controller-state }
-{ $subsection keyboard-state }
-{ $subsection mouse-state } ;
+{ $subsections
+ read-controller
+ read-keyboard
+ read-mouse
+ controller-state
+ keyboard-state
+ mouse-state
+} ;
HELP: open-game-input
{ $description "Initializes the game input interface. An exception will be thrown if the initialization fails. Calls to open-game-input are reference counted; each call to open-game-input needs a corresponding call to close-game-input to close the game input interface." } ;
sequences locals combinators.short-circuit threads
namespaces assocs arrays combinators hints alien
core-foundation.run-loop accessors sequences.private
-alien.c-types math parser game-input vectors bit-arrays ;
+alien.c-types alien.data math parser game-input vectors
+bit-arrays ;
IN: game-input.iokit
SINGLETON: iokit-game-input-backend
} ;\r
\r
HELP: napply\r
-{ $values { "quot" quotation } { "n" integer } }\r
+{ $values { "n" integer } }\r
{ $description "A generalization of " { $link bi@ } " and " { $link tri@ } " that can work for any stack depth."\r
} \r
{ $examples\r
{ $description "A generalization of " { $link tuck } " that can work for any stack depth. The top item will be copied and placed " { $snippet "n" } " items down on the stack." } ;\r
\r
ARTICLE: "sequence-generalizations" "Generalized sequence operations"\r
-{ $subsection narray }\r
-{ $subsection nsequence }\r
-{ $subsection firstn }\r
-{ $subsection nappend }\r
-{ $subsection nappend-as } ;\r
+{ $subsections\r
+ narray\r
+ nsequence\r
+ firstn\r
+ nappend\r
+ nappend-as\r
+} ;\r
\r
ARTICLE: "shuffle-generalizations" "Generalized shuffle words"\r
-{ $subsection ndup }\r
-{ $subsection npick }\r
-{ $subsection nrot }\r
-{ $subsection -nrot }\r
-{ $subsection nnip }\r
-{ $subsection ndrop }\r
-{ $subsection ntuck }\r
-{ $subsection mnswap }\r
-{ $subsection nweave } ;\r
+{ $subsections\r
+ ndup\r
+ npick\r
+ nrot\r
+ -nrot\r
+ nnip\r
+ ndrop\r
+ ntuck\r
+ mnswap\r
+ nweave\r
+} ;\r
\r
ARTICLE: "combinator-generalizations" "Generalized combinators"\r
-{ $subsection ndip }\r
-{ $subsection nkeep }\r
-{ $subsection napply }\r
-{ $subsection ncleave }\r
-{ $subsection nspread } ;\r
+{ $subsections\r
+ ndip\r
+ nkeep\r
+ napply\r
+ ncleave\r
+ nspread\r
+} ;\r
\r
ARTICLE: "other-generalizations" "Additional generalizations"\r
-{ $subsection ncurry } \r
-{ $subsection nwith }\r
-{ $subsection nsum } ;\r
+{ $subsections\r
+ ncurry\r
+ nwith\r
+ nsum\r
+} ;\r
\r
ARTICLE: "generalizations" "Generalized shuffle words and combinators"\r
"The " { $vocab-link "generalizations" } " vocabulary defines a number of stack shuffling words and combinators for use in "\r
"macros where the arity of the input quotations depends on an "\r
"input parameter."\r
-{ $subsection "sequence-generalizations" }\r
-{ $subsection "shuffle-generalizations" }\r
-{ $subsection "combinator-generalizations" }\r
-{ $subsection "other-generalizations" } ;\r
+{ $subsections\r
+ "sequence-generalizations"\r
+ "shuffle-generalizations"\r
+ "combinator-generalizations"\r
+ "other-generalizations"\r
+} ;\r
\r
ABOUT: "generalizations"\r
-USING: tools.test generalizations kernel math arrays sequences ascii ;\r
+USING: tools.test generalizations kernel math arrays sequences\r
+ascii fry math.parser ;\r
IN: generalizations.tests\r
\r
{ 1 2 3 4 1 } [ 1 2 3 4 4 npick ] unit-test\r
1 2 3 4 3 nover ;\r
\r
[ 1 2 3 4 1 2 3 ] [ nover-test ] unit-test\r
+\r
+[ '[ number>string _ append ] 4 napply ] must-infer\r
'[ [ _ _ nspread ] _ ndip @ ]
] if ;
-MACRO: napply ( quot n -- )
- swap <repetition> spread>quot ;
+MACRO: napply ( n -- )
+ [ [ drop ] ] dip [ '[ tuck _ 2dip call ] ] times ;
MACRO: mnswap ( m n -- )
1 + '[ _ -nrot ] swap '[ _ _ napply ] ;
! Copyright (C) 2008 Matthew Willis.
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license
-USING: alien alien.syntax alien.destructors combinators system
-alien.libraries ;
+USING: alien alien.c-types alien.syntax alien.destructors
+combinators system alien.libraries ;
IN: glib
<<
TYPEDEF: int gint
TYPEDEF: bool gboolean
-FUNCTION: void
-g_free ( gpointer mem ) ;
+FUNCTION: void g_free ( gpointer mem ) ;
LIBRARY: gobject
-FUNCTION: void
-g_object_unref ( gpointer object ) ;
+FUNCTION: void g_object_unref ( gpointer object ) ;
DESTRUCTOR: g_object_unref
ARTICLE: "grouping" "Groups and clumps"
"Splitting a sequence into disjoint, fixed-length subsequences:"
-{ $subsection group }
+{ $subsections group }
"A virtual sequence for splitting a sequence into disjoint, fixed-length subsequences:"
-{ $subsection groups }
-{ $subsection <groups> }
-{ $subsection <sliced-groups> }
+{ $subsections groups <groups> <sliced-groups> }
"Splitting a sequence into overlapping, fixed-length subsequences:"
-{ $subsection clump }
+{ $subsections clump }
"A virtual sequence for splitting a sequence into overlapping, fixed-length subsequences:"
-{ $subsection clumps }
-{ $subsection <clumps> }
-{ $subsection <sliced-clumps> }
+{ $subsections clumps <clumps> <sliced-clumps> }
"The difference can be summarized as the following:"
{ $list
{ "With groups, the subsequences form the original sequence when concatenated:"
}
}
}
+$nl
"A combinator built using clumps:"
-{ $subsection monotonic? }
+{ $subsections monotonic? }
"Testing how elements are related:"
-{ $subsection all-eq? }
-{ $subsection all-equal? } ;
+{ $subsections all-eq? all-equal? } ;
ABOUT: "grouping"
ARTICLE: { "hash2" "intro" } "Hash2"
"The hash2 vocabulary specifies a simple minimal datastructure for hash tables with two integers as keys. These hash tables are fixed size and do not conform to the associative mapping protocol. Words used in creating and manipulating these hash tables include:"
-{ $subsection <hash2> }
-{ $subsection hash2 }
-{ $subsection set-hash2 }
-{ $subsection alist>hash2 } ;
+{ $subsections
+ <hash2>
+ hash2
+ set-hash2
+ alist>hash2
+} ;
HELP: <hash2>
{ $values { "size" "size of the underlying array" } { "hash2" hash2 } }
"Heap elements are key/value pairs and are compared using the " { $link <=> } " generic word on the first element of the pair."
$nl
"There are two classes of heaps. Min-heaps sort their elements so that the minimum element is first:"
-{ $subsection min-heap }
-{ $subsection min-heap? }
-{ $subsection <min-heap> }
+{ $subsections
+ min-heap
+ min-heap?
+ <min-heap>
+}
"Max-heaps sort their elements so that the maximum element is first:"
-{ $subsection max-heap }
-{ $subsection max-heap? }
-{ $subsection <max-heap> }
+{ $subsections
+ max-heap
+ max-heap?
+ <max-heap>
+}
"Both obey a protocol."
$nl
"Queries:"
-{ $subsection heap-empty? }
-{ $subsection heap-size }
-{ $subsection heap-peek }
+{ $subsections
+ heap-empty?
+ heap-size
+ heap-peek
+}
"Insertion:"
-{ $subsection heap-push }
-{ $subsection heap-push* }
-{ $subsection heap-push-all }
+{ $subsections
+ heap-push
+ heap-push*
+ heap-push-all
+}
"Removal:"
-{ $subsection heap-pop* }
-{ $subsection heap-pop }
-{ $subsection heap-delete }
+{ $subsections
+ heap-pop*
+ heap-pop
+ heap-delete
+}
"Processing heaps:"
-{ $subsection slurp-heap } ;
+{ $subsections slurp-heap } ;
ABOUT: "heaps"
USING: help.markup help.syntax io kernel math parser
prettyprint sequences vocabs.loader namespaces stack-checker
-help command-line multiline see ;
+help command-line see ;
IN: help.cookbook
ARTICLE: "cookbook-syntax" "Basic syntax cookbook"
{ $heading "Example: ls" }
"Here is an example implementing a simplified version of the Unix " { $snippet "ls" } " command in Factor:"
{ $code
- <" USING: command-line namespaces io io.files
+ """USING: command-line namespaces io io.files
io.pathnames tools.files sequences kernel ;
command-line get [
dup length 1 = [ first directory. ] [
[ [ nl write ":" print ] [ directory. ] bi ] each
] if
-] if-empty">
+] if-empty"""
}
"You can put it in a file named " { $snippet "ls.factor" } ", and then run it, to list the " { $snippet "/usr/bin" } " directory for example:"
{ $code "./factor ls.factor /usr/bin" }
{ $heading "Example: grep" }
"The following is a more complicated example, implementing something like the Unix " { $snippet "grep" } " command:"
-{ $code <" USING: kernel fry io io.files io.encodings.ascii sequences
+{ $code """USING: kernel fry io io.files io.encodings.ascii sequences
regexp command-line namespaces ;
IN: grep
] [
[ grep-file ] with each
] if-empty
-] if-empty"> }
+] if-empty""" }
"You can run it like so,"
{ $code "./factor grep.factor '.*hello.*' myfile.txt" }
"You'll notice this script takes a while to start. This is because it is loading and compiling the " { $vocab-link "regexp" } " vocabulary every time. To speed up startup, load the vocabulary into your image, and save the image:"
ARTICLE: "cookbook" "Factor cookbook"
"The Factor cookbook is a high-level overview of the most important concepts required to program in Factor."
-{ $subsection "cookbook-syntax" }
-{ $subsection "cookbook-colon-defs" }
-{ $subsection "cookbook-combinators" }
-{ $subsection "cookbook-variables" }
-{ $subsection "cookbook-vocabs" }
-{ $subsection "cookbook-application" }
-{ $subsection "cookbook-scripts" }
-{ $subsection "cookbook-philosophy" }
-{ $subsection "cookbook-pitfalls" }
-{ $subsection "cookbook-next" } ;
+{ $subsections
+ "cookbook-syntax"
+ "cookbook-colon-defs"
+ "cookbook-combinators"
+ "cookbook-variables"
+ "cookbook-vocabs"
+ "cookbook-application"
+ "cookbook-scripts"
+ "cookbook-philosophy"
+ "cookbook-pitfalls"
+ "cookbook-next"
+} ;
ABOUT: "cookbook"
collect-elements [ >link ] map ;
: article-children ( topic -- seq )
- { $subsection } article-links ;
+ { $subsection $subsections } article-links ;
: help-path ( topic -- seq )
[ article-parent ] follow rest ;
{ "a " { $link wrapper } " - the wrapped object is pushed on the data stack. Wrappers are used to push word objects directly on the stack when they would otherwise execute. See the " { $link POSTPONE: \ } " parsing word." }
{ "All other types of objects are pushed on the data stack." }
}
-{ $subsection "tail-call-opt" }
+{ $subsections "tail-call-opt" }
{ $see-also "compiler" } ;
ARTICLE: "objects" "Objects"
"An " { $emphasis "object" } " is any datum which may be identified. All values are objects in Factor. Each object carries type information, and types are checked at runtime; Factor is dynamically typed."
-{ $subsection "equality" }
-{ $subsection "math.order" }
-{ $subsection "classes" }
-{ $subsection "tuples" }
-{ $subsection "generic" }
+{ $subsections
+ "equality"
+ "math.order"
+ "classes"
+ "tuples"
+ "generic"
+}
"Advanced features:"
-{ $subsection "delegate" }
-{ $subsection "mirrors" }
-{ $subsection "slots" } ;
+{ $subsections
+ "delegate"
+ "mirrors"
+ "slots"
+} ;
ARTICLE: "numbers" "Numbers"
-{ $subsection "arithmetic" }
-{ $subsection "math-constants" }
-{ $subsection "math-functions" }
-{ $subsection "number-strings" }
+{ $subsections
+ "arithmetic"
+ "math-constants"
+ "math-functions"
+ "number-strings"
+}
"Number implementations:"
-{ $subsection "integers" }
-{ $subsection "rationals" }
-{ $subsection "floats" }
-{ $subsection "complex-numbers" }
+{ $subsections
+ "integers"
+ "rationals"
+ "floats"
+ "complex-numbers"
+}
"Advanced features:"
-{ $subsection "math-vectors" }
-{ $subsection "math-intervals" }
-{ $subsection "math-bitfields" }
-"Implementation:"
-{ $subsection "math.libm" } ;
+{ $subsections
+ "math-vectors"
+ "math-intervals"
+} ;
USE: io.buffers
ARTICLE: "collections" "Collections"
{ $heading "Sequences" }
-{ $subsection "sequences" }
-{ $subsection "virtual-sequences" }
-{ $subsection "namespaces-make" }
+{ $subsections
+ "sequences"
+ "virtual-sequences"
+ "namespaces-make"
+}
"Fixed-length sequences:"
-{ $subsection "arrays" }
-{ $subsection "quotations" }
-{ $subsection "strings" }
-{ $subsection "byte-arrays" }
-{ $subsection "specialized-arrays" }
+{ $subsections
+ "arrays"
+ "quotations"
+ "strings"
+ "byte-arrays"
+ "specialized-arrays"
+}
"Resizable sequences:"
-{ $subsection "vectors" }
-{ $subsection "byte-vectors" }
-{ $subsection "sbufs" }
-{ $subsection "growable" }
+{ $subsections
+ "vectors"
+ "byte-vectors"
+ "sbufs"
+ "growable"
+}
{ $heading "Associative mappings" }
-{ $subsection "assocs" }
-{ $subsection "linked-assocs" }
-{ $subsection "biassocs" }
-{ $subsection "refs" }
+{ $subsections
+ "assocs"
+ "linked-assocs"
+ "biassocs"
+ "refs"
+}
"Implementations:"
-{ $subsection "hashtables" }
-{ $subsection "alists" }
-{ $subsection "enums" }
+{ $subsections
+ "hashtables"
+ "alists"
+ "enums"
+}
{ $heading "Double-ended queues" }
-{ $subsection "deques" }
+{ $subsections "deques" }
"Implementations:"
-{ $subsection "dlists" }
-{ $subsection "search-deques" }
+{ $subsections
+ "dlists"
+ "search-deques"
+}
{ $heading "Other collections" }
-{ $subsection "lists" }
-{ $subsection "disjoint-sets" }
-{ $subsection "interval-maps" }
-{ $subsection "heaps" }
-{ $subsection "boxes" }
-{ $subsection "graphs" }
-{ $subsection "buffers" }
+{ $subsections
+ "lists"
+ "disjoint-sets"
+ "interval-maps"
+ "heaps"
+ "boxes"
+ "graphs"
+ "buffers"
+}
"There are also many other vocabularies tagged " { $link T{ vocab-tag { name "collections" } } } " in the library." ;
USING: io.encodings.utf8 io.encodings.binary io.files ;
ARTICLE: "io" "Input and output"
{ $heading "Streams" }
-{ $subsection "streams" }
-{ $subsection "io.files" }
+{ $subsections
+ "streams"
+ "io.files"
+}
{ $heading "The file system" }
-{ $subsection "io.pathnames" }
-{ $subsection "io.files.info" }
-{ $subsection "io.files.links" }
-{ $subsection "io.directories" }
+{ $subsections
+ "io.pathnames"
+ "io.files.info"
+ "io.files.links"
+ "io.directories"
+}
{ $heading "Encodings" }
-{ $subsection "encodings-introduction" }
-{ $subsection "io.encodings" }
+{ $subsections
+ "encodings-introduction"
+ "io.encodings"
+}
{ $heading "Wrapper streams" }
-{ $subsection "io.streams.duplex" }
-{ $subsection "io.streams.plain" }
-{ $subsection "io.streams.string" }
-{ $subsection "io.streams.byte-array" }
+{ $subsections
+ "io.streams.duplex"
+ "io.streams.plain"
+ "io.streams.string"
+ "io.streams.byte-array"
+}
{ $heading "Utilities" }
-{ $subsection "stream-binary" }
-{ $subsection "io.styles" }
-{ $subsection "checksums" }
+{ $subsections
+ "stream-binary"
+ "io.styles"
+ "checksums"
+}
{ $heading "Implementation" }
-{ $subsection "io.streams.c" }
-{ $subsection "io.ports" }
+{ $subsections
+ "io.streams.c"
+ "io.ports"
+}
{ $see-also "destructors" } ;
ARTICLE: "article-index" "Article index"
ARTICLE: "handbook-language-reference" "The language"
{ $heading "Fundamentals" }
-{ $subsection "conventions" }
-{ $subsection "syntax" }
+{ $subsections
+ "conventions"
+ "syntax"
+}
{ $heading "The stack" }
-{ $subsection "evaluator" }
-{ $subsection "effects" }
-{ $subsection "inference" }
+{ $subsections
+ "evaluator"
+ "effects"
+ "inference"
+}
{ $heading "Basic data types" }
-{ $subsection "booleans" }
-{ $subsection "numbers" }
-{ $subsection "collections" }
+{ $subsections
+ "booleans"
+ "numbers"
+ "collections"
+}
{ $heading "Evaluation" }
-{ $subsection "words" }
-{ $subsection "shuffle-words" }
-{ $subsection "combinators" }
-{ $subsection "threads" }
+{ $subsections
+ "words"
+ "shuffle-words"
+ "combinators"
+ "threads"
+}
{ $heading "Named values" }
-{ $subsection "locals" }
-{ $subsection "namespaces" }
-{ $subsection "namespaces-global" }
-{ $subsection "values" }
+{ $subsections
+ "locals"
+ "namespaces"
+ "namespaces-global"
+ "values"
+}
{ $heading "Abstractions" }
-{ $subsection "fry" }
-{ $subsection "objects" }
-{ $subsection "errors" }
-{ $subsection "destructors" }
-{ $subsection "memoize" }
-{ $subsection "parsing-words" }
-{ $subsection "macros" }
-{ $subsection "continuations" }
+{ $subsections
+ "fry"
+ "objects"
+ "errors"
+ "destructors"
+ "memoize"
+ "parsing-words"
+ "macros"
+ "continuations"
+}
{ $heading "Program organization" }
-{ $subsection "vocabs.loader" }
+{ $subsections "vocabs.loader" }
"Vocabularies tagged " { $link T{ vocab-tag { name "extensions" } } } " implement various additional language abstractions." ;
ARTICLE: "handbook-system-reference" "The implementation"
{ $heading "Parse time and compile time" }
-{ $subsection "parser" }
-{ $subsection "definitions" }
-{ $subsection "vocabularies" }
-{ $subsection "source-files" }
-{ $subsection "compiler" }
-{ $subsection "tools.errors" }
+{ $subsections
+ "parser"
+ "definitions"
+ "vocabularies"
+ "source-files"
+ "compiler"
+ "tools.errors"
+}
{ $heading "Virtual machine" }
-{ $subsection "images" }
-{ $subsection "cli" }
-{ $subsection "rc-files" }
-{ $subsection "init" }
-{ $subsection "system" }
-{ $subsection "layouts" } ;
+{ $subsections
+ "images"
+ "cli"
+ "rc-files"
+ "init"
+ "system"
+ "layouts"
+} ;
ARTICLE: "handbook-tools-reference" "Developer tools"
"The below tools are text-based. " { $link "ui-tools" } " are documented separately."
{ $heading "Workflow" }
-{ $subsection "listener" }
-{ $subsection "editor" }
-{ $subsection "vocabs.refresh" }
-{ $subsection "tools.test" }
-{ $subsection "help" }
+{ $subsections
+ "listener"
+ "editor"
+ "vocabs.refresh"
+ "tools.test"
+ "help"
+}
{ $heading "Debugging" }
-{ $subsection "prettyprint" }
-{ $subsection "inspector" }
-{ $subsection "tools.inference" }
-{ $subsection "tools.annotations" }
-{ $subsection "tools.deprecation" }
+{ $subsections
+ "prettyprint"
+ "inspector"
+ "tools.inference"
+ "tools.annotations"
+ "tools.deprecation"
+}
{ $heading "Browsing" }
-{ $subsection "see" }
-{ $subsection "tools.crossref" }
-{ $subsection "vocabs.hierarchy" }
+{ $subsections
+ "see"
+ "tools.crossref"
+ "vocabs.hierarchy"
+}
{ $heading "Performance" }
-{ $subsection "timing" }
-{ $subsection "profiling" }
-{ $subsection "tools.memory" }
-{ $subsection "tools.threads" }
-{ $subsection "tools.destructors" }
-{ $subsection "tools.disassembler" }
+{ $subsections
+ "timing"
+ "profiling"
+ "tools.memory"
+ "tools.threads"
+ "tools.destructors"
+ "tools.disassembler"
+}
{ $heading "Deployment" }
-{ $subsection "tools.deploy" } ;
+{ $subsections "tools.deploy" } ;
ARTICLE: "handbook-library-reference" "Libraries"
"This index lists articles from loaded vocabularies which are not subsections of any other article. To explore more vocabularies, see " { $link "vocab-index" } "."
{ $index [ orphan-articles { "help.home" "handbook" } diff ] } ;
ARTICLE: "handbook" "Factor handbook"
-"Learn the language:"
-{ $subsection "cookbook" }
-{ $subsection "first-program" }
-"Reference material:"
-{ $subsection "handbook-language-reference" }
-{ $subsection "io" }
-{ $subsection "ui" }
-{ $subsection "handbook-system-reference" }
-{ $subsection "handbook-tools-reference" }
-{ $subsection "ui-tools" }
-{ $subsection "alien" }
-{ $subsection "handbook-library-reference" }
-"Explore loaded libraries:"
-{ $subsection "article-index" }
-{ $subsection "primitive-index" }
-{ $subsection "error-index" }
-{ $subsection "type-index" }
-{ $subsection "class-index" }
-"Explore the code base:"
-{ $subsection "vocab-index" } ;
+{ $heading "Getting Started" }
+{ $subsections
+ "cookbook"
+ "first-program"
+}
+{ $heading "Reference" }
+{ $subsections
+ "handbook-language-reference"
+ "io"
+ "ui"
+ "handbook-system-reference"
+ "handbook-tools-reference"
+ "ui-tools"
+ "alien"
+ "handbook-library-reference"
+}
+{ $heading "Explore loaded libraries" }
+{ $subsections
+ "article-index"
+ "primitive-index"
+ "error-index"
+ "type-index"
+ "class-index"
+}
+{ $heading "Explore the code base" }
+{ $subsections "vocab-index" } ;
ABOUT: "handbook"
ARTICLE: "printing-elements" "Printing markup elements"
"When writing documentation, it is useful to be able to print markup elements for testing purposes. Markup elements which are strings or arrays of elements are printed in the obvious way. Markup elements of the form " { $snippet "{ $directive content... }" } " are printed by executing the " { $snippet "$directive" } " word with the element content on the stack."
-{ $subsection print-element }
-{ $subsection print-content } ;
+{ $subsections
+ print-element
+ print-content
+} ;
ARTICLE: "span-elements" "Span elements"
-{ $subsection $emphasis }
-{ $subsection $strong }
-{ $subsection $link }
-{ $subsection $vocab-link }
-{ $subsection $snippet }
-{ $subsection $slot }
-{ $subsection $url } ;
+{ $subsections
+ $emphasis
+ $strong
+ $link
+ $vocab-link
+ $snippet
+ $slot
+ $url
+} ;
ARTICLE: "block-elements" "Block elements"
"Paragraph break:"
-{ $subsection $nl }
+{ $subsections $nl }
"Standard headings for word documentation:"
-{ $subsection $values }
-{ $subsection $description }
-{ $subsection $class-description }
-{ $subsection $error-description }
-{ $subsection $var-description }
-{ $subsection $contract }
-{ $subsection $examples }
-{ $subsection $warning }
-{ $subsection $notes }
-{ $subsection $side-effects }
-{ $subsection $errors }
-{ $subsection $see-also }
+{ $subsections
+ $values
+ $description
+ $class-description
+ $error-description
+ $var-description
+ $contract
+ $examples
+ $warning
+ $notes
+ $side-effects
+ $errors
+ $see-also
+}
"Elements used in " { $link $values } " forms:"
-{ $subsection $instance }
-{ $subsection $maybe }
-{ $subsection $or }
-{ $subsection $quotation }
+{ $subsections
+ $instance
+ $maybe
+ $or
+ $quotation
+}
"Boilerplate paragraphs:"
-{ $subsection $low-level-note }
-{ $subsection $io-error }
+{ $subsections
+ $low-level-note
+ $io-error
+}
"Some additional elements:"
-{ $subsection $code }
-{ $subsection $curious }
-{ $subsection $example }
-{ $subsection $heading }
-{ $subsection $links }
-{ $subsection $list }
-{ $subsection $markup-example }
-{ $subsection $references }
-{ $subsection $see }
-{ $subsection $subsection }
-{ $subsection $table } ;
+{ $subsections
+ $code
+ $curious
+ $example
+ $heading
+ $links
+ $list
+ $markup-example
+ $references
+ $see
+ $subsection
+ $table
+} ;
ARTICLE: "markup-utils" "Markup element utilities"
"Utility words to assist in defining new elements:"
-{ $subsection simple-element }
-{ $subsection ($span) }
-{ $subsection ($block) } ;
+{ $subsections
+ simple-element
+ ($span)
+ ($block)
+} ;
ARTICLE: "element-types" "Element types"
"Markup elements can be classified into two broad categories, block elements and span elements. Block elements are inset with newlines before and after, whereas span elements flow with the paragraph text."
-{ $subsection "span-elements" }
-{ $subsection "block-elements" }
-{ $subsection "markup-utils" } ;
+{ $subsections
+ "span-elements"
+ "block-elements"
+ "markup-utils"
+} ;
IN: help.markup
ABOUT: "element-types"
"By convention, documentation is written in files whose names end with " { $snippet "-docs.factor" } ". Vocabulary documentation should be placed in the same directory as the vocabulary source code; see " { $link "vocabs.loader" } "."
$nl
"A pair of parsing words are used to define free-standing articles and to associate documentation with words:"
-{ $subsection POSTPONE: ARTICLE: }
-{ $subsection POSTPONE: HELP: }
+{ $subsections
+ POSTPONE: ARTICLE:
+ POSTPONE: HELP:
+}
"A parsing word defines the main help article for a vocabulary:"
-{ $subsection POSTPONE: ABOUT: }
+{ $subsections POSTPONE: ABOUT: }
"The " { $emphasis "content" } " in both cases is a " { $emphasis "markup element" } ", a recursive structure taking one of the following forms:"
{ $list
{ "a string," }
"<simple-element> ::== { <element>* }"
"<fancy-element> ::== { <type> <element> }"
}
-{ $subsection "element-types" }
-{ $subsection "printing-elements" }
+{ $subsections
+ "element-types"
+ "printing-elements"
+}
"Related words can be cross-referenced:"
-{ $subsection related-words }
+{ $subsections related-words }
{ $see-also "help.lint" } ;
ARTICLE: "help-impl" "Help system implementation"
"Help topic protocol:"
-{ $subsection article-name }
-{ $subsection article-title }
-{ $subsection article-content }
-{ $subsection article-parent }
-{ $subsection set-article-parent }
+{ $subsections
+ article-name
+ article-title
+ article-content
+ article-parent
+ set-article-parent
+}
"Boilerplate word help can be automatically generated (for example, slot accessor help):"
-{ $subsection word-help }
-{ $subsection word-help* }
+{ $subsections
+ word-help
+ word-help*
+}
"Help article implementation:"
-{ $subsection article }
-{ $subsection articles }
+{ $subsections
+ article
+ articles
+}
"Links:"
-{ $subsection link }
-{ $subsection >link }
+{ $subsections
+ link
+ >link
+}
"Utilities for traversing markup element trees:"
-{ $subsection elements }
-{ $subsection collect-elements }
+{ $subsections
+ elements
+ collect-elements
+}
"Links and " { $link article } " instances implement the definition protocol; refer to " { $link "definitions" } "." ;
ARTICLE: "help" "Help system"
"The help system maintains documentation written in a simple markup language, along with cross-referencing and search. Documentation can either exist as free-standing " { $emphasis "articles" } " or be associated with words."
-{ $subsection "browsing-help" }
-{ $subsection "writing-help" }
-{ $subsection "help.lint" }
-{ $subsection "tips-of-the-day" }
-{ $subsection "help-impl" } ;
+{ $subsections
+ "browsing-help"
+ "writing-help"
+ "help.lint"
+ "tips-of-the-day"
+ "help-impl"
+} ;
IN: help
ABOUT: "help"
HELP: $subsection
{ $values { "element" "a markup element of the form " { $snippet "{ topic }" } } }
-{ $description "Prints a large clickable link to the help topic named by the first string element of " { $snippet "element" } "." }
+{ $description "Prints a large clickable link to the help topic named by the first item in " { $snippet "element" } ". The link is printed along with its associated definition icon." }
+{ $examples
+ { $markup-example { $subsections "sequences" } }
+ { $markup-example { $subsections nth } }
+ { $markup-example { $subsections each } }
+} ;
+
+HELP: $subsections
+{ $values { "children" "a " { $link sequence } " of one or more " { $link topic } "s or, in the case of a help article, the article's string name." } }
+{ $description "Prints a large clickable link for each of the listed help topics in " { $snippet "children" } ". The link is printed along with its associated definition icon." }
+{ $examples
+ { $markup-example { $subsections "sequences" nth each } }
+} ;
+
+{ $subsection $subsections $link } related-words
+
+HELP: $vocab-subsection
+{ $values { "element" "a markup element of the form " { $snippet "{ title vocab }" } } }
+{ $description "Prints a large clickable link for " { $snippet "vocab" } ". If " { $snippet "vocab" } " has a main help article, the link will point at that article and the " { $snippet "title" } " input will be ignored. Otherwise, the link text will be taken from " { $snippet "title" } " and point to " { $snippet "vocab" } "'s automatically generated documentation."
+$nl
+"The link will be printed along with its associated definition icon." }
{ $examples
- { $code "{ $subsection \"sequences\" }" }
+ { $markup-example { $vocab-subsection "SQLite" "db.sqlite" } }
+ { $markup-example { $vocab-subsection "Alien" "alien" } }
} ;
HELP: $index
{ $values { "seq" "a sequence" } { "quot" { $quotation "( elt -- )" } } }
{ $description "Applies the quotation to each element of the sequence, printing a comma between each pair of elements." }
{ $examples
- { $example "USING: help.markup io ;" "{ \"fish\" \"chips\" \"salt\" } [ write ] textual-list" "fish, chips, salt" }
+ { $example "USING: help.markup io namespaces ;" "last-element off" "{ \"fish\" \"chips\" \"salt\" } [ write ] textual-list" "fish, chips, salt" }
} ;
HELP: $links
: $navigation-row ( content element label -- )
[ prefix 1array ] dip prefix , ;
+: ($navigation-table) ( element -- )
+ help-path-style get table-style set [ $table ] with-scope ;
+
: $navigation-table ( topic -- )
[
- [ help-path [ \ $links "Up:" $navigation-row ] unless-empty ]
[ prev-article [ 1array \ $long-link "Prev:" $navigation-row ] when* ]
[ next-article [ 1array \ $long-link "Next:" $navigation-row ] when* ]
- tri
- ] { } make [ $table ] unless-empty ;
+ bi
+ ] { } make [ ($navigation-table) ] unless-empty ;
+
+: ($navigation) ( topic -- )
+ help-path-style get [
+ [ help-path [ reverse $breadcrumbs ] unless-empty ]
+ [ $navigation-table ] bi
+ ] with-style ;
: $title ( topic -- )
title-style get [
title-style get [
- [ ($title) ]
- [ help-path-style get [ $navigation-table ] with-style ] bi
+ [ ($title) ] [ ($navigation) ] bi
] with-nesting
] with-style nl ;
: print-topic ( topic -- )
>link
last-element off
- [ $title ] [ article-content print-content nl ] bi ;
+ [ $title ] [ nl article-content print-content nl ] bi ;
SYMBOL: help-hook
-USING: help.html tools.test help.topics kernel ;
+USING: help.html tools.test help.topics kernel sequences vocabs ;
IN: help.html.tests
[ ] [ "xml" >link help>html drop ] unit-test
[ "article-foobar.html" ] [ "foobar" >link topic>filename ] unit-test
+
+[ t ] [ all-vocabs-really [ vocab-spec? ] all? ] unit-test
+
+[ t ] [ all-vocabs-really [ vocab-name "sequences.private" = ] any? ] unit-test
+
+[ f ] [ all-vocabs-really [ vocab-name "scratchpad" = ] any? ] unit-test
dup topic>filename utf8 [ help>html write-xml ] with-file-writer ;
: all-vocabs-really ( -- seq )
- all-vocabs-recursive >hashtable f over delete-at no-roots remove-redundant-prefixes ;
+ all-vocabs-recursive >hashtable no-roots remove-redundant-prefixes
+ [ vocab-name "scratchpad" = not ] filter ;
: all-topics ( -- topics )
[
-a:link { text-decoration: none; color: #00004c; }
-a:visited { text-decoration: none; color: #00004c; }
-a:active { text-decoration: none; color: #00004c; }
-a:hover { text-decoration: underline; color: #00004c; }
+a:link { text-decoration: none; color: #104e8b; }
+a:visited { text-decoration: none; color: #104e8b; }
+a:active { text-decoration: none; color: #104e8b; }
+a:hover { text-decoration: underline; color: #104e8b; }
"The " { $vocab-link "help.lint" } " vocabulary implements a tool to check documentation in an automated fashion. You should use this tool to check any documentation that you write."
$nl
"To run help lint, use one of the following two words:"
-{ $subsection help-lint }
-{ $subsection help-lint-all }
+{ $subsections
+ help-lint
+ help-lint-all
+}
"Once a help lint run completes, failures can be listed:"
-{ $subsection :lint-failures }
+{ $subsections :lint-failures }
"Help lint failures are also shown in the " { $link "ui.tools.error-list" } "."
$nl
"Help lint performs the following checks:"
[ "a string, a fixnum, or an integer" ]
[ [ { $or string fixnum integer } print-element ] with-string-writer ] unit-test
+! Layout
+
+[ "span" ]
+[ [ { "span" } print-content ] with-string-writer ] unit-test
+
+[ "span1span2" ]
+[ [ { "span1" "span2" } print-content ] with-string-writer ] unit-test
+
+[ "span1\n\nspan2" ]
+[ [ { "span1" { $nl } "span2" } print-content ] with-string-writer ] unit-test
+
+[ "\nspan" ]
+[ [ { { $nl } "span" } print-content ] with-string-writer ] unit-test
+
+[ "2 2 +\nspan" ]
+[ [ { { $code "2 2 +" } "span" } print-content ] with-string-writer ] unit-test
+
+[ "2 2 +" ]
+[ [ { { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n2 2 +" ]
+[ [ { "span" { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "\n2 2 +" ]
+[ [ { { $nl } { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n\n2 2 +" ]
+[ [ { "span" { $nl } { $code "2 2 +" } } print-content ] with-string-writer ] unit-test
+
+[ "Heading" ]
+[ [ { { $heading "Heading" } } print-content ] with-string-writer ] unit-test
+
+[ "Heading1\n\nHeading2" ]
+[ [ { { $heading "Heading1" } { $heading "Heading2" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n\nHeading" ]
+[ [ { "span" { $heading "Heading" } } print-content ] with-string-writer ] unit-test
+
+[ "\nHeading" ]
+[ [ { { $nl } { $heading "Heading" } } print-content ] with-string-writer ] unit-test
+
+[ "span\n\nHeading" ]
+[ [ { "span" { $nl } { $heading "Heading" } } print-content ] with-string-writer ] unit-test
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays definitions generic io kernel assocs
-hashtables namespaces make parser prettyprint sequences strings
-io.styles vectors words math sorting splitting classes slots fry
-sets vocabs help.stylesheet help.topics vocabs.loader quotations
-combinators see present ;
+USING: accessors arrays assocs classes colors colors.constants
+combinators definitions definitions.icons effects fry generic
+hashtables help.stylesheet help.topics io io.styles kernel make
+math namespaces parser present prettyprint
+prettyprint.stylesheet quotations see sequences sets slots
+sorting splitting strings vectors vocabs vocabs.loader words ;
FROM: prettyprint.sections => with-pprint ;
IN: help.markup
SYMBOL: last-element
SYMBOL: span
SYMBOL: block
+SYMBOL: blank-line
: last-span? ( -- ? ) last-element get span eq? ;
: last-block? ( -- ? ) last-element get block eq? ;
+: last-blank-line? ( -- ? ) last-element get blank-line eq? ;
+
+: ?nl ( -- )
+ last-element get
+ last-blank-line? not
+ and [ nl ] when ;
: ($span) ( quot -- )
last-block? [ nl ] when
[ print-element ] with-default-style ;
: ($block) ( quot -- )
- last-element get [ nl ] when
+ ?nl
span last-element set
call
block last-element set ; inline
] ($span) ;
: $nl ( children -- )
- nl nl drop ;
+ drop nl last-element get [ nl ] when
+ blank-line last-element set ;
! Some blocks
: ($heading) ( children quot -- )
- last-element get [ nl ] when ($block) ; inline
+ ?nl ($block) ; inline
: $heading ( element -- )
[ heading-style get print-element* ] ($heading) ;
: ($code) ( presentation quot -- )
[
- snippet-style get [
+ code-char-style get [
last-element off
[ ($code-style) ] dip with-nesting
] with-style
1array \ $image prefix ;
! Some links
+
+<PRIVATE
+
: write-link ( string object -- )
link-style get [ write-object ] with-style ;
-: ($link) ( article -- )
- [ [ article-name ] [ >link ] bi write-link ] ($span) ;
+: link-icon ( topic -- )
+ definition-icon 1array $image ;
-: $link ( element -- )
- first ($link) ;
-
-: ($definition-link) ( word -- )
+: link-text ( topic -- )
[ article-name ] keep write-link ;
-: $definition-link ( element -- )
- first ($definition-link) ;
+GENERIC: link-long-text ( topic -- )
+
+M: topic link-long-text
+ [ article-title ] keep write-link ;
+
+M: word link-long-text
+ dup presented associate [
+ [ article-name link-style get format ]
+ [ drop bl ]
+ [ stack-effect effect>string stack-effect-style get format ]
+ tri
+ ] with-nesting ;
+
+: >topic ( obj -- topic ) dup topic? [ >link ] unless ;
+
+: topic-span ( topic quot -- ) [ >topic ] dip ($span) ; inline
+
+PRIVATE>
+
+: ($link) ( topic -- ) [ link-text ] topic-span ;
+: $link ( element -- ) first ($link) ;
+
+: ($long-link) ( topic -- ) [ link-long-text ] topic-span ;
+: $long-link ( element -- ) first ($long-link) ;
-: ($long-link) ( object -- )
- [ article-title ] [ >link ] bi write-link ;
+: ($pretty-link) ( topic -- )
+ [ [ link-icon ] [ drop bl ] [ link-text ] tri ] topic-span ;
+: $pretty-link ( element -- ) first ($pretty-link) ;
-: $long-link ( object -- )
- first ($long-link) ;
+: ($long-pretty-link) ( topic -- )
+ [ [ link-icon ] [ drop bl ] [ link-long-text ] tri ] topic-span ;
+
+: <$pretty-link> ( definition -- element )
+ 1array \ $pretty-link prefix ;
: ($subsection) ( element quot -- )
[
- subsection-style get [
- bullet get write bl
- call
- ] with-style
+ subsection-style get [ call ] with-style
] ($block) ; inline
+: $subsection* ( topic -- )
+ [
+ [ ($long-pretty-link) ] with-scope
+ ] ($subsection) ;
+
+: $subsections ( children -- )
+ [ $subsection* ] each nl nl blank-line last-element set ;
+
: $subsection ( element -- )
- [ first ($long-link) ] ($subsection) ;
+ first $subsection* ;
: ($vocab-link) ( text vocab -- )
>vocab-link write-link ;
: $vocab-subsection ( element -- )
[
- first2 dup vocab-help dup [
- 2nip ($long-link)
- ] [
- drop ($vocab-link)
- ] if
+ first2 dup vocab-help
+ [ 2nip ($long-pretty-link) ]
+ [ [ >vocab-link link-icon bl ] [ ($vocab-link) ] bi ]
+ if*
] ($subsection) ;
: $vocab-link ( element -- )
"Vocabulary" $heading nl dup ($vocab-link)
] when* ;
+: (textual-list) ( seq quot sep -- )
+ '[ _ print-element ] swap interleave ; inline
+
: textual-list ( seq quot -- )
- [ ", " print-element ] swap interleave ; inline
+ ", " (textual-list) ; inline
: $links ( topics -- )
[ [ ($link) ] textual-list ] ($span) ;
: $vocab-links ( vocabs -- )
[ vocab ] map $links ;
+: $breadcrumbs ( topics -- )
+ [ [ ($link) ] " > " (textual-list) ] ($span) ;
+
: $see-also ( topics -- )
"See also" $heading $links ;
: ($see) ( word quot -- )
[
- snippet-style get [
+ code-char-style get [
code-style get swap with-nesting
] with-style
] ($block) ; inline
: <$snippet> ( str -- element )
1array \ $snippet prefix ;
+
+: $definition-icons ( element -- )
+ drop
+ icons get >alist sort-keys
+ [ [ <$link> ] [ definition-icon-path <$image> ] bi* swap ] assoc-map
+ { "" "Definition class" } prefix
+ $table ;
\ No newline at end of file
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: io.styles namespaces colors colors.constants ;
+USING: colors colors.constants io.styles namespaces ;
IN: help.stylesheet
SYMBOL: default-span-style
SYMBOL: link-style
H{
- { foreground COLOR: dark-blue }
+ { foreground COLOR: DodgerBlue4 }
{ font-style bold }
} link-style set-global
SYMBOL: title-style
H{
{ font-name "sans-serif" }
- { font-size 18 }
+ { font-size 20 }
{ font-style bold }
{ wrap-margin 500 }
- { page-color COLOR: light-gray }
- { border-width 5 }
+ { foreground COLOR: gray20 }
+ { page-color COLOR: FactorLightTan }
+ { inset { 5 5 } }
} title-style set-global
SYMBOL: help-path-style
-H{ { font-size 10 } } help-path-style set-global
+H{
+ { font-size 10 }
+ { table-gap { 5 5 } }
+ { table-border COLOR: FactorLightTan }
+} help-path-style set-global
SYMBOL: heading-style
H{
{ font-name "sans-serif" }
{ font-size 16 }
{ font-style bold }
+ { foreground COLOR: FactorDarkSlateBlue }
} heading-style set-global
SYMBOL: subsection-style
H{
{ font-name "monospace" }
{ font-size 12 }
- { foreground COLOR: navy-blue }
+ { foreground COLOR: DarkOrange4 }
} snippet-style set-global
+SYMBOL: code-char-style
+H{
+ { font-name "monospace" }
+ { font-size 12 }
+} code-char-style set-global
+
SYMBOL: code-style
H{
- { page-color COLOR: gray80 }
- { border-width 5 }
+ { page-color COLOR: FactorLightTan }
+ { inset { 5 5 } }
{ wrap-margin f }
} code-style set-global
SYMBOL: url-style
H{
{ font-name "monospace" }
- { foreground COLOR: blue }
+ { foreground COLOR: DodgerBlue4 }
} url-style set-global
SYMBOL: warning-style
H{
{ page-color COLOR: gray90 }
{ border-color COLOR: red }
- { border-width 5 }
+ { inset { 5 5 } }
{ wrap-margin 500 }
} warning-style set-global
H{
{ page-color COLOR: gray90 }
{ border-color COLOR: red }
- { border-width 5 }
+ { inset { 5 5 } }
{ wrap-margin 500 }
} deprecated-style set-global
SYMBOL: table-style
H{
{ table-gap { 5 5 } }
- { table-border COLOR: light-gray }
+ { table-border COLOR: FactorTan }
} table-style set-global
SYMBOL: list-style
ARTICLE: "tips-of-the-day" "Tips of the day"
"The " { $vocab-link "help.tips" } " vocabulary provides a facility for displaying tips of the day in the " { $link "ui-listener" } ". Tips are defined with a parsing word:"
-{ $subsection POSTPONE: TIP: }
+{ $subsections POSTPONE: TIP: }
"All tips defined so far:"
-{ $subsection "all-tips-of-the-day" } ;
+{ $subsections "all-tips-of-the-day" } ;
ABOUT: "tips-of-the-day"
\ No newline at end of file
H{
{ page-color COLOR: lavender }
- { border-width 5 }
+ { inset { 5 5 } }
{ wrap-margin 500 }
} tip-of-the-day-style set-global
"In this tutorial, we will write a simple Factor program which prompts the user to enter a word, and tests if it is a palindrome (that is, the word is spelled the same backwards and forwards)."
$nl
"In this tutorial, you will learn about basic Factor development tools."
-{ $subsection "first-program-start" }
-{ $subsection "first-program-logic" }
-{ $subsection "first-program-test" }
-{ $subsection "first-program-extend" } ;
+{ $subsections
+ "first-program-start"
+ "first-program-logic"
+ "first-program-test"
+ "first-program-extend"
+} ;
ABOUT: "first-program"
{ $all-authors } ;
ARTICLE: "vocab-index" "Vocabulary index"
-{ $subsection "vocab-tags" }
-{ $subsection "vocab-authors" }
+{ $subsections
+ "vocab-tags"
+ "vocab-authors"
+}
{ $vocab "" } ;
HELP: words.
ARTICLE: "browsing-help" "Browsing documentation"
"Help topics are instances of a mixin:"
-{ $subsection topic }
+{ $subsections topic }
"Most commonly, topics are article name strings, or words. You can display a specific help topic:"
-{ $subsection help }
+{ $subsections help }
"You can also display the help for a vocabulary:"
-{ $subsection about }
+{ $subsections about }
"To list a vocabulary's words only:"
-{ $subsection words. }
+{ $subsections words. }
{ $examples
{ $code "\"evaluator\" help" }
{ $code "\\ + help" }
USING: accessors arrays assocs classes classes.builtin
classes.intersection classes.mixin classes.predicate
classes.singleton classes.tuple classes.union combinators
-definitions effects fry generic help help.markup help.stylesheet
-help.topics io io.files io.pathnames io.styles kernel macros
-make namespaces prettyprint sequences sets sorting summary
-vocabs vocabs.files vocabs.hierarchy vocabs.loader
-vocabs.metadata words words.symbol definitions.icons ;
+effects fry generic help help.markup help.stylesheet
+help.topics io io.pathnames io.styles kernel macros make
+namespaces sequences sorting summary vocabs vocabs.files
+vocabs.hierarchy vocabs.loader vocabs.metadata words
+words.symbol ;
FROM: vocabs.hierarchy => child-vocabs ;
IN: help.vocabs
: about ( vocab -- )
[ require ] [ vocab help ] bi ;
-: $pretty-link ( element -- )
- [ first definition-icon 1array $image " " print-element ]
- [ $definition-link ]
- bi ;
-
-: <$pretty-link> ( definition -- element )
- 1array \ $pretty-link prefix ;
-
: vocab-row ( vocab -- row )
[ <$pretty-link> ] [ vocab-summary ] bi 2array ;
] bi
] unless-empty ;
+: vocab-is-not-loaded ( vocab -- )
+ "Not loaded" $heading
+ "You must first load this vocabulary to browse its documentation and words."
+ print-element vocab-name "USE: " prepend 1array $code ;
+
+: describe-words ( vocab -- )
+ {
+ { [ dup vocab ] [ words $words ] }
+ { [ dup find-vocab-root ] [ vocab-is-not-loaded ] }
+ [ drop ]
+ } cond ;
+
: words. ( vocab -- )
last-element off
[ require ] [ words $words ] bi nl ;
first {
[ describe-help ]
[ describe-metadata ]
- [ words $words ]
+ [ describe-words ]
[ describe-files ]
[ describe-children ]
} cleave ;
"In some cases, specialization will not help at all, and can make generated code slower from the increase in code size. The compiler is capable of inferring enough static type information to generate efficient code in many cases without explicit help from the programmer. Specializers should be used as a last resort, after profiling shows that a critical loop makes a lot of repeated calls to generic words which dispatch on the same class."
$nl
"Type hints are declared with a parsing word:"
-{ $subsection POSTPONE: HINTS: }
+{ $subsections POSTPONE: HINTS: }
"The specialized version of a word which will be compiled by the compiler can be inspected:"
-{ $subsection specialized-def } ;
+{ $subsections specialized-def } ;
HELP: specialized-def
{ $values { "word" word } { "quot" quotation } }
--- /dev/null
+USING: math hashtables accessors kernel words hints
+compiler.tree.debugger tools.test ;
+IN: hints.tests
+
+! Regression
+GENERIC: blahblah ( a b c -- )
+
+M: hashtable blahblah 2nip [ 1 + ] change-count drop ;
+
+HINTS: M\ hashtable blahblah { object fixnum object } { object word object } ;
+
+[ t ] [ M\ hashtable blahblah { count>> (>>count) } inlined? ] unit-test
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays byte-vectors classes
-combinators definitions fry generic generic.single
+combinators definitions effects fry generic generic.single
generic.standard hashtables io.binary io.streams.string kernel
kernel.private math math.parser namespaces parser sbufs
sequences splitting splitting.private strings vectors words ;
M: object specializer-declaration class ;
+: specializer ( word -- specializer )
+ "specializer" word-prop ;
+
: make-specializer ( specs -- quot )
dup length <reversed>
[ (picker) 2array ] 2map
[ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
] if-empty ;
-: specializer-cases ( quot word -- default alist )
+: specializer-cases ( quot specializer -- alist )
dup [ array? ] all? [ 1array ] unless [
- [ make-specializer ] keep
- [ specializer-declaration ] map '[ _ declare ] pick append
- ] { } map>assoc ;
+ [ nip make-specializer ]
+ [ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi
+ ] with { } map>assoc ;
: specialize-quot ( quot specializer -- quot' )
- specializer-cases alist>quot ;
+ [ drop ] [ specializer-cases ] 2bi alist>quot ;
! compiler.tree.propagation.inlining sets this to f
SYMBOL: specialize-method?
: specialize-method ( quot method -- quot' )
[ specialize-method? get [ method-declaration prepend ] [ drop ] if ]
- [ "method-generic" word-prop "specializer" word-prop ] bi
- [ specialize-quot ] when* ;
+ [ "method-generic" word-prop ] bi
+ specializer [ specialize-quot ] when* ;
: standard-method? ( method -- ? )
dup method-body? [
[ def>> ] keep
dup generic? [ drop ] [
[ dup standard-method? [ specialize-method ] [ drop ] if ]
- [ "specializer" word-prop [ specialize-quot ] when* ]
+ [ specializer [ specialize-quot ] when* ]
bi
] if ;
ARTICLE: "html.components.links" "Link components"
"Link components render a link to an object."
-{ $subsection link }
+{ $subsections link }
"The link title and URL are determined by passing the object to a pair of generic words:"
-{ $subsection link-title }
-{ $subsection link-href }
+{ $subsections
+ link-title
+ link-href
+}
"The generic words provide methods on the " { $link string } " and " { $link url } " classes which treat the object as a URL. New methods can be defined for rendering links to custom data types." ;
HELP: comparison
"Most web applications can use the " { $vocab-link "html.templates.chloe" } " templating framework instead of using this vocabulary directly. Where maximum flexibility is required, this vocabulary can be used together with the " { $vocab-link "html.templates.fhtml" } " templating framework."
$nl
"Rendering components:"
-{ $subsection render }
+{ $subsections render }
"Components render a named value, and the name of the value is passed in every time the component is rendered, rather than being associated with the component itself. Named values are taken from the current HTML form (see " { $link "html.forms" } ")."
$nl
"Component come in two varieties: singletons and tuples. Components with no configuration are singletons; they do not have to instantiated, rather the class word represents the component. Tuple components have to be instantiated and offer configuration options."
$nl
"Singleton components:"
-{ $subsection hidden }
-{ $subsection link }
-{ $subsection inspector }
-{ $subsection comparison }
-{ $subsection html }
-{ $subsection xml }
+{ $subsections
+ hidden
+ link
+ inspector
+ comparison
+ html
+ xml
+}
"Tuple components:"
-{ $subsection field }
-{ $subsection password }
-{ $subsection textarea }
-{ $subsection choice }
-{ $subsection checkbox }
-{ $subsection code }
-{ $subsection farkup }
+{ $subsections
+ field
+ password
+ textarea
+ choice
+ checkbox
+ code
+ farkup
+}
"Creating custom components:"
-{ $subsection render* }
+{ $subsections render* }
"Custom components can emit HTML using the " { $vocab-link "xml.syntax" } " vocabulary." ;
ABOUT: "html.components"
"The below words are used to implement the " { $vocab-link "furnace.actions" } " vocabulary. Calling them directly is rarely necessary."
$nl
"Creating a new form:"
-{ $subsection <form> }
+{ $subsections <form> }
"Variable holding current form:"
-{ $subsection form }
+{ $subsections form }
"Working with forms:"
-{ $subsection with-form }
-{ $subsection begin-form }
+{ $subsections
+ with-form
+ begin-form
+}
"Validation:"
-{ $subsection validation-error }
-{ $subsection validation-failed? }
-{ $subsection validate-values } ;
+{ $subsections
+ validation-error
+ validation-failed?
+ validate-values
+} ;
ARTICLE: "html.forms.values" "HTML form values"
"Form values are a central concept in the Furnace framework. Web actions primarily concern themselves with validating values, marshalling values to a database, and setting values for display in a form."
$nl
"Getting and setting values:"
-{ $subsection value }
-{ $subsection set-value }
-{ $subsection from-object }
-{ $subsection to-object }
+{ $subsections
+ value
+ set-value
+ from-object
+ to-object
+}
"Iterating over values; these words are used by " { $vocab-link "html.templates.chloe" } " to implement the " { $snippet "t:each" } " and " { $snippet "t:bind-each" } " tags:"
-{ $subsection with-each-value }
-{ $subsection with-each-object }
+{ $subsections
+ with-each-value
+ with-each-object
+}
"Nesting a form inside another form as a value:"
-{ $subsection nest-form } ;
+{ $subsections nest-form } ;
ARTICLE: "html.forms" "HTML forms"
"The " { $vocab-link "html.forms" } " vocabulary implements support for rendering and validating HTML forms. The definition of a " { $emphasis "form" } " is a bit more general than the content of an " { $snippet "<form>" } " tag. Namely, a page which displays a database record without offering any editing capability is considered a form too; it consists entirely of read-only components."
"This vocabulary is an integral part of the " { $vocab-link "furnace" } " web framework. The " { $vocab-link "html.templates.chloe" } " vocabulary uses the HTML form words to implement various template tags. The words are also often used directly from web action implementations."
$nl
"This vocabulary can be used without either the Furnace framework or the HTTP server; for example, as part of a static HTML generation tool."
-{ $subsection "html.forms.forms" }
-{ $subsection "html.forms.values" } ;
+{ $subsections
+ "html.forms.forms"
+ "html.forms.values"
+} ;
ABOUT: "html.forms"
: simple-link ( xml url -- xml' )
url-encode swap [XML <a href=<->><-></a> XML] ;
+
+: simple-image ( url -- xml )
+ url-encode [XML <img src=<-> /> XML] ;
\ No newline at end of file
ARTICLE: "html.streams" "HTML streams"
"The " { $vocab-link "html.streams" } " vocabulary provides a stream which implements " { $link "io.styles" } " by constructing HTML markup in the form of " { $vocab-link "xml.data" } " types."
-{ $subsection html-writer }
-{ $subsection <html-writer> }
-{ $subsection with-html-writer } ;
+{ $subsections
+ html-writer
+ <html-writer>
+ with-html-writer
+} ;
ABOUT: "html.streams"
[ H{ } [ ] with-nesting nl ] make-html-string
] unit-test
-[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
\ No newline at end of file
+[ ] [ [ { 1 2 3 } describe ] with-html-writer drop ] unit-test
+
+[ "<img src=\"/icons/class-word.tiff\"/>" ] [
+ [
+ "text"
+ { { image "vocab:definitions/icons/class-word.tiff" } }
+ format
+ ] make-html-string
+] unit-test
! Copyright (C) 2004, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel assocs io io.styles math math.order math.parser
-sequences strings make words combinators macros xml.syntax html fry
-destructors ;
+USING: accessors assocs combinators destructors fry html io
+io.backend io.pathnames io.styles kernel macros make math
+math.order math.parser namespaces sequences strings words
+splitting xml xml.syntax ;
IN: html.streams
GENERIC: url-of ( object -- url )
: emit-html ( quot stream -- )
dip data>> push ; inline
+: image-path ( path -- images-path )
+ "vocab:definitions/icons/" ?head [ "/icons/" prepend ] when ;
+
+: img-tag ( xml style -- xml )
+ image swap at [ nip image-path simple-image ] when* ;
+
: format-html-span ( string style stream -- )
- [ [ span-tag ] [ href-link-tag ] [ object-link-tag ] tri ]
- emit-html ;
+ [
+ {
+ [ span-tag ]
+ [ href-link-tag ]
+ [ object-link-tag ]
+ [ img-tag ]
+ } cleave
+ ] emit-html ;
TUPLE: html-span-stream < html-sub-stream ;
: border-css, ( border -- )
"border: 1px solid #" % hex-color, "; " % ;
-: padding-css, ( padding -- ) "padding: " % # "px; " % ;
+: padding-css, ( padding -- )
+ first2 "padding: " % # "px " % # "px; " % ;
CONSTANT: pre-css "white-space: pre; font-family: monospace;"
{
{ page-color bg-css, }
{ border-color border-css, }
- { border-width padding-css, }
+ { inset padding-css, }
} make-css
] [
wrap-margin swap at
{ $description "Compiles code which pushes an attribute value previously extracted by " { $link required-attr } " or " { $link optional-attr } " on the stack. If the attribute value begins with " { $snippet "@" } ", compiles into code which pushes the a form value." } ;
HELP: CHLOE:
-{ $syntax "name definition... ;" }
+{ $syntax "CHLOE: name definition... ;" }
{ $values { "name" "the tag name" } { "definition" { $quotation "( tag -- )" } } }
{ $description "Defines compilation semantics for the Chloe tag named " { $snippet "tag" } ". The definition body receives a " { $link tag } " on the stack." } ;
" ..."
"</t:chloe>"
}
-{ $subsection "html.templates.chloe.tags.component" }
-{ $subsection "html.templates.chloe.tags.boilerplate" }
-{ $subsection "html.templates.chloe.tags.control" }
-{ $subsection "html.templates.chloe.tags.form" } ;
+{ $subsections
+ "html.templates.chloe.tags.component"
+ "html.templates.chloe.tags.boilerplate"
+ "html.templates.chloe.tags.control"
+ "html.templates.chloe.tags.form"
+} ;
ARTICLE: "html.templates.chloe.extend" "Extending Chloe"
"The " { $vocab-link "html.templates.chloe.syntax" } " and " { $vocab-link "html.templates.chloe.compiler" } " vocabularies contain the heart of the Chloe implementation."
"Chloe is implemented as a compiler which converts XML templates into Factor quotations. The template only has to be parsed and compiled once, and not on every HTTP request. This helps improve performance and memory usage."
$nl
"These vocabularies provide various hooks by which Chloe can be extended. First of all, new " { $link "html.components" } " can be wired in. If further flexibility is needed, entirely new tags can be defined by hooking into the Chloe compiler."
-{ $subsection "html.templates.chloe.extend.components" }
-{ $subsection "html.templates.chloe.extend.tags" } ;
+{ $subsections
+ "html.templates.chloe.extend.components"
+ "html.templates.chloe.extend.tags"
+} ;
ARTICLE: "html.templates.chloe.extend.tags" "Extending Chloe with custom tags"
"Syntax for defining custom tags:"
-{ $subsection POSTPONE: CHLOE: }
+{ $subsections POSTPONE: CHLOE: }
"A number of compiler words can be used from the " { $link POSTPONE: CHLOE: } " body to emit compiled template code."
$nl
"Extracting attributes from the XML tag:"
-{ $subsection required-attr }
-{ $subsection optional-attr }
-{ $subsection compile-attr }
+{ $subsections
+ required-attr
+ optional-attr
+ compile-attr
+}
"Examining tag nesting:"
-{ $subsection tag-stack }
+{ $subsections tag-stack }
"Generating code for printing strings and calling quotations:"
-{ $subsection [write] }
-{ $subsection [code] }
+{ $subsections
+ [write]
+ [code]
+}
"Generating code from child elements:"
-{ $subsection process-children }
-{ $subsection compile-children>string }
-{ $subsection compile-with-scope }
+{ $subsections
+ process-children
+ compile-children>string
+ compile-with-scope
+}
"Examples which illustrate some of the above:"
-{ $subsection "html.templates.chloe.extend.tags.example" } ;
+{ $subsections "html.templates.chloe.extend.tags.example" } ;
ARTICLE: "html.templates.chloe.extend.tags.example" "Examples of custom Chloe tags"
"As a first example, let's develop a custom Chloe tag which simply renders a random number. The tag will be used as follows:"
ARTICLE: "html.templates.chloe.extend.components" "Extending Chloe with custom components"
"Custom HTML components implementing the " { $link render* } " word can be wired up with Chloe using the following syntax from " { $vocab-link "html.templates.chloe.components" } ":"
-{ $subsection POSTPONE: COMPONENT: }
-{ $subsection "html.templates.chloe.extend.components.example" } ;
+{ $subsections
+ POSTPONE: COMPONENT:
+ "html.templates.chloe.extend.components.example"
+} ;
ARTICLE: "html.templates.chloe" "Chloe templates"
"The " { $vocab-link "html.templates.chloe" } " vocabulary implements an XHTML templating engine. Unlike " { $vocab-link "html.templates.fhtml" } ", Chloe templates are always well-formed XML, and no Factor code can be embedded in them, enforcing proper separation of concerns. Chloe templates can be edited using standard XML editing tools; they are less flexible than FHTML, but often simpler as a result."
-{ $subsection <chloe> }
-{ $subsection reset-cache }
-{ $subsection "html.templates.chloe.tags" }
-{ $subsection "html.templates.chloe.extend" } ;
+{ $subsections
+ <chloe>
+ reset-cache
+ "html.templates.chloe.tags"
+ "html.templates.chloe.extend"
+} ;
ABOUT: "html.templates.chloe"
"FHTML provides an alternative to " { $vocab-link "html.templates.chloe" } " for situations where complex logic must be embedded in the presentation layer of a web application. While this is discouraged for larger applications, it is useful for prototyping as well as simpler applications."
$nl
"The entire syntax of an FHTML template can be summarized as thus: text outside of " { $snippet "<%" } " and " { $snippet "%>" } " is rendered literally. Text inside " { $snippet "<%" } " and " { $snippet "%>" } " is interpreted as Factor source code."
-{ $subsection <fhtml> } ;
+{ $subsections <fhtml> } ;
ABOUT: "html.templates.fhtml"
USING: io io.files io.streams.string io.encodings.utf8
-html.templates html.templates.fhtml kernel multiline
+html.templates html.templates.fhtml kernel
tools.test sequences parser splitting prettyprint ;
IN: html.templates.fhtml.tests
[
[ ] [
- <"
- <%
+ """<%
IN: html.templates.fhtml.tests
: test-word ( -- ) ;
- %>
- "> parse-template drop
+ %>""" parse-template drop
] unit-test
] with-file-vocabs
"The following words define the interface between a templating engine and the " { $vocab-link "furnace.boilerplate" } " vocabulary."
$nl
"The master/child template interface follows a pattern where for each concept there is a word called by the child to store an entity, and another word to write the entity out; this solves the problem where certain HTML tags, such as " { $snippet "<title>" } " and " { $snippet "<link>" } " must appear inside the " { $snippet "<head>" } " tag, even though those tags are usually precisely those that the child template will want to set."
-{ $subsection set-title }
-{ $subsection write-title }
-{ $subsection add-style }
-{ $subsection write-style }
-{ $subsection add-atom-feed }
-{ $subsection write-atom-feeds }
+{ $subsections
+ set-title
+ write-title
+ add-style
+ write-style
+ add-atom-feed
+ write-atom-feeds
+}
"Processing a master template with a child:"
-{ $subsection with-boilerplate }
-{ $subsection call-next-template } ;
+{ $subsections
+ with-boilerplate
+ call-next-template
+} ;
ARTICLE: "html.templates" "HTML template interface"
"The " { $vocab-link "html.templates" } " vocabulary implements an abstract interface to HTML templating engines. The " { $vocab-link "html.templates.fhtml" } " and " { $vocab-link "html.templates.chloe" } " vocabularies are two implementations of this."
$nl
"An HTML template is an instance of a mixin:"
-{ $subsection template }
+{ $subsections template }
"HTML templates must also implement a method on a generic word:"
-{ $subsection call-template* }
+{ $subsections call-template* }
"Calling an HTML template:"
-{ $subsection call-template }
+{ $subsections call-template }
"Usually HTML templates are invoked dynamically by the Furnace web framework and HTTP server. They can also be used in static HTML generation tools:"
-{ $subsection template-convert }
-{ $subsection "html.templates.boilerplate" } ;
+{ $subsections
+ template-convert
+ "html.templates.boilerplate"
+} ;
ABOUT: "html.templates"
ARTICLE: "http.client.get" "GET requests with the HTTP client"
"Basic usage involves passing a " { $link url } " and getting a " { $link response } " and data back:"
-{ $subsection http-get }
+{ $subsections http-get }
"Utilities to retrieve a " { $link url } " and save the contents to a file:"
-{ $subsection download }
-{ $subsection download-to }
+{ $subsections
+ download
+ download-to
+}
"Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:"
-{ $subsection <get-request> }
-{ $subsection http-request }
+{ $subsections
+ <get-request>
+ http-request
+}
"The " { $link http-get } " and " { $link http-request } " words output sequences. This is undesirable if the response data may be large. Another pair of words take a quotation instead, and pass the quotation chunks of data incrementally:"
-{ $subsection with-http-get }
-{ $subsection with-http-request } ;
+{ $subsections
+ with-http-get
+ with-http-request
+} ;
ARTICLE: "http.client.post-data" "HTTP client post data"
"HTTP POST and PUT request words take a post data parameter, which can be one of the following:"
"[ URL\" http://www.my-company.com/web-service\" http-post ] with-disposal"
}
"An internal word used to convert objects to " { $link post-data } " instances:"
-{ $subsection >post-data } ;
+{ $subsections >post-data } ;
ARTICLE: "http.client.post" "POST requests with the HTTP client"
"Basic usage involves passing post data and a " { $link url } ", and getting a " { $link response } " and data back:"
-{ $subsection http-post }
+{ $subsections http-post }
"Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:"
-{ $subsection <post-request> }
+{ $subsection
s <post-request> }
"Both words take a post data parameter; see " { $link "http.client.post-data" } "." ;
ARTICLE: "http.client.put" "PUT requests with the HTTP client"
"Basic usage involves passing post data and a " { $link url } ", and getting a " { $link response } " and data back:"
-{ $subsection http-post }
+{ $subsections http-post }
"Advanced usage involves constructing a " { $link request } ", which allows " { $link "http.cookies" } " and " { $link "http.headers" } " to be set:"
-{ $subsection <post-request> }
+{ $subsection
s <post-request> }
"Both words take a post data parameter; see " { $link "http.client.post-data" } "." ;
ARTICLE: "http.client.encoding" "Character encodings and the HTTP client"
ARTICLE: "http.client.errors" "HTTP client errors"
"HTTP operations may fail for one of two reasons. The first is an I/O error resulting from a network problem; a name server lookup failure, or a refused connection. The second is a protocol-level error returned by the server. There are two such errors:"
-{ $subsection download-failed }
-{ $subsection too-many-redirects } ;
+{ $subsections
+ download-failed
+ too-many-redirects
+} ;
ARTICLE: "http.client" "HTTP client"
"The " { $vocab-link "http.client" } " vocabulary implements an HTTP and HTTPS client on top of " { $link "http" } "."
"For HTTPS support, you must load the " { $vocab-link "urls.secure" } " vocab first. If you don't need HTTPS support, don't load " { $vocab-link "urls.secure" } "; this will reduce the size of images generated by " { $vocab-link "tools.deploy" } "."
$nl
"There are two primary usage patterns, data retrieval with GET requests and form submission with POST requests:"
-{ $subsection "http.client.get" }
-{ $subsection "http.client.post" }
-{ $subsection "http.client.put" }
+{ $subsections
+ "http.client.get"
+ "http.client.post"
+ "http.client.put"
+}
"Submission data for POST and PUT requests:"
-{ $subsection "http.client.post-data" }
+{ $subsections "http.client.post-data" }
"More esoteric use-cases, for example HTTP methods other than the above, are accomodated by constructing an empty request object with " { $link <request> } " and filling everything in by hand."
-{ $subsection "http.client.encoding" }
-{ $subsection "http.client.errors" }
+{ $subsections
+ "http.client.encoding"
+ "http.client.errors"
+}
{ $see-also "urls" } ;
ABOUT: "http.client"
"The " { $vocab-link "furnace.sessions" } " vocabulary implements session management using cookies, thus the most common use case can be taken care of without working with cookies directly."
$nl
"The class of cookies:"
-{ $subsection cookie }
+{ $subsections cookie }
"Creating cookies:"
-{ $subsection <cookie> }
+{ $subsections <cookie> }
"Getting, adding, and deleting cookies in " { $link request } " and " { $link response } " objects:"
-{ $subsection get-cookie }
-{ $subsection put-cookie }
-{ $subsection delete-cookie } ;
+{ $subsections
+ get-cookie
+ put-cookie
+ delete-cookie
+} ;
ARTICLE: "http.headers" "HTTP headers"
"Every " { $link request } " and " { $link response } " has a set of HTTP headers stored in the " { $slot "header" } " slot. Header names are normalized to lower-case when a request or response is being parsed."
-{ $subsection header }
-{ $subsection set-header } ;
+{ $subsections
+ header
+ set-header
+} ;
ARTICLE: "http.post-data" "HTTP post data"
"Every " { $link request } " where the " { $slot "method" } " slot is " { $snippet "POST" } " can contain post data."
-{ $subsection post-data }
-{ $subsection <post-data> } ;
+{ $subsections
+ post-data
+ <post-data>
+} ;
ARTICLE: "http.requests" "HTTP requests"
"HTTP requests:"
-{ $subsection request }
-{ $subsection <request> }
+{ $subsections
+ request
+ <request>
+}
"Requests can contain form submissions:"
-{ $subsection "http.post-data" } ;
+{ $subsections "http.post-data" } ;
ARTICLE: "http.responses" "HTTP responses"
"HTTP responses:"
-{ $subsection response }
-{ $subsection <response> }
+{ $subsections
+ response
+ <response>
+}
"Raw responses only contain a status line, with no header. They are used by webapps which need full control over the HTTP response, for example " { $vocab-link "http.server.cgi" } ":"
-{ $subsection raw-response }
-{ $subsection <raw-response> } ;
+{ $subsections
+ raw-response
+ <raw-response>
+} ;
ARTICLE: "http" "HTTP protocol objects"
"The " { $vocab-link "http" } " vocabulary contains data types shared by " { $vocab-link "http.client" } " and " { $vocab-link "http.server" } "."
$nl
"The HTTP client sends an HTTP request to the server and receives an HTTP response back. The HTTP server receives HTTP requests from clients and sends HTTP responses back."
-{ $subsection "http.requests" }
-{ $subsection "http.responses" }
+{ $subsections
+ "http.requests"
+ "http.responses"
+}
"Both requests and responses support some common functionality:"
-{ $subsection "http.headers" }
-{ $subsection "http.cookies" }
+{ $subsections
+ "http.headers"
+ "http.cookies"
+}
{ $see-also "urls" } ;
ABOUT: "http"
-USING: help.markup help.syntax http.server.static multiline ;
+USING: help.markup help.syntax http.server.static ;
IN: http.server.cgi
HELP: enable-cgi
{ $description "Enables the responder to serve " { $snippet ".cgi" } " scripts by executing them as per the CGI specification." }
{ $examples
{ $code
- <" <dispatcher>
- "/var/www/cgi/" <static> enable-cgi "cgi-bin" add-responder" ">
+ """<dispatcher>
+ "/var/www/cgi/" <static> enable-cgi "cgi-bin" add-responder"""
}
}
{ $side-effects "responder" } ;
ARTICLE: "http.server.cgi" "Serving CGI scripts"
"The " { $vocab-link "http.server.cgi" } " implements CGI support. It is used in conjunction with a " { $link <static> } " responder."
-{ $subsection enable-cgi } ;
+{ $subsections enable-cgi } ;
-! Copyright (C) 2008 Your name.
+! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: classes help.markup help.syntax io.streams.string
-multiline ;
+USING: classes help.markup help.syntax io.streams.string ;
IN: http.server.dispatchers
HELP: new-dispatcher
ARTICLE: "http.server.dispatchers.example" "HTTP dispatcher examples"
{ $heading "Simple pathname dispatcher" }
{ $code
- <" <dispatcher>
+ """<dispatcher>
<new-action> "new" add-responder
<edit-action> "edit" add-responder
<delete-action> "delete" add-responder
<list-action> "" add-responder
-main-responder set-global">
+main-responder set-global"""
}
"In the above example, visiting any URL other than " { $snippet "/new" } ", " { $snippet "/edit" } ", " { $snippet "/delete" } ", or " { $snippet "/" } " will result in a 404 error."
{ $heading "Another pathname dispatcher" }
"On the other hand, suppose we wanted to route all unrecognized paths to a “view” action:"
{ $code
- <" <dispatcher>
+ """<dispatcher>
<new-action> "new" add-responder
<edit-action> "edit" add-responder
<delete-action> "delete" add-responder
<view-action> >>default
-main-responder set-global">
+main-responder set-global"""
}
"The " { $slot "default" } " slot holds a responder to which all unrecognized paths are sent to."
{ $heading "Dispatcher subclassing example" }
{ $code
- <" TUPLE: golf-courses < dispatcher ;
+ """TUPLE: golf-courses < dispatcher ;
: <golf-courses> ( -- golf-courses )
golf-courses new-dispatcher ;
<edit-action> "edit" add-responder
<delete-action> "delete" add-responder
<list-action> "" add-responder
-main-responder set-global">
+main-responder set-global"""
}
"The action templates can now emit links to responder-relative URLs prefixed by " { $snippet "$golf-courses/" } "."
{ $heading "Virtual hosting example" }
{ $code
- <" <vhost-dispatcher>
+ """<vhost-dispatcher>
<casino> "concatenative-casino.com" add-responder
<dating> "raptor-dating.com" add-responder
-main-responder set-global">
+main-responder set-global"""
}
"Note that the virtual host dispatcher strips off a " { $snippet "www." } " prefix, so " { $snippet "www.concatenative-casino.com" } " would be routed to the " { $snippet "<casino>" } " responder instead of receiving a 404." ;
ARTICLE: "http.server.dispatchers" "HTTP dispatchers and virtual hosting"
"The " { $vocab-link "http.server.dispatchers" } " vocabulary implements two responders which route HTTP requests to one or more child responders."
-{ $subsection "http.server.dispatchers.example" }
+{ $subsections "http.server.dispatchers.example" }
"Pathname dispatchers implement a directory hierarchy where each subdirectory is its own responder:"
-{ $subsection dispatcher }
-{ $subsection <dispatcher> }
+{ $subsections
+ dispatcher
+ <dispatcher>
+}
"Virtual host dispatchers dispatch each virtual host to a different responder:"
-{ $subsection vhost-dispatcher }
-{ $subsection <vhost-dispatcher> }
+{ $subsections
+ vhost-dispatcher
+ <vhost-dispatcher>
+}
"Adding responders to dispatchers:"
-{ $subsection add-responder }
+{ $subsections add-responder }
"The " { $slot "default" } " slot holds a responder which receives all unrecognized URLs. By default, it responds with 404 messages." ;
ABOUT: "http.server.dispatchers"
ARTICLE: "http.server.filters" "HTTP responder filters"
"The " { $vocab-link "http.server.filters" } " vocabulary implements the common pattern where one responder wraps another, doing some processing before calling the wrapped responder."
-{ $subsection filter-responder }
+{ $subsections filter-responder }
"To use it, simply subclass " { $link filter-responder } ", and call " { $link POSTPONE: call-next-method } " from your " { $link call-responder* } " method to pass control to the wrapped responder." ;
ABOUT: "http.server.filters"
ARTICLE: "http.server.redirection" "HTTP responder redirection"
"The " { $vocab-link "http.server.redirection" } " defines some " { $link response } " types which redirect the user's client to a new page."
-{ $subsection <permanent-redirect> }
-{ $subsection <temporary-redirect> }
+{ $subsections
+ <permanent-redirect>
+ <temporary-redirect>
+}
"A utility used by the above:"
-{ $subsection relative-to-request }
+{ $subsections relative-to-request }
"The " { $vocab-link "furnace.redirection" } " vocabulary provides a higher-level implementation of this. The " { $vocab-link "furnace.conversations" } " vocabulary allows state to be maintained between redirects." ;
ABOUT: "http.server.redirection"
"However, the HTTP server is unaware of the forwarding, and still believes that it is listening on port 8080 and 8443, respectively. This can be a problem if a responder wishes to redirect the user to a secure page; they will be sent to port 8443 and not 443 as one would expect."
$nl
"The " { $vocab-link "http.server.remapping" } " vocabulary defines a variable which may store an assoc of port mappings:"
-{ $subsection port-remapping }
+{ $subsections port-remapping }
"For example, with the above setup, we would set it as follows:"
{ $code
"{ { 8080 80 } { 8443 443 } } port-remapping set-global"
ARTICLE: "http.server.responses" "Canned HTTP responses"
"The " { $vocab-link "http.server.responses" } " vocabulary provides constructors for a few useful " { $link response } " objects."
-{ $subsection <content> }
-{ $subsection <304> }
-{ $subsection <403> }
-{ $subsection <400> }
-{ $subsection <404> }
+{ $subsections
+ <content>
+ <304>
+ <403>
+ <400>
+ <404>
+}
"New error responses like the above can be created for other error codes too:"
-{ $subsection <trivial-response> } ;
+{ $subsections <trivial-response> } ;
ABOUT: "http.server.responses"
ARTICLE: "http.server.rewrite" "URL rewrite responders"
"The " { $vocab-link "http.server.rewrite" } " vocabulary defines two responder types which can help make website URLs more human-friendly."
-{ $subsection "http.server.rewrite.overview" }
+{ $subsections "http.server.rewrite.overview" }
"Directory rewrite responders:"
-{ $subsection rewrite }
-{ $subsection <rewrite> }
+{ $subsections
+ rewrite
+ <rewrite>
+}
"Virtual host rewrite responders -- these chop off the value in the " { $snippet "suffix" } " slot from the tail of the host name, and use the rest as the parameter value:"
-{ $subsection vhost-rewrite }
-{ $subsection <vhost-rewrite> } ;
+{ $subsections
+ vhost-rewrite
+ <vhost-rewrite>
+} ;
ABOUT: "http.server.rewrite"
\ No newline at end of file
ARTICLE: "http.server.requests" "HTTP request variables"
"The following variables are set by the HTTP server at the beginning of a request."
-{ $subsection request }
-{ $subsection url }
-{ $subsection post-request? }
-{ $subsection responder-nesting }
-{ $subsection params }
+{ $subsections
+ request
+ url
+ post-request?
+ responder-nesting
+ params
+}
"Utility words:"
-{ $subsection param }
-{ $subsection set-param }
-{ $subsection request-params }
+{ $subsections
+ param
+ set-param
+ request-params
+}
"Additional vocabularies may be set by vocabularies such as " { $vocab-link "html.forms" } " and " { $vocab-link "furnace.sessions" } "." ;
ARTICLE: "http.server.responders" "HTTP server responders"
"The HTTP server dispatches requests to a main responder:"
-{ $subsection main-responder }
+{ $subsections main-responder }
"The main responder may in turn dispatch it a subordinate dispatcher, and so on."
$nl
"Responders process requests and output " { $link "http.responses" } "; concretely are instances of classes which implement a generic word:"
-{ $subsection call-responder* }
+{ $subsections call-responder* }
"To actually call a subordinate responder, use the following word instead:"
-{ $subsection call-responder }
+{ $subsections call-responder }
"A simple implementation of a responder which always outputs the same response:"
-{ $subsection trivial-responder }
-{ $subsection <trivial-responder> }
+{ $subsections
+ trivial-responder
+ <trivial-responder>
+}
{ $vocab-subsection "Furnace actions" "furnace.actions" }
"In particular, writing new responders by hand is rarely necessary, because in most cases it is easier to use " { $vocab-link "furnace.actions" } " instead." ;
ARTICLE: "http.server.variables" "HTTP server variables"
"The following global variables control the behavior of the HTTP server. Both are off by default."
-{ $subsection development? }
-{ $subsection benchmark? } ;
+{ $subsections
+ development?
+ benchmark?
+} ;
ARTICLE: "http.server" "HTTP server"
"The " { $vocab-link "http.server" } " vocabulary implements an HTTP and HTTPS server on top of " { $vocab-link "io.servers.connection" } "."
-{ $subsection "http.server.responders" }
-{ $subsection "http.server.requests" }
+{ $subsections
+ "http.server.responders"
+ "http.server.requests"
+}
"Various types of responders are defined in other vocabularies:"
-{ $subsection "http.server.dispatchers" }
-{ $subsection "http.server.filters" }
+{ $subsections
+ "http.server.dispatchers"
+ "http.server.filters"
+}
"Useful canned responses:"
-{ $subsection "http.server.responses" }
-{ $subsection "http.server.redirection" }
+{ $subsections
+ "http.server.responses"
+ "http.server.redirection"
+}
"Configuration:"
-{ $subsection "http.server.variables" }
-{ $subsection "http.server.remapping" }
+{ $subsections
+ "http.server.variables"
+ "http.server.remapping"
+}
"Features:"
-{ $subsection "http.server.static" }
-{ $subsection "http.server.cgi" }
+{ $subsections
+ "http.server.static"
+ "http.server.cgi"
+}
"The " { $vocab-link "furnace" } " framework implements high-level abstractions which make developing web applications much easier than writing responders by hand." ;
ABOUT: "http.server"
"The static responder can be extended for dynamic content by associating quotations with MIME types in the hashtable stored in the " { $slot "special" } " slot. The quotations have stack effect " { $snippet "( path -- response )" } "."
$nl
"A utility word uses the above feature to enable server-side " { $snippet ".fhtml" } " scripts, allowing a development style much like PHP:"
-{ $subsection enable-fhtml }
+{ $subsections enable-fhtml }
"This feature is also used by " { $vocab-link "http.server.cgi" } " to run " { $snippet ".cgi" } " files."
$nl
"It is also possible to override the hook used when serving static files to the client:"
-{ $subsection <file-responder> }
+{ $subsections <file-responder> }
"The default just sends the file's contents with the request; " { $vocab-link "xmode.code2html.responder" } " provides an alternate hook which sends a syntax-highlighted version of the file." ;
ARTICLE: "http.server.static" "Serving static content"
"The " { $vocab-link "http.server.static" } " vocabulary implements a responder for serving static files."
-{ $subsection <static> }
+{ $subsections <static> }
"The static responder does not serve directory listings by default, as a security measure. Directory listings can be enabled by storing a true value in the " { $slot "allow-listings" } " slot."
$nl
"If all you want to do is serve files from a directory, the following phrase does the trick:"
"\"/var/www/mysite.com/\" <static> main-responder set"
"8080 httpd"
}
-{ $subsection "http.server.static.extend" } ;
+{ $subsections "http.server.static.extend" } ;
ABOUT: "http.server.static"
literals sequences checksums.md5 checksums ;
IN: images.bitmap.tests
-CONSTANT: test-bitmap24 "vocab:images/test-images/thiswayup24.bmp"
+CONSTANT: test-bitmap24 "vocab:images/testing/bmp/thiswayup24.bmp"
-CONSTANT: test-bitmap8 "vocab:images/test-images/rgb8bit.bmp"
+CONSTANT: test-bitmap8 "vocab:images/testing/bmp/rgb8bit.bmp"
-CONSTANT: test-bitmap4 "vocab:images/test-images/rgb4bit.bmp"
+CONSTANT: test-bitmap4 "vocab:images/testing/bmp/rgb4bit.bmp"
-CONSTANT: test-bitmap1 "vocab:images/test-images/1bit.bmp"
+CONSTANT: test-bitmap1 "vocab:images/testing/bmp/1bit.bmp"
-CONSTANT: test-40 "vocab:images/test-images/40red24bit.bmp"
-CONSTANT: test-41 "vocab:images/test-images/41red24bit.bmp"
-CONSTANT: test-42 "vocab:images/test-images/42red24bit.bmp"
-CONSTANT: test-43 "vocab:images/test-images/43red24bit.bmp"
+CONSTANT: test-40 "vocab:images/testing/bmp/40red24bit.bmp"
+CONSTANT: test-41 "vocab:images/testing/bmp/41red24bit.bmp"
+CONSTANT: test-42 "vocab:images/testing/bmp/42red24bit.bmp"
+CONSTANT: test-43 "vocab:images/testing/bmp/43red24bit.bmp"
${
test-bitmap8
images.bitmap.loading images.loader io io.binary
io.encodings.binary io.encodings.string io.files
io.streams.limited kernel locals macros math math.bitwise
-math.functions namespaces sequences specialized-arrays.uint
-specialized-arrays.ushort strings summary ;
+math.functions namespaces sequences specialized-arrays
+strings summary ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ushort
IN: images.bitmap
: write2 ( n -- ) 2 >le write ;
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays combinators
+USING: accessors alien.c-types arrays byte-arrays combinators
compression.run-length fry grouping images images.loader io
io.binary io.encodings.8-bit io.encodings.binary
io.encodings.string io.streams.limited kernel math math.bitwise
-sequences specialized-arrays.ushort summary ;
+sequences specialized-arrays summary ;
QUALIFIED-WITH: bitstreams b
+SPECIALIZED-ARRAY: ushort
IN: images.bitmap.loading
SINGLETON: bitmap-image
+++ /dev/null
-Doug Coleman
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: http.client images.loader images.loader.private kernel ;
-IN: images.http
-
-: load-http-image ( path -- image )
- [ http-get nip ] [ image-class new ] bi load-image* ;
QUALIFIED-WITH: bitstreams bs
-TUPLE: jpeg-image < image
+SINGLETON: jpeg-image
+
+TUPLE: loading-jpeg < image
{ headers }
{ bitstream }
{ color-info initial: { f f f f } }
<PRIVATE
-: <jpeg-image> ( headers bitstream -- image )
- jpeg-image new swap >>bitstream swap >>headers ;
+: <loading-jpeg> ( headers bitstream -- image )
+ loading-jpeg new swap >>bitstream swap >>headers ;
SINGLETONS: SOF DHT DAC RST SOI EOI SOS DQT DNL DRI DHP EXP
APP JPG COM TEM RES ;
ERROR: not-a-jpeg-image ;
-PRIVATE>
-
-M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
- drop [
- parse-marker { SOI } = [ not-a-jpeg-image ] unless
- parse-headers
- contents <jpeg-image>
- ] with-input-stream
+: loading-jpeg>image ( loading-jpeg -- image )
dup jpeg-image [
baseline-parse
baseline-decompress
] with-variable ;
+
+: load-jpeg ( stream -- loading-jpeg )
+ [
+ parse-marker { SOI } = [ not-a-jpeg-image ] unless
+ parse-headers
+ unlimited-input contents <loading-jpeg>
+ ] with-input-stream ;
+
+PRIVATE>
+
+M: jpeg-image stream>image ( stream jpeg-image -- bitmap )
+ drop load-jpeg loading-jpeg>image ;
! Copyright (C) 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs byte-arrays combinators images
-io.encodings.binary io.pathnames io.streams.byte-array
-io.streams.limited kernel namespaces splitting strings
-unicode.case ;
+io.encodings.binary io.files io.pathnames io.streams.byte-array
+io.streams.limited kernel namespaces sequences splitting
+strings unicode.case ;
IN: images.loader
ERROR: unknown-image-extension extension ;
PRIVATE>
+! Image Decode
+
GENERIC# load-image* 1 ( obj class -- image )
GENERIC: stream>image ( stream class -- image )
[ open-image-file ] [ image-class ] bi load-image* ;
M: byte-array load-image*
- [ binary <byte-reader> ] dip stream>image ;
+ [
+ [ binary <byte-reader> ]
+ [ length stream-throws <limited-stream> ] bi
+ ] dip stream>image ;
M: limited-stream load-image* stream>image ;
M: string load-image* [ open-image-file ] dip stream>image ;
M: pathname load-image* [ open-image-file ] dip stream>image ;
+
+! Image Encode
+
+GENERIC: image>stream ( image class -- )
+
+: save-graphic-image ( image path -- )
+ [ image-class ] [ ] bi
+ binary [ image>stream ] with-file-writer ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types destructors fry images kernel
-libc math sequences ;
+USING: accessors alien.c-types alien.data destructors fry images
+kernel libc math sequences ;
IN: images.memory
! Some code shared by core-graphics and cairo for constructing
: make-memory-bitmap ( dim quot -- image )
'[
[ malloc-bitmap-data ] keep _ [ <bitmap-image> ] 2bi
- ] with-destructors ; inline
\ No newline at end of file
+ ] with-destructors ; inline
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test images.png ;
+USING: images.png images.testing namespaces tools.test
+images.pam ;
IN: images.png.tests
-: png-test-path ( -- path )
- "vocab:images/test-images/rgb.png" ;
\ No newline at end of file
+"vocab:images/testing/png/rgb.png" decode-test
+"vocab:images/testing/png/yin_yang.png" decode-test
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors images io io.binary io.encodings.ascii
-io.encodings.binary io.encodings.string io.files io.files.info kernel
-sequences io.streams.limited fry combinators arrays math checksums
-checksums.crc32 compression.inflate grouping byte-arrays images.loader ;
+USING: accessors arrays checksums checksums.crc32 combinators
+compression.inflate fry grouping images images.loader io
+io.binary io.encodings.ascii io.encodings.string kernel locals
+math math.bitwise math.ranges sequences sorting ;
IN: images.png
SINGLETON: png-image
width height bit-depth color-type compression-method
filter-method interlace-method uncompressed ;
+CONSTANT: filter-none 0
+CONSTANT: filter-sub 1
+CONSTANT: filter-up 2
+CONSTANT: filter-average 3
+CONSTANT: filter-paeth 4
+
+CONSTANT: greyscale 0
+CONSTANT: truecolor 2
+CONSTANT: indexed-color 3
+CONSTANT: greyscale-alpha 4
+CONSTANT: truecolor-alpha 6
+
: <loading-png> ( -- image )
loading-png new
V{ } clone >>chunks ;
chunks>> [ type>> "IDAT" = ] filter
[ data>> ] map concat ;
-
-: zlib-data ( loading-png -- bytes )
- chunks>> [ type>> "IDAT" = ] find nip data>> ;
-
ERROR: unknown-color-type n ;
ERROR: unimplemented-color-type image ;
: inflate-data ( loading-png -- bytes )
- zlib-data zlib-inflate ;
+ find-compressed-bytes zlib-inflate ;
-: decode-greyscale ( loading-png -- loading-png )
- unimplemented-color-type ;
+: scale-bit-depth ( loading-png -- n ) bit-depth>> 8 / ; inline
+
+: png-bytes-per-pixel ( loading-png -- n )
+ dup color-type>> {
+ { 2 [ scale-bit-depth 3 * ] }
+ { 6 [ scale-bit-depth 4 * ] }
+ [ unknown-color-type ]
+ } case ; inline
+
+: png-group-width ( loading-png -- n )
+ ! 1 + is for the filter type, 1 byte preceding each line
+ [ png-bytes-per-pixel ] [ width>> ] bi * 1 + ;
+
+:: paeth ( a b c -- p )
+ a b + c - { a b c } [ [ - abs ] keep 2array ] with map
+ sort-keys first second ;
+
+:: png-unfilter-line ( width prev curr filter -- curr' )
+ prev :> c
+ prev width tail-slice :> b
+ curr :> a
+ curr width tail-slice :> x
+ x length [0,b)
+ filter {
+ { filter-none [ drop ] }
+ { filter-sub [ [| n | n x nth n a nth + 256 wrap n x set-nth ] each ] }
+ { filter-up [ [| n | n x nth n b nth + 256 wrap n x set-nth ] each ] }
+ { filter-average [ [| n | n x nth n a nth n b nth + 2/ + 256 wrap n x set-nth ] each ] }
+ { filter-paeth [ [| n | n x nth n a nth n b nth n c nth paeth + 256 wrap n x set-nth ] each ] }
+ } case
+ curr width tail ;
+
+:: reverse-png-filter ( n lines -- byte-array )
+ lines dup first length 0 <array> prefix
+ [ n 1 - 0 <array> prepend ] map
+ 2 clump [
+ n swap first2 [ ] [ n 1 - swap nth ] [ [ 0 n 1 - ] dip set-nth ] tri
+ png-unfilter-line
+ ] map B{ } concat-as ;
: png-image-bytes ( loading-png -- byte-array )
- [ inflate-data ] [ width>> 3 * 1 + ] bi group
- reverse-png-filter ;
+ [ png-bytes-per-pixel ]
+ [ inflate-data ]
+ [ png-group-width ] tri group reverse-png-filter ;
-: decode-truecolor ( loading-png -- loading-png )
- [ <image> ] dip {
+: loading-png>image ( loading-png -- image )
+ [ image new ] dip {
[ png-image-bytes >>bitmap ]
[ [ width>> ] [ height>> ] bi 2array >>dim ]
- [ drop RGB >>component-order ubyte-components >>component-type ]
+ [ drop ubyte-components >>component-type ]
} cleave ;
+
+: decode-greyscale ( loading-png -- image )
+ unimplemented-color-type ;
+
+: decode-truecolor ( loading-png -- image )
+ loading-png>image RGB >>component-order ;
-: decode-indexed-color ( loading-png -- loading-png )
+: decode-indexed-color ( loading-png -- image )
unimplemented-color-type ;
-: decode-greyscale-alpha ( loading-png -- loading-png )
+: decode-greyscale-alpha ( loading-png -- image )
unimplemented-color-type ;
-: decode-truecolor-alpha ( loading-png -- loading-png )
- [ <image> ] dip {
- [ png-image-bytes >>bitmap ]
- [ [ width>> ] [ height>> ] bi 2array >>dim ]
- [ drop RGBA >>component-order ubyte-components >>component-type ]
- } cleave ;
+: decode-truecolor-alpha ( loading-png -- image )
+ loading-png>image RGBA >>component-order ;
+
+ERROR: invalid-color-type/bit-depth loading-png ;
+
+: validate-bit-depth ( loading-png seq -- loading-png )
+ [ dup bit-depth>> ] dip member?
+ [ invalid-color-type/bit-depth ] unless ;
+
+: validate-greyscale ( loading-png -- loading-png )
+ { 1 2 4 8 16 } validate-bit-depth ;
+
+: validate-truecolor ( loading-png -- loading-png )
+ { 8 16 } validate-bit-depth ;
-: decode-png ( loading-png -- loading-png )
+: validate-indexed-color ( loading-png -- loading-png )
+ { 1 2 4 8 } validate-bit-depth ;
+
+: validate-greyscale-alpha ( loading-png -- loading-png )
+ { 8 16 } validate-bit-depth ;
+
+: validate-truecolor-alpha ( loading-png -- loading-png )
+ { 8 16 } validate-bit-depth ;
+
+: png>image ( loading-png -- image )
dup color-type>> {
- { 0 [ decode-greyscale ] }
- { 2 [ decode-truecolor ] }
- { 3 [ decode-indexed-color ] }
- { 4 [ decode-greyscale-alpha ] }
- { 6 [ decode-truecolor-alpha ] }
+ { greyscale [ validate-greyscale decode-greyscale ] }
+ { truecolor [ validate-truecolor decode-truecolor ] }
+ { indexed-color [ validate-indexed-color decode-indexed-color ] }
+ { greyscale-alpha [ validate-greyscale-alpha decode-greyscale-alpha ] }
+ { truecolor-alpha [ validate-truecolor-alpha decode-truecolor-alpha ] }
[ unknown-color-type ]
} case ;
-M: png-image stream>image
- drop [
+: load-png ( stream -- loading-png )
+ [
<loading-png>
read-png-header
read-png-chunks
parse-ihdr-chunk
- decode-png
] with-input-stream ;
+
+M: png-image stream>image
+ drop load-png png>image ;
--- /dev/null
+P7
+HEIGHT 224
+WIDTH 400
+MAXVAL 255
+DEPTH 3
+TUPLTYPE RGB
+ENDHDR
+ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0ÿ\0\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\80\0\80\80\0\80\80\0\80\80\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0\0ÿ\0ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80\0\0\80ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka.
+! See http://factorcode.org/license.txt for BSD license.
+USING: fry images.loader io io.encodings.binary io.files
+io.pathnames io.streams.byte-array kernel locals namespaces
+quotations sequences tools.test ;
+IN: images.testing
+
+:: encode-test ( path image-class -- )
+ path binary file-contents 1quotation
+ [
+ binary <byte-writer> dup [
+ path load-image image-class image>stream
+ ] with-output-stream B{ } like
+ ] unit-test ;
+
+<PRIVATE
+
+: pam-name ( path -- newpath )
+ [ parent-directory canonicalize-path ]
+ [ file-stem ".pam" append ] bi
+ append-path ;
+
+: save-as-reference-image ( path -- )
+ [ load-image ] [ pam-name ] bi save-graphic-image ;
+
+PRIVATE>
+
+: decode-test ( path -- )
+ f verbose-tests? [
+ [ load-image 1quotation ]
+ [ '[ _ pam-name load-image ] ] bi
+ unit-test
+ ] with-variable ;
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test images.tiff ;
+USING: accessors images.testing images.tiff images.viewer io
+io.encodings.binary io.files namespaces sequences tools.test
+images.pam ;
IN: images.tiff.tests
-: tiff-test-path ( -- path )
- "resource:extra/images/test-images/rgb.tiff" ;
-
-: tiff-test-path2 ( -- path )
- "resource:extra/images/test-images/octagon.tiff" ;
+"vocab:images/testing/tiff/octagon.tiff" decode-test
+"vocab:images/testing/tiff/elephants.tiff" decode-test
+"vocab:images/testing/tiff/noise.tiff" decode-test
+"vocab:images/testing/tiff/alpha.tiff" decode-test
+"vocab:images/testing/tiff/color_spectrum.tiff" decode-test
+! "vocab:images/testing/tiff/rgb.tiff" decode-test
io.binary io.encodings.ascii io.encodings.binary
io.encodings.string io.encodings.utf8 io.files kernel math
math.bitwise math.order math.parser pack prettyprint sequences
-strings math.vectors specialized-arrays.float locals
+strings math.vectors specialized-arrays locals
images.loader ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: images.tiff
SINGLETON: tiff-image
: (uncompress-strips) ( strips compression -- uncompressed-strips )
{
{ compression-none [ ] }
- { compression-lzw [ [ lzw-uncompress ] map ] }
+ { compression-lzw [ [ tiff-lzw-uncompress ] map ] }
[ unhandled-compression ]
} case ;
: process-tif-ifds ( loading-tiff -- )
ifds>> [ process-ifd ] each ;
-: load-tiff ( path -- loading-tiff )
+: load-tiff ( stream -- loading-tiff )
[ load-tiff-ifds dup ]
[
[ [ 0 seek-absolute ] dip stream-seek ]
"The inspector displays a tabular view of an object and adds navigation and editing features. Inspector words are found in the " { $vocab-link "inspector" } " vocabulary."
$nl
"Starting the inspector:"
-{ $subsection inspect }
+{ $subsections inspect }
"The inspector supports a number of commands which operate on the most recently inspected object:"
-{ $subsection &push }
-{ $subsection &back }
-{ $subsection &at }
-{ $subsection &put }
-{ $subsection &add }
-{ $subsection &rename }
-{ $subsection &delete }
+{ $subsections
+ &push
+ &back
+ &at
+ &put
+ &add
+ &rename
+ &delete
+}
"A variable holding the current object:"
-{ $subsection me }
+{ $subsections me }
"A description of an object can be printed without starting the inspector:"
-{ $subsection describe } ;
+{ $subsections describe } ;
ABOUT: "inspector"
H{ } describe
H{ } describe
-[ "fixnum instance\n\n" ] [ [ 3 describe ] with-string-writer ] unit-test
+[ "fixnum\n\n" ] [ [ 3 describe ] with-string-writer ] unit-test
[ ] [ H{ } clone inspect ] unit-test
"The " { $vocab-link "interval-maps" } " vocabulary implements a data structure, similar to assocs, where a set of closed intervals of keys are associated with values. As such, interval maps do not conform to the assoc protocol, because intervals of floats, for example, can be used, and it is impossible to get a list of keys in between."\r
$nl\r
"The following operations are used to query interval maps:"\r
-{ $subsection interval-at* }\r
-{ $subsection interval-at }\r
-{ $subsection interval-key? }\r
-{ $subsection interval-values }\r
+{ $subsections\r
+ interval-at*\r
+ interval-at\r
+ interval-key?\r
+ interval-values\r
+}\r
"Use the following to construct interval maps"\r
-{ $subsection <interval-map> }\r
-{ $subsection coalesce } ;\r
+{ $subsections\r
+ <interval-map>\r
+ coalesce\r
+} ;\r
\r
ABOUT: "interval-maps"\r
ARTICLE: { "inverse" "intro" } "Invertible quotations"
"The inverse vocab defines a way to 'undo' quotations, and builds a pattern matching framework on that basis. A quotation can be inverted by reversing it and inverting each word. To define the inverse for particular word, use"
-{ $subsection define-inverse }
-{ $subsection define-pop-inverse }
+{ $subsections
+ define-inverse
+ define-pop-inverse
+}
"To build an inverse quotation"
-{ $subsection [undo] }
+{ $subsections [undo] }
"To use the inverse quotation for pattern matching"
-{ $subsection undo }
-{ $subsection matches? }
-{ $subsection switch } ;
+{ $subsections
+ undo
+ matches?
+ switch
+} ;
IN: inverse
ABOUT: { "inverse" "intro" }
--- /dev/null
+Slava Pestov\r
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types kernel destructors bit-arrays
-sequences assocs struct-arrays math namespaces locals fry unix
-unix.linux.epoll unix.time io.ports io.backend.unix
-io.backend.unix.multiplexers ;
+USING: accessors classes.struct kernel destructors bit-arrays
+sequences assocs specialized-arrays math namespaces
+locals fry unix unix.linux.epoll unix.time io.ports
+io.backend.unix io.backend.unix.multiplexers ;
+SPECIALIZED-ARRAY: epoll-event
IN: io.backend.unix.multiplexers.epoll
TUPLE: epoll-mx < mx events ;
: <epoll-mx> ( -- mx )
epoll-mx new-mx
max-events epoll_create dup io-error >>fd
- max-events "epoll-event" <struct-array> >>events ;
+ max-events <epoll-event-array> >>events ;
M: epoll-mx dispose* fd>> close-file ;
: make-event ( fd events -- event )
- "epoll-event" <c-object>
- [ set-epoll-event-events ] keep
- [ set-epoll-event-fd ] keep ;
+ epoll-event <struct>
+ swap >>events
+ swap >>fd ;
:: do-epoll-ctl ( fd mx what events -- )
mx fd>> what fd fd events make-event epoll_ctl io-error ;
epoll_wait multiplexer-error ;
: handle-event ( event mx -- )
- [ epoll-event-fd ] dip
+ [ fd>> ] dip
[ EPOLLIN EPOLLOUT bitor do-epoll-del ]
[ input-available ] [ output-available ] 2tri ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types combinators destructors
-io.backend.unix kernel math.bitwise sequences struct-arrays unix
-unix.kqueue unix.time assocs io.backend.unix.multiplexers ;
+io.backend.unix kernel math.bitwise sequences
+specialized-arrays unix unix.kqueue unix.time assocs
+io.backend.unix.multiplexers classes.struct ;
+SPECIALIZED-ARRAY: kevent
IN: io.backend.unix.multiplexers.kqueue
TUPLE: kqueue-mx < mx events ;
-: max-events ( -- n )
- #! We read up to 256 events at a time. This is an arbitrary
- #! constant...
- 256 ; inline
+! We read up to 256 events at a time. This is an arbitrary
+! constant...
+CONSTANT: max-events 256
: <kqueue-mx> ( -- mx )
kqueue-mx new-mx
kqueue dup io-error >>fd
- max-events "kevent" <struct-array> >>events ;
+ max-events <kevent-array> >>events ;
M: kqueue-mx dispose* fd>> close-file ;
: make-kevent ( fd filter flags -- event )
- "kevent" <c-object>
- [ set-kevent-flags ] keep
- [ set-kevent-filter ] keep
- [ set-kevent-ident ] keep ;
+ \ kevent <struct>
+ swap >>flags
+ swap >>filter
+ swap >>ident ;
: register-kevent ( kevent mx -- )
fd>> swap 1 f 0 f kevent io-error ;
] dip kevent multiplexer-error ;
: handle-kevent ( mx kevent -- )
- [ kevent-ident swap ] [ kevent-filter ] bi {
+ [ ident>> swap ] [ filter>> ] bi {
{ EVFILT_READ [ input-available ] }
{ EVFILT_WRITE [ output-available ] }
} case ;
: handle-kevents ( mx n -- )
- [ dup events>> ] dip head-slice [ handle-kevent ] with each ;
+ [ dup events>> ] dip head-slice
+ [ handle-kevent ] with each ;
M: kqueue-mx wait-for-events ( us mx -- )
swap dup [ make-timespec ] when
--- /dev/null
+unportable\r
[ datagram-client delete-file ] ignore-errors
-datagram-client <local> <datagram>
-"d" set
+[ ] [ datagram-client <local> <datagram> "d" set ] unit-test
[ ] [
"hello" >byte-array
2bi
] if ;
+M: unix tell-handle ( handle -- n )
+ fd>> 0 SEEK_CUR lseek [ io-error ] [ ] bi ;
+
M: unix seek-handle ( n seek-type handle -- )
swap {
{ io:seek-absolute [ SEEK_SET ] }
io.streams.c io.streams.null libc kernel math namespaces sequences
threads windows windows.errors windows.kernel32 strings splitting
ascii system accessors locals classes.struct combinators.short-circuit ;
-QUALIFIED: windows.winsock
IN: io.backend.windows.nt
! Global variable with assoc mapping overlapped to threads
C: <io-callback> io-callback
: (make-overlapped) ( -- overlapped-ext )
- "OVERLAPPED" malloc-object &free ;
+ OVERLAPPED malloc-struct &free ;
: make-overlapped ( port -- overlapped-ext )
[ (make-overlapped) ] dip
- handle>> ptr>> [ over set-OVERLAPPED-offset ] when* ;
+ handle>> ptr>> [ >>offset ] when* ;
M: winnt FileArgs-overlapped ( port -- overlapped )
make-overlapped ;
: twiddle-thumbs ( overlapped port -- bytes-transferred )
[
drop
- [ pending-overlapped get-global set-at ] curry "I/O" suspend
+ [ >c-ptr pending-overlapped get-global set-at ] curry "I/O" suspend
{
{ [ dup integer? ] [ ] }
{ [ dup array? ] [
f <void*> [ ! overlapped
us [ 1000 /i ] [ INFINITE ] if* ! timeout
GetQueuedCompletionStatus zero?
- ] keep *void*
+ ] keep
+ *void* dup [ OVERLAPPED memory>struct ] when
] keep *int spin ;
: resume-callback ( result overlapped -- )
- pending-overlapped get-global delete-at* drop resume-with ;
+ >c-ptr pending-overlapped get-global delete-at* drop resume-with ;
: handle-overlapped ( us -- ? )
wait-for-overlapped [
M: winnt init-io ( -- )
<master-completion-port> master-completion-port set-global
- H{ } clone pending-overlapped set-global
- windows.winsock:init-winsock ;
+ H{ } clone pending-overlapped set-global ;
ERROR: invalid-file-size n ;
: set-seek-ptr ( n handle -- )
[ dup 0 < [ seek-before-start ] when ] dip (>>ptr) ;
+M: winnt tell-handle ( handle -- n ) ptr>> ;
+
M: winnt seek-handle ( n seek-type handle -- )
swap {
{ seek-absolute [ set-seek-ptr ] }
-USING: alien alien.c-types alien.syntax arrays continuations\r
-destructors generic io.mmap io.ports io.backend.windows io.files.windows\r
-kernel libc math math.bitwise namespaces quotations sequences windows\r
-windows.advapi32 windows.kernel32 io.backend system accessors\r
-io.backend.windows.privileges windows.errors ;\r
-IN: io.backend.windows.nt.privileges\r
-\r
-TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES\r
-\r
-! Security tokens\r
-! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/\r
-\r
-: (open-process-token) ( handle -- handle )\r
- { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags "PHANDLE" <c-object>\r
- [ OpenProcessToken win32-error=0/f ] keep *void* ;\r
-\r
-: open-process-token ( -- handle )\r
- #! remember to CloseHandle\r
- GetCurrentProcess (open-process-token) ;\r
-\r
-: with-process-token ( quot -- )\r
- #! quot: ( token-handle -- token-handle )\r
- [ open-process-token ] dip\r
- [ keep ] curry\r
- [ CloseHandle drop ] [ ] cleanup ; inline\r
-\r
-: lookup-privilege ( string -- luid )\r
- [ f ] dip "LUID" <c-object>\r
- [ LookupPrivilegeValue win32-error=0/f ] keep ;\r
-\r
-: make-token-privileges ( name ? -- obj )\r
- "TOKEN_PRIVILEGES" <c-object>\r
- 1 [ over set-TOKEN_PRIVILEGES-PrivilegeCount ] keep\r
- "LUID_AND_ATTRIBUTES" malloc-array &free\r
- over set-TOKEN_PRIVILEGES-Privileges\r
-\r
- swap [\r
- SE_PRIVILEGE_ENABLED over TOKEN_PRIVILEGES-Privileges\r
- set-LUID_AND_ATTRIBUTES-Attributes\r
- ] when\r
-\r
- [ lookup-privilege ] dip\r
- [\r
- TOKEN_PRIVILEGES-Privileges\r
- set-LUID_AND_ATTRIBUTES-Luid\r
- ] keep ;\r
-\r
-M: winnt set-privilege ( name ? -- )\r
- [\r
- -rot 0 -rot make-token-privileges\r
- dup length f f AdjustTokenPrivileges win32-error=0/f\r
- ] with-process-token ;\r
+USING: alien alien.c-types alien.data alien.syntax arrays continuations
+destructors generic io.mmap io.ports io.backend.windows io.files.windows
+kernel libc locals math math.bitwise namespaces quotations sequences windows
+windows.advapi32 windows.kernel32 windows.types io.backend system accessors
+io.backend.windows.privileges classes.struct windows.errors ;
+IN: io.backend.windows.nt.privileges
+
+TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
+
+! Security tokens
+! http://msdn.microsoft.com/msdnmag/issues/05/03/TokenPrivileges/
+
+: (open-process-token) ( handle -- handle )
+ { TOKEN_ADJUST_PRIVILEGES TOKEN_QUERY } flags PHANDLE <c-object>
+ [ OpenProcessToken win32-error=0/f ] keep *void* ;
+
+: open-process-token ( -- handle )
+ #! remember to CloseHandle
+ GetCurrentProcess (open-process-token) ;
+
+: with-process-token ( quot -- )
+ #! quot: ( token-handle -- token-handle )
+ [ open-process-token ] dip
+ [ keep ] curry
+ [ CloseHandle drop ] [ ] cleanup ; inline
+
+: lookup-privilege ( string -- luid )
+ [ f ] dip LUID <struct>
+ [ LookupPrivilegeValue win32-error=0/f ] keep ;
+
+:: make-token-privileges ( name enabled? -- obj )
+ TOKEN_PRIVILEGES <struct>
+ 1 >>PrivilegeCount
+ LUID_AND_ATTRIBUTES malloc-struct &free
+ enabled? [ SE_PRIVILEGE_ENABLED >>Attributes ] when
+ name lookup-privilege >>Luid
+ >>Privileges ;
+
+M: winnt set-privilege ( name ? -- )
+ [
+ -rot 0 -rot make-token-privileges
+ dup byte-length f f AdjustTokenPrivileges win32-error=0/f
+ ] with-process-token ;
USING: alien alien.c-types arrays destructors io io.backend
io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors
-windows.kernel32 windows.shell32 windows.types windows.winsock
-splitting continuations math.bitwise accessors init sets assocs
+windows.kernel32 windows.shell32 windows.types splitting
+continuations math.bitwise accessors init sets assocs
classes.struct classes ;
IN: io.backend.windows
: default-security-attributes ( -- obj )
SECURITY_ATTRIBUTES <struct>
- dup class heap-size >>nLength ;
+ SECURITY_ATTRIBUTES heap-size >>nLength ;
"Buffers are used to implement native I/O backends."
$nl
"Buffer words are found in the " { $vocab-link "io.buffers" } " vocabulary."
-{ $subsection buffer }
-{ $subsection <buffer> }
+{ $subsections
+ buffer
+ <buffer>
+}
"Buffers must be manually deallocated by calling " { $link dispose } "."
$nl
"Buffer operations:"
-{ $subsection buffer-reset }
-{ $subsection buffer-length }
-{ $subsection buffer-empty? }
-{ $subsection buffer-capacity }
-{ $subsection buffer@ }
+{ $subsections
+ buffer-reset
+ buffer-length
+ buffer-empty?
+ buffer-capacity
+ buffer@
+}
"Reading from the buffer:"
-{ $subsection buffer-peek }
-{ $subsection buffer-pop }
-{ $subsection buffer-read }
+{ $subsections
+ buffer-peek
+ buffer-pop
+ buffer-read
+}
"Writing to the buffer:"
-{ $subsection byte>buffer }
-{ $subsection >buffer }
-{ $subsection n>buffer } ;
+{ $subsections
+ byte>buffer
+ >buffer
+ n>buffer
+} ;
ABOUT: "buffers"
IN: io.buffers.tests
-USING: alien alien.c-types io.buffers kernel kernel.private libc
-sequences tools.test namespaces byte-arrays strings accessors
-destructors ;
+USING: alien alien.c-types alien.data io.buffers kernel
+kernel.private libc sequences tools.test namespaces byte-arrays
+strings accessors destructors ;
: buffer-set ( string buffer -- )
over >byte-array over ptr>> byte-array>memory
! Copyright (C) 2006, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.accessors alien.c-types
-alien.syntax kernel libc math sequences byte-arrays strings
-hints math.order destructors combinators ;
+alien.data alien.syntax kernel libc math sequences byte-arrays
+strings hints math.order destructors combinators ;
IN: io.buffers
TUPLE: buffer
ARTICLE: "current-directory" "Current working directory"
"File system I/O operations use the value of a variable to resolve relative pathnames:"
-{ $subsection current-directory }
+{ $subsections current-directory }
"This variable can be changed with a pair of words:"
-{ $subsection set-current-directory }
-{ $subsection with-directory }
+{ $subsections
+ set-current-directory
+ with-directory
+}
"This variable is independent of the operating system notion of “current working directory”. While all Factor I/O operations use the variable and not the operating system's value, care must be taken when making FFI calls which expect a pathname. The first option is to resolve relative paths:"
-{ $subsection (normalize-path) }
+{ $subsections (normalize-path) }
"The second is to change the working directory of the current process:"
-{ $subsection cd }
-{ $subsection cwd } ;
+{ $subsections
+ cd
+ cwd
+} ;
ARTICLE: "io.directories.listing" "Directory listing"
"Directory listing:"
-{ $subsection directory-entries }
-{ $subsection directory-files }
-{ $subsection with-directory-entries }
-{ $subsection with-directory-files } ;
+{ $subsections
+ directory-entries
+ directory-files
+ with-directory-entries
+ with-directory-files
+} ;
ARTICLE: "io.directories.create" "Creating directories"
-{ $subsection make-directory }
-{ $subsection make-directories } ;
+{ $subsections
+ make-directory
+ make-directories
+} ;
ARTICLE: "delete-move-copy" "Deleting, moving, and copying files"
"Operations for deleting and copying files come in two forms:"
"Since both of the above lists apply to copying files, that this means that there are a total of six variations on copying a file."
$nl
"Deleting files:"
-{ $subsection delete-file }
-{ $subsection delete-directory }
+{ $subsections
+ delete-file
+ delete-directory
+}
"Moving files:"
-{ $subsection move-file }
-{ $subsection move-file-into }
-{ $subsection move-files-into }
+{ $subsections
+ move-file
+ move-file-into
+ move-files-into
+}
"Copying files:"
-{ $subsection copy-file }
-{ $subsection copy-file-into }
-{ $subsection copy-files-into }
+{ $subsections
+ copy-file
+ copy-file-into
+ copy-files-into
+}
"On most operating systems, files can only be moved within the same file system. To move files between file systems, use " { $link copy-file } " followed by " { $link delete-file } " on the old name." ;
ARTICLE: "io.directories" "Directory manipulation"
"The " { $vocab-link "io.directories" } " vocabulary defines words for inspecting and manipulating directory trees."
-{ $subsection home }
-{ $subsection "current-directory" }
-{ $subsection "io.directories.listing" }
-{ $subsection "io.directories.create" }
-{ $subsection "delete-move-copy" }
-{ $subsection "io.directories.hierarchy" } ;
+{ $subsections
+ home
+ "current-directory"
+ "io.directories.listing"
+ "io.directories.create"
+ "delete-move-copy"
+ "io.directories.hierarchy"
+} ;
ABOUT: "io.directories"
"The " { $vocab-link "io.directories.hierarchy" } " vocabulary defines words for operating on directory hierarchies recursively."
$nl
"Deleting directory trees recursively:"
-{ $subsection delete-tree }
+{ $subsections delete-tree }
"Copying directory trees recursively:"
-{ $subsection copy-tree }
-{ $subsection copy-tree-into }
-{ $subsection copy-trees-into } ;
+{ $subsections
+ copy-tree
+ copy-tree-into
+ copy-trees-into
+} ;
ABOUT: "io.directories.hierarchy"
ARTICLE: "io.directories.search" "Searching directories"
"The " { $vocab-link "io.directories.search" } " vocabulary contains words used for recursively iterating over a directory and for finding files in a directory tree." $nl
"Traversing directories:"
-{ $subsection recursive-directory-files }
-{ $subsection recursive-directory-entries }
-{ $subsection each-file }
+{ $subsections
+ recursive-directory-files
+ recursive-directory-entries
+ each-file
+}
"Finding files by name:"
-{ $subsection find-file }
-{ $subsection find-all-files }
-{ $subsection find-in-directories }
-{ $subsection find-all-in-directories }
+{ $subsections
+ find-file
+ find-all-files
+ find-in-directories
+ find-all-in-directories
+}
"Finding files by extension:"
-{ $subsection find-by-extension }
-{ $subsection find-by-extensions } ;
+{ $subsections
+ find-by-extension
+ find-by-extensions
+} ;
ABOUT: "io.directories.search"
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types io.directories.unix kernel system unix ;
+USING: alien.c-types io.directories.unix kernel system unix
+classes.struct ;
IN: io.directories.unix.linux
-M: unix find-next-file ( DIR* -- byte-array )
- "dirent" <c-object>
+M: unix find-next-file ( DIR* -- dirent )
+ dirent <struct>
f <void*>
[ readdir64_r 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;
continuations destructors fry io io.backend io.backend.unix
io.directories io.encodings.binary io.encodings.utf8 io.files
io.pathnames io.files.types kernel math.bitwise sequences system
-unix unix.stat vocabs.loader ;
+unix unix.stat vocabs.loader classes.struct ;
IN: io.directories.unix
: touch-mode ( -- n )
HOOK: find-next-file os ( DIR* -- byte-array )
M: unix find-next-file ( DIR* -- byte-array )
- "dirent" <c-object>
+ dirent <struct>
f <void*>
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;
M: unix >directory-entry ( byte-array -- directory-entry )
{
- [ dirent-d_name underlying>> utf8 alien>string ]
- [ dirent-d_type dirent-type>file-type ]
+ [ d_name>> underlying>> utf8 alien>string ]
+ [ d_type>> dirent-type>file-type ]
} cleave directory-entry boa ;
M: unix (directory-entries) ( path -- seq )
io.pathnames io.backend io.files.windows destructors
kernel accessors calendar windows windows.errors
windows.kernel32 alien.c-types sequences splitting
-fry continuations ;
+fry continuations classes.struct ;
IN: io.directories.windows
M: windows touch-file ( path -- )
RemoveDirectory win32-error=0/f ;
: find-first-file ( path -- WIN32_FIND_DATA handle )
- "WIN32_FIND_DATA" <c-object>
+ WIN32_FIND_DATA <struct>
[ nip ] [ FindFirstFile ] 2bi
[ INVALID_HANDLE_VALUE = [ win32-error-string throw ] when ] keep ;
: find-next-file ( path -- WIN32_FIND_DATA/f )
- "WIN32_FIND_DATA" <c-object>
+ WIN32_FIND_DATA <struct>
[ nip ] [ FindNextFile ] 2bi 0 = [
GetLastError ERROR_NO_MORE_FILES = [
win32-error
TUPLE: windows-directory-entry < directory-entry attributes ;
M: windows >directory-entry ( byte-array -- directory-entry )
- [ WIN32_FIND_DATA-cFileName utf16n alien>string ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-type ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes ]
- tri
+ [ cFileName>> utf16n alien>string ]
+ [
+ dwFileAttributes>>
+ [ win32-file-type ] [ win32-file-attributes ] bi
+ ] bi
dupd remove windows-directory-entry boa ;
M: windows (directory-entries) ( path -- seq )
ARTICLE: "io.encodings.8-bit" "Legacy 8-bit encodings"
"Many encodings are a simple mapping of bytes onto characters. The " { $vocab-link "io.encodings.8-bit" } " vocabulary implements these generically using existing resource files. These encodings should be used with extreme caution, as fully general Unicode encodings like UTF-8 are nearly always more appropriate. The following 8-bit encodings are already defined:"
-{ $subsection latin1 }
-{ $subsection latin2 }
-{ $subsection latin3 }
-{ $subsection latin4 }
-{ $subsection latin/cyrillic }
-{ $subsection latin/arabic }
-{ $subsection latin/greek }
-{ $subsection latin/hebrew }
-{ $subsection latin5 }
-{ $subsection latin6 }
-{ $subsection latin/thai }
-{ $subsection latin7 }
-{ $subsection latin8 }
-{ $subsection latin9 }
-{ $subsection latin10 }
-{ $subsection koi8-r }
-{ $subsection windows-1252 }
-{ $subsection ebcdic }
-{ $subsection mac-roman } ;
+{ $subsections
+ latin1
+ latin2
+ latin3
+ latin4
+ latin/cyrillic
+ latin/arabic
+ latin/greek
+ latin/hebrew
+ latin5
+ latin6
+ latin/thai
+ latin7
+ latin8
+ latin9
+ latin10
+ koi8-r
+ windows-1252
+ ebcdic
+ mac-roman
+} ;
ABOUT: "io.encodings.8-bit"
ARTICLE: "io.encodings.ascii" "ASCII encoding"
"By default, if there's a non-ASCII character in an input stream, it will be replaced with a replacement character (U+FFFD), and if a non-ASCII character is used in output, an exception is thrown."
-{ $subsection ascii } ;
+{ $subsections ascii } ;
ABOUT: "io.encodings.ascii"
ARTICLE: "io.encodings.binary" "Binary encoding"
"Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings."
-{ $subsection binary } ;
+{ $subsections binary } ;
ABOUT: "io.encodings.binary"
{ $see-also "encodings-introduction" } ;
ARTICLE: "io.encodings.euc-kr" "EUC-KR encoding"
-{ $subsection euc-kr } ;
+{ $subsections euc-kr } ;
ABOUT: "io.encodings.euc-kr"
\ No newline at end of file
ARTICLE: "io.encodings.gb18030" "GB 18030"
"The " { $vocab-link "io.encodings.gb18030" } " vocabulary implements GB18030, a commonly used encoding for Chinese text besides the standard UTF encodings for Unicode strings."
-{ $subsection gb18030 } ;
+{ $subsections gb18030 } ;
ABOUT: "io.encodings.gb18030"
ARTICLE: "io.encodings.iana" "IANA-registered encoding names"
"The " { $vocab-link "io.encodings.iana" } " vocabulary provides words for accessing the names of encodings and the encoding descriptors corresponding to names." $nl
"Most text encodings in common use have been registered with IANA. There is a standard set of names for each encoding. Simple conversion functions:"
-{ $subsection name>encoding }
-{ $subsection encoding>name }
+{ $subsections
+ name>encoding
+ encoding>name
+}
"To let a new encoding be used with the above words, use the following:"
-{ $subsection register-encoding } ;
+{ $subsections register-encoding } ;
HELP: name>encoding
{ $values { "name" "an encoding name" } { "encoding" "an encoding descriptor" } }
{ $see-also "encodings-introduction" } ;
ARTICLE: "io.encodings.iso2022" "ISO 2022-JP-1 encoding"
-{ $subsection iso2022 } ;
+{ $subsections iso2022 } ;
ABOUT: "io.encodings.iso2022"
{ $class-description "Korean Johab encoding (KSC5601-1992). This encoding is not commonly used anymore." } ;
ARTICLE: "io.encodings.johab" "Korean Johab encoding"
-{ $subsection johab } ;
+{ $subsections johab } ;
ABOUT: "io.encodings.johab"
\ No newline at end of file
ARTICLE: "io.encodings.shift-jis" "Shift JIS"
"Shift JIS is a text encoding for Japanese. There are multiple versions, depending on whether the offical standard or the modified Microsoft version is required."
-{ $subsection shift-jis }
-{ $subsection windows-31j } ;
+{ $subsections
+ shift-jis
+ windows-31j
+} ;
ABOUT: "io.encodings.shift-jis"
ARTICLE: "io.encodings.string" "Encoding and decoding strings"
"Strings can be encoded or decoded to and from byte arrays through an encoding by passing "
{ $link "encodings-descriptors" } " to the following words:"
-{ $subsection encode }
-{ $subsection decode } ;
+{ $subsections
+ encode
+ decode
+} ;
HELP: decode
{ $values { "byte-array" byte-array } { "encoding" "an encoding descriptor" }
ARTICLE: "io.encodings.utf32" "UTF-32 encoding"
"The UTF-32 encoding is a fixed-width encoding. Unicode code points are encoded as 4 byte sequences. There are three encoding descriptor classes for working with UTF-32, depending on endianness or the presence of a BOM:"
-{ $subsection utf32 }
-{ $subsection utf32le }
-{ $subsection utf32be } ;
+{ $subsections
+ utf32
+ utf32le
+ utf32be
+} ;
ABOUT: "io.encodings.utf32"
ARTICLE: "io.files.info" "File system meta-data"
"File meta-data:"
-{ $subsection file-info }
-{ $subsection link-info }
-{ $subsection exists? }
-{ $subsection directory? }
+{ $subsections
+ file-info
+ link-info
+ exists?
+ directory?
+}
"File types:"
-{ $subsection "file-types" }
+{ $subsections "file-types" }
"File system meta-data:"
-{ $subsection file-system-info }
-{ $subsection file-systems } ;
+{ $subsections
+ file-system-info
+ file-systems
+} ;
ABOUT: "io.files.info"
M: bsd stat>file-info ( stat -- file-info )
[ call-next-method ] keep
{
- [ stat-st_flags >>flags ]
- [ stat-st_gen >>gen ]
- [
- stat-st_birthtimespec timespec>unix-time
- >>birth-time
- ]
+ [ st_flags>> >>flags ]
+ [ st_gen>> >>gen ]
+ [ st_birthtimespec>> timespec>unix-time >>birth-time ]
} cleave ;
io.backend io.files io.files.info io.files.unix kernel math system unix
unix.statfs.freebsd unix.statvfs.freebsd unix.getfsstat.freebsd
sequences grouping alien.strings io.encodings.utf8 unix.types
-specialized-arrays.direct.uint arrays io.files.info.unix ;
+arrays io.files.info.unix classes.struct
+specialized-arrays ;
+SPECIALIZED-ARRAY: statfs
IN: io.files.info.unix.freebsd
TUPLE: freebsd-file-system-info < unix-file-system-info
M: freebsd new-file-system-info freebsd-file-system-info new ;
M: freebsd file-system-statfs ( path -- byte-array )
- "statfs" <c-object> [ statfs io-error ] keep ;
+ \ statfs <struct> [ statfs io-error ] keep ;
M: freebsd statfs>file-system-info ( file-system-info statvfs -- file-system-info )
{
- [ statfs-f_version >>version ]
- [ statfs-f_type >>type ]
- [ statfs-f_flags >>flags ]
- [ statfs-f_bsize >>block-size ]
- [ statfs-f_iosize >>io-size ]
- [ statfs-f_blocks >>blocks ]
- [ statfs-f_bfree >>blocks-free ]
- [ statfs-f_bavail >>blocks-available ]
- [ statfs-f_files >>files ]
- [ statfs-f_ffree >>files-free ]
- [ statfs-f_syncwrites >>syncwrites ]
- [ statfs-f_asyncwrites >>asyncwrites ]
- [ statfs-f_syncreads >>syncreads ]
- [ statfs-f_asyncreads >>asyncreads ]
- [ statfs-f_namemax >>name-max ]
- [ statfs-f_owner >>owner ]
- [ statfs-f_fsid 2 <direct-uint-array> >array >>id ]
- [ statfs-f_fstypename utf8 alien>string >>type ]
- [ statfs-f_mntfromname utf8 alien>string >>device-name ]
- [ statfs-f_mntonname utf8 alien>string >>mount-point ]
+ [ f_version>> >>version ]
+ [ f_type>> >>type ]
+ [ f_flags>> >>flags ]
+ [ f_bsize>> >>block-size ]
+ [ f_iosize>> >>io-size ]
+ [ f_blocks>> >>blocks ]
+ [ f_bfree>> >>blocks-free ]
+ [ f_bavail>> >>blocks-available ]
+ [ f_files>> >>files ]
+ [ f_ffree>> >>files-free ]
+ [ f_syncwrites>> >>syncwrites ]
+ [ f_asyncwrites>> >>asyncwrites ]
+ [ f_syncreads>> >>syncreads ]
+ [ f_asyncreads>> >>asyncreads ]
+ [ f_namemax>> >>name-max ]
+ [ f_owner>> >>owner ]
+ [ f_fsid>> >>id ]
+ [ f_fstypename>> utf8 alien>string >>type ]
+ [ f_mntfromname>> utf8 alien>string >>device-name ]
+ [ f_mntonname>> utf8 alien>string >>mount-point ]
} cleave ;
M: freebsd file-system-statvfs ( path -- byte-array )
- "statvfs" <c-object> [ statvfs io-error ] keep ;
+ \ statvfs <struct> [ statvfs io-error ] keep ;
M: freebsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info )
{
- [ statvfs-f_favail >>files-available ]
- [ statvfs-f_frsize >>preferred-block-size ]
+ [ f_favail>> >>files-available ]
+ [ f_frsize>> >>preferred-block-size ]
} cleave ;
M: freebsd file-systems ( -- array )
f 0 0 getfsstat dup io-error
- "statfs" <c-array> dup dup length 0 getfsstat io-error
- "statfs" heap-size group
- [ statfs-f_mntonname alien>native-string file-system-info ] map ;
+ <statfs-array>
+ [ dup byte-length 0 getfsstat io-error ]
+ [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
io.backend io.encodings.utf8 io.files io.files.info io.streams.string
io.files.unix kernel math.order namespaces sequences sorting
system unix unix.statfs.linux unix.statvfs.linux io.files.links
-specialized-arrays.direct.uint arrays io.files.info.unix assocs
-io.pathnames unix.types ;
+arrays io.files.info.unix assocs io.pathnames unix.types
+classes.struct ;
FROM: csv => delimiter ;
IN: io.files.info.unix.linux
M: linux new-file-system-info linux-file-system-info new ;
M: linux file-system-statfs ( path -- byte-array )
- "statfs64" <c-object> [ statfs64 io-error ] keep ;
+ \ statfs64 <struct> [ statfs64 io-error ] keep ;
M: linux statfs>file-system-info ( struct -- statfs )
{
- [ statfs64-f_type >>type ]
- [ statfs64-f_bsize >>block-size ]
- [ statfs64-f_blocks >>blocks ]
- [ statfs64-f_bfree >>blocks-free ]
- [ statfs64-f_bavail >>blocks-available ]
- [ statfs64-f_files >>files ]
- [ statfs64-f_ffree >>files-free ]
- [ statfs64-f_fsid 2 <direct-uint-array> >array >>id ]
- [ statfs64-f_namelen >>namelen ]
- [ statfs64-f_frsize >>preferred-block-size ]
+ [ f_type>> >>type ]
+ [ f_bsize>> >>block-size ]
+ [ f_blocks>> >>blocks ]
+ [ f_bfree>> >>blocks-free ]
+ [ f_bavail>> >>blocks-available ]
+ [ f_files>> >>files ]
+ [ f_ffree>> >>files-free ]
+ [ f_fsid>> >>id ]
+ [ f_namelen>> >>namelen ]
+ [ f_frsize>> >>preferred-block-size ]
! [ statfs64-f_spare >>spare ]
} cleave ;
M: linux file-system-statvfs ( path -- byte-array )
- "statvfs64" <c-object> [ statvfs64 io-error ] keep ;
+ \ statvfs64 <struct> [ statvfs64 io-error ] keep ;
M: linux statvfs>file-system-info ( struct -- statfs )
{
- [ statvfs64-f_flag >>flags ]
- [ statvfs64-f_namemax >>name-max ]
+ [ f_flag>> >>flags ]
+ [ f_namemax>> >>name-max ]
} cleave ;
TUPLE: mtab-entry file-system-name mount-point type options
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings combinators
-grouping io.encodings.utf8 io.files kernel math sequences
-system unix io.files.unix specialized-arrays.direct.uint arrays
-unix.statfs.macosx unix.statvfs.macosx unix.getfsstat.macosx
-io.files.info.unix io.files.info ;
+grouping io.encodings.utf8 io.files kernel math sequences system
+unix io.files.unix arrays unix.statfs.macosx unix.statvfs.macosx
+unix.getfsstat.macosx io.files.info.unix io.files.info
+classes.struct specialized-arrays ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: statfs64
IN: io.files.info.unix.macosx
TUPLE: macosx-file-system-info < unix-file-system-info
M: macosx file-systems ( -- array )
f <void*> dup 0 getmntinfo64 dup io-error
- [ *void* ] dip
- "statfs64" heap-size [ * memory>byte-array ] keep group
- [ statfs64-f_mntonname utf8 alien>string file-system-info ] map ;
- ! [ [ new-file-system-info ] dip statfs>file-system-info ] map ;
+ [ *void* ] dip <direct-statfs64-array>
+ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ;
M: macosx new-file-system-info macosx-file-system-info new ;
M: macosx file-system-statfs ( normalized-path -- statfs )
- "statfs64" <c-object> [ statfs64 io-error ] keep ;
+ \ statfs64 <struct> [ statfs64 io-error ] keep ;
M: macosx file-system-statvfs ( normalized-path -- statvfs )
- "statvfs" <c-object> [ statvfs io-error ] keep ;
+ \ statvfs <struct> [ statvfs io-error ] keep ;
M: macosx statfs>file-system-info ( file-system-info byte-array -- file-system-info' )
{
- [ statfs64-f_bsize >>block-size ]
- [ statfs64-f_iosize >>io-size ]
- [ statfs64-f_blocks >>blocks ]
- [ statfs64-f_bfree >>blocks-free ]
- [ statfs64-f_bavail >>blocks-available ]
- [ statfs64-f_files >>files ]
- [ statfs64-f_ffree >>files-free ]
- [ statfs64-f_fsid 2 <direct-uint-array> >array >>id ]
- [ statfs64-f_owner >>owner ]
- [ statfs64-f_type >>type-id ]
- [ statfs64-f_flags >>flags ]
- [ statfs64-f_fssubtype >>filesystem-subtype ]
- [ statfs64-f_fstypename utf8 alien>string >>type ]
- [ statfs64-f_mntonname utf8 alien>string >>mount-point ]
- [ statfs64-f_mntfromname utf8 alien>string >>device-name ]
+ [ f_bsize>> >>block-size ]
+ [ f_iosize>> >>io-size ]
+ [ f_blocks>> >>blocks ]
+ [ f_bfree>> >>blocks-free ]
+ [ f_bavail>> >>blocks-available ]
+ [ f_files>> >>files ]
+ [ f_ffree>> >>files-free ]
+ [ f_fsid>> >>id ]
+ [ f_owner>> >>owner ]
+ [ f_type>> >>type-id ]
+ [ f_flags>> >>flags ]
+ [ f_fssubtype>> >>filesystem-subtype ]
+ [ f_fstypename>> utf8 alien>string >>type ]
+ [ f_mntonname>> utf8 alien>string >>mount-point ]
+ [ f_mntfromname>> utf8 alien>string >>device-name ]
} cleave ;
M: macosx statvfs>file-system-info ( file-system-info byte-array -- file-system-info' )
{
- [ statvfs-f_frsize >>preferred-block-size ]
- [ statvfs-f_favail >>files-available ]
- [ statvfs-f_namemax >>name-max ]
+ [ f_frsize>> >>preferred-block-size ]
+ [ f_favail>> >>files-available ]
+ [ f_namemax>> >>name-max ]
} cleave ;
combinators system io.backend accessors alien.c-types
io.encodings.utf8 alien.strings unix.types io.files.unix
io.files io.files.info unix.statvfs.netbsd unix.getfsstat.netbsd arrays
-grouping sequences io.encodings.utf8
-specialized-arrays.direct.uint io.files.info.unix ;
+grouping sequences io.encodings.utf8 classes.struct
+specialized-arrays io.files.info.unix ;
+SPECIALIZED-ARRAY: statvfs
IN: io.files.info.unix.netbsd
TUPLE: netbsd-file-system-info < unix-file-system-info
M: netbsd new-file-system-info netbsd-file-system-info new ;
M: netbsd file-system-statvfs
- "statvfs" <c-object> [ statvfs io-error ] keep ;
+ \ statvfs <struct> [ statvfs io-error ] keep ;
M: netbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' )
{
- [ statvfs-f_flag >>flags ]
- [ statvfs-f_bsize >>block-size ]
- [ statvfs-f_frsize >>preferred-block-size ]
- [ statvfs-f_iosize >>io-size ]
- [ statvfs-f_blocks >>blocks ]
- [ statvfs-f_bfree >>blocks-free ]
- [ statvfs-f_bavail >>blocks-available ]
- [ statvfs-f_bresvd >>blocks-reserved ]
- [ statvfs-f_files >>files ]
- [ statvfs-f_ffree >>files-free ]
- [ statvfs-f_favail >>files-available ]
- [ statvfs-f_fresvd >>files-reserved ]
- [ statvfs-f_syncreads >>sync-reads ]
- [ statvfs-f_syncwrites >>sync-writes ]
- [ statvfs-f_asyncreads >>async-reads ]
- [ statvfs-f_asyncwrites >>async-writes ]
- [ statvfs-f_fsidx 2 <direct-uint-array> >array >>idx ]
- [ statvfs-f_fsid >>id ]
- [ statvfs-f_namemax >>name-max ]
- [ statvfs-f_owner >>owner ]
- ! [ statvfs-f_spare >>spare ]
- [ statvfs-f_fstypename utf8 alien>string >>type ]
- [ statvfs-f_mntonname utf8 alien>string >>mount-point ]
- [ statvfs-f_mntfromname utf8 alien>string >>device-name ]
+ [ f_flag>> >>flags ]
+ [ f_bsize>> >>block-size ]
+ [ f_frsize>> >>preferred-block-size ]
+ [ f_iosize>> >>io-size ]
+ [ f_blocks>> >>blocks ]
+ [ f_bfree>> >>blocks-free ]
+ [ f_bavail>> >>blocks-available ]
+ [ f_bresvd>> >>blocks-reserved ]
+ [ f_files>> >>files ]
+ [ f_ffree>> >>files-free ]
+ [ f_favail>> >>files-available ]
+ [ f_fresvd>> >>files-reserved ]
+ [ f_syncreads>> >>sync-reads ]
+ [ f_syncwrites>> >>sync-writes ]
+ [ f_asyncreads>> >>async-reads ]
+ [ f_asyncwrites>> >>async-writes ]
+ [ f_fsidx>> >>idx ]
+ [ f_fsid>> >>id ]
+ [ f_namemax>> >>name-max ]
+ [ f_owner>> >>owner ]
+ [ f_fstypename>> utf8 alien>string >>type ]
+ [ f_mntonname>> utf8 alien>string >>mount-point ]
+ [ f_mntfromname>> utf8 alien>string >>device-name ]
} cleave ;
M: netbsd file-systems ( -- array )
f 0 0 getvfsstat dup io-error
- "statvfs" <c-array> dup dup length 0 getvfsstat io-error
- "statvfs" heap-size group
- [ statvfs-f_mntonname utf8 alien>string file-system-info ] map ;
+ <statvfs-array>
+ [ dup byte-length 0 getvfsstat io-error ]
+ [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
combinators io.backend io.files io.files.info io.files.unix kernel math
sequences system unix unix.getfsstat.openbsd grouping
unix.statfs.openbsd unix.statvfs.openbsd unix.types
-specialized-arrays.direct.uint arrays io.files.info.unix ;
+arrays io.files.info.unix classes.struct
+specialized-arrays io.encodings.utf8 ;
+SPECIALIZED-ARRAY: statfs
IN: io.files.unix.openbsd
-TUPLE: freebsd-file-system-info < unix-file-system-info
+TUPLE: openbsd-file-system-info < unix-file-system-info
io-size sync-writes sync-reads async-writes async-reads
owner ;
-M: openbsd new-file-system-info freebsd-file-system-info new ;
+M: openbsd new-file-system-info openbsd-file-system-info new ;
M: openbsd file-system-statfs
- "statfs" <c-object> [ statfs io-error ] keep ;
+ \ statfs <struct> [ statfs io-error ] keep ;
M: openbsd statfs>file-system-info ( file-system-info statfs -- file-system-info' )
{
- [ statfs-f_flags >>flags ]
- [ statfs-f_bsize >>block-size ]
- [ statfs-f_iosize >>io-size ]
- [ statfs-f_blocks >>blocks ]
- [ statfs-f_bfree >>blocks-free ]
- [ statfs-f_bavail >>blocks-available ]
- [ statfs-f_files >>files ]
- [ statfs-f_ffree >>files-free ]
- [ statfs-f_favail >>files-available ]
- [ statfs-f_syncwrites >>sync-writes ]
- [ statfs-f_syncreads >>sync-reads ]
- [ statfs-f_asyncwrites >>async-writes ]
- [ statfs-f_asyncreads >>async-reads ]
- [ statfs-f_fsid 2 <direct-uint-array> >array >>id ]
- [ statfs-f_namemax >>name-max ]
- [ statfs-f_owner >>owner ]
- ! [ statfs-f_spare >>spare ]
- [ statfs-f_fstypename alien>native-string >>type ]
- [ statfs-f_mntonname alien>native-string >>mount-point ]
- [ statfs-f_mntfromname alien>native-string >>device-name ]
+ [ f_flags>> >>flags ]
+ [ f_bsize>> >>block-size ]
+ [ f_iosize>> >>io-size ]
+ [ f_blocks>> >>blocks ]
+ [ f_bfree>> >>blocks-free ]
+ [ f_bavail>> >>blocks-available ]
+ [ f_files>> >>files ]
+ [ f_ffree>> >>files-free ]
+ [ f_favail>> >>files-available ]
+ [ f_syncwrites>> >>sync-writes ]
+ [ f_syncreads>> >>sync-reads ]
+ [ f_asyncwrites>> >>async-writes ]
+ [ f_asyncreads>> >>async-reads ]
+ [ f_fsid>> >>id ]
+ [ f_namemax>> >>name-max ]
+ [ f_owner>> >>owner ]
+ [ f_fstypename>> utf8 alien>string >>type ]
+ [ f_mntonname>> utf8 alien>string >>mount-point ]
+ [ f_mntfromname>> utf8 alien>string >>device-name ]
} cleave ;
M: openbsd file-system-statvfs ( normalized-path -- statvfs )
- "statvfs" <c-object> [ statvfs io-error ] keep ;
+ \ statvfs <struct> [ statvfs io-error ] keep ;
M: openbsd statvfs>file-system-info ( file-system-info statvfs -- file-system-info' )
- {
- [ statvfs-f_frsize >>preferred-block-size ]
- } cleave ;
+ f_frsize>> >>preferred-block-size ;
M: openbsd file-systems ( -- seq )
f 0 0 getfsstat dup io-error
- "statfs" <c-array> dup dup length 0 getfsstat io-error
- "statfs" heap-size group
- [ statfs-f_mntonname alien>native-string file-system-info ] map ;
+ <statfs-array>
+ [ dup byte-length 0 getfsstat io-error ]
+ [ [ f_mntonname>> utf8 alien>string file-system-info ] { } map-as ] bi ;
ARTICLE: "unix-file-permissions" "Unix file permissions"
"Reading all file permissions:"
-{ $subsection file-permissions }
+{ $subsections file-permissions }
"Reading individual file permissions:"
-{ $subsection uid? }
-{ $subsection gid? }
-{ $subsection sticky? }
-{ $subsection user-read? }
-{ $subsection user-write? }
-{ $subsection user-execute? }
-{ $subsection group-read? }
-{ $subsection group-write? }
-{ $subsection group-execute? }
-{ $subsection other-read? }
-{ $subsection other-write? }
-{ $subsection other-execute? }
+{ $subsections
+ uid?
+ gid?
+ sticky?
+ user-read?
+ user-write?
+ user-execute?
+ group-read?
+ group-write?
+ group-execute?
+ other-read?
+ other-write?
+ other-execute?
+}
"Writing all file permissions:"
-{ $subsection set-file-permissions }
+{ $subsections set-file-permissions }
"Writing individual file permissions:"
-{ $subsection set-uid }
-{ $subsection set-gid }
-{ $subsection set-sticky }
-{ $subsection set-user-read }
-{ $subsection set-user-write }
-{ $subsection set-user-execute }
-{ $subsection set-group-read }
-{ $subsection set-group-write }
-{ $subsection set-group-execute }
-{ $subsection set-other-read }
-{ $subsection set-other-write }
-{ $subsection set-other-execute } ;
+{ $subsections
+ set-uid
+ set-gid
+ set-sticky
+ set-user-read
+ set-user-write
+ set-user-execute
+ set-group-read
+ set-group-write
+ set-group-execute
+ set-other-read
+ set-other-write
+ set-other-execute
+} ;
ARTICLE: "unix-file-timestamps" "Unix file timestamps"
"To read file times, use the accessors on the object returned by the " { $link file-info } " word." $nl
"Setting multiple file times:"
-{ $subsection set-file-times }
+{ $subsections set-file-times }
"Setting just the last access time:"
-{ $subsection set-file-access-time }
+{ $subsections set-file-access-time }
"Setting just the last modified time:"
-{ $subsection set-file-modified-time } ;
+{ $subsections set-file-modified-time } ;
ARTICLE: "unix-file-ids" "Unix file user and group ids"
"Reading file user data:"
-{ $subsection file-user-id }
-{ $subsection file-user-name }
+{ $subsections
+ file-user-id
+ file-user-name
+}
"Setting file user data:"
-{ $subsection set-file-user }
+{ $subsections set-file-user }
"Reading file group data:"
-{ $subsection file-group-id }
-{ $subsection file-group-name }
+{ $subsections
+ file-group-id
+ file-group-name
+}
"Setting file group data:"
-{ $subsection set-file-group } ;
+{ $subsections set-file-group } ;
ARTICLE: "io.files.info.unix" "Unix file attributes"
"The " { $vocab-link "io.files.info.unix" } " vocabulary implements a high-level way to set Unix-specific permissions, timestamps, and user and group IDs for files."
-{ $subsection "unix-file-permissions" }
-{ $subsection "unix-file-timestamps" }
-{ $subsection "unix-file-ids" } ;
+{ $subsections
+ "unix-file-permissions"
+ "unix-file-timestamps"
+ "unix-file-ids"
+} ;
ABOUT: "io.files.info.unix"
USING: accessors kernel system math math.bitwise strings arrays
sequences combinators combinators.short-circuit alien.c-types
vocabs.loader calendar calendar.unix io.files.info
-io.files.types io.backend io.directories unix unix.stat unix.time unix.users
-unix.groups ;
+io.files.types io.backend io.directories unix unix.stat
+unix.time unix.users unix.groups classes.struct
+specialized-arrays ;
+SPECIALIZED-ARRAY: timeval
IN: io.files.info.unix
TUPLE: unix-file-system-info < file-system-info
[ new-file-info ] dip
{
[ stat>type >>type ]
- [ stat-st_size >>size ]
- [ stat-st_mode >>permissions ]
- [ stat-st_ctimespec timespec>unix-time >>created ]
- [ stat-st_mtimespec timespec>unix-time >>modified ]
- [ stat-st_atimespec timespec>unix-time >>accessed ]
- [ stat-st_uid >>uid ]
- [ stat-st_gid >>gid ]
- [ stat-st_dev >>dev ]
- [ stat-st_ino >>ino ]
- [ stat-st_nlink >>nlink ]
- [ stat-st_rdev >>rdev ]
- [ stat-st_blocks >>blocks ]
- [ stat-st_blksize >>blocksize ]
+ [ st_size>> >>size ]
+ [ st_mode>> >>permissions ]
+ [ st_ctimespec>> timespec>unix-time >>created ]
+ [ st_mtimespec>> timespec>unix-time >>modified ]
+ [ st_atimespec>> timespec>unix-time >>accessed ]
+ [ st_uid>> >>uid ]
+ [ st_gid>> >>gid ]
+ [ st_dev>> >>dev ]
+ [ st_ino>> >>ino ]
+ [ st_nlink>> >>nlink ]
+ [ st_rdev>> >>rdev ]
+ [ st_blocks>> >>blocks ]
+ [ st_blksize>> >>blocksize ]
[ drop dup blocks>> standard-unix-block-size * >>size-on-disk ]
} cleave ;
} case ;
M: unix stat>type ( stat -- type )
- stat-st_mode n>file-type ;
+ st_mode>> n>file-type ;
<PRIVATE
: stat-mode ( path -- mode )
- normalize-path file-status stat-st_mode ;
+ normalize-path file-status st_mode>> ;
: chmod-set-bit ( path mask ? -- )
[ dup stat-mode ] 2dip
<PRIVATE
-: make-timeval-array ( array -- byte-array )
- [ [ "timeval" <c-object> ] unless* ] map concat ;
-
: timestamp>timeval ( timestamp -- timeval )
unix-1970 time- duration>microseconds make-timeval ;
: timestamps>byte-array ( timestamps -- byte-array )
- [ dup [ timestamp>timeval ] when ] map make-timeval-array ;
+ [ [ timestamp>timeval ] [ \ timeval <struct> ] if* ] map
+ >timeval-array ;
PRIVATE>
f swap 2array set-file-times ;
: set-file-ids ( path uid gid -- )
- [ normalize-path ] 2dip
- [ [ -1 ] unless* ] bi@ chown io-error ;
+ [ normalize-path ] 2dip [ -1 or ] bi@ chown io-error ;
GENERIC: set-file-user ( path string/id -- )
windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit locals classes.struct ;
+calendar ascii combinators.short-circuit locals classes.struct
+specialized-arrays alien.data ;
+SPECIALIZED-ARRAY: ushort
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
: WIN32_FIND_DATA>file-info ( WIN32_FIND_DATA -- file-info )
[ \ windows-file-info new ] dip
{
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-type >>type ]
- [ WIN32_FIND_DATA-dwFileAttributes win32-file-attributes >>attributes ]
- [
- [ WIN32_FIND_DATA-nFileSizeLow ]
- [ WIN32_FIND_DATA-nFileSizeHigh ] bi >64bit >>size
- ]
- [ WIN32_FIND_DATA-dwFileAttributes >>permissions ]
- [ WIN32_FIND_DATA-ftCreationTime FILETIME>timestamp >>created ]
- [ WIN32_FIND_DATA-ftLastWriteTime FILETIME>timestamp >>modified ]
- [ WIN32_FIND_DATA-ftLastAccessTime FILETIME>timestamp >>accessed ]
+ [ dwFileAttributes>> win32-file-type >>type ]
+ [ dwFileAttributes>> win32-file-attributes >>attributes ]
+ [ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit >>size ]
+ [ dwFileAttributes>> >>permissions ]
+ [ ftCreationTime>> FILETIME>timestamp >>created ]
+ [ ftLastWriteTime>> FILETIME>timestamp >>modified ]
+ [ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
} cleave ;
: find-first-file-stat ( path -- WIN32_FIND_DATA )
- "WIN32_FIND_DATA" <c-object> [
+ WIN32_FIND_DATA <struct> [
FindFirstFile
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep
FindClose win32-error=0/f
file-info ;
: volume-information ( normalized-path -- volume-name volume-serial max-component flags type )
- MAX_PATH 1 + [ <byte-array> ] keep
+ MAX_PATH 1 + [ <ushort-array> ] keep
"DWORD" <c-object>
"DWORD" <c-object>
"DWORD" <c-object>
- MAX_PATH 1 + [ <byte-array> ] keep
+ MAX_PATH 1 + [ <ushort-array> ] keep
[ GetVolumeInformation win32-error=0/f ] 7 nkeep
drop 5 nrot drop
[ utf16n alien>string ] 4 ndip
[ first Letter? ]
} 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ;
-M: winnt file-system-info ( path -- file-system-info )
- normalize-path root-directory
+<PRIVATE
+
+: (file-system-info) ( path -- file-system-info )
dup [ volume-information ] [ file-system-space ] bi
\ win32-file-system-info new
swap *ulonglong >>free-space
swap >>mount-point
calculate-file-system-info ;
+PRIVATE>
+
+M: winnt file-system-info ( path -- file-system-info )
+ normalize-path root-directory (file-system-info) ;
+
: volume>paths ( string -- array )
- 16384 "ushort" <c-array> tuck dup length
+ 16384 <ushort-array> tuck dup length
0 <uint> dup [ GetVolumePathNamesForVolumeName 0 = ] dip swap [
win32-error-string throw
] [
] if ;
: find-first-volume ( -- string handle )
- MAX_PATH 1 + [ <byte-array> ] keep
+ MAX_PATH 1 + [ <ushort-array> ] keep
dupd
FindFirstVolume dup win32-error=0/f
[ utf16n alien>string ] dip ;
: find-next-volume ( handle -- string/f )
- MAX_PATH 1 + [ <byte-array> tuck ] keep
+ MAX_PATH 1 + [ <ushort-array> tuck ] keep
FindNextVolume 0 = [
GetLastError ERROR_NO_MORE_FILES =
[ drop f ] [ win32-error-string throw ] if
M: winnt file-systems ( -- array )
find-volumes [ volume>paths ] map
concat [
- [ file-system-info ]
+ [ (file-system-info) ]
[ drop \ file-system-info new swap >>mount-point ] recover
] map ;
ARTICLE: "io.files.links" "Symbolic links"
"Reading links:"
-{ $subsection read-link }
-{ $subsection follow-link }
-{ $subsection follow-links }
+{ $subsections
+ read-link
+ follow-link
+ follow-links
+}
"Creating links:"
-{ $subsection make-link }
+{ $subsections make-link }
"Copying links:"
-{ $subsection copy-link }
+{ $subsections copy-link }
"Not all operating systems support symbolic links."
{ $see-also link-info } ;
ARTICLE: "io.files.temp" "Temporary files"
"Pathnames relative to Factor's temporary files directory:"
-{ $subsection temp-directory }
-{ $subsection temp-file } ;
+{ $subsections
+ temp-directory
+ temp-file
+} ;
ABOUT: "io.files.temp"
ARTICLE: "file-types" "File types"
"Platform-independent types:"
-{ $subsection +regular-file+ }
-{ $subsection +directory+ }
+{ $subsections
+ +regular-file+
+ +directory+
+}
"Platform-specific types:"
-{ $subsection +character-device+ }
-{ $subsection +block-device+ }
-{ $subsection +fifo+ }
-{ $subsection +symbolic-link+ }
-{ $subsection +socket+ }
-{ $subsection +unknown+ } ;
+{ $subsections
+ +character-device+
+ +block-device+
+ +fifo+
+ +symbolic-link+
+ +socket+
+ +unknown+
+} ;
ABOUT: "file-types"
ARTICLE: "io.files.unique" "Unique files"
"The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform unique file creation in temporary directories in a high-level and secure way." $nl
"Changing the temporary path:"
-{ $subsection current-temporary-directory }
+{ $subsections current-temporary-directory }
"Creating unique files:"
-{ $subsection unique-file }
-{ $subsection cleanup-unique-file }
-{ $subsection make-unique-file }
+{ $subsections
+ unique-file
+ cleanup-unique-file
+ make-unique-file
+}
"Creating unique directories:"
-{ $subsection unique-directory }
-{ $subsection with-unique-directory }
-{ $subsection cleanup-unique-directory }
+{ $subsections
+ unique-directory
+ with-unique-directory
+ cleanup-unique-directory
+}
"Default temporary directory:"
-{ $subsection default-temporary-directory } ;
+{ $subsections default-temporary-directory } ;
ABOUT: "io.files.unique"
alien.c-types alien.arrays alien.strings sequences combinators
combinators.short-circuit ascii splitting alien strings assocs
namespaces make accessors tr windows.time windows.shell32
-windows.errors ;
+windows.errors specialized-arrays classes.struct ;
+SPECIALIZED-ARRAY: ushort
IN: io.files.windows.nt
M: winnt cwd
- MAX_UNICODE_PATH dup "ushort" <c-array>
+ MAX_UNICODE_PATH dup <ushort-array>
[ GetCurrentDirectory win32-error=0/f ] keep
utf16n alien>string ;
M: winnt cd
SetCurrentDirectory win32-error=0/f ;
-: unicode-prefix ( -- seq )
- "\\\\?\\" ; inline
+CONSTANT: unicode-prefix "\\\\?\\"
M: winnt root-directory? ( path -- ? )
{
<PRIVATE
: windows-file-size ( path -- size )
- normalize-path 0 "WIN32_FILE_ATTRIBUTE_DATA" <c-object>
+ normalize-path 0 WIN32_FILE_ATTRIBUTE_DATA <struct>
[ GetFileAttributesEx win32-error=0/f ] keep
- [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeLow ]
- [ WIN32_FILE_ATTRIBUTE_DATA-nFileSizeHigh ] bi >64bit ;
+ [ nFileSizeLow>> ] [ nFileSizeHigh>> ] bi >64bit ;
PRIVATE>
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words system
destructors accessors math.bitwise continuations windows.errors
-arrays byte-arrays generalizations ;
+arrays byte-arrays generalizations alien.data ;
IN: io.files.windows
: open-file ( path access-mode create-mode flags -- handle )
ARTICLE: "io.launcher.detached" "Running processes in the background"
"By default, " { $link run-process } " waits for the process to complete. To run a process without waiting for it to finish, set the " { $snippet "detached" } " slot of a " { $link process } ", or use the following word:"
-{ $subsection run-detached } ;
+{ $subsections run-detached } ;
ARTICLE: "io.launcher.environment" "Setting environment variables"
"The " { $snippet "environment" } " slot of a " { $link process } " contains an association mapping environment variable names to values. The interpretation of environment variables is operating system-specific."
$nl
"The " { $snippet "environment-mode" } " slot controls how the environment of the current Factor instance is composed with the value of the " { $snippet "environment" } " slot:"
-{ $subsection +prepend-environment+ }
-{ $subsection +replace-environment+ }
-{ $subsection +append-environment+ }
+{ $subsections
+ +prepend-environment+
+ +replace-environment+
+ +append-environment+
+}
"The default value is " { $link +append-environment+ } "." ;
ARTICLE: "io.launcher.redirection" "Input/output redirection"
ARTICLE: "io.launcher.lifecycle" "The process lifecycle"
"A freshly instantiated " { $link process } " represents a set of launch parameters."
-{ $subsection process }
-{ $subsection <process> }
+{ $subsections
+ process
+ <process>
+}
"Words for launching processes take a fresh process which has never been started before as input, and output a copy as output."
-{ $subsection process-started? }
+{ $subsections process-started? }
"The " { $link process } " instance output by launching words contains all original slot values in addition to the " { $snippet "handle" } " slot, which indicates the process is currently running."
-{ $subsection process-running? }
+{ $subsections process-running? }
"It is possible to wait for a process to exit:"
-{ $subsection wait-for-process }
+{ $subsections wait-for-process }
"A running process can also be killed:"
-{ $subsection kill-process } ;
+{ $subsections kill-process } ;
ARTICLE: "io.launcher.launch" "Launching processes"
"Launching processes:"
-{ $subsection run-process }
-{ $subsection try-process }
-{ $subsection run-detached }
+{ $subsections
+ run-process
+ try-process
+ run-detached
+}
"Redirecting standard input and output to a pipe:"
-{ $subsection <process-reader> }
-{ $subsection <process-writer> }
-{ $subsection <process-stream> }
+{ $subsections
+ <process-reader>
+ <process-writer>
+ <process-stream>
+}
"Combinators built on top of the above:"
-{ $subsection with-process-reader }
-{ $subsection with-process-writer }
-{ $subsection with-process-stream } ;
+{ $subsections
+ with-process-reader
+ with-process-writer
+ with-process-stream
+} ;
ARTICLE: "io.launcher.examples" "Launcher examples"
"Starting a command and waiting for it to finish:"
ARTICLE: "io.launcher" "Operating system processes"
"The " { $vocab-link "io.launcher" } " vocabulary implements cross-platform process launching."
-{ $subsection "io.launcher.examples" }
-{ $subsection "io.launcher.descriptors" }
-{ $subsection "io.launcher.launch" }
+{ $subsections
+ "io.launcher.examples"
+ "io.launcher.descriptors"
+ "io.launcher.launch"
+}
"Advanced topics:"
-{ $subsection "io.launcher.lifecycle" }
-{ $subsection "io.launcher.command" }
-{ $subsection "io.launcher.detached" }
-{ $subsection "io.launcher.environment" }
-{ $subsection "io.launcher.redirection" }
-{ $subsection "io.launcher.priority" }
-{ $subsection "io.launcher.timeouts" } ;
+{ $subsections
+ "io.launcher.lifecycle"
+ "io.launcher.command"
+ "io.launcher.detached"
+ "io.launcher.environment"
+ "io.launcher.redirection"
+ "io.launcher.priority"
+ "io.launcher.timeouts"
+} ;
ABOUT: "io.launcher"
console-vm "-run=listener" 2array >>command
+closed+ >>stdin
+stdout+ >>stderr
- ascii [ contents ] with-process-reader
+ ascii [ lines last ] with-process-reader
] unit-test
: launcher-test-path ( -- str )
[ "( scratchpad ) " ] [
console-vm "-run=listener" 2array
- ascii [ "USE: system 0 exit" print flush readln ] with-process-stream
+ ascii [ "USE: system 0 exit" print flush lines last ] with-process-stream
] unit-test
[ ] [
! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays continuations io
-io.backend.windows io.pipes.windows.nt io.pathnames libc io.ports
-windows.types math windows.kernel32
-namespaces make io.launcher kernel sequences windows.errors
-splitting system threads init strings combinators
-io.backend accessors concurrency.flags io.files assocs
-io.files.private windows destructors specialized-arrays.ushort
-specialized-arrays.alien classes classes.struct ;
+io.backend.windows io.pipes.windows.nt io.pathnames libc
+io.ports windows.types math windows.kernel32 namespaces make
+io.launcher kernel sequences windows.errors splitting system
+threads init strings combinators io.backend accessors
+concurrency.flags io.files assocs io.files.private windows
+destructors classes classes.struct specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: void*
IN: io.launcher.windows
TUPLE: CreateProcess-args
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.alien ;
-IN: io.mmap.alien
-
-<< "void*" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.bool ;
-IN: io.mmap.bool
-
-<< "bool" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.char ;
-IN: io.mmap.char
-
-<< "char" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.double ;
-IN: io.mmap.double
-
-<< "double" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.float ;
-IN: io.mmap.float
-
-<< "float" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: io.mmap functors accessors alien.c-types math kernel
-words fry ;
-IN: io.mmap.functor
-
-SLOT: address
-SLOT: length
-
-: mapped-file>direct ( mapped-file type -- alien length )
- [ [ address>> ] [ length>> ] bi ] dip
- heap-size [ 1 - + ] keep /i ;
-
-FUNCTOR: define-mapped-array ( T -- )
-
-<mapped-A> DEFINES <mapped-${T}-array>
-<A> IS <direct-${T}-array>
-with-mapped-A-file DEFINES with-mapped-${T}-file
-with-mapped-A-file-reader DEFINES with-mapped-${T}-file-reader
-
-WHERE
-
-: <mapped-A> ( mapped-file -- direct-array )
- T mapped-file>direct <A> ; inline
-
-: with-mapped-A-file ( path quot -- )
- '[ <mapped-A> @ ] with-mapped-file ; inline
-
-: with-mapped-A-file-reader ( path quot -- )
- '[ <mapped-A> @ ] with-mapped-file-reader ; inline
-
-;FUNCTOR
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.int ;
-IN: io.mmap.int
-
-<< "int" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.long ;
-IN: io.mmap.long
-
-<< "long" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.longlong ;
-IN: io.mmap.longlong
-
-<< "longlong" define-mapped-array >>
\ No newline at end of file
USING: help.markup help.syntax alien math continuations
-destructors ;
+destructors specialized-arrays ;
IN: io.mmap
HELP: mapped-file
HELP: with-mapped-file-reader
{ $values { "path" "a pathname string" } { "quot" { $quotation "( mmap -- )" } } }
{ $contract "Opens a file for read-only access and maps its contents into memory, passing the " { $link mapped-file } " instance to the quotation. The mapped file is disposed of when the quotation returns, or if an error is thrown." }
-{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. Most applications should use " { $link "io.mmap.arrays" } " instead." }
+{ $notes "This is a low-level word, because " { $link mapped-file } " objects simply expose their base address and length. See " { $link "io.mmap.arrays" } " for a discussion of how to access data in a mapped file." }
{ $errors "Throws an error if a memory mapping could not be established." } ;
HELP: close-mapped-file
{ $contract "Releases system resources associated with the mapped file. This word should not be called by user code; use " { $link dispose } " instead." }
{ $errors "Throws an error if a memory mapping could not be established." } ;
-ARTICLE: "io.mmap.arrays" "Memory-mapped arrays"
-"Mapped file can be viewed as a sequence using the words in sub-vocabularies of " { $vocab-link "io.mmap" } ". For each primitive C type " { $snippet "T" } ", a set of words are defined in the vocabulary named " { $snippet "io.mmap.T" } ":"
-{ $table
- { { $snippet "<mapped-T-array>" } { "Wraps a " { $link mapped-file } " in a sequence; stack effect " { $snippet "( mapped-file -- direct-array )" } } }
- { { $snippet "with-mapped-T-file" } { "Maps a file into memory and wraps it in a sequence by combining " { $link with-mapped-file } " and " { $snippet "<mapped-T-array>" } "; stack effect " { $snippet "( path quot -- )" } } }
-}
-"The primitive C types for which mapped arrays exist:"
-{ $list
- { $snippet "char" }
- { $snippet "uchar" }
- { $snippet "short" }
- { $snippet "ushort" }
- { $snippet "int" }
- { $snippet "uint" }
- { $snippet "long" }
- { $snippet "ulong" }
- { $snippet "longlong" }
- { $snippet "ulonglong" }
- { $snippet "float" }
- { $snippet "double" }
- { $snippet "void*" }
- { $snippet "bool" }
-} ;
-
-ARTICLE: "io.mmap.low-level" "Reading and writing mapped files directly"
-"Data can be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. See " { $link "reading-writing-memory" } "." ;
+ARTICLE: "io.mmap.arrays" "Working with memory-mapped data"
+"The " { $link <mapped-file> } " word returns an instance of " { $link mapped-file } ", which doesn't directly support the sequence protocol. Instead, it needs to be wrapped in a specialized array of the appropriate C type:"
+{ $subsections <mapped-array> }
+"The appropriate specialized array type must first be generated with " { $link POSTPONE: SPECIALIZED-ARRAY: } "."
+$nl
+"Data can also be read and written from the " { $link mapped-file } " by applying low-level alien words to the " { $slot "address" } " slot. This approach is not recommended, though, since in most cases the compiler will generate efficient code for specialized array usage. See " { $link "reading-writing-memory" } " for a description of low-level memory access primitives." ;
-ARTICLE: "io.mmap.examples" "Memory-mapped file example"
+ARTICLE: "io.mmap.examples" "Memory-mapped file examples"
"Convert a file of 4-byte cells from little to big endian or vice versa, by directly mapping it into memory and operating on it with sequence words:"
{ $code
- "USING: accessors grouping io.files io.mmap.char kernel sequences ;"
+ "USING: alien.c-types grouping io.mmap sequences" "specialized-arrays ;"
+ "SPECIALIZED-ARRAY: char"
+ ""
"\"mydata.dat\" ["
- " 4 <sliced-groups> [ reverse-here ] change-each"
- "] with-mapped-char-file"
+ " char <mapped-array> 4 <sliced-groups>"
+ " [ reverse-here ] change-each"
+ "] with-mapped-file"
+}
+"Normalize a file containing packed quadrupes of floats:"
+{ $code
+ "USING: kernel io.mmap math.vectors math.vectors.simd" "sequences specialized-arrays ;"
+ "SIMD: float"
+ "SPECIALIZED-ARRAY: float-4"
+ ""
+ "\"mydata.dat\" ["
+ " float-4 <mapped-array>"
+ " [ normalize ] change-each"
+ "] with-mapped-file"
} ;
ARTICLE: "io.mmap" "Memory-mapped files"
"The " { $vocab-link "io.mmap" } " vocabulary implements support for memory-mapped files."
-{ $subsection <mapped-file> }
-"Memory-mapped files are disposable and can be closed with " { $link dispose } " or " { $link with-disposal } "."
-{ $subsection "io.mmap.examples" }
-"A utility combinator which wraps the above:"
-{ $subsection with-mapped-file }
+{ $subsections <mapped-file> }
+"Memory-mapped files are disposable and can be closed with " { $link dispose } " or " { $link with-disposal } ". A utility combinator which wraps the above:"
+{ $subsections with-mapped-file }
"Instances of " { $link mapped-file } " don't support any interesting operations in themselves. There are two facilities for accessing their contents:"
-{ $subsection "io.mmap.arrays" }
-{ $subsection "io.mmap.low-level" } ;
+{ $subsections
+ "io.mmap.arrays"
+ "io.mmap.examples"
+} ;
ABOUT: "io.mmap"
-USING: io io.mmap io.mmap.char io.files io.files.temp
-io.directories kernel tools.test continuations sequences
-io.encodings.ascii accessors math ;
+USING: io io.mmap io.files io.files.temp io.directories kernel
+tools.test continuations sequences io.encodings.ascii accessors
+math compiler.tree.debugger alien.data alien.c-types
+sequences.private ;
IN: io.mmap.tests
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
[ ] [ "12345" "mmap-test-file.txt" temp-file ascii set-file-contents ] unit-test
-[ ] [ "mmap-test-file.txt" temp-file [ CHAR: 2 0 pick set-nth drop ] with-mapped-char-file ] unit-test
-[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file ] unit-test
-[ 5 ] [ "mmap-test-file.txt" temp-file [ length ] with-mapped-char-file-reader ] unit-test
+[ ] [ "mmap-test-file.txt" temp-file [ char <mapped-array> CHAR: 2 0 pick set-nth drop ] with-mapped-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ char <mapped-array> length ] with-mapped-file ] unit-test
+[ 5 ] [ "mmap-test-file.txt" temp-file [ char <mapped-array> length ] with-mapped-file-reader ] unit-test
[ "22345" ] [ "mmap-test-file.txt" temp-file ascii file-contents ] unit-test
[ "mmap-test-file.txt" temp-file delete-file ] ignore-errors
drop
] with-mapped-file
] [ bad-mmap-size? ] must-fail-with
+
+[ t ] [
+ [ "test.txt" <mapped-file> void* <c-direct-array> first-unsafe ]
+ { nth-unsafe } inlined?
+] unit-test
-! Copyright (C) 2007, 2008 Doug Coleman, Slava Pestov.
+! Copyright (C) 2007, 2009 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: continuations destructors io.files io.files.info
io.backend kernel quotations system alien alien.accessors
-accessors vocabs.loader combinators alien.c-types
+accessors vocabs.loader combinators alien.c-types alien.data
math ;
IN: io.mmap
PRIVATE>
: <mapped-file-reader> ( path -- mmap )
- [ (mapped-file-reader) ] prepare-mapped-file ;
+ [ (mapped-file-reader) ] prepare-mapped-file ; inline
: <mapped-file> ( path -- mmap )
- [ (mapped-file-r/w) ] prepare-mapped-file ;
+ [ (mapped-file-r/w) ] prepare-mapped-file ; inline
+
+: <mapped-array> ( mmap c-type -- direct-array )
+ [ [ address>> ] [ length>> ] bi ] dip
+ [ heap-size /i ] keep
+ <c-direct-array> ; inline
HOOK: close-mapped-file io-backend ( mmap -- )
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.short ;
-IN: io.mmap.short
-
-<< "short" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.uchar ;
-IN: io.mmap.uchar
-
-<< "uchar" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.uint ;
-IN: io.mmap.uint
-
-<< "uint" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.ulong ;
-IN: io.mmap.ulong
-
-<< "ulong" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.ulonglong ;
-IN: io.mmap.ulonglong
-
-<< "ulonglong" define-mapped-array >>
\ No newline at end of file
+++ /dev/null
-USING: io.mmap.functor specialized-arrays.direct.ushort ;
-IN: io.mmap.ushort
-
-<< "ushort" define-mapped-array >>
\ No newline at end of file
io.backend.unix io.encodings.utf8 unix.linux.inotify assocs
namespaces make threads continuations init math math.bitwise
sets alien alien.strings alien.c-types vocabs.loader accessors
-system hashtables destructors unix ;
+system hashtables destructors unix classes.struct ;
IN: io.monitors.linux
SYMBOL: watches
] { } make prune ;
: parse-event-name ( event -- name )
- dup inotify-event-len zero?
- [ drop "" ] [ inotify-event-name utf8 alien>string ] if ;
+ dup len>> zero?
+ [ drop "" ] [ name>> utf8 alien>string ] if ;
: parse-file-notify ( buffer -- path changed )
- dup inotify-event-mask ignore-flags? [
+ dup mask>> ignore-flags? [
drop f f
] [
- [ parse-event-name ] [ inotify-event-mask parse-action ] bi
+ [ parse-event-name ] [ mask>> parse-action ] bi
] if ;
: events-exhausted? ( i buffer -- ? )
fill>> >= ;
-: inotify-event@ ( i buffer -- alien )
- ptr>> <displaced-alien> ;
+: inotify-event@ ( i buffer -- inotify-event )
+ ptr>> <displaced-alien> inotify-event memory>struct ;
: next-event ( i buffer -- i buffer )
2dup inotify-event@
- inotify-event-len "inotify-event" heap-size +
+ len>> inotify-event heap-size +
swap [ + ] dip ;
: parse-file-notifications ( i buffer -- )
2dup events-exhausted? [ 2drop ] [
- 2dup inotify-event@ dup inotify-event-wd wd>monitor
+ 2dup inotify-event@ dup wd>> wd>monitor
[ parse-file-notify ] dip queue-change
next-event parse-file-notifications
] if ;
\r
ARTICLE: "io.monitors.descriptors" "File system change descriptors"\r
"The " { $link next-change } " word outputs instances of a class:"\r
-{ $subsection file-change }\r
+{ $subsections file-change }\r
"The " { $slot "changed" } " slot holds a sequence which may contain any of the following symbols:"\r
-{ $subsection +add-file+ }\r
-{ $subsection +remove-file+ }\r
-{ $subsection +modify-file+ }\r
-{ $subsection +rename-file-old+ }\r
-{ $subsection +rename-file-new+ }\r
-{ $subsection +rename-file+ } ;\r
+{ $subsections\r
+ +add-file+\r
+ +remove-file+\r
+ +modify-file+\r
+ +rename-file-old+\r
+ +rename-file-new+\r
+ +rename-file+\r
+} ;\r
\r
ARTICLE: "io.monitors.platforms" "Monitors on different platforms"\r
"Whether the " { $slot "path" } " slot of a " { $link file-change } " contains an absolute path or a path relative to the path given to " { $link <monitor> } " is unspecified, and may even vary on the same platform. User code should not assume either case."\r
"File system change monitors listen for changes to file names, attributes and contents under a specified directory. They can optionally be recursive, in which case subdirectories are also monitored."\r
$nl\r
"Monitoring operations must be wrapped in a combinator:"\r
-{ $subsection with-monitors }\r
+{ $subsections with-monitors }\r
"Creating a file system change monitor and listening for changes:"\r
-{ $subsection <monitor> }\r
-{ $subsection next-change }\r
+{ $subsections\r
+ <monitor>\r
+ next-change\r
+}\r
"An alternative programming style is where instead of having a thread listen for changes on a monitor, change notifications are posted to a mailbox:"\r
-{ $subsection (monitor) }\r
-{ $subsection "io.monitors.descriptors" }\r
-{ $subsection "io.monitors.platforms" } \r
+{ $subsections\r
+ (monitor)\r
+ "io.monitors.descriptors"\r
+ "io.monitors.platforms"\r
+}\r
"Monitors are closed by calling " { $link dispose } " or " { $link with-disposal } ". An easy way to pair construction with disposal is to use a combinator:"\r
-{ $subsection with-monitor }\r
+{ $subsections with-monitor }\r
"Monitors support the " { $link "io.timeouts" } "."\r
$nl\r
"An example which watches a directory for changes:"\r
! Copyright (C) 2008 Doug Coleman, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings libc destructors locals
-kernel math assocs namespaces make continuations sequences
+USING: alien alien.c-types alien.data alien.strings libc destructors
+locals kernel math assocs namespaces make continuations sequences
hashtables sorting arrays combinators math.bitwise strings
system accessors threads splitting io.backend io.backend.windows
io.backend.windows.nt io.files.windows.nt io.monitors io.ports
io.buffers io.files io.timeouts io.encodings.string
io.encodings.utf16n io windows.errors windows.kernel32 windows.types
-io.pathnames ;
+io.pathnames classes.struct ;
IN: io.monitors.windows.nt
: open-directory ( path -- handle )
memory>byte-array utf16n decode ;
: parse-notify-record ( buffer -- path changed )
- [
- [ FILE_NOTIFY_INFORMATION-FileName ]
- [ FILE_NOTIFY_INFORMATION-FileNameLength ]
- bi memory>u16-string
- ]
- [ FILE_NOTIFY_INFORMATION-Action parse-action ] bi ;
+ [ [ FileName>> ] [ FileNameLength>> ] bi memory>u16-string ]
+ [ Action>> parse-action ] bi ;
: (file-notify-records) ( buffer -- buffer )
+ FILE_NOTIFY_INFORMATION memory>struct
dup ,
- dup FILE_NOTIFY_INFORMATION-NextEntryOffset zero? [
- [ FILE_NOTIFY_INFORMATION-NextEntryOffset ] keep <displaced-alien>
+ dup NextEntryOffset>> zero? [
+ [ NextEntryOffset>> ] [ >c-ptr <displaced-alien> ] bi
(file-notify-records)
] unless ;
"A " { $emphasis "pipe" } " is a unidirectional channel for transfer of bytes. Data written to one end of the pipe can be read from the other. Pipes can be used to pass data between processes; they can also be used within a single process to implement communication between coroutines."
$nl
"Low-level pipes:"
-{ $subsection pipe }
-{ $subsection (pipe) }
+{ $subsections
+ pipe
+ (pipe)
+}
"High-level pipe streams:"
-{ $subsection <pipe> }
"Pipelines of coroutines and processes:"
-{ $subsection run-pipeline } ;
+{ $subsections run-pipeline } ;
ABOUT: "io.pipes"
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: system kernel unix math sequences
-io.backend.unix io.ports specialized-arrays.int accessors ;
-IN: io.pipes.unix
+USING: alien.c-types system kernel unix math sequences
+io.backend.unix io.ports specialized-arrays accessors ;
QUALIFIED: io.pipes
+SPECIALIZED-ARRAY: int
+IN: io.pipes.unix
M: unix io.pipes:(pipe) ( -- pair )
2 <int-array>
"Connection pools are implemented in the " { $snippet "io.pools" } " vocabulary. They are used to reuse sockets and connections which may be potentially expensive to create and destroy."
$nl
"The class of connection pools:"
-{ $subsection pool }
+{ $subsections pool }
"Creating connection pools:"
-{ $subsection <pool> }
"A utility combinator:"
-{ $subsection with-pool }
+{ $subsections with-pool }
"Acquiring and returning connections, and a utility combinator:"
-{ $subsection acquire-connection }
-{ $subsection return-connection }
-{ $subsection with-pooled-connection }
+{ $subsections
+ acquire-connection
+ return-connection
+ with-pooled-connection
+}
"Pools are not created directly, instead one uses subclasses which implement a generic word:"
-{ $subsection make-connection }
+{ $subsections make-connection }
"One example is a datagram socket pool:"
-{ $subsection datagram-pool }
-{ $subsection <datagram-pool> } ;
+{ $subsections
+ datagram-pool
+ <datagram-pool>
+} ;
ABOUT: "io.pools"
"On Windows and Unix, Factor implements blocking file and network streams on top of a non-blocking I/O substrate, ensuring that Factor threads will yield when performing I/O. This substrate is implemented in the " { $vocab-link "io.ports" } " vocabulary."
$nl
"A " { $emphasis "port" } " is a stream using non-blocking I/O substrate:"
-{ $subsection port }
-{ $subsection <port> }
-{ $subsection <buffered-port> }
+{ $subsections
+ port
+ <port>
+ <buffered-port>
+}
"Input ports:"
-{ $subsection input-port }
-{ $subsection <input-port> }
+{ $subsections
+ input-port
+ <input-port>
+}
"Output ports:"
-{ $subsection output-port }
-{ $subsection <output-port> }
+{ $subsections
+ output-port
+ <output-port>
+}
"Global native I/O protocol:"
-{ $subsection io-backend }
-{ $subsection init-io }
-{ $subsection init-stdio }
-{ $subsection io-multiplex }
+{ $subsections
+ io-backend
+ init-io
+ init-stdio
+ io-multiplex
+}
"Per-port native I/O protocol:"
-{ $subsection (wait-to-read) }
-{ $subsection (wait-to-write) }
+{ $subsections
+ (wait-to-read)
+ (wait-to-write)
+}
"Additionally, the I/O backend must provide an implementation of the " { $link dispose } " generic word." ;
ABOUT: "io.ports"
HOOK: (wait-to-write) io-backend ( port -- )
+HOOK: tell-handle os ( handle -- n )
HOOK: seek-handle os ( n seek-type handle -- )
+M: buffered-port stream-tell ( stream -- n )
+ [ check-disposed ]
+ [ handle>> tell-handle ]
+ [ [ buffer>> size>> - 0 max ] [ buffer>> pos>> ] bi + ] tri ;
+
M: input-port stream-seek ( n seek-type stream -- )
[ check-disposed ]
[ buffer>> 0 swap buffer-reset ]
ARTICLE: "server-config" "Threaded server configuration"
"The " { $link threaded-server } " tuple has a variety of slots which can be set before starting the server with " { $link start-server } " or " { $link start-server* } "."
-{ $subsection "server-config-logging" }
-{ $subsection "server-config-listen" }
-{ $subsection "server-config-limit" }
-{ $subsection "server-config-stream" }
-{ $subsection "server-config-handler" } ;
+{ $subsections
+ "server-config-logging"
+ "server-config-listen"
+ "server-config-limit"
+ "server-config-stream"
+ "server-config-handler"
+} ;
ARTICLE: "server-config-logging" "Logging connections"
"The " { $snippet "name" } " slot of a threaded server instance should be set to a string naming the logging service name to use. See " { $link "logging" } " for details." ;
"The " { $snippet "secure" } " slot of a threaded server instance is interpreted in the same manner as the " { $snippet "insecure" } " slot, except that secure encrypted connections are then allowed. If this slot is set, the " { $snippet "secure-config" } " slot should also be set to a " { $link secure-config } " instance containing SSL server configuration. See " { $link "ssl-config" } " for details."
$nl
"Two utility words for producing address specifiers:"
-{ $subsection local-server }
-{ $subsection internet-server } ;
+{ $subsections
+ local-server
+ internet-server
+} ;
ARTICLE: "server-config-limit" "Limiting connections"
"The " { $snippet "max-connections" } " slot is initially set to " { $link f } ", which disables connection limiting, but can be set to an integer specifying the maximum number of simultaneous connections."
ARTICLE: "io.servers.connection" "Threaded servers"
"The " { $vocab-link "io.servers.connection" } " vocabulary implements a generic server abstraction for " { $link "network-connection" } ". A set of threads listen for connections, and additional threads are spawned for each client connection. In addition to this basic functionality, it provides some advanced features such as logging, connection limits and secure socket support."
-{ $subsection "server-examples" }
+{ $subsections "server-examples" }
"Creating threaded servers with client handler quotations:"
-{ $subsection <threaded-server> }
+{ $subsections <threaded-server> }
"Client handlers can also be implemented by subclassing a threaded server; see " { $link "server-config-handler" } " for details:"
-{ $subsection threaded-server }
-{ $subsection new-threaded-server }
-{ $subsection handle-client* }
+{ $subsections
+ threaded-server
+ new-threaded-server
+ handle-client*
+}
"The server must be configured before it can be started."
-{ $subsection "server-config" }
+{ $subsections "server-config" }
"Starting the server:"
-{ $subsection start-server }
-{ $subsection start-server* }
-{ $subsection wait-for-server }
+{ $subsections
+ start-server
+ start-server*
+ wait-for-server
+}
"Stopping the server:"
-{ $subsection stop-server }
+{ $subsections stop-server }
"From within the dynamic scope of a client handler, several words can be used to interact with the threaded server:"
-{ $subsection stop-this-server }
-{ $subsection secure-port }
-{ $subsection insecure-port }
+{ $subsections
+ stop-this-server
+ secure-port
+ insecure-port
+}
"Additionally, the " { $link local-address } " and "
-{ $subsection remote-address } " variables are set, as in " { $link with-client } "." ;
+{ $subsections remote-address } " variables are set, as in " { $link with-client } "." ;
ABOUT: "io.servers.connection"
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-arrays kernel sequences namespaces math
-math.order combinators init alien alien.c-types alien.strings
-libc continuations destructors summary splitting assocs random
-math.parser locals unicode.case openssl openssl.libcrypto
-openssl.libssl io.backend io.ports io.pathnames
+math.order combinators init alien alien.c-types alien.data
+alien.strings libc continuations destructors summary splitting
+assocs random math.parser locals unicode.case openssl
+openssl.libcrypto openssl.libssl io.backend io.ports io.pathnames
io.encodings.8-bit io.timeouts io.sockets.secure ;
IN: io.sockets.secure.openssl
] [ drop ] if ;
: password-callback ( -- alien )
- "int" { "void*" "int" "bool" "void*" } "cdecl"
+ int { void* int bool void* } "cdecl"
[| buf size rwflag password! |
password [ B{ 0 } password! ] unless
ARTICLE: "ssl-methods" "SSL/TLS methods"
"The " { $snippet "method" } " slot of a " { $link secure-config } " can be set to one of the following values:"
-{ $subsection SSLv2 }
-{ $subsection SSLv23 }
-{ $subsection SSLv3 }
-{ $subsection TLSv1 }
+{ $subsections
+ SSLv2
+ SSLv23
+ SSLv3
+ TLSv1
+}
"The default value is " { $link SSLv23 } "." ;
HELP: secure-config
ARTICLE: "ssl-config" "Secure socket configuration"
"Secure sockets require some configuration, particularly for server sockets. A class represents secure socket configuration parameters:"
-{ $subsection secure-config }
+{ $subsections secure-config }
"Creating new instances:"
-{ $subsection <secure-config> }
+{ $subsections <secure-config> }
"Configuration parameters:"
-{ $subsection "ssl-methods" }
-{ $subsection "ssl-key-file" }
-{ $subsection "ssl-ca-file" }
-{ $subsection "ssl-dh-file" }
-{ $subsection "ssl-ephemeral-rsa" } ;
+{ $subsections
+ "ssl-methods"
+ "ssl-key-file"
+ "ssl-ca-file"
+ "ssl-dh-file"
+ "ssl-ephemeral-rsa"
+} ;
HELP: <secure-context>
{ $values { "config" secure-config } { "context" secure-context } }
ARTICLE: "ssl-contexts" "Secure socket contexts"
"All secure socket operations must be performed in a secure socket context. A context is created from a secure socket configuration. An implicit context with the default configuration is always available, however server sockets require a certificate to be set together with other parameters, and the default configuration is insufficient, so a context must be explicitly created in that case."
-{ $subsection with-secure-context } ;
+{ $subsections with-secure-context } ;
HELP: secure
{ $class-description "The class of secure socket addresses." } ;
"Secure socket connections are established by passing a secure socket address to " { $link <client> } " or " { $link <server> } "."
$nl
"Secure socket addresses form a class:"
-{ $subsection secure }
+{ $subsections secure }
"Constructing secure socket addresses:"
-{ $subsection <secure> }
+{ $subsections <secure> }
"Instances of this class can wrap an " { $link inet } ", " { $link inet4 } " or an " { $link inet6 } ", although note that certificate validation is only performed for instances of " { $link inet } " since otherwise the host name is not available." ;
HELP: send-secure-handshake
"Some protocols, such as HTTPS, require that the connection be established as an SSL/TLS connection. Others, such as secure SMTP and POP3 require that the client and server initiate an SSL/TLS handshake upon the client sending a plain-text request. The latter use-case is accomodated by a pair of words."
$nl
"Upgrading a connection to a secure socket by initiating an SSL/TLS handshake with the server:"
-{ $subsection send-secure-handshake }
+{ $subsections send-secure-handshake }
"Upgrading a connection to a secure socket by waiting for an SSL/TLS handshake from the client:"
-{ $subsection accept-secure-handshake } ;
+{ $subsections accept-secure-handshake } ;
HELP: premature-close
{ $error-description "Thrown if an SSL connection is closed without the proper " { $snippet "close_notify" } " sequence. This error is never reported for " { $link SSLv2 } " connections because there is no distinction between expected and unexpected connection closure in that case." } ;
ARTICLE: "ssl-errors" "Secure socket errors"
"Secure sockets can throw one of several errors in addition to the usual I/O errors:"
-{ $subsection premature-close }
-{ $subsection certificate-verify-error }
-{ $subsection common-name-verify-error }
+{ $subsections
+ premature-close
+ certificate-verify-error
+ common-name-verify-error
+}
"The " { $link send-secure-handshake } " word can throw one of two errors:"
-{ $subsection upgrade-on-non-socket }
-{ $subsection upgrade-buffers-full } ;
+{ $subsections
+ upgrade-on-non-socket
+ upgrade-buffers-full
+} ;
ARTICLE: "io.sockets.secure" "Secure sockets (SSL, TLS)"
"The " { $vocab-link "io.sockets.secure" } " vocabulary implements secure, encrypted sockets using the OpenSSL library."
"At present, this vocabulary only works on Unix, and not on Windows."
$nl
"This product includes software developed by the OpenSSL Project for use in the OpenSSL Toolkit (" { $url "http://www.openssl.org/" } "), cryptographic software written by Eric Young (eay@cryptsoft.com) and software written by Tim Hudson (tjh@cryptsoft.com)."
-{ $subsection "ssl-config" }
-{ $subsection "ssl-contexts" }
-{ $subsection "ssl-addresses" }
-{ $subsection "ssl-upgrade" }
-{ $subsection "ssl-errors" } ;
+{ $subsections
+ "ssl-config"
+ "ssl-contexts"
+ "ssl-addresses"
+ "ssl-upgrade"
+ "ssl-errors"
+} ;
ABOUT: "io.sockets.secure"
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel namespaces continuations
-destructors io debugger io.sockets sequences summary calendar
-delegate system vocabs.loader combinators present ;
+USING: accessors kernel namespaces continuations destructors io
+debugger io.sockets io.sockets.private sequences summary
+calendar delegate system vocabs.loader combinators present ;
IN: io.sockets.secure
SYMBOL: secure-socket-timeout
! Copyright (C) 2007, 2008, Slava Pestov, Elie CHAFTARI.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors unix byte-arrays kernel sequences
-namespaces math math.order combinators init alien alien.c-types
+USING: accessors unix byte-arrays kernel sequences namespaces
+math math.order combinators init alien alien.c-types
alien.strings libc continuations destructors openssl
openssl.libcrypto openssl.libssl io io.files io.ports
io.backend.unix io.sockets.unix io.encodings.ascii io.buffers
-io.sockets io.sockets.secure io.sockets.secure.openssl
-io.timeouts system summary fry ;
+io.sockets io.sockets.private io.sockets.secure
+io.sockets.secure.openssl io.timeouts system summary fry ;
FROM: io.ports => shutdown ;
IN: io.sockets.secure.unix
"The networking words are quite general and work with " { $emphasis "address specifiers" } " rather than concrete concepts such as host names. There are four types of address specifiers."
$nl
"Unix domain sockets:"
-{ $subsection local }
-{ $subsection <local> }
+{ $subsections
+ local
+ <local>
+}
"Internet host name/port number pairs; the host name is resolved to an IPv4 or IPv6 address using the operating system's resolver:"
-{ $subsection inet }
-{ $subsection <inet> }
+{ $subsections
+ inet
+ <inet>
+}
"IPv4 addresses, with no host name resolution:"
-{ $subsection inet4 }
-{ $subsection <inet4> }
+{ $subsections
+ inet4
+ <inet4>
+}
"IPv6 addresses, with no host name resolution:"
-{ $subsection inet6 }
-{ $subsection <inet6> }
+{ $subsections
+ inet6
+ <inet6>
+}
"While the " { $link inet } " addressing specifier is capable of performing name lookups when passed to " { $link <client> } ", sometimes it is necessary to look up a host name without making a connection:"
-{ $subsection resolve-host } ;
+{ $subsections resolve-host } ;
ARTICLE: "network-connection" "Connection-oriented networking"
"Network connections can be established with this word:"
-{ $subsection <client> }
-{ $subsection with-client }
+{ $subsections
+ <client>
+ with-client
+}
"Connection-oriented network servers are implemented by first opening a server socket, then waiting for connections:"
-{ $subsection <server> }
-{ $subsection accept }
+{ $subsections
+ <server>
+ accept
+}
"Server sockets are closed by calling " { $link dispose } "."
$nl
"Address specifiers have the following interpretation with connection-oriented networking words:"
ARTICLE: "network-packet" "Packet-oriented networking"
"A packet-oriented socket can be opened with this word:"
-{ $subsection <datagram> }
+{ $subsections <datagram> }
"Packets can be sent and received with a pair of words:"
-{ $subsection send }
-{ $subsection receive }
+{ $subsections
+ send
+ receive
+}
"Packet-oriented sockets are closed by calling " { $link dispose } "."
$nl
"Address specifiers have the following interpretation with packet-oriented networking words:"
"TCP/IP and UDP/IP, over IPv4 and IPv6"
"Unix domain sockets (Unix only)"
}
-{ $subsection "network-examples" }
-{ $subsection "network-addressing" }
-{ $subsection "network-connection" }
-{ $subsection "network-packet" }
+{ $subsections
+ "network-examples"
+ "network-addressing"
+ "network-connection"
+ "network-packet"
+}
{ $vocab-subsection "Secure sockets (SSL, TLS)" "io.sockets.secure" }
{ $see-also "io.pipes" } ;
IN: io.sockets.tests
-USING: io.sockets sequences math tools.test namespaces accessors
-kernel destructors calendar io.timeouts io.encodings.utf8 io
-concurrency.promises threads io.streams.string ;
+USING: io.sockets io.sockets.private sequences math tools.test
+namespaces accessors kernel destructors calendar io.timeouts
+io.encodings.utf8 io concurrency.promises threads
+io.streams.string ;
[ B{ 1 2 3 4 } ]
[ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
arrays io.encodings io.ports io.streams.duplex io.encodings.ascii
alien.strings io.binary accessors destructors classes byte-arrays
parser alien.c-types math.parser splitting grouping math assocs
-summary system vocabs.loader combinators present fry vocabs.parser ;
+summary system vocabs.loader combinators present fry vocabs.parser
+classes.struct alien.data ;
IN: io.sockets
<< {
} cond use-vocab >>
! Addressing
+<PRIVATE
+
GENERIC: protocol-family ( addrspec -- af )
GENERIC: sockaddr-size ( addrspec -- n )
GENERIC: parse-sockaddr ( sockaddr addrspec -- newaddrspec )
-TUPLE: local path ;
+HOOK: sockaddr-of-family os ( alien af -- sockaddr )
-: <local> ( path -- addrspec )
- normalize-path local boa ;
+HOOK: addrspec-of-family os ( af -- addrspec )
-M: local present path>> "Unix domain socket: " prepend ;
+PRIVATE>
TUPLE: abstract-inet host port ;
M: abstract-inet present
[ host>> ":" ] [ port>> number>string ] bi 3append ;
+TUPLE: local path ;
+
+: <local> ( path -- addrspec )
+ normalize-path local boa ;
+
+M: local present path>> "Unix domain socket: " prepend ;
+
TUPLE: inet4 < abstract-inet ;
C: <inet4> inet4
M: inet4 protocol-family drop PF_INET ;
-M: inet4 sockaddr-size drop "sockaddr-in" heap-size ;
+M: inet4 sockaddr-size drop sockaddr-in heap-size ;
-M: inet4 empty-sockaddr drop "sockaddr-in" <c-object> ;
+M: inet4 empty-sockaddr drop sockaddr-in <struct> ;
M: inet4 make-sockaddr ( inet -- sockaddr )
- "sockaddr-in" <c-object>
- AF_INET over set-sockaddr-in-family
- over port>> htons over set-sockaddr-in-port
- over host>>
- "0.0.0.0" or
- rot inet-pton *uint over set-sockaddr-in-addr ;
+ sockaddr-in <struct>
+ AF_INET >>family
+ swap [ port>> htons >>port ]
+ [ host>> "0.0.0.0" or ]
+ [ inet-pton *uint >>addr ] tri ;
-M: inet4 parse-sockaddr
- [ dup sockaddr-in-addr <uint> ] dip inet-ntop
- swap sockaddr-in-port ntohs <inet4> ;
+M: inet4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
+ [ [ addr>> <uint> ] dip inet-ntop ]
+ [ drop port>> ntohs ] 2bi <inet4> ;
TUPLE: inet6 < abstract-inet ;
M: inet6 protocol-family drop PF_INET6 ;
-M: inet6 sockaddr-size drop "sockaddr-in6" heap-size ;
+M: inet6 sockaddr-size drop sockaddr-in6 heap-size ;
-M: inet6 empty-sockaddr drop "sockaddr-in6" <c-object> ;
+M: inet6 empty-sockaddr drop sockaddr-in6 <struct> ;
M: inet6 make-sockaddr ( inet -- sockaddr )
- "sockaddr-in6" <c-object>
- AF_INET6 over set-sockaddr-in6-family
- over port>> htons over set-sockaddr-in6-port
- over host>> "::" or
- rot inet-pton over set-sockaddr-in6-addr ;
+ sockaddr-in6 <struct>
+ AF_INET6 >>family
+ swap [ port>> htons >>port ]
+ [ host>> "::" or ]
+ [ inet-pton >>addr ] tri ;
M: inet6 parse-sockaddr
- [ dup sockaddr-in6-addr ] dip inet-ntop
- swap sockaddr-in6-port ntohs <inet6> ;
-
-: addrspec-of-family ( af -- addrspec )
- {
- { AF_INET [ T{ inet4 } ] }
- { AF_INET6 [ T{ inet6 } ] }
- { AF_UNIX [ T{ local } ] }
- [ drop f ]
- } case ;
+ [ [ addr>> ] dip inet-ntop ]
+ [ drop port>> ntohs ] 2bi <inet6> ;
M: f parse-sockaddr nip ;
+<PRIVATE
+
GENERIC: (get-local-address) ( handle remote -- sockaddr )
: get-local-address ( handle remote -- local )
2bi
] with-destructors ;
+TUPLE: server-port < port addr encoding ;
+
+: check-server-port ( port -- port )
+ dup check-disposed
+ dup server-port? [ "Not a server port" throw ] unless ; inline
+
+GENERIC: (server) ( addrspec -- handle )
+
+GENERIC: (accept) ( server addrspec -- handle sockaddr )
+
+TUPLE: datagram-port < port addr ;
+
+HOOK: (datagram) io-backend ( addr -- datagram )
+
+: check-datagram-port ( port -- port )
+ dup check-disposed
+ dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
+
+HOOK: (receive) io-backend ( datagram -- packet addrspec )
+
+: check-datagram-send ( packet addrspec port -- packet addrspec port )
+ check-datagram-port
+ 2dup addr>> [ class ] bi@ assert=
+ pick class byte-array assert= ;
+
+HOOK: (send) io-backend ( packet addrspec datagram -- )
+
+: addrinfo>addrspec ( addrinfo -- addrspec )
+ [ [ addr>> ] [ family>> ] bi sockaddr-of-family ]
+ [ family>> addrspec-of-family ] bi
+ parse-sockaddr ;
+
+: parse-addrinfo-list ( addrinfo -- seq )
+ [ next>> dup [ addrinfo memory>struct ] when ] follow
+ [ addrinfo>addrspec ] map
+ sift ;
+
+HOOK: addrinfo-error io-backend ( n -- )
+
+: resolve-passive-host ( -- addrspecs )
+ { T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
+
+: prepare-addrinfo ( -- addrinfo )
+ addrinfo <struct>
+ PF_UNSPEC >>family
+ IPPROTO_TCP >>protocol ;
+
+: fill-in-ports ( addrspecs port -- addrspecs )
+ '[ _ >>port ] map ;
+
+PRIVATE>
+
: <client> ( remote encoding -- stream local )
[ (client) ] dip swap [ <encoder-duplex> ] dip ;
] dip with-stream
] with-scope ; inline
-TUPLE: server-port < port addr encoding ;
-
-: check-server-port ( port -- port )
- dup check-disposed
- dup server-port? [ "Not a server port" throw ] unless ; inline
-
-GENERIC: (server) ( addrspec -- handle )
-
: <server> ( addrspec encoding -- server )
[
[ (server) ] keep
>>addr
] dip >>encoding ;
-GENERIC: (accept) ( server addrspec -- handle sockaddr )
-
: accept ( server -- client remote )
[
dup addr>>
<ports>
] keep encoding>> <encoder-duplex> swap ;
-TUPLE: datagram-port < port addr ;
-
-HOOK: (datagram) io-backend ( addr -- datagram )
-
: <datagram> ( addrspec -- datagram )
[
[ (datagram) |dispose ] keep
>>addr
] with-destructors ;
-: check-datagram-port ( port -- port )
- dup check-disposed
- dup datagram-port? [ "Not a datagram port" throw ] unless ; inline
-
-HOOK: (receive) io-backend ( datagram -- packet addrspec )
-
: receive ( datagram -- packet addrspec )
check-datagram-port
[ (receive) ] [ addr>> ] bi parse-sockaddr ;
-: check-datagram-send ( packet addrspec port -- packet addrspec port )
- check-datagram-port
- 2dup addr>> [ class ] bi@ assert=
- pick class byte-array assert= ;
-
-HOOK: (send) io-backend ( packet addrspec datagram -- )
-
: send ( packet addrspec datagram -- )
check-datagram-send (send) ;
-: addrinfo>addrspec ( addrinfo -- addrspec )
- [ addrinfo-addr ] [ addrinfo-family addrspec-of-family ] bi
- parse-sockaddr ;
-
-: parse-addrinfo-list ( addrinfo -- seq )
- [ addrinfo-next ] follow
- [ addrinfo>addrspec ] map
- sift ;
-
-HOOK: addrinfo-error io-backend ( n -- )
-
GENERIC: resolve-host ( addrspec -- seq )
TUPLE: inet < abstract-inet ;
C: <inet> inet
-: resolve-passive-host ( -- addrspecs )
- { T{ inet6 f "::" f } T{ inet4 f "0.0.0.0" f } } [ clone ] map ;
-
-: prepare-addrinfo ( -- addrinfo )
- "addrinfo" <c-object>
- PF_UNSPEC over set-addrinfo-family
- IPPROTO_TCP over set-addrinfo-protocol ;
-
-: fill-in-ports ( addrspecs port -- addrspecs )
- '[ _ >>port ] map ;
-
M: inet resolve-host
[ port>> ] [ host>> ] bi [
f prepare-addrinfo f <void*>
- [ getaddrinfo addrinfo-error ] keep *void*
+ [ getaddrinfo addrinfo-error ] keep *void* addrinfo memory>struct
[ parse-addrinfo-list ] keep freeaddrinfo
] [ resolve-passive-host ] if*
swap fill-in-ports ;
! Copyright (C) 2004, 2008 Slava Pestov, Ivan Tikhonov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings generic kernel math threads
-sequences byte-arrays io.binary io.backend.unix io.streams.duplex
-io.backend io.pathnames io.files.private io.encodings.utf8 math.parser
-continuations libc combinators system accessors destructors unix
-locals init ;
+USING: alien alien.c-types alien.strings generic kernel math
+threads sequences byte-arrays io.binary io.backend.unix
+io.streams.duplex io.backend io.pathnames io.sockets.private
+io.files.private io.encodings.utf8 math.parser continuations
+libc combinators system accessors destructors unix locals init
+classes.struct alien.data ;
EXCLUDE: namespaces => bind ;
EXCLUDE: io => read write ;
M: unix addrinfo-error ( n -- )
[ gai_strerror throw ] unless-zero ;
+M: unix sockaddr-of-family ( alien af -- addrspec )
+ {
+ { AF_INET [ sockaddr-in memory>struct ] }
+ { AF_INET6 [ sockaddr-in6 memory>struct ] }
+ { AF_UNIX [ sockaddr-un memory>struct ] }
+ [ 2drop f ]
+ } case ;
+
+M: unix addrspec-of-family ( af -- addrspec )
+ {
+ { AF_INET [ T{ inet4 } ] }
+ { AF_INET6 [ T{ inet6 } ] }
+ { AF_UNIX [ T{ local } ] }
+ [ drop f ]
+ } case ;
+
! Client sockets - TCP and Unix domain
M: object (get-local-address) ( handle remote -- sockaddr )
[ handle-fd ] dip empty-sockaddr/size <int>
: server-socket-fd ( addrspec type -- fd )
[ dup protocol-family ] dip socket-fd
- dup init-server-socket
- dup handle-fd rot make-sockaddr/size bind io-error ;
+ [ init-server-socket ] keep
+ [ handle-fd swap make-sockaddr/size bind io-error ] keep ;
M: object (server) ( addrspec -- handle )
[
[ packet-size malloc receive-buffer set-global ] "io.sockets.unix" add-init-hook
:: do-receive ( port -- packet sockaddr )
- port addr>> empty-sockaddr/size [| sockaddr len |
- port handle>> handle-fd ! s
- receive-buffer get-global ! buf
- packet-size ! nbytes
- 0 ! flags
- sockaddr ! from
- len <int> ! fromlen
- recvfrom dup 0 >= [
- receive-buffer get-global swap memory>byte-array sockaddr
- ] [
- drop f f
- ] if
- ] call ;
+ port addr>> empty-sockaddr/size :> len :> sockaddr
+ port handle>> handle-fd ! s
+ receive-buffer get-global ! buf
+ packet-size ! nbytes
+ 0 ! flags
+ sockaddr ! from
+ len <int> ! fromlen
+ recvfrom dup 0 >=
+ [ receive-buffer get-global swap memory>byte-array sockaddr ]
+ [ drop f f ]
+ if ;
M: unix (receive) ( datagram -- packet sockaddr )
dup do-receive dup [ [ drop ] 2dip ] [
! Unix domain sockets
M: local protocol-family drop PF_UNIX ;
-M: local sockaddr-size drop "sockaddr-un" heap-size ;
+M: local sockaddr-size drop sockaddr-un heap-size ;
-M: local empty-sockaddr drop "sockaddr-un" <c-object> ;
+M: local empty-sockaddr drop sockaddr-un <struct> ;
M: local make-sockaddr
path>> (normalize-path)
dup length 1 + max-un-path > [ "Path too long" throw ] when
- "sockaddr-un" <c-object>
- AF_UNIX over set-sockaddr-un-family
- dup sockaddr-un-path rot utf8 string>alien dup length memcpy ;
+ sockaddr-un <struct>
+ AF_UNIX >>family
+ swap utf8 string>alien >>path ;
M: local parse-sockaddr
drop
- sockaddr-un-path utf8 alien>string <local> ;
+ path>> utf8 alien>string <local> ;
-USING: alien alien.accessors alien.c-types byte-arrays
+USING: alien alien.accessors alien.c-types alien.data byte-arrays
continuations destructors io.ports io.timeouts io.sockets
-io namespaces io.streams.duplex io.backend.windows
-io.sockets.windows io.backend.windows.nt windows.winsock kernel
-libc math sequences threads system combinators accessors ;
+io.sockets.private io namespaces io.streams.duplex
+io.backend.windows io.sockets.windows io.backend.windows.nt
+windows.winsock kernel libc math sequences threads system
+combinators accessors classes.struct windows.kernel32 ;
IN: io.sockets.windows.nt
-: malloc-int ( object -- object )
- "int" heap-size malloc [ nip ] [ 0 set-alien-signed-4 ] 2bi ; inline
+: malloc-int ( n -- alien )
+ <int> malloc-byte-array ; inline
M: winnt WSASocket-flags ( -- DWORD )
WSA_FLAG_OVERLAPPED ;
: get-ConnectEx-ptr ( socket -- void* )
SIO_GET_EXTENSION_FUNCTION_POINTER
WSAID_CONNECTEX
- "GUID" heap-size
+ GUID heap-size
"void*" <c-object>
[
"void*" heap-size
} cleave AcceptEx drop
winsock-error-string [ throw ] when* ; inline
+: (extract-remote-address) ( lpOutputBuffer dwReceiveDataLength dwLocalAddressLength dwRemoteAddressLength -- sockaddr )
+ f <void*> 0 <int> f <void*> [ 0 <int> GetAcceptExSockaddrs ] keep *void* ;
+
: extract-remote-address ( AcceptEx -- sockaddr )
- {
- [ lpOutputBuffer>> ]
- [ dwReceiveDataLength>> ]
- [ dwLocalAddressLength>> ]
- [ dwRemoteAddressLength>> ]
- } cleave
- f <void*>
- 0 <int>
- f <void*>
- [ 0 <int> GetAcceptExSockaddrs ] keep *void* ; inline
+ [
+ {
+ [ lpOutputBuffer>> ]
+ [ dwReceiveDataLength>> ]
+ [ dwLocalAddressLength>> ]
+ [ dwRemoteAddressLength>> ]
+ } cleave
+ (extract-remote-address)
+ ] [ port>> addr>> protocol-family ] bi
+ sockaddr-of-family ; inline
M: object (accept) ( server addr -- handle sockaddr )
[
lpFlags lpFrom lpFromLen lpOverlapped lpCompletionRoutine ;
: make-receive-buffer ( -- WSABUF )
- "WSABUF" malloc-object &free
- default-buffer-size get over set-WSABUF-len
- default-buffer-size get malloc &free over set-WSABUF-buf ; inline
+ WSABUF malloc-struct &free
+ default-buffer-size get
+ [ >>len ] [ malloc &free >>buf ] bi ; inline
: <WSARecvFrom-args> ( datagram -- WSARecvFrom )
WSARecvFrom-args new
} cleave WSARecvFrom socket-error* ; inline
: parse-WSARecvFrom ( n WSARecvFrom -- packet sockaddr )
- [ lpBuffers>> WSABUF-buf swap memory>byte-array ]
- [ [ lpFrom>> ] [ lpFromLen>> *int ] bi memory>byte-array ] bi ; inline
+ [ lpBuffers>> buf>> swap memory>byte-array ]
+ [
+ [ port>> addr>> empty-sockaddr dup ]
+ [ lpFrom>> ]
+ [ lpFromLen>> *int ]
+ tri memcpy
+ ] bi ; inline
M: winnt (receive) ( datagram -- packet addrspec )
[
dwFlags lpTo iToLen lpOverlapped lpCompletionRoutine ;
: make-send-buffer ( packet -- WSABUF )
- "WSABUF" malloc-object &free
- [ [ malloc-byte-array &free ] dip set-WSABUF-buf ]
- [ [ length ] dip set-WSABUF-len ]
- [ nip ]
- 2tri ; inline
+ [ WSABUF malloc-struct &free ] dip
+ [ malloc-byte-array &free >>buf ]
+ [ length >>len ] bi ; inline
: <WSASendTo-args> ( packet addrspec datagram -- WSASendTo )
WSASendTo-args new
-USING: kernel accessors io.sockets io.backend.windows io.backend\r
-windows.winsock system destructors alien.c-types ;\r
+USING: kernel accessors io.sockets io.sockets.private\r
+io.backend.windows io.backend windows.winsock system destructors\r
+alien.c-types classes.struct combinators ;\r
IN: io.sockets.windows\r
\r
+M: windows addrinfo-error ( n -- )\r
+ winsock-return-check ;\r
+\r
+M: windows sockaddr-of-family ( alien af -- addrspec )\r
+ {\r
+ { AF_INET [ sockaddr-in memory>struct ] }\r
+ { AF_INET6 [ sockaddr-in6 memory>struct ] }\r
+ [ 2drop f ]\r
+ } case ;\r
+\r
+M: windows addrspec-of-family ( af -- addrspec )\r
+ {\r
+ { AF_INET [ T{ inet4 } ] }\r
+ { AF_INET6 [ T{ inet6 } ] }\r
+ [ drop f ]\r
+ } case ;\r
+\r
HOOK: WSASocket-flags io-backend ( -- DWORD )\r
\r
TUPLE: win32-socket < win32-file ;\r
handle>> closesocket drop ;\r
\r
: unspecific-sockaddr/size ( addrspec -- sockaddr len )\r
- [ empty-sockaddr/size ] [ protocol-family ] bi\r
- pick set-sockaddr-in-family ;\r
+ [ empty-sockaddr/size ] [ protocol-family ] bi pick (>>family) ;\r
\r
: opened-socket ( handle -- win32-socket )\r
<win32-socket> |dispose dup add-completion ;\r
\r
M: windows (datagram) ( addrspec -- handle )\r
[ SOCK_DGRAM server-socket ] with-destructors ;\r
-\r
-M: windows addrinfo-error ( n -- )\r
- winsock-return-check ;\r
ARTICLE: "io.streams.duplex" "Duplex streams"
"Duplex streams combine an input stream and an output stream into a bidirectional stream."
-{ $subsection duplex-stream }
-{ $subsection <duplex-stream> }
+{ $subsections
+ duplex-stream
+ <duplex-stream>
+}
"A pair of combinators for rebinding both default streams at once:"
-{ $subsection with-stream }
-{ $subsection with-stream* } ;
+{ $subsections
+ with-stream
+ with-stream*
+} ;
ABOUT: "io.streams.duplex"
>duplex-stream<
[ underlying-handle ] bi@
[ = [ invalid-duplex-stream ] when ] keep ;
-
" \"123456\" <string-reader> 3 stream-throws limit"
" 100 swap stream-read ."
"] [ ] recover ."
- "T{ limit-exceeded }"
+"""T{ limit-exceeded
+ { n 1 }
+ { stream
+ T{ limited-stream
+ { stream
+ T{ string-reader
+ { underlying "123456" }
+ { i 3 }
+ }
+ }
+ { mode stream-throws }
+ { count 4 }
+ { limit 3 }
+ }
+ }
+}"""
}
"Returning " { $link f } " on exhaustion:"
{ $example
{ stream-eofs stream-throws } related-words
ARTICLE: "io.streams.limited" "Limited input streams"
-"The " { $vocab-link "io.streams.limited" } " vocabulary wraps a stream to behave as if it had only a limited number of bytes, either throwing an error or returning " { $link f } " upon reaching the end." $nl
+"The " { $vocab-link "io.streams.limited" } " vocabulary wraps a stream to behave as if it had only a limited number of bytes, either throwing an error or returning " { $link f } " upon reaching the end. Limiting a non-seekable stream keeps a byte count and triggers the end-of-stream behavior when this byte count has been reached. However, limiting a seekable stream creates a window of bytes that supports seeking and re-reading of bytes in that window." $nl
"Wrap a stream in a limited stream:"
-{ $subsection limit }
+{ $subsections limit }
"Wrap the current " { $link input-stream } " in a limited stream:"
-{ $subsection limit-input }
+{ $subsections limit-input }
"Unlimits a limited stream:"
-{ $subsection unlimited }
+{ $subsections unlimited }
"Unlimits the current " { $link input-stream } ":"
-{ $subsection unlimited-input }
+{ $subsections unlimited-input }
"Make a limited stream throw an exception on exhaustion:"
-{ $subsection stream-throws }
+{ $subsections stream-throws }
"Make a limited stream return " { $link f } " on exhaustion:"
-{ $subsection stream-eofs } ;
+{ $subsections stream-eofs } ;
ABOUT: "io.streams.limited"
-USING: io io.streams.limited io.encodings io.encodings.string
-io.encodings.ascii io.encodings.binary io.streams.byte-array
-namespaces tools.test strings kernel io.streams.string accessors
-io.encodings.utf8 io.files destructors ;
+USING: accessors continuations destructors io io.encodings
+io.encodings.8-bit io.encodings.ascii io.encodings.binary
+io.encodings.string io.encodings.utf8 io.files io.pipes
+io.streams.byte-array io.streams.limited io.streams.string
+kernel namespaces strings tools.test system ;
IN: io.streams.limited.tests
[ ] [
"HELLO"
[ f stream-throws limit-input 4 read ]
with-string-reader
-] unit-test
\ No newline at end of file
+] unit-test
+
+
+[ "asdf" ] [
+ "asdf" <string-reader> 2 stream-eofs <limited-stream> [
+ unlimited-input contents
+ ] with-input-stream
+] unit-test
+
+[ 4 ] [
+ "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
+ 4 seek-relative seek-input tell-input
+ ] with-input-stream
+] unit-test
+
+[
+ "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
+ 4 seek-relative seek-input
+ 4 read
+ ] with-input-stream
+] [
+ limit-exceeded?
+] must-fail-with
+
+[
+ "abcdefgh" <string-reader> 4 stream-throws <limited-stream> [
+ 4 seek-relative seek-input
+ -2 seek-relative
+ 2 read
+ ] with-input-stream
+] [
+ limit-exceeded?
+] must-fail-with
+
+[
+ "abcdefgh" <string-reader> [
+ 4 seek-relative seek-input
+ 2 stream-throws limit-input
+ -2 seek-relative seek-input
+ 2 read
+ ] with-input-stream
+] [
+ limit-exceeded?
+] must-fail-with
+
+[ "ef" ] [
+ "abcdefgh" <string-reader> [
+ 4 seek-relative seek-input
+ 2 stream-throws limit-input
+ 4 seek-absolute seek-input
+ 2 read
+ ] with-input-stream
+] unit-test
+
+[ "ef" ] [
+ "abcdefgh" <string-reader> [
+ 4 seek-absolute seek-input
+ 2 stream-throws limit-input
+ 2 seek-absolute seek-input
+ 4 seek-absolute seek-input
+ 2 read
+ ] with-input-stream
+] unit-test
+
+! stream-throws, pipes are duplex and not seekable
+[ "as" ] [
+ latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ 2 swap stream-read
+] unit-test
+
+[
+ latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ 3 swap stream-read
+] [
+ limit-exceeded?
+] must-fail-with
+
+! stream-eofs, pipes are duplex and not seekable
+[ "as" ] [
+ latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ 2 swap stream-read
+] unit-test
+
+[ "as" ] [
+ latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ 3 swap stream-read
+] unit-test
+
+! test seeking on limited unseekable streams
+[ "as" ] [
+ latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ 2 swap stream-read
+] unit-test
+
+[ "as" ] [
+ latin1 <pipe> [ 2 stream-eofs <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ 3 swap stream-read
+] unit-test
+
+[
+ latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+ 2 seek-absolute rot in>> stream-seek
+] must-fail
+
+[
+ "as"
+] [
+ latin1 <pipe> [ 2 stream-throws <limited-stream> ] change-in
+ "asdf" over stream-write dup stream-flush
+ [ 2 seek-absolute rot in>> stream-seek ] [ drop ] recover
+ 2 swap stream-read
+] unit-test
+
+[ 7 ] [
+ image binary stream-throws <limited-file-reader> [
+ 7 read drop
+ tell-input
+ ] with-input-stream
+] unit-test
+
+[ 70000 ] [
+ image binary stream-throws <limited-file-reader> [
+ 70000 read drop
+ tell-input
+ ] with-input-stream
+] unit-test
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors byte-vectors combinators destructors fry io
-io.encodings io.files io.files.info kernel math namespaces
-sequences ;
+io.encodings io.files io.files.info kernel locals math
+namespaces sequences ;
IN: io.streams.limited
-TUPLE: limited-stream stream count limit mode stack ;
+TUPLE: limited-stream
+ stream mode
+ count limit
+ current start stop ;
SINGLETONS: stream-throws stream-eofs ;
[ stream>> ] change-stream ;
M: object unlimited ( stream -- stream' )
- stream>> stream>> ;
+ stream>> ;
: limit-input ( limit mode -- )
[ input-stream ] 2dip '[ _ _ limit ] change ;
: with-limited-stream ( stream limit mode quot -- )
[ limit ] dip call ; inline
-ERROR: limit-exceeded ;
+ERROR: limit-exceeded n stream ;
ERROR: bad-stream-mode mode ;
<PRIVATE
-: adjust-limit ( n stream -- n' stream )
+: adjust-current-limit ( n stream -- n' stream )
+ 2dup [ + ] change-current
+ [ current>> ] [ stop>> ] bi >
+ [
+ dup mode>> {
+ { stream-throws [ limit-exceeded ] }
+ { stream-eofs [
+ dup [ current>> ] [ stop>> ] bi -
+ '[ _ - ] dip
+ ] }
+ [ bad-stream-mode ]
+ } case
+ ] when ; inline
+
+: adjust-count-limit ( n stream -- n' stream )
2dup [ + ] change-count
[ count>> ] [ limit>> ] bi >
[
{ stream-eofs [
dup [ count>> ] [ limit>> ] bi -
'[ _ - ] dip
+ dup limit>> >>count
] }
[ bad-stream-mode ]
} case
] when ; inline
+: check-count-bounds ( n stream -- n stream )
+ dup [ count>> ] [ limit>> ] bi >
+ [ limit-exceeded ] when ;
+
+: check-current-bounds ( n stream -- n stream )
+ dup [ current>> ] [ start>> ] bi <
+ [ limit-exceeded ] when ;
+
+: adjust-limited-read ( n stream -- n stream )
+ dup start>> [
+ check-current-bounds adjust-current-limit
+ ] [
+ check-count-bounds adjust-count-limit
+ ] if ;
+
: maybe-read ( n limited-stream quot: ( n stream -- seq/f ) -- seq/f )
- [ adjust-limit ] dip
+ [ adjust-limited-read ] dip
pick 0 <= [ 3drop f ] [ [ stream>> ] dip call ] if ; inline
PRIVATE>
3dup [ [ stream-read1 dup ] dip memq? ] dip
swap [ drop ] [ push (read-until) ] if ;
+:: limited-stream-seek ( n seek-type stream -- )
+ seek-type {
+ { seek-absolute [ n stream (>>current) ] }
+ { seek-relative [ stream [ n + ] change-current drop ] }
+ { seek-end [ stream stop>> n - stream (>>current) ] }
+ [ bad-seek-type ]
+ } case ;
+
+: >limited-seek ( stream -- stream' )
+ dup start>> [
+ dup stream-tell >>current
+ dup [ current>> ] [ count>> ] bi - >>start
+ dup [ start>> ] [ limit>> ] bi + >>stop
+ ] unless ;
+
PRIVATE>
M: limited-stream stream-read-until
swap BV{ } clone (read-until) [ 2nip B{ } like ] dip ;
+M: limited-stream stream-tell
+ stream>> stream-tell ;
+
M: limited-stream stream-seek
- stream>> stream-seek ;
+ >limited-seek
+ [ stream>> stream-seek ]
+ [ limited-stream-seek ] 3bi ;
+
+M: limited-stream dispose stream>> dispose ;
-M: limited-stream dispose
- stream>> dispose ;
+M: limited-stream stream-element-type
+ stream>> stream-element-type ;
"The " { $vocab-link "io.streams.null" } " vocabulary implements a pair of streams which are useful for testing. The null reader always yields EOF and the null writer ignores all output. Conceptually, they are similar to " { $snippet "/dev/null" } " on a Unix system."
$nl
"Null readers:"
-{ $subsection null-reader }
-{ $subsection with-null-writer }
+{ $subsections
+ null-reader
+ with-null-writer
+}
"Null writers:"
-{ $subsection null-writer }
-{ $subsection with-null-reader } ;
+{ $subsections
+ null-writer
+ with-null-reader
+} ;
ABOUT: "io.streams.null"
\ No newline at end of file
ARTICLE: "io.streams.string" "String streams"
"String streams:"
-{ $subsection <string-reader> }
-{ $subsection <string-writer> }
+{ $subsections
+ <string-reader>
+ <string-writer>
+}
"Utility combinators:"
-{ $subsection with-string-reader }
-{ $subsection with-string-writer } ;
+{ $subsections
+ with-string-reader
+ with-string-writer
+} ;
ABOUT: "io.streams.string"
! See http://factorcode.org/license.txt for BSD license.
USING: accessors io kernel math namespaces sequences sbufs
strings generic splitting continuations destructors sequences.private
-io.streams.plain io.encodings math.order growable io.streams.sequence ;
+io.streams.plain io.encodings math.order growable io.streams.sequence
+io.private ;
IN: io.streams.string
! Readers
M: string-reader stream-read sequence-read ;
M: string-reader stream-read1 sequence-read1 ;
M: string-reader stream-read-until sequence-read-until ;
+M: string-reader stream-tell i>> ;
+M: string-reader stream-seek (stream-seek) ;
M: string-reader dispose drop ;
<PRIVATE
: with-string-writer ( quot -- str )
<string-writer> [
swap with-output-stream*
- ] keep >string ; inline
\ No newline at end of file
+ ] keep >string ; inline
ARTICLE: "formatted-stream-protocol" "Formatted stream protocol"
"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for output streams that support rich text."
-{ $subsection stream-format }
-{ $subsection make-span-stream }
-{ $subsection make-block-stream }
-{ $subsection make-cell-stream }
-{ $subsection stream-write-table } ;
+{ $subsections
+ stream-format
+ make-span-stream
+ make-block-stream
+ make-cell-stream
+ stream-write-table
+} ;
ARTICLE: "formatted-stdout" "Formatted output on the default stream"
"The below words perform formatted output on " { $link output-stream } "."
$nl
"Formatted output:"
-{ $subsection format }
-{ $subsection with-style }
-{ $subsection with-nesting }
+{ $subsections
+ format
+ with-style
+ with-nesting
+}
"Tabular output:"
-{ $subsection tabular-output }
-{ $subsection with-row }
-{ $subsection with-cell }
-{ $subsection write-cell } ;
+{ $subsections
+ tabular-output
+ with-row
+ with-cell
+ write-cell
+} ;
HELP: href
{ $description "Character style. A URL string that the text links to." } ;
ARTICLE: "character-styles" "Character styles"
"Character styles for " { $link stream-format } " and " { $link with-style } ":"
-{ $subsection foreground }
-{ $subsection background }
-{ $subsection font-name }
-{ $subsection font-size }
-{ $subsection font-style }
+{ $subsections
+ foreground
+ background
+ font-name
+ font-size
+ font-style
+}
"Special styles:"
-{ $subsection href }
-{ $subsection image }
+{ $subsections
+ href
+ image
+}
{ $see-also "presentations" } ;
ARTICLE: "paragraph-styles" "Paragraph styles"
"Paragraph styles for " { $link with-nesting } ":"
-{ $subsection page-color }
-{ $subsection border-color }
-{ $subsection border-width }
-{ $subsection wrap-margin }
-{ $subsection presented } ;
+{ $subsections
+ page-color
+ border-color
+ inset
+ wrap-margin
+ presented
+} ;
ARTICLE: "table-styles" "Table styles"
"Table styles for " { $link tabular-output } ":"
-{ $subsection table-gap }
-{ $subsection table-border } ;
+{ $subsections
+ table-gap
+ table-border
+} ;
HELP: write-object
{ $values { "str" string } { "obj" "an object" } }
ARTICLE: "presentations" "Presentations"
"A special style for " { $link format } " and " { $link with-nesting } ":"
-{ $subsection presented }
+{ $subsections presented }
"The " { $link presented } " style can be used to emit clickable objects. A utility word for outputting this style:"
-{ $subsection write-object } ;
+{ $subsections write-object } ;
ARTICLE: "styles" "Text styles"
"The " { $link stream-format } ", " { $link with-style } ", " { $link with-nesting } " and " { $link tabular-output } " words take a hashtable of style attributes. Output stream implementations are free to ignore style information."
$nl
"Style hashtables are keyed by symbols from the " { $vocab-link "io.styles" } " vocabulary."
-{ $subsection "character-styles" }
-{ $subsection "paragraph-styles" }
-{ $subsection "table-styles" }
-{ $subsection "presentations" } ;
+{ $subsections
+ "character-styles"
+ "paragraph-styles"
+ "table-styles"
+ "presentations"
+} ;
ARTICLE: "io.styles" "Formatted output"
"The " { $vocab-link "io.styles" } " vocabulary defines a protocol for formatted output. This is used by the prettyprinter, help system, and various developer tools. Implementations include " { $vocab-link "ui.gadgets.panes" } ", " { $vocab-link "html.streams" } ", and " { $vocab-link "io.streams.plain" } "."
-{ $subsection "formatted-stream-protocol" }
-{ $subsection "formatted-stdout" }
-{ $subsection "styles" } ;
+{ $subsections
+ "formatted-stream-protocol"
+ "formatted-stdout"
+ "styles"
+} ;
ABOUT: "io.styles"
{ $code "H{ { border-color T{ rgba f 1 0 0 1 } } }\n[ \"A border\" write ] with-nesting nl" }
} ;
-HELP: border-width
-{ $description "Paragraph style. Pixels between edge of text and border, an integer." }
+HELP: inset
+{ $description "Paragraph style. A pair of integers representing the number of pixels that the content should be inset from the border. The first number is the horizontal inset, and the second is the vertical inset." }
{ $examples
- { $code "H{ { border-width 10 } }\n[ \"Some inset text\" write ] with-nesting nl" }
+ { $code "H{ { inset { 10 10 } } }\n[ \"Some inset text\" write ] with-nesting nl" }
} ;
HELP: wrap-margin
{ $link make-span-stream } ", "
{ $link make-block-stream } " and "
{ $link make-cell-stream } "."
-{ $subsection plain-writer } ;
\ No newline at end of file
+{ $subsections plain-writer } ;
\ No newline at end of file
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables io io.streams.plain io.streams.string
-colors summary make accessors splitting math.order
-kernel namespaces assocs destructors strings sequences
-present fry strings.tables delegate delegate.protocols ;
+USING: accessors assocs colors colors.constants delegate
+delegate.protocols destructors fry hashtables io
+io.streams.plain io.streams.string kernel make math.order
+namespaces present sequences splitting strings strings.tables
+summary ;
IN: io.styles
GENERIC: stream-format ( str style stream -- )
! Paragraph styles
SYMBOL: page-color
SYMBOL: border-color
-SYMBOL: border-width
+SYMBOL: inset
SYMBOL: wrap-margin
! Table styles
: write-object ( str obj -- ) presented associate format ;
: write-image ( image -- ) [ "" ] dip image associate format ;
+
+SYMBOL: stack-effect-style
+H{
+ { foreground COLOR: FactorDarkGreen }
+ { font-style plain }
+} stack-effect-style set-global
\r
ARTICLE: "io.timeouts" "I/O timeout protocol"\r
"Streams, processes and monitors support optional timeouts, which impose an upper bound on the length of time for which an operation on these objects can block. Timeouts are used in network servers to prevent malicious clients from holding onto connections forever, and to ensure that runaway processes get killed."\r
-{ $subsection timeout }\r
-{ $subsection set-timeout }\r
+{ $subsections\r
+ timeout\r
+ set-timeout\r
+}\r
"The I/O timeout protocol can be implemented by any class wishing to support timeouts on blocking operations."\r
-{ $subsection cancel-operation }\r
+{ $subsections cancel-operation }\r
"A combinator to be used in operations which can time out:"\r
-{ $subsection with-timeout }\r
+{ $subsections with-timeout }\r
{ $see-also "stream-protocol" "io.launcher" "io.monitors" } ;\r
\r
ABOUT: "io.timeouts"\r
-USING: iokit alien alien.syntax alien.c-types kernel
-system core-foundation core-foundation.data
-core-foundation.dictionaries ;
+USING: iokit alien alien.syntax alien.c-types kernel system
+core-foundation core-foundation.arrays core-foundation.data
+core-foundation.dictionaries core-foundation.run-loop
+core-foundation.strings core-foundation.time ;
IN: iokit.hid
CONSTANT: kIOHIDDeviceKey "IOHIDDevice"
TYPEDEF: UInt32 IOHIDValueScaleType
TYPEDEF: UInt32 IOHIDTransactionDirectionType
-TYPEDEF: void* IOHIDCallback
-: IOHIDCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDReportCallback
-: IOHIDReportCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "IOHIDReportType" "UInt32" "uchar*" "CFIndex" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDValueCallback
-: IOHIDValueCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "IOHIDValueRef" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDValueMultipleCallback
-: IOHIDValueMultipleCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "CFDictionaryRef" } "cdecl" ]
- dip alien-callback ; inline
-
-TYPEDEF: void* IOHIDDeviceCallback
-: IOHIDDeviceCallback ( quot -- alien )
- [ "void" { "void*" "IOReturn" "void*" "IOHIDDeviceRef" } "cdecl" ]
- dip alien-callback ; inline
+CALLBACK: void IOHIDCallback ( void* context, IOReturn result, void* sender ) ;
+CALLBACK: void IOHIDReportCallback ( void* context, IOReturn result, void* sender, IOHIDReportType type, UInt32 reportID, uchar* report, CFIndex reportLength ) ;
+CALLBACK: void IOHIDValueCallback ( void* context, IOReturn result, void* sender, IOHIDValueRef value ) ;
+CALLBACK: void IOHIDValueMultipleCallback ( void* context, IOReturn result, void* sender, CFDictionaryRef multiple ) ;
+CALLBACK: void IOHIDDeviceCallback ( void* context, IOReturn result, void* sender, IOHIDDeviceRef device ) ;
! IOHIDDevice
USING: help.markup help.syntax ;
ARTICLE: "json" "JSON serialization"
-{ $subsection "json.reader" }
-{ $subsection "json.writer" } ;
+{ $subsections
+ "json.reader"
+ "json.writer"
+} ;
ABOUT: "json"
ARTICLE: "json.reader" "JSON reader"
"The " { $vocab-link "json.reader" } " vocabulary defines a word for parsing strings in JSON format."
-{ $subsection json> } ;
+{ $subsections json> } ;
ABOUT: "json.reader"
-USING: arrays json.reader kernel multiline strings tools.test
+USING: arrays json.reader kernel strings tools.test
hashtables json ;
IN: json.reader.tests
! feature to get
{ -0.0 } [ "-0.0" json> ] unit-test
-{ " fuzzy pickles " } [ <" " fuzzy pickles " "> json> ] unit-test
-{ "while 1:\n\tpass" } [ <" "while 1:\n\tpass" "> json> ] unit-test
+{ " fuzzy pickles " } [ """ " fuzzy pickles " """ json> ] unit-test
+{ "while 1:\n\tpass" } [ """ "while 1:\n\tpass" """ json> ] unit-test
! unicode is allowed in json
-{ "ß∂¬ƒ˚∆" } [ <" "ß∂¬ƒ˚∆""> json> ] unit-test
-{ 8 9 10 12 13 34 47 92 } >string 1array [ <" "\b\t\n\f\r\"\/\\" "> json> ] unit-test
-{ HEX: abcd } >string 1array [ <" "\uaBCd" "> json> ] unit-test
+{ "ß∂¬ƒ˚∆" } [ """ "ß∂¬ƒ˚∆"""" json> ] unit-test
+{ 8 9 10 12 13 34 47 92 } >string 1array [ """ "\\b\\t\\n\\f\\r\\"\\/\\\\" """ json> ] unit-test
+{ HEX: abcd } >string 1array [ """ "\\uaBCd" """ json> ] unit-test
{ H{ { "a" { } } { "b" 123 } } } [ "{\"a\":[],\"b\":123}" json> ] unit-test
{ { } } [ "[]" json> ] unit-test
-{ { 1 "two" 3.0 } } [ <" [1, "two", 3.0] "> json> ] unit-test
+{ { 1 "two" 3.0 } } [ """ [1, "two", 3.0] """ json> ] unit-test
{ H{ } } [ "{}" json> ] unit-test
! the returned hashtable should be different every time
{ H{ } } [ "key" "value" "{}" json> ?set-at "{}" json> nip ] unit-test
-{ H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ <" { "US$":1.00, "EU\u20AC":1.50 } "> json> ] unit-test
+{ H{ { "US$" 1.0 } { "EU€" 1.5 } } } [ """ { "US$":1.00, "EU\\u20AC":1.50 } """ json> ] unit-test
{ H{
{ "fib" { 1 1 2 3 5 8 H{ { "etc" "etc" } } } }
{ "prime" { 2 3 5 7 11 13 } }
-} } [ <" {
+} } [ """ {
"fib": [1, 1, 2, 3, 5, 8,
{ "etc":"etc" } ],
"prime":
11,
13
] }
-"> json> ] unit-test
+""" json> ] unit-test
{ 0 } [ " 0" json> ] unit-test
{ 0 } [ "0 " json> ] unit-test
! Copyright (C) 2008 Peter Burns, 2009 Philipp Winkler
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators io io.streams.string json
-kernel math math.parser math.parser.private prettyprint
+kernel math math.parser prettyprint
sequences strings vectors ;
IN: json.reader
PRIVATE>
: json> ( string -- object )
- (json-parser>) ;
\ No newline at end of file
+ (json-parser>) ;
ARTICLE: "json.writer" "JSON writer"
"The " { $vocab-link "json.writer" } " vocabulary defines words for converting objects to JSON format."
-{ $subsection >json }
-{ $subsection json-print } ;
+{ $subsections
+ >json
+ json-print
+} ;
ABOUT: "json.writer"
-USING: json.writer tools.test multiline json.reader json ;
+USING: json.writer tools.test json.reader json ;
IN: json.writer.tests
{ "false" } [ f >json ] unit-test
{ "102.5" } [ 102.5 >json ] unit-test
{ "[1,\"two\",3.0]" } [ { 1 "two" 3.0 } >json ] unit-test
-{ <" {"US$":1.0,"EU€":1.5}"> } [ H{ { "US$" 1.0 } { "EU€" 1.5 } } >json ] unit-test
+{ """{"US$":1.0,"EU€":1.5}""" } [ H{ { "US$" 1.0 } { "EU€" 1.5 } } >json ] unit-test
! Random symbols are written simply as strings
SYMBOL: testSymbol
-{ <" "testSymbol""> } [ testSymbol >json ] unit-test
+{ """"testSymbol"""" } [ testSymbol >json ] unit-test
-[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test
\ No newline at end of file
+[ { 0.5 } ] [ { 1/2 } >json json> ] unit-test
\r
ARTICLE: "lcs" "LCS, diffing and distance"\r
"This vocabulary provides words for three apparently unrelated but in fact very similar problems: finding a longest common subsequence between two sequences, getting a minimal edit script (diff) between two sequences, and calculating the Levenshtein distance between two sequences. The implementations of these algorithms are very closely related, and all running times are O(nm), where n and m are the lengths of the input sequences."\r
-{ $subsection lcs }\r
-{ $subsection diff }\r
-{ $subsection levenshtein }\r
+{ $subsections\r
+ lcs\r
+ diff\r
+ levenshtein\r
+}\r
"The " { $link diff } " word returns a sequence of tuples of the following classes. They all hold their contents in the 'item' slot."\r
-{ $subsection insert }\r
-{ $subsection delete }\r
-{ $subsection retain } ;\r
+{ $subsections\r
+ insert\r
+ delete\r
+ retain\r
+} ;\r
\r
ABOUT: "lcs"\r
! Copyright (C) 2007, 2009 Slava Pestov
! Copyright (C) 2007, 2008 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
-USING: alien assocs continuations alien.destructors kernel
+USING: alien alien.c-types assocs continuations alien.destructors kernel
namespaces accessors sets summary destructors destructors.private ;
IN: libc
: errno ( -- int )
- "int" "factor" "err_no" { } alien-invoke ;
+ int "factor" "err_no" { } alien-invoke ;
: clear-errno ( -- )
- "void" "factor" "clear_err_no" { } alien-invoke ;
+ void "factor" "clear_err_no" { } alien-invoke ;
<PRIVATE
: (malloc) ( size -- alien )
- "void*" "libc" "malloc" { "ulong" } alien-invoke ;
+ void* "libc" "malloc" { ulong } alien-invoke ;
: (calloc) ( count size -- alien )
- "void*" "libc" "calloc" { "ulong" "ulong" } alien-invoke ;
+ void* "libc" "calloc" { ulong ulong } alien-invoke ;
: (free) ( alien -- )
- "void" "libc" "free" { "void*" } alien-invoke ;
+ void "libc" "free" { void* } alien-invoke ;
: (realloc) ( alien size -- newalien )
- "void*" "libc" "realloc" { "void*" "ulong" } alien-invoke ;
+ void* "libc" "realloc" { void* ulong } alien-invoke ;
! We stick malloc-ptr instances in the global disposables set
TUPLE: malloc-ptr value continuation ;
>c-ptr [ delete-malloc ] [ (free) ] bi ;
: memcpy ( dst src size -- )
- "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ;
+ void "libc" "memcpy" { void* void* ulong } alien-invoke ;
: memcmp ( a b size -- cmp )
- "int" "libc" "memcmp" { "void*" "void*" "ulong" } alien-invoke ;
+ int "libc" "memcmp" { void* void* ulong } alien-invoke ;
: memory= ( a b size -- ? )
memcmp 0 = ;
: strlen ( alien -- len )
- "size_t" "libc" "strlen" { "char*" } alien-invoke ;
+ size_t "libc" "strlen" { char* } alien-invoke ;
DESTRUCTOR: free
"A " { $emphasis "linked assoc" } " is an assoc which combines an underlying assoc with a dlist to form a structure which has the insertion and retrieval characteristics of the underlying assoc (typically a hashtable), but with the ability to get the entries in insertion order by calling " { $link >alist } "."
$nl
"Linked assocs are implemented in the " { $vocab-link "linked-assocs" } " vocabulary."
-{ $subsection linked-assoc }
-{ $subsection <linked-hash> }
-{ $subsection <linked-assoc> } ;
+{ $subsections
+ linked-assoc
+ <linked-hash>
+ <linked-assoc>
+} ;
ABOUT: "linked-assocs"
\ No newline at end of file
ARTICLE: "listener-watch" "Watching variables in the listener"
"The listener prints the concepts of the data and retain stacks after every expression. It can also print values of dynamic variables which are added to a watch list:"
-{ $subsection visible-vars }
+{ $subsections visible-vars }
"To add or remove a single variable:"
-{ $subsection show-var }
-{ $subsection hide-var }
+{ $subsections
+ show-var
+ hide-var
+}
"To add and remove multiple variables:"
-{ $subsection show-vars }
-{ $subsection hide-vars }
+{ $subsections
+ show-vars
+ hide-vars
+}
"Hiding all visible variables:"
-{ $subsection hide-all-vars } ;
+{ $subsections hide-all-vars } ;
HELP: only-use-vocabs
{ $values { "vocabs" "a sequence of vocabulary specifiers" } }
"Multi-line expressions are supported:"
{ $example "{ 1 2 3 } [\n .\n] each" "1\n2\n3" }
"The listener knows when to expect more input by looking at the height of the stack. Parsing words such as " { $link POSTPONE: { } " leave elements on the parser stack, and corresponding words such as " { $link POSTPONE: } } " pop them."
-{ $subsection "listener-watch" }
+{ $subsections "listener-watch" }
"To start a nested listener:"
-{ $subsection listener }
+{ $subsections listener }
"To exit the listener, invoke the " { $link return } " word."
$nl
"Multi-line quotations can be read independently of the rest of the listener:"
-{ $subsection read-quot } ;
+{ $subsections read-quot } ;
ABOUT: "listener"
ARTICLE: "lists.lazy" "Lazy lists"
"The " { $vocab-link "lists.lazy" } " vocabulary implements lazy lists and standard operations to manipulate them."
-{ $subsection { "lists.lazy" "construction" } }
-{ $subsection { "lists.lazy" "manipulation" } }
-{ $subsection { "lists.lazy" "combinators" } }
-{ $subsection { "lists.lazy" "io" } } ;
+{ $subsections
+ { "lists.lazy" "construction" }
+ { "lists.lazy" "manipulation" }
+ { "lists.lazy" "combinators" }
+ { "lists.lazy" "io" }
+} ;
ARTICLE: { "lists.lazy" "combinators" } "Combinators for manipulating lazy lists"
"The following combinators create lazy lists from other lazy lists:"
-{ $subsection lazy-map }
-{ $subsection lfilter }
-{ $subsection luntil }
-{ $subsection lwhile }
-{ $subsection lfrom-by }
-{ $subsection lcomp }
-{ $subsection lcomp* } ;
+{ $subsections
+ lazy-map
+ lfilter
+ luntil
+ lwhile
+ lfrom-by
+ lcomp
+ lcomp*
+} ;
ARTICLE: { "lists.lazy" "io" } "Lazy list I/O"
"Input from a stream can be read through a lazy list, using the following words:"
-{ $subsection lcontents }
-{ $subsection llines } ;
+{ $subsections
+ lcontents
+ llines
+} ;
ARTICLE: { "lists.lazy" "construction" } "Constructing lazy lists"
"Words for constructing lazy lists:"
-{ $subsection lazy-cons }
-{ $subsection 1lazy-list }
-{ $subsection 2lazy-list }
-{ $subsection 3lazy-list }
-{ $subsection sequence-tail>list }
-{ $subsection >list }
-{ $subsection lfrom } ;
+{ $subsections
+ lazy-cons
+ 1lazy-list
+ 2lazy-list
+ 3lazy-list
+ sequence-tail>list
+ >list
+ lfrom
+} ;
ARTICLE: { "lists.lazy" "manipulation" } "Manipulating lazy lists"
"To make new lazy lists from old ones:"
-{ $subsection <memoized-cons> }
-{ $subsection lappend }
-{ $subsection lconcat }
-{ $subsection lcartesian-product }
-{ $subsection lcartesian-product* }
-{ $subsection lmerge }
-{ $subsection ltake } ;
+{ $subsections
+ <memoized-cons>
+ lappend
+ lconcat
+ lcartesian-product
+ lcartesian-product*
+ lmerge
+ ltake
+} ;
HELP: lazy-cons
{ $values { "car" { $quotation "( -- elt )" } } { "cdr" { $quotation "( -- cons )" } } { "promise" "the resulting cons object" } }
ARTICLE: "lists" "Lists"
"The " { $vocab-link "lists" } " vocabulary implements linked lists. There are simple strict linked lists, but a generic list protocol allows the implementation of lazy lists as well."
-{ $subsection { "lists" "protocol" } }
-{ $subsection { "lists" "strict" } }
-{ $subsection { "lists" "manipulation" } }
-{ $subsection { "lists" "combinators" } }
+{ $subsections
+ { "lists" "protocol" }
+ { "lists" "strict" }
+ { "lists" "manipulation" }
+ { "lists" "combinators" }
+}
{ $vocab-subsection "Lazy lists" "lists.lazy" } ;
ARTICLE: { "lists" "protocol" } "The list protocol"
"Lists are instances of a mixin class:"
-{ $subsection list }
+{ $subsections list }
"Instances of the mixin must implement the following words:"
-{ $subsection car }
-{ $subsection cdr }
-{ $subsection nil? } ;
+{ $subsections
+ car
+ cdr
+ nil?
+} ;
ARTICLE: { "lists" "strict" } "Constructing strict lists"
"Strict lists are simply cons cells where the car and cdr have already been evaluated. These are the lists of Lisp. To construct a strict list, the following words are provided:"
-{ $subsection cons }
-{ $subsection swons }
-{ $subsection sequence>list }
-{ $subsection 1list }
-{ $subsection 2list }
-{ $subsection 3list } ;
+{ $subsections
+ cons
+ swons
+ sequence>list
+ 1list
+ 2list
+ 3list
+} ;
ARTICLE: { "lists" "combinators" } "Combinators for lists"
"Several combinators exist for list traversal."
-{ $subsection leach }
-{ $subsection lmap }
-{ $subsection foldl }
-{ $subsection foldr }
-{ $subsection lmap>array }
-{ $subsection traverse } ;
+{ $subsections
+ leach
+ lmap
+ foldl
+ foldr
+ lmap>array
+ traverse
+} ;
ARTICLE: { "lists" "manipulation" } "Manipulating lists"
"To get at the contents of a list:"
-{ $subsection uncons }
-{ $subsection unswons }
-{ $subsection lnth }
-{ $subsection cadr }
-{ $subsection llength }
+{ $subsections
+ uncons
+ unswons
+ lnth
+ cadr
+ llength
+}
"To get a new list from an old one:"
-{ $subsection lreverse }
-{ $subsection lappend }
-{ $subsection lcut } ;
+{ $subsections
+ lreverse
+ lappend
+ lcut
+} ;
HELP: cons
{ $values { "car" "the head of the list cell" } { "cdr" "the tail of the list cell" } { "cons" list } }
{ $notes { $snippet "word" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
{ $examples
- { $example <"
+ { $example """
USING: kernel literals prettyprint ;
IN: scratchpad
CONSTANT: five 5
{ $ five } .
- "> "{ 5 }" }
+ """ "{ 5 }" }
- { $example <"
+ { $example """
USING: kernel literals prettyprint ;
IN: scratchpad
: seven-eleven ( -- a b ) 7 11 ;
{ $ seven-eleven } .
- "> "{ 7 11 }" }
+ """ "{ 7 11 }" }
} ;
{ $notes "Since " { $snippet "code" } " is " { $link call } "ed at parse time, it cannot reference any words defined in the same compilation unit." }
{ $examples
- { $example <"
+ { $example """
USING: kernel literals math prettyprint ;
IN: scratchpad
<< CONSTANT: five 5 >>
{ $[ five dup 1 + dup 2 + ] } .
- "> "{ 5 6 8 }" }
+ """ "{ 5 6 8 }" }
} ;
{ $notes { $snippet "code" } "'s definition is looked up and " { $link call } "ed at parse time, so words that reference words in the current compilation unit cannot be used with " { $snippet "$" } "." }
{ $examples
- { $example <"
+ { $example """
USING: kernel literals math prettyprint ;
IN: scratchpad
CONSTANT: five 5
CONSTANT: six 6
${ five six 7 } .
- "> "{ 5 6 7 }"
+ """ "{ 5 6 7 }"
}
} ;
ARTICLE: "literals" "Interpolating code results into literal values"
"The " { $vocab-link "literals" } " vocabulary contains words to run code at parse time and insert the results into more complex literal values."
-{ $example <"
+{ $example """
USE: literals
IN: scratchpad
CONSTANT: five 5
{ $ five $[ five dup 1 + dup 2 + ] } .
- "> "{ 5 5 6 8 }" }
-{ $subsection POSTPONE: $ }
-{ $subsection POSTPONE: $[ }
-{ $subsection POSTPONE: ${ }
-;
+ """ "{ 5 5 6 8 }" }
+{ $subsections
+ POSTPONE: $
+ POSTPONE: $[
+ POSTPONE: ${
+} ;
ABOUT: "literals"
! (c) Joe Groff, see license for details
USING: accessors continuations kernel parser words quotations
-combinators.smart vectors sequences fry ;
+vectors sequences fry ;
IN: literals
<PRIVATE
SYNTAX: $ scan-word expand-literal >vector ;
SYNTAX: $[ parse-quotation with-datastack >vector ;
SYNTAX: ${ \ } [ expand-literals ] parse-literal ;
-
-SYNTAX: $$
- scan-word execute( accum -- accum ) dup pop [ >quotation ] keep
- [ output>sequence ] 2curry call( -- object ) parsed ;
"Compile-time transformation is used to compile local variables to efficient code; prettyprinter extensions are defined so that " { $link see } " can display original word definitions with local variables and not the closure-converted concatenative code which results."
$nl
"Applicative word definitions where the inputs are named local variables:"
-{ $subsection POSTPONE: :: }
-{ $subsection POSTPONE: M:: }
-{ $subsection POSTPONE: MEMO:: }
-{ $subsection POSTPONE: MACRO:: }
+{ $subsections
+ POSTPONE: ::
+ POSTPONE: M::
+ POSTPONE: MEMO::
+ POSTPONE: MACRO::
+}
"Lexical binding forms:"
-{ $subsection POSTPONE: [let }
-{ $subsection POSTPONE: [let* }
-{ $subsection POSTPONE: [wlet }
+{ $subsections
+ POSTPONE: [let
+ POSTPONE: [let*
+ POSTPONE: [wlet
+}
"Lambda abstractions:"
-{ $subsection POSTPONE: [| }
+{ $subsections POSTPONE: [| }
"Lightweight binding form:"
-{ $subsection POSTPONE: :> }
+{ $subsections POSTPONE: :> }
"Additional topics:"
-{ $subsection "locals-literals" }
-{ $subsection "locals-mutable" }
-{ $subsection "locals-fry" }
-{ $subsection "locals-limitations" }
+{ $subsections
+ "locals-literals"
+ "locals-mutable"
+ "locals-fry"
+ "locals-limitations"
+}
"Locals complement dynamically scoped variables implemented in the " { $vocab-link "namespaces" } " vocabulary." ;
ABOUT: "locals"
"The " { $vocab-link "logging.analysis" } " vocabulary builds on the " { $vocab-link "logging.parser" } " vocabulary. It parses log files and produces formatted summary reports. It is used by the " { $vocab-link "logging.insomniac" } " vocabulary to e-mail daily reports."
$nl
"Print log file summary:"
-{ $subsection analyze-log }
+{ $subsections analyze-log }
"Factors:"
-{ $subsection analyze-entries }
-{ $subsection analysis. } ;
+{ $subsections
+ analyze-entries
+ analysis.
+} ;
ABOUT: "logging.analysis"
"The " { $vocab-link "logging.insomniac" } " vocabulary builds on the " { $vocab-link "logging.analysis" } " vocabulary. It provides support for e-mailing log reports and rotating logs on a daily basis. E-mails are sent using the " { $vocab-link "smtp" } " vocabulary."
$nl
"Required configuration parameters:"
-{ $subsection insomniac-sender }
-{ $subsection insomniac-recipients }
+{ $subsections
+ insomniac-sender
+ insomniac-recipients
+}
"E-mailing a one-off report:"
-{ $subsection email-log-report }
+{ $subsections email-log-report }
"E-mailing reports and rotating logs on a daily basis:"
-{ $subsection schedule-insomniac } ;
+{ $subsections schedule-insomniac } ;
ABOUT: "logging.insomniac"
ARTICLE: "logging.levels" "Log levels"
"Several log levels are supported, from lowest to highest:"
-{ $subsection DEBUG }
-{ $subsection NOTICE }
-{ $subsection WARNING }
-{ $subsection ERROR }
-{ $subsection CRITICAL } ;
+{ $subsections
+ DEBUG
+ NOTICE
+ WARNING
+ ERROR
+ CRITICAL
+} ;
ARTICLE: "logging.files" "Log files"
"Each application that wishes to use logging must choose a log service name; the following combinator should wrap the top level of the application:"
-{ $subsection with-logging }
+{ $subsections with-logging }
"Log messages are written to " { $snippet "log-root/service/1.log" } ", where"
{ $list
{ { $snippet "log-root" } " is the Factor source directory by default, but can be overriden with the " { $link log-root } " variable" }
{ { $snippet "service" } " is the service name" }
}
"You can get the log path for a service:"
-{ $subsection log-path }
-{ $subsection log# }
+{ $subsections
+ log-path
+ log#
+}
"New log entries are always sent to " { $snippet "1.log" } " but " { $link "logging.rotation" } " moves " { $snippet "1.log" } " to " { $snippet "2.log" } ", " { $snippet "2.log" } " to " { $snippet "3.log" } ", and so on." ;
HELP: log-message
ARTICLE: "logging.messages" "Logging messages"
"Logging messages explicitly:"
-{ $subsection log-message }
-{ $subsection log-error }
-{ $subsection log-critical }
+{ $subsections
+ log-message
+ log-error
+ log-critical
+}
"A utility for defining words which just log and do nothing else:"
-{ $subsection POSTPONE: LOG: }
+{ $subsections POSTPONE: LOG: }
"Annotating words to log; this uses the " { $link "tools.annotations" } " feature:"
-{ $subsection add-input-logging }
-{ $subsection add-output-logging }
-{ $subsection add-error-logging } ;
+{ $subsections
+ add-input-logging
+ add-output-logging
+ add-error-logging
+} ;
HELP: rotate-logs
{ $description "Rotates all logs. The highest numbered log file in each log directory is deleted, and each file is renamed so that its number increments by one. Subsequent logging calls will create a new #1 log file. This keeps log files from getting too large and makes them easier to search." } ;
ARTICLE: "logging.rotation" "Log rotation"
"Log files should be rotated periodically to prevent unbounded growth."
-{ $subsection rotate-logs }
-{ $subsection close-logs }
+{ $subsections
+ rotate-logs
+ close-logs
+}
"The " { $vocab-link "logging.insomniac" } " vocabulary automates log rotation." ;
ARTICLE: "logging.server" "Log implementation"
"The " { $vocab-link "logging.server" } " vocabulary implements a concurrent log server using " { $vocab-link "concurrency.messaging" } ". User code never interacts with the server directly, instead it uses the words in the " { $link "logging" } " vocabulary. The server is used to synchronize access to log files and ensure that log rotation can proceed in an orderly fashion."
$nl
"The " { $link log-message } " word sends a message to the server which results in the server executing an internal word:"
-{ $subsection (log-message) }
+{ $subsections (log-message) }
"The " { $link rotate-logs } " word sends a message to the server which results in the server executing an internal word:"
-{ $subsection (rotate-logs) }
+{ $subsections (rotate-logs) }
"The " { $link close-logs } " word sends a message to the server which results in the server executing an internal word:"
-{ $subsection (close-logs) } ;
+{ $subsections (close-logs) } ;
ARTICLE: "logging" "Logging framework"
"The " { $vocab-link "logging" } " vocabulary implements a comprehensive logging framework suitable for server-side production applications."
-{ $subsection "logging.files" }
-{ $subsection "logging.levels" }
-{ $subsection "logging.messages" }
-{ $subsection "logging.rotation" }
-{ $subsection "logging.parser" }
-{ $subsection "logging.analysis" }
-{ $subsection "logging.server" } ;
+{ $subsections
+ "logging.files"
+ "logging.levels"
+ "logging.messages"
+ "logging.rotation"
+ "logging.parser"
+ "logging.analysis"
+ "logging.server"
+} ;
ABOUT: "logging"
"The " { $vocab-link "logging.parser" } " vocabulary parses log files output by the " { $vocab-link "logging" } " vocabulary. It is used by " { $link "logging.analysis" } " and " { $vocab-link "logging.insomniac" } " to analyze logs."
$nl
"There is only one primary entry point:"
-{ $subsection parse-log } ;
+{ $subsections parse-log } ;
ABOUT: "logging.parser"
"Factor macros are similar to Lisp macros; they are not like C preprocessor macros."
$nl
"Defining new macros:"
-{ $subsection POSTPONE: MACRO: }
+{ $subsections POSTPONE: MACRO: }
"A slightly lower-level facility, " { $emphasis "compiler transforms" } ", allows an ordinary word definition to co-exist with a version that performs compile-time expansion."
-{ $subsection define-transform }
+{ $subsections define-transform }
"An example is the " { $link member? } " word. If the input sequence is a literal, the compile transform kicks in and converts the " { $link member? } " call into a series of conditionals. Otherwise, if the input sequence is not literal, a call to the definition of " { $link member? } " is generated."
{ $see-also "generalizations" "fry" } ;
"The " { $vocab-link "match" } " vocabulary implements ML-style pattern matching."
$nl
"Variables used for pattern matching must be explicitly defined first:"
-{ $subsection POSTPONE: MATCH-VARS: }
+{ $subsections POSTPONE: MATCH-VARS: }
"A basic pattern match:"
-{ $subsection match }
+{ $subsections match }
"A conditional form analogous to " { $link cond } ":"
-{ $subsection match-cond }
+{ $subsections match-cond }
"Pattern replacement:"
-{ $subsection match-replace } ;
+{ $subsections match-replace } ;
ABOUT: "match"
dup length zero? not [ rest ] [ drop f ] if ;
: (match-first) ( seq pattern-seq -- bindings leftover/f )
- 2dup [ length ] bi@ < [ 2drop f f ]
- [
+ 2dup shorter? [ 2drop f f ] [
2dup length head over match
- [ nip swap ?1-tail ] [ [ rest ] dip (match-first) ] if*
+ [ swap ?1-tail ] [ [ rest ] dip (match-first) ] ?if
] if ;
: match-first ( seq pattern-seq -- bindings )
: (match-all) ( seq pattern-seq -- )
[ nip ] [ (match-first) swap ] 2bi
- [
- , [ swap (match-all) ] [ drop ] if*
- ] [ 2drop ] if* ;
+ [ , [ swap (match-all) ] [ drop ] if* ] [ 2drop ] if* ;
: match-all ( seq pattern-seq -- bindings-seq )
[ (match-all) ] { } make ;
-
ABOUT: "math.bits"
ARTICLE: "math.bits" "Number bits virtual sequence"
-{ $subsection bits }
-{ $subsection <bits> }
-{ $subsection make-bits } ;
+"The " { $vocab-link "math.bits" } " vocabulary implements a virtual sequence which presents an integer as a sequence of bits, with the first element of the sequence being the least significant bit of the integer."
+{ $subsections
+ bits
+ <bits>
+ make-bits
+} ;
HELP: bits
{ $class-description "Virtual sequence class of bits of a number. The first bit is the least significant bit. This can be constructed with " { $link <bits> } " or " { $link make-bits } "." } ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: assocs help.markup help.syntax math sequences ;
+USING: assocs help.markup help.syntax math sequences kernel ;
IN: math.bitwise
HELP: bitfield
HELP: bit-count
{ $values
- { "x" integer }
+ { "obj" object }
{ "n" integer }
}
-{ $description "Returns the number of set bits as an integer." }
+{ $description "Returns the number of set bits as an object. This word only works on non-negative integers or objects that can be represented as a byte-array." }
{ $examples
{ $example "USING: math.bitwise prettyprint ;"
"HEX: f0 bit-count ."
"4"
}
{ $example "USING: math.bitwise prettyprint ;"
- "-7 bit-count ."
+ "-1 32 bits bit-count ."
+ "32"
+ }
+ { $example "USING: math.bitwise prettyprint ;"
+ "B{ 1 0 1 } bit-count ."
"2"
}
} ;
} ;
HELP: flags
-{ $values
- { "values" sequence }
-}
+{ $values { "values" sequence } }
{ $description "Constructs a constant flag value from a sequence of integers or words that output integers. The resulting constant is computed at compile-time, which makes this word as efficient as using a literal integer." }
{ $examples
{ $example "USING: math.bitwise kernel prettyprint ;"
}
} ;
+HELP: even-parity?
+{ $values
+ { "obj" object }
+ { "?" boolean }
+}
+{ $description "Returns true if the number of set bits in an object is even." } ;
+
+HELP: odd-parity?
+{ $values
+ { "obj" object }
+ { "?" boolean }
+}
+{ $description "Returns true if the number of set bits in an object is odd." } ;
+
HELP: on-bits
{ $values
{ "n" integer }
ARTICLE: "math-bitfields" "Constructing bit fields"
"Some applications, such as binary communication protocols and assemblers, need to construct integers from elaborate bit field specifications. Hand-coding this using " { $link shift } " and " { $link bitor } " results in repetitive code. A higher-level facility exists to factor out this repetition:"
-{ $subsection bitfield } ;
+{ $subsections bitfield } ;
ARTICLE: "math.bitwise" "Additional bitwise arithmetic"
"The " { $vocab-link "math.bitwise" } " vocabulary provides bitwise arithmetic words extending " { $link "bitwise-arithmetic" } ". They are useful for efficiency, low-level programming, and interfacing with C libraries."
$nl
"Setting and clearing bits:"
-{ $subsection set-bit }
-{ $subsection clear-bit }
+{ $subsections
+ set-bit
+ clear-bit
+}
"Testing if bits are set or clear:"
-{ $subsection bit? }
-{ $subsection bit-clear? }
+{ $subsections
+ bit?
+ bit-clear?
+}
"Operations with bitmasks:"
-{ $subsection mask }
-{ $subsection unmask }
-{ $subsection mask? }
-{ $subsection unmask? }
+{ $subsections
+ mask
+ unmask
+ mask?
+ unmask?
+}
"Generating an integer with n set bits:"
-{ $subsection on-bits }
+{ $subsections on-bits }
"Counting the number of set bits:"
-{ $subsection bit-count }
+{ $subsections bit-count }
+"Testing the parity of an object:"
+{ $subsections even-parity? odd-parity? }
"More efficient modding by powers of two:"
-{ $subsection wrap }
+{ $subsections wrap }
"Bit-rolling:"
-{ $subsection bitroll }
-{ $subsection bitroll-32 }
-{ $subsection bitroll-64 }
+{ $subsections
+ bitroll
+ bitroll-32
+ bitroll-64
+}
"32-bit arithmetic:"
-{ $subsection w+ }
-{ $subsection w- }
-{ $subsection w* }
+{ $subsections
+ w+
+ w-
+ w*
+}
"Bitfields:"
-{ $subsection flags }
-{ $subsection "math-bitfields" } ;
+{ $subsections
+ flags
+ "math-bitfields"
+} ;
ABOUT: "math.bitwise"
-USING: accessors math math.bitwise tools.test kernel words ;
+USING: accessors math math.bitwise tools.test kernel words
+specialized-arrays alien.c-types math.vectors.simd
+sequences destructors libc ;
+SPECIALIZED-ARRAY: int
IN: math.bitwise.tests
[ 0 ] [ 1 0 0 bitroll ] unit-test
[ 4 ] [ BIN: 1010101 bit-count ] unit-test
[ 0 ] [ BIN: 0 bit-count ] unit-test
[ 1 ] [ BIN: 1 bit-count ] unit-test
+
+SIMD: uint
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: uint-4
+
+[ 1 ] [ uint-4{ 1 0 0 0 } bit-count ] unit-test
+
+[ 1 ] [
+ [
+ 2 malloc-int-array &free 1 0 pick set-nth bit-count
+ ] with-destructors
+] unit-test
+
+[ 1 ] [ B{ 1 0 0 } bit-count ] unit-test
+[ 3 ] [ B{ 1 1 1 } bit-count ] unit-test
+
+[ t ] [ BIN: 0 even-parity? ] unit-test
+[ f ] [ BIN: 1 even-parity? ] unit-test
+[ f ] [ BIN: 0 odd-parity? ] unit-test
+[ t ] [ BIN: 1 odd-parity? ] unit-test
! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays assocs combinators combinators.smart fry kernel
-macros math math.bits sequences sequences.private words ;
+macros math math.bits sequences sequences.private words
+byte-arrays alien alien.c-types specialized-arrays ;
+SPECIALIZED-ARRAY: uchar
IN: math.bitwise
! utilities
GENERIC: (bit-count) ( x -- n )
M: fixnum (bit-count)
- [
- {
- [ byte-bit-count ]
- [ -8 shift byte-bit-count ]
- [ -16 shift byte-bit-count ]
- [ -24 shift byte-bit-count ]
- } cleave
- ] sum-outputs ;
+ 0 swap [
+ dup 0 >
+ ] [
+ [ 8 bits byte-bit-count ] [ -8 shift ] bi
+ [ + ] dip
+ ] while drop ;
M: bignum (bit-count)
dup 0 = [ drop 0 ] [
[ byte-bit-count ] [ -8 shift (bit-count) ] bi +
] if ;
+: byte-array-bit-count ( byte-array -- n )
+ 0 [ byte-bit-count + ] reduce ;
+
PRIVATE>
-: bit-count ( x -- n )
- dup 0 < [ bitnot ] when (bit-count) ; inline
+ERROR: invalid-bit-count-target object ;
+
+GENERIC: bit-count ( obj -- n )
+
+M: integer bit-count
+ dup 0 < [ invalid-bit-count-target ] when (bit-count) ; inline
+
+M: byte-array bit-count
+ byte-array-bit-count ;
+
+M: object bit-count
+ [ >c-ptr ] [ byte-length ] bi <direct-uchar-array>
+ byte-array-bit-count ;
: >signed ( x n -- y )
2dup neg 1 + shift 1 = [ 2^ - ] [ drop ] if ;
: next-even ( m -- n ) >even 2 + ; foldable
: next-odd ( m -- n ) dup even? [ 1 + ] [ 2 + ] if ; foldable
+
+: even-parity? ( obj -- ? ) bit-count even? ;
+
+: odd-parity? ( obj -- ? ) bit-count odd? ;
-USING: alien.fortran help.markup help.syntax math.blas.config multiline ;
+USING: alien.fortran help.markup help.syntax math.blas.config ;
IN: math.blas.config
ARTICLE: "math.blas.config" "Configuring the BLAS interface"
"The " { $link "math.blas-summary" } " chooses the underlying BLAS interface to use based on the values of the following global variables:"
-{ $subsection blas-library }
-{ $subsection blas-fortran-abi }
+{ $subsections
+ blas-library
+ blas-fortran-abi
+}
"The interface attempts to set default values based on the ones encountered on the Factor project's build machines. If these settings don't work with your system's BLAS, or you wish to use a commercial BLAS, you may change the global values of those variables in your " { $link "factor-rc" } ". For example, to use AMD's ACML library on Windows with " { $snippet "math.blas" } ", your " { $snippet "factor-rc" } " would look like this:"
-{ $code <"
+{ $code """
USING: math.blas.config namespaces ;
"X:\\path\\to\\acml.dll" blas-library set-global
intel-windows-abi blas-fortran-abi set-global
-"> }
+""" }
"To take effect, the " { $snippet "blas-library" } " and " { $snippet "blas-fortran-abi" } " variables must be set before any other " { $snippet "math.blas" } " vocabularies are loaded."
;
-USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings multiline ;
+USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ;
IN: math.blas.matrices
ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
"Factor provides an interface to high-performance vector and matrix math routines available in implementations of the BLAS math library. A set of specialized types are provided for handling packed, unboxed vector data:"
-{ $subsection "math.blas-types" }
+{ $subsections "math.blas-types" }
"Scalar-vector and vector-vector operations are available in the " { $vocab-link "math.blas.vectors" } " vocabulary:"
-{ $subsection "math.blas.vectors" }
+{ $subsections "math.blas.vectors" }
"Vector-matrix and matrix-matrix operations are available in the " { $vocab-link "math.blas.matrices" } " vocabulary:"
-{ $subsection "math.blas.matrices" }
+{ $subsections "math.blas.matrices" }
"The low-level BLAS Fortran interface can be accessed directly through the " { $vocab-link "math.blas.ffi" } " vocabulary. The BLAS interface can be configured to use different underlying BLAS implementations:"
-{ $subsection "math.blas.config" } ;
+{ $subsections "math.blas.config" } ;
ARTICLE: "math.blas-types" "BLAS interface types"
"BLAS vectors come in single- and double-precision, real and complex flavors:"
-{ $subsection float-blas-vector }
-{ $subsection double-blas-vector }
-{ $subsection complex-float-blas-vector }
-{ $subsection complex-double-blas-vector }
+{ $subsections
+ float-blas-vector
+ double-blas-vector
+ complex-float-blas-vector
+ complex-double-blas-vector
+}
"These vector types all follow the " { $link sequence } " protocol. In addition, there are corresponding types for matrix data:"
-{ $subsection float-blas-matrix }
-{ $subsection double-blas-matrix }
-{ $subsection complex-float-blas-matrix }
-{ $subsection complex-double-blas-matrix }
+{ $subsections
+ float-blas-matrix
+ double-blas-matrix
+ complex-float-blas-matrix
+ complex-double-blas-matrix
+}
"There are BOA constructors for all vector and matrix types, which provide the most flexibility in specifying memory layout:"
-{ $subsection <float-blas-vector> }
-{ $subsection <double-blas-vector> }
-{ $subsection <complex-float-blas-vector> }
-{ $subsection <complex-double-blas-vector> }
-{ $subsection <float-blas-matrix> }
-{ $subsection <double-blas-matrix> }
-{ $subsection <complex-float-blas-matrix> }
-{ $subsection <complex-double-blas-matrix> }
+{ $subsections
+ <float-blas-vector>
+ <double-blas-vector>
+ <complex-float-blas-vector>
+ <complex-double-blas-vector>
+ <float-blas-matrix>
+ <double-blas-matrix>
+ <complex-float-blas-matrix>
+ <complex-double-blas-matrix>
+}
"For the simple case of creating a dense, zero-filled vector or matrix, simple empty object constructors are provided:"
-{ $subsection <empty-vector> }
-{ $subsection <empty-matrix> }
+{ $subsections
+ <empty-vector>
+ <empty-matrix>
+}
"BLAS vectors and matrices can also be constructed from other Factor sequences:"
-{ $subsection >float-blas-vector }
-{ $subsection >double-blas-vector }
-{ $subsection >complex-float-blas-vector }
-{ $subsection >complex-double-blas-vector }
-{ $subsection >float-blas-matrix }
-{ $subsection >double-blas-matrix }
-{ $subsection >complex-float-blas-matrix }
-{ $subsection >complex-double-blas-matrix } ;
+{ $subsections
+ >float-blas-vector
+ >double-blas-vector
+ >complex-float-blas-vector
+ >complex-double-blas-vector
+ >float-blas-matrix
+ >double-blas-matrix
+ >complex-float-blas-matrix
+ >complex-double-blas-matrix
+} ;
ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
"Transposing and slicing matrices:"
-{ $subsection Mtranspose }
-{ $subsection Mrows }
-{ $subsection Mcols }
-{ $subsection Msub }
+{ $subsections
+ Mtranspose
+ Mrows
+ Mcols
+ Msub
+}
"Matrix-vector products:"
-{ $subsection n*M.V+n*V! }
-{ $subsection n*M.V+n*V }
-{ $subsection n*M.V }
-{ $subsection M.V }
+{ $subsections
+ n*M.V+n*V!
+ n*M.V+n*V
+ n*M.V
+ M.V
+}
"Vector outer products:"
-{ $subsection n*V(*)V+M! }
-{ $subsection n*V(*)Vconj+M! }
-{ $subsection n*V(*)V+M }
-{ $subsection n*V(*)Vconj+M }
-{ $subsection n*V(*)V }
-{ $subsection n*V(*)Vconj }
-{ $subsection V(*) }
-{ $subsection V(*)conj }
+{ $subsections
+ n*V(*)V+M!
+ n*V(*)Vconj+M!
+ n*V(*)V+M
+ n*V(*)Vconj+M
+ n*V(*)V
+ n*V(*)Vconj
+ V(*)
+ V(*)conj
+}
"Matrix products:"
-{ $subsection n*M.M+n*M! }
-{ $subsection n*M.M+n*M }
-{ $subsection n*M.M }
-{ $subsection M. }
+{ $subsections
+ n*M.M+n*M!
+ n*M.M+n*M
+ n*M.M
+ M.
+}
"Scalar-matrix products:"
-{ $subsection n*M! }
-{ $subsection n*M }
-{ $subsection M*n }
-{ $subsection M/n }
+{ $subsections
+ n*M!
+ n*M
+ M*n
+ M/n
+}
"Literal syntax:"
-{ $subsection POSTPONE: smatrix{ }
-{ $subsection POSTPONE: dmatrix{ }
-{ $subsection POSTPONE: cmatrix{ }
-{ $subsection POSTPONE: zmatrix{ } ;
+{ $subsections
+ POSTPONE: smatrix{
+ POSTPONE: dmatrix{
+ POSTPONE: cmatrix{
+ POSTPONE: zmatrix{
+} ;
ABOUT: "math.blas.matrices"
{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ;
HELP: smatrix{
-{ $syntax <" smatrix{
+{ $syntax """smatrix{
{ 1.0 0.0 0.0 1.0 }
{ 0.0 1.0 0.0 2.0 }
{ 0.0 0.0 1.0 3.0 }
{ 0.0 0.0 0.0 1.0 }
-} "> }
+}""" }
{ $description "Construct a literal " { $link float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
HELP: dmatrix{
-{ $syntax <" dmatrix{
+{ $syntax """dmatrix{
{ 1.0 0.0 0.0 1.0 }
{ 0.0 1.0 0.0 2.0 }
{ 0.0 0.0 1.0 3.0 }
{ 0.0 0.0 0.0 1.0 }
-} "> }
+}""" }
{ $description "Construct a literal " { $link double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
HELP: cmatrix{
-{ $syntax <" cmatrix{
+{ $syntax """cmatrix{
{ 1.0 0.0 0.0 1.0 }
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
{ 0.0 0.0 -1.0 3.0 }
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
-} "> }
+}""" }
{ $description "Construct a literal " { $link complex-float-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
HELP: zmatrix{
-{ $syntax <" zmatrix{
+{ $syntax """zmatrix{
{ 1.0 0.0 0.0 1.0 }
{ 0.0 C{ 0.0 1.0 } 0.0 2.0 }
{ 0.0 0.0 -1.0 3.0 }
{ 0.0 0.0 0.0 C{ 0.0 -1.0 } }
-} "> }
+}""" }
{ $description "Construct a literal " { $link complex-double-blas-matrix } ". Note that although BLAS matrices are stored in column-major order, the literal is specified in row-major order." } ;
{
-USING: accessors alien alien.c-types arrays byte-arrays combinators
-combinators.short-circuit fry kernel locals macros
-math math.blas.ffi math.blas.vectors math.blas.vectors.private
+USING: accessors alien alien.c-types alien.complex
+alien.data arrays byte-arrays combinators
+combinators.short-circuit fry kernel locals macros math
+math.blas.ffi math.blas.vectors math.blas.vectors.private
math.complex math.functions math.order functors words
sequences sequences.merged sequences.private shuffle
-specialized-arrays.direct.float specialized-arrays.direct.double
-specialized-arrays.float specialized-arrays.double
-specialized-arrays.direct.complex-float specialized-arrays.direct.complex-double
-specialized-arrays.complex-float specialized-arrays.complex-double
-parser prettyprint.backend prettyprint.custom ascii ;
+parser prettyprint.backend prettyprint.custom ascii
+specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: complex-float
+SPECIALIZED-ARRAY: complex-double
IN: math.blas.matrices
TUPLE: blas-matrix-base underlying ld rows cols transpose ;
! XXX try rounding stride to next 128 bit bound for better vectorizin'
: <empty-matrix> ( rows cols exemplar -- matrix )
- [ element-type [ * ] dip <c-array> ]
+ [ element-type heap-size * * <byte-array> ]
[ 2drop ]
[ f swap (blas-matrix-like) ] 3tri ;
ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
"Slicing vectors:"
-{ $subsection Vsub }
+{ $subsections Vsub }
"Taking the norm (magnitude) of a vector:"
-{ $subsection Vnorm }
+{ $subsections Vnorm }
"Summing and taking the maximum of elements:"
-{ $subsection Vasum }
-{ $subsection Viamax }
-{ $subsection Vamax }
+{ $subsections
+ Vasum
+ Viamax
+ Vamax
+}
"Scalar-vector products:"
-{ $subsection n*V! }
-{ $subsection n*V }
-{ $subsection V*n }
-{ $subsection V/n }
-{ $subsection Vneg }
+{ $subsections
+ n*V!
+ n*V
+ V*n
+ V/n
+ Vneg
+}
"Vector addition:"
-{ $subsection n*V+V! }
-{ $subsection n*V+V }
-{ $subsection V+ }
-{ $subsection V- }
+{ $subsections
+ n*V+V!
+ n*V+V
+ V+
+ V-
+}
"Vector inner products:"
-{ $subsection V. }
-{ $subsection V.conj }
+{ $subsections
+ V.
+ V.conj
+}
"Literal syntax:"
-{ $subsection POSTPONE: svector{ }
-{ $subsection POSTPONE: dvector{ }
-{ $subsection POSTPONE: cvector{ }
-{ $subsection POSTPONE: zvector{ } ;
+{ $subsections
+ POSTPONE: svector{
+ POSTPONE: dvector{
+ POSTPONE: cvector{
+ POSTPONE: zvector{
+} ;
ABOUT: "math.blas.vectors"
-USING: accessors alien alien.c-types arrays ascii byte-arrays combinators
-combinators.short-circuit fry kernel math math.blas.ffi
-math.complex math.functions math.order sequences sequences.private
-functors words locals parser prettyprint.backend prettyprint.custom
-specialized-arrays.float specialized-arrays.double
-specialized-arrays.direct.float specialized-arrays.direct.double
-specialized-arrays.complex-float specialized-arrays.complex-double
-specialized-arrays.direct.complex-float
-specialized-arrays.direct.complex-double ;
+USING: accessors alien alien.c-types alien.complex arrays ascii
+byte-arrays combinators combinators.short-circuit fry kernel
+math math.blas.ffi math.complex math.functions math.order
+sequences sequences.private functors words locals parser
+prettyprint.backend prettyprint.custom specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: complex-float
+SPECIALIZED-ARRAY: complex-double
IN: math.blas.vectors
TUPLE: blas-vector-base underlying length inc ;
length v inc>> v (blas-vector-like) ;
: <zero-vector> ( exemplar -- zero )
- [ element-type <c-object> ]
+ [ element-type heap-size <byte-array> ]
[ length>> 0 ]
[ (blas-vector-like) ] tri ;
: <empty-vector> ( length exemplar -- vector )
- [ element-type <c-array> ]
+ [ element-type heap-size * <byte-array> ]
[ 1 swap ] 2bi
(blas-vector-like) ;
-USING: help.markup help.syntax kernel math math.order multiline sequences ;
+USING: help.markup help.syntax kernel math math.order sequences ;
IN: math.combinatorics
HELP: factorial
{ $examples
{ $example "USING: math.combinatorics prettyprint ;"
"{ \"a\" \"b\" \"c\" \"d\" } 2 all-combinations ."
-<" {
+"""{
{ "a" "b" }
{ "a" "c" }
{ "a" "d" }
{ "b" "c" }
{ "b" "d" }
{ "c" "d" }
-}"> } } ;
+}""" } } ;
HELP: each-combination
{ $values { "seq" sequence } { "k" "a non-negative integer" } { "quot" { $quotation "( seq -- )" } } }
"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ;
ARTICLE: "complex-numbers" "Complex numbers"
-{ $subsection complex }
+{ $subsections complex }
"Complex numbers arise as solutions to quadratic equations whose graph does not intersect the " { $emphasis "x" } " axis. Their literal syntax is covered in " { $link "syntax-complex-numbers" } "."
$nl
"Complex numbers can be taken apart:"
-{ $subsection real-part }
-{ $subsection imaginary-part }
-{ $subsection >rect }
+{ $subsections
+ real-part
+ imaginary-part
+ >rect
+}
"Complex numbers can be constructed from real numbers:"
-{ $subsection rect> }
-{ $subsection "complex-numbers-zero" }
+{ $subsections
+ rect>
+ "complex-numbers-zero"
+}
{ $see-also "syntax-complex-numbers" } ;
HELP: complex
{ $class-description "The class of complex numbers with non-zero imaginary part." } ;
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel kernel.private math math.private
-math.libm math.functions arrays math.functions.private sequences
-parser ;
+math.functions arrays math.functions.private sequences parser ;
IN: math.complex.private
M: real real-part ; inline
M: complex / [ / ] complex/ ; inline
M: complex /f [ /f ] complex/ ; inline
M: complex /i [ /i ] complex/ ; inline
-M: complex abs absq >float fsqrt ; inline
-M: complex sqrt >polar [ fsqrt ] [ 2.0 / ] bi* polar> ; inline
+M: complex abs absq sqrt ; inline
+M: complex sqrt >polar [ sqrt ] [ 2.0 / ] bi* polar> ; inline
IN: syntax
ARTICLE: "math-constants" "Constants"
"Standard mathematical constants:"
-{ $subsection e }
-{ $subsection euler }
-{ $subsection phi }
-{ $subsection pi }
-{ $subsection epsilon } ;
+{ $subsections
+ e
+ euler
+ phi
+ pi
+ epsilon
+ single-epsilon
+} ;
ABOUT: "math-constants"
{ $values { "pi" "circumference of circle with diameter 1" } } ;
HELP: epsilon
-{ $values { "epsilon" "smallest floating point value you can add to 1 without underflow" } } ;
+{ $values { "epsilon" "smallest double-precision floating point value you can add to 1 without underflow" } } ;
+
+HELP: single-epsilon
+{ $values { "epsilon" "smallest single-precision floating point value you can add to 1 without underflow" } } ;
: phi ( -- phi ) 1.61803398874989484820 ; inline
: pi ( -- pi ) 3.14159265358979323846 ; inline
: 2pi ( -- pi ) 2 pi * ; inline
-: epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline
+: epsilon ( -- epsilon ) HEX: 3cb0000000000000 bits>double ; foldable
+: single-epsilon ( -- epsilon ) HEX: 34000000 bits>float ; foldable
: smallest-float ( -- x ) HEX: 1 bits>double ; foldable
: largest-float ( -- x ) HEX: 7fefffffffffffff bits>double ; foldable
--- /dev/null
+! (c)Joe Groff bsd license
+USING: help help.markup help.syntax kernel quotations ;
+IN: math.floats.env
+
+HELP: fp-exception
+{ $class-description "Symbols of this type represent floating-point exceptions. They are used to get and set the floating-point unit's exception flags (using " { $link fp-exception-flags } " and " { $link set-fp-exception-flags } ") and to control processor traps (using " { $link with-fp-traps } "). The following symbols are defined:"
+{ $list
+{ { $link +fp-invalid-operation+ } " indicates that an invalid floating-point operation occurred, such as taking the square root of a negative number or dividing zero by zero." }
+{ { $link +fp-overflow+ } " indicates that a floating-point operation gave a result larger than the maximum representable value of the type used to perform the calculation." }
+{ { $link +fp-underflow+ } " indicates that a floating-point operation gave a result smaller than the minimum representable normalized value of the type used to perform the calculation." }
+{ { $link +fp-zero-divide+ } " indicates that a floating-point division by zero was attempted." }
+{ { $link +fp-inexact+ } " indicates that a floating-point operation gave an inexact result that needed to be rounded." }
+} } ;
+
+HELP: +fp-invalid-operation+
+{ $class-description "This symbol represents a invalid operation " { $link fp-exception } "." } ;
+HELP: +fp-overflow+
+{ $class-description "This symbol represents an overflow " { $link fp-exception } "." } ;
+HELP: +fp-underflow+
+{ $class-description "This symbol represents an underflow " { $link fp-exception } "." } ;
+HELP: +fp-zero-divide+
+{ $class-description "This symbol represents a division-by-zero " { $link fp-exception } "." } ;
+HELP: +fp-inexact+
+{ $class-description "This symbol represents an inexact result " { $link fp-exception } "." } ;
+
+HELP: fp-rounding-mode
+{ $class-description "Symbols of this type represent floating-point rounding modes. They are passed to the " { $link with-rounding-mode } " word to control how inexact values are calculated when exact results cannot fit in a floating-point type. The following symbols are defined:"
+{ $list
+{ { $link +round-nearest+ } " rounds the exact result to the nearest representable value, using the even value when the result is halfway between its two nearest values." }
+{ { $link +round-zero+ } " rounds the exact result toward zero, that is, down for positive values, and up for negative values." }
+{ { $link +round-down+ } " always rounds the exact result down." }
+{ { $link +round-up+ } " always rounds the exact result up." }
+} } ;
+
+HELP: +round-nearest+
+{ $class-description "This symbol represents the round-to-nearest " { $link fp-rounding-mode } "." } ;
+HELP: +round-zero+
+{ $class-description "This symbol represents the round-toward-zero " { $link fp-rounding-mode } "." } ;
+HELP: +round-down+
+{ $class-description "This symbol represents the round-down " { $link fp-rounding-mode } "." } ;
+HELP: +round-up+
+{ $class-description "This symbol represents the round-up " { $link fp-rounding-mode } "." } ;
+
+HELP: fp-denormal-mode
+{ $class-description "Symbols of this type represent floating-point denormal modes. They are passed to the " { $link with-denormal-mode } " word to control whether denormals are generated as outputs of floating-point operations and how they are treated when given as inputs."
+{ $list
+{ { $link +denormal-keep+ } " causes denormal results to be generated and accepted as inputs as required by IEEE 754." }
+{ { $link +denormal-flush+ } " causes denormal results to be flushed to zero and be treated as zero when given as inputs. This mode may allow floating point operations to give results that are not compliant with the IEEE 754 standard." }
+} } ;
+
+HELP: +denormal-keep+
+{ $class-description "This symbol represents the IEEE 754 compliant keep-denormals " { $link fp-denormal-mode } "." } ;
+HELP: +denormal-flush+
+{ $class-description "This symbol represents the non-IEEE-754-compliant flush-denormals-to-zero " { $link fp-denormal-mode } "." } ;
+
+HELP: fp-exception-flags
+{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $description "Returns the set of floating-point exception flags that have been raised." } ;
+
+HELP: set-fp-exception-flags
+{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $description "Replaces the set of floating-point exception flags with the set specified in " { $snippet "exceptions" } "." }
+{ $notes "On Intel platforms, the legacy x87 floating-point unit does not support setting exception flags, so this word only clears the x87 exception flags. However, the SSE unit's flags are set as expected." } ;
+
+HELP: clear-fp-exception-flags
+{ $description "Clears all of the floating-point exception flags." } ;
+
+HELP: collect-fp-exceptions
+{ $values { "quot" quotation } { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $description "Clears the floating-point exception flags and then calls " { $snippet "quot" } ", returning the set of floating-point exceptions raised during its execution and placing them on the datastack on " { $snippet "quot" } "'s completion." } ;
+
+{ fp-exception-flags set-fp-exception-flags clear-fp-exception-flags collect-fp-exceptions } related-words
+
+HELP: denormal-mode
+{ $values { "mode" fp-denormal-mode } }
+{ $description "Returns the current floating-point denormal mode." } ;
+
+HELP: with-denormal-mode
+{ $values { "mode" fp-denormal-mode } { "quot" quotation } }
+{ $description "Sets the floating-point denormal mode to " { $snippet "mode" } " for the dynamic extent of " { $snippet "quot" } ", restoring the denormal mode to its original value on " { $snippet "quot" } "'s completion." } ;
+
+{ denormal-mode with-denormal-mode } related-words
+
+HELP: rounding-mode
+{ $values { "mode" fp-rounding-mode } }
+{ $description "Returns the current floating-point rounding mode." } ;
+
+HELP: with-rounding-mode
+{ $values { "mode" fp-rounding-mode } { "quot" quotation } }
+{ $description "Sets the floating-point rounding mode to " { $snippet "mode" } " for the dynamic extent of " { $snippet "quot" } ", restoring the rounding mode to its original value on " { $snippet "quot" } "'s completion." } ;
+
+{ rounding-mode with-rounding-mode } related-words
+
+HELP: fp-traps
+{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $description "Returns the set of floating point exceptions with processor traps currently set." } ;
+
+HELP: with-fp-traps
+{ $values { "exceptions" "a sequence of " { $link fp-exception } " symbols" } { "quot" quotation } }
+{ $description "Clears the floating-point exception flags and replaces the exception mask, enabling processor traps for the set of exception conditions specified in " { $snippet "exceptions" } " for the dynamic extent of " { $snippet "quot" } ". The original exception mask is restored on " { $snippet "quot" } "'s completion." } ;
+
+HELP: without-fp-traps
+{ $values { "quot" quotation } }
+{ $description "Disables all floating-pointer processor traps for the dynamic extent of " { $snippet "quot" } ", restoring the original exception mask on " { $snippet "quot" } "'s completion." } ;
+
+{ fp-traps with-fp-traps without-fp-traps vm-error>exception-flags vm-error-exception-flag? } related-words
+
+HELP: vm-error>exception-flags
+{ $values { "error" "a floating-point error object from the Factor VM" } { "exceptions" "a sequence of " { $link fp-exception } " symbols" } }
+{ $description "When a floating-point trap is raised, the Factor VM reports the trap by throwing a Factor exception containing the exception flags at the time the trap was raised. This word extracts the exception flag information from " { $snippet "error" } " and converts it into a sequence of " { $link fp-exception } "s." } ;
+
+HELP: vm-error-exception-flag?
+{ $values { "error" "a floating-point error object from the Factor VM" } { "flag" fp-exception } { "?" boolean } }
+{ $description "When a floating-point trap is raised, the Factor VM reports the trap by throwing a Factor exception containing the exception flags at the time the trap was raised. This word returns a boolean indicating whether the exception " { $snippet "flag" } " was raised at the time " { $snippet "error" } " was thrown." } ;
+
+ARTICLE: "math.floats.env" "Controlling the floating-point environment"
+"The " { $vocab-link "math.floats.env" } " vocabulary contains words for querying and controlling the floating-point environment."
+$nl
+"Querying and setting exception flags:"
+{ $subsections
+ fp-exception-flags
+ set-fp-exception-flags
+ clear-fp-exception-flags
+ collect-fp-exceptions
+}
+"Querying and controlling processor traps for floating-point exceptions:"
+{ $subsections
+ fp-traps
+ with-fp-traps
+ without-fp-traps
+}
+"Getting the floating-point exception state from errors raised by enabled traps:"
+{ $subsections
+ vm-error>exception-flags
+ vm-error-exception-flag?
+}
+"Querying and controlling the rounding mode and treatment of denormals:"
+{ $subsections
+ rounding-mode
+ with-rounding-mode
+ denormal-mode
+ with-denormal-mode
+} ;
+
+ABOUT: "math.floats.env"
--- /dev/null
+USING: kernel math math.floats.env math.floats.env.private
+math.functions math.libm sequences tools.test locals
+compiler.units kernel.private fry compiler math.private words
+system ;
+IN: math.floats.env.tests
+
+: set-default-fp-env ( -- )
+ { } { } +round-nearest+ +denormal-keep+ set-fp-env ;
+
+! In case the tests screw up the FP env because of bugs in math.floats.env
+set-default-fp-env
+
+: test-fp-exception ( exception inputs quot -- quot' )
+ '[ _ [ @ @ ] collect-fp-exceptions nip member? ] ;
+
+: test-fp-exception-compiled ( exception inputs quot -- quot' )
+ '[ _ @ [ _ collect-fp-exceptions ] compile-call nip member? ] ;
+
+[ t ] +fp-zero-divide+ [ 1.0 0.0 ] [ /f ] test-fp-exception unit-test
+[ t ] +fp-inexact+ [ 1.0 3.0 ] [ /f ] test-fp-exception unit-test
+[ t ] +fp-overflow+ [ 1.0e250 1.0e100 ] [ * ] test-fp-exception unit-test
+[ t ] +fp-underflow+ [ 1.0e-250 1.0e-100 ] [ * ] test-fp-exception unit-test
+[ t ] +fp-overflow+ [ 2.0 100,000.0 ] [ fpow ] test-fp-exception unit-test
+[ t ] +fp-invalid-operation+ [ 0.0 0.0 ] [ /f ] test-fp-exception unit-test
+[ t ] +fp-invalid-operation+ [ -1.0 ] [ fsqrt ] test-fp-exception unit-test
+
+[ t ] +fp-zero-divide+ [ 1.0 0.0 ] [ /f ] test-fp-exception-compiled unit-test
+[ t ] +fp-inexact+ [ 1.0 3.0 ] [ /f ] test-fp-exception-compiled unit-test
+[ t ] +fp-overflow+ [ 1.0e250 1.0e100 ] [ * ] test-fp-exception-compiled unit-test
+[ t ] +fp-underflow+ [ 1.0e-250 1.0e-100 ] [ * ] test-fp-exception-compiled unit-test
+[ t ] +fp-overflow+ [ 2.0 100,000.0 ] [ fpow ] test-fp-exception-compiled unit-test
+[ t ] +fp-invalid-operation+ [ 2.0 0/0. 1.0e-9 ] [ ~ ] test-fp-exception-compiled unit-test
+
+! No underflow on Linux with this test, just inexact. Reported as an Ubuntu bug:
+! https://bugs.launchpad.net/ubuntu/+source/glibc/+bug/429113
+os linux? cpu x86.64? and [
+ [ t ] +fp-underflow+ [ 2.0 -100,000.0 ] [ fpow ] test-fp-exception unit-test
+ [ t ] +fp-underflow+ [ 2.0 -100,000.0 ] [ fpow ] test-fp-exception-compiled unit-test
+] unless
+
+[ t ] +fp-invalid-operation+ [ 0.0 0.0 ] [ /f ] test-fp-exception-compiled unit-test
+[ t ] +fp-invalid-operation+ [ -1.0 ] [ fsqrt ] test-fp-exception-compiled unit-test
+
+[
+ HEX: 3fd5,5555,5555,5555
+ HEX: 3fc9,9999,9999,999a
+ HEX: bfc9,9999,9999,999a
+ HEX: bfd5,5555,5555,5555
+] [
+ +round-nearest+ [
+ 1.0 3.0 /f double>bits
+ 1.0 5.0 /f double>bits
+ -1.0 5.0 /f double>bits
+ -1.0 3.0 /f double>bits
+ ] with-rounding-mode
+] unit-test
+
+[
+ HEX: 3fd5,5555,5555,5555
+ HEX: 3fc9,9999,9999,9999
+ HEX: bfc9,9999,9999,999a
+ HEX: bfd5,5555,5555,5556
+] [
+ +round-down+ [
+ 1.0 3.0 /f double>bits
+ 1.0 5.0 /f double>bits
+ -1.0 5.0 /f double>bits
+ -1.0 3.0 /f double>bits
+ ] with-rounding-mode
+] unit-test
+
+[
+ HEX: 3fd5,5555,5555,5556
+ HEX: 3fc9,9999,9999,999a
+ HEX: bfc9,9999,9999,9999
+ HEX: bfd5,5555,5555,5555
+] [
+ +round-up+ [
+ 1.0 3.0 /f double>bits
+ 1.0 5.0 /f double>bits
+ -1.0 5.0 /f double>bits
+ -1.0 3.0 /f double>bits
+ ] with-rounding-mode
+] unit-test
+
+[
+ HEX: 3fd5,5555,5555,5555
+ HEX: 3fc9,9999,9999,9999
+ HEX: bfc9,9999,9999,9999
+ HEX: bfd5,5555,5555,5555
+] [
+ +round-zero+ [
+ 1.0 3.0 /f double>bits
+ 1.0 5.0 /f double>bits
+ -1.0 5.0 /f double>bits
+ -1.0 3.0 /f double>bits
+ ] with-rounding-mode
+] unit-test
+
+! ensure rounding mode is restored to +round-nearest+
+[
+ HEX: 3fd5,5555,5555,5555
+ HEX: 3fc9,9999,9999,999a
+ HEX: bfc9,9999,9999,999a
+ HEX: bfd5,5555,5555,5555
+] [
+ 1.0 3.0 /f double>bits
+ 1.0 5.0 /f double>bits
+ -1.0 5.0 /f double>bits
+ -1.0 3.0 /f double>bits
+] unit-test
+
+! FP traps cause a kernel panic on OpenBSD 4.5 i386
+os openbsd eq? cpu x86.32 eq? and [
+
+ : test-traps ( traps inputs quot -- quot' )
+ append '[ _ _ with-fp-traps ] ;
+
+ : test-traps-compiled ( traps inputs quot -- quot' )
+ swapd '[ @ [ _ _ with-fp-traps ] compile-call ] ;
+
+ { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps must-fail
+ { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps must-fail
+ { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps must-fail
+ { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps must-fail
+ { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps must-fail
+
+ { +fp-zero-divide+ } [ 1.0 0.0 ] [ /f ] test-traps-compiled must-fail
+ { +fp-inexact+ } [ 1.0 3.0 ] [ /f ] test-traps-compiled must-fail
+ { +fp-invalid-operation+ } [ -1.0 ] [ fsqrt ] test-traps-compiled must-fail
+ { +fp-overflow+ } [ 2.0 ] [ 100,000.0 ^ ] test-traps-compiled must-fail
+ { +fp-underflow+ +fp-inexact+ } [ 2.0 ] [ -100,000.0 ^ ] test-traps-compiled must-fail
+
+ ! Ensure ordered comparisons raise traps
+ :: test-comparison-quot ( word -- quot )
+ [
+ { float float } declare
+ { +fp-invalid-operation+ } [ word execute ] with-fp-traps
+ ] ;
+
+ : test-comparison ( inputs word -- quot )
+ test-comparison-quot append ;
+
+ : test-comparison-compiled ( inputs word -- quot )
+ test-comparison-quot '[ @ _ compile-call ] ;
+
+ \ float< "intrinsic" word-prop [
+ [ 0/0. -15.0 ] \ < test-comparison must-fail
+ [ 0/0. -15.0 ] \ < test-comparison-compiled must-fail
+ [ -15.0 0/0. ] \ < test-comparison must-fail
+ [ -15.0 0/0. ] \ < test-comparison-compiled must-fail
+ [ 0/0. -15.0 ] \ <= test-comparison must-fail
+ [ 0/0. -15.0 ] \ <= test-comparison-compiled must-fail
+ [ -15.0 0/0. ] \ <= test-comparison must-fail
+ [ -15.0 0/0. ] \ <= test-comparison-compiled must-fail
+ [ 0/0. -15.0 ] \ > test-comparison must-fail
+ [ 0/0. -15.0 ] \ > test-comparison-compiled must-fail
+ [ -15.0 0/0. ] \ > test-comparison must-fail
+ [ -15.0 0/0. ] \ > test-comparison-compiled must-fail
+ [ 0/0. -15.0 ] \ >= test-comparison must-fail
+ [ 0/0. -15.0 ] \ >= test-comparison-compiled must-fail
+ [ -15.0 0/0. ] \ >= test-comparison must-fail
+ [ -15.0 0/0. ] \ >= test-comparison-compiled must-fail
+
+ [ f ] [ 0/0. -15.0 ] \ u< test-comparison unit-test
+ [ f ] [ 0/0. -15.0 ] \ u< test-comparison-compiled unit-test
+ [ f ] [ -15.0 0/0. ] \ u< test-comparison unit-test
+ [ f ] [ -15.0 0/0. ] \ u< test-comparison-compiled unit-test
+ [ f ] [ 0/0. -15.0 ] \ u<= test-comparison unit-test
+ [ f ] [ 0/0. -15.0 ] \ u<= test-comparison-compiled unit-test
+ [ f ] [ -15.0 0/0. ] \ u<= test-comparison unit-test
+ [ f ] [ -15.0 0/0. ] \ u<= test-comparison-compiled unit-test
+ [ f ] [ 0/0. -15.0 ] \ u> test-comparison unit-test
+ [ f ] [ 0/0. -15.0 ] \ u> test-comparison-compiled unit-test
+ [ f ] [ -15.0 0/0. ] \ u> test-comparison unit-test
+ [ f ] [ -15.0 0/0. ] \ u> test-comparison-compiled unit-test
+ [ f ] [ 0/0. -15.0 ] \ u>= test-comparison unit-test
+ [ f ] [ 0/0. -15.0 ] \ u>= test-comparison-compiled unit-test
+ [ f ] [ -15.0 0/0. ] \ u>= test-comparison unit-test
+ [ f ] [ -15.0 0/0. ] \ u>= test-comparison-compiled unit-test
+ ] when
+
+] unless
+
+! Ensure traps get cleared
+[ 1/0. ] [ 1.0 0.0 /f ] unit-test
+
+! Ensure state is back to normal
+[ +round-nearest+ ] [ rounding-mode ] unit-test
+[ +denormal-keep+ ] [ denormal-mode ] unit-test
+[ { } ] [ fp-traps ] unit-test
+
+! In case the tests screw up the FP env because of bugs in math.floats.env
+set-default-fp-env
+
--- /dev/null
+! (c)Joe Groff bsd license
+USING: alien.syntax arrays assocs biassocs combinators
+combinators.short-circuit continuations generalizations kernel
+literals locals math math.bitwise sequences sets system
+vocabs.loader ;
+IN: math.floats.env
+
+SINGLETONS:
+ +fp-invalid-operation+
+ +fp-overflow+
+ +fp-underflow+
+ +fp-zero-divide+
+ +fp-inexact+ ;
+
+UNION: fp-exception
+ +fp-invalid-operation+
+ +fp-overflow+
+ +fp-underflow+
+ +fp-zero-divide+
+ +fp-inexact+ ;
+
+CONSTANT: all-fp-exceptions
+ {
+ +fp-invalid-operation+
+ +fp-overflow+
+ +fp-underflow+
+ +fp-zero-divide+
+ +fp-inexact+
+ }
+
+SINGLETONS:
+ +round-nearest+
+ +round-down+
+ +round-up+
+ +round-zero+ ;
+
+UNION: fp-rounding-mode
+ +round-nearest+
+ +round-down+
+ +round-up+
+ +round-zero+ ;
+
+SINGLETONS:
+ +denormal-keep+
+ +denormal-flush+ ;
+
+UNION: fp-denormal-mode
+ +denormal-keep+
+ +denormal-flush+ ;
+
+<PRIVATE
+
+HOOK: (fp-env-registers) cpu ( -- registers )
+
+: fp-env-register ( -- register ) (fp-env-registers) first ;
+
+:: mask> ( bits assoc -- symbols )
+ assoc [| k v | bits v mask zero? not ] assoc-filter keys ;
+: >mask ( symbols assoc -- bits )
+ over empty?
+ [ 2drop 0 ]
+ [ [ at ] curry [ bitor ] map-reduce ] if ;
+
+: remask ( x new-bits mask-bits -- x' )
+ [ unmask ] [ mask ] bi-curry bi* bitor ; inline
+
+GENERIC: (set-fp-env-register) ( fp-env -- )
+
+GENERIC: (get-exception-flags) ( fp-env -- exceptions )
+GENERIC# (set-exception-flags) 1 ( fp-env exceptions -- fp-env )
+
+GENERIC: (get-fp-traps) ( fp-env -- exceptions )
+GENERIC# (set-fp-traps) 1 ( fp-env exceptions -- fp-env )
+
+GENERIC: (get-rounding-mode) ( fp-env -- mode )
+GENERIC# (set-rounding-mode) 1 ( fp-env mode -- fp-env )
+
+GENERIC: (get-denormal-mode) ( fp-env -- mode )
+GENERIC# (set-denormal-mode) 1 ( fp-env mode -- fp-env )
+
+: change-fp-env-registers ( quot -- )
+ (fp-env-registers) swap [ (set-fp-env-register) ] compose each ; inline
+
+: set-fp-traps ( exceptions -- ) [ (set-fp-traps) ] curry change-fp-env-registers ;
+: set-rounding-mode ( mode -- ) [ (set-rounding-mode) ] curry change-fp-env-registers ;
+: set-denormal-mode ( mode -- ) [ (set-denormal-mode) ] curry change-fp-env-registers ;
+
+: get-fp-env ( -- exception-flags fp-traps rounding-mode denormal-mode )
+ fp-env-register {
+ [ (get-exception-flags) ]
+ [ (get-fp-traps) ]
+ [ (get-rounding-mode) ]
+ [ (get-denormal-mode) ]
+ } cleave ;
+
+: set-fp-env ( exception-flags fp-traps rounding-mode denormal-mode -- )
+ [
+ {
+ [ [ (set-exception-flags) ] when* ]
+ [ [ (set-fp-traps) ] when* ]
+ [ [ (set-rounding-mode) ] when* ]
+ [ [ (set-denormal-mode) ] when* ]
+ } spread
+ ] 4 ncurry change-fp-env-registers ;
+
+CONSTANT: vm-error-exception-flag>bit
+ H{
+ { +fp-invalid-operation+ HEX: 01 }
+ { +fp-overflow+ HEX: 02 }
+ { +fp-underflow+ HEX: 04 }
+ { +fp-zero-divide+ HEX: 08 }
+ { +fp-inexact+ HEX: 10 }
+ }
+
+PRIVATE>
+
+: fp-exception-flags ( -- exceptions )
+ (fp-env-registers) [ (get-exception-flags) ] [ union ] map-reduce >array ; inline
+: set-fp-exception-flags ( exceptions -- )
+ [ (set-exception-flags) ] curry change-fp-env-registers ; inline
+: clear-fp-exception-flags ( -- ) { } set-fp-exception-flags ; inline
+
+: collect-fp-exceptions ( quot -- exceptions )
+ [ clear-fp-exception-flags ] dip call fp-exception-flags ; inline
+
+: vm-error>exception-flags ( error -- exceptions )
+ third vm-error-exception-flag>bit mask> ;
+: vm-error-exception-flag? ( error flag -- ? )
+ vm-error>exception-flags member? ;
+
+: denormal-mode ( -- mode ) fp-env-register (get-denormal-mode) ;
+
+:: with-denormal-mode ( mode quot -- )
+ denormal-mode :> orig
+ mode set-denormal-mode
+ quot [ orig set-denormal-mode ] [ ] cleanup ; inline
+
+: rounding-mode ( -- mode ) fp-env-register (get-rounding-mode) ;
+
+:: with-rounding-mode ( mode quot -- )
+ rounding-mode :> orig
+ mode set-rounding-mode
+ quot [ orig set-rounding-mode ] [ ] cleanup ; inline
+
+: fp-traps ( -- exceptions )
+ (fp-env-registers) [ (get-fp-traps) ] [ union ] map-reduce >array ; inline
+
+:: with-fp-traps ( exceptions quot -- )
+ clear-fp-exception-flags
+ fp-traps :> orig
+ exceptions set-fp-traps
+ quot [ orig set-fp-traps ] [ ] cleanup ; inline
+
+: without-fp-traps ( quot -- )
+ { } swap with-fp-traps ; inline
+
+<< {
+ { [ cpu x86? ] [ "math.floats.env.x86" require ] }
+ { [ cpu ppc? ] [ "math.floats.env.ppc" require ] }
+ [ "CPU architecture unsupported by math.floats.env" throw ]
+} cond >>
+
--- /dev/null
+USING: accessors alien.c-types alien.syntax arrays assocs
+biassocs classes.struct combinators kernel literals math
+math.bitwise math.floats.env math.floats.env.private system ;
+IN: math.floats.env.ppc
+
+STRUCT: ppc-fpu-env
+ { padding uint }
+ { fpscr uint } ;
+
+STRUCT: ppc-vmx-env
+ { vscr uint } ;
+
+! defined in the vm, cpu-ppc*.S
+FUNCTION: void get_ppc_fpu_env ( ppc-fpu-env* env ) ;
+FUNCTION: void set_ppc_fpu_env ( ppc-fpu-env* env ) ;
+
+FUNCTION: void get_ppc_vmx_env ( ppc-vmx-env* env ) ;
+FUNCTION: void set_ppc_vmx_env ( ppc-vmx-env* env ) ;
+
+: <ppc-fpu-env> ( -- ppc-fpu-env )
+ ppc-fpu-env (struct)
+ [ get_ppc_fpu_env ] keep ;
+
+: <ppc-vmx-env> ( -- ppc-fpu-env )
+ ppc-vmx-env (struct)
+ [ get_ppc_vmx_env ] keep ;
+
+M: ppc-fpu-env (set-fp-env-register)
+ set_ppc_fpu_env ;
+
+M: ppc-vmx-env (set-fp-env-register)
+ set_ppc_vmx_env ;
+
+M: ppc (fp-env-registers)
+ <ppc-fpu-env> <ppc-vmx-env> 2array ;
+
+CONSTANT: ppc-exception-flag-bits HEX: fff8,0700
+CONSTANT: ppc-exception-flag>bit
+ H{
+ { +fp-invalid-operation+ HEX: 2000,0000 }
+ { +fp-overflow+ HEX: 1000,0000 }
+ { +fp-underflow+ HEX: 0800,0000 }
+ { +fp-zero-divide+ HEX: 0400,0000 }
+ { +fp-inexact+ HEX: 0200,0000 }
+ }
+
+CONSTANT: ppc-fp-traps-bits HEX: f8
+CONSTANT: ppc-fp-traps>bit
+ H{
+ { +fp-invalid-operation+ HEX: 80 }
+ { +fp-overflow+ HEX: 40 }
+ { +fp-underflow+ HEX: 20 }
+ { +fp-zero-divide+ HEX: 10 }
+ { +fp-inexact+ HEX: 08 }
+ }
+
+CONSTANT: ppc-rounding-mode-bits HEX: 3
+CONSTANT: ppc-rounding-mode>bit
+ $[ H{
+ { +round-nearest+ HEX: 0 }
+ { +round-zero+ HEX: 1 }
+ { +round-up+ HEX: 2 }
+ { +round-down+ HEX: 3 }
+ } >biassoc ]
+
+CONSTANT: ppc-denormal-mode-bits HEX: 4
+
+M: ppc-fpu-env (get-exception-flags) ( register -- exceptions )
+ fpscr>> ppc-exception-flag>bit mask> ; inline
+M: ppc-fpu-env (set-exception-flags) ( register exceptions -- register' )
+ [ ppc-exception-flag>bit >mask ppc-exception-flag-bits remask ] curry change-fpscr ; inline
+
+M: ppc-fpu-env (get-fp-traps) ( register -- exceptions )
+ fpscr>> ppc-fp-traps>bit mask> ; inline
+M: ppc-fpu-env (set-fp-traps) ( register exceptions -- register' )
+ [ ppc-fp-traps>bit >mask ppc-fp-traps-bits remask ] curry change-fpscr ; inline
+
+M: ppc-fpu-env (get-rounding-mode) ( register -- mode )
+ fpscr>> ppc-rounding-mode-bits mask ppc-rounding-mode>bit value-at ; inline
+M: ppc-fpu-env (set-rounding-mode) ( register mode -- register' )
+ [ ppc-rounding-mode>bit at ppc-rounding-mode-bits remask ] curry change-fpscr ; inline
+
+M: ppc-fpu-env (get-denormal-mode) ( register -- mode )
+ fpscr>> ppc-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
+M: ppc-fpu-env (set-denormal-mode) ( register mode -- register' )
+ [
+ {
+ { +denormal-keep+ [ ppc-denormal-mode-bits unmask ] }
+ { +denormal-flush+ [ ppc-denormal-mode-bits bitor ] }
+ } case
+ ] curry change-fpscr ; inline
+
+CONSTANT: vmx-denormal-mode-bits HEX: 10000
+
+M: ppc-vmx-env (get-exception-flags) ( register -- exceptions )
+ drop { } ; inline
+M: ppc-vmx-env (set-exception-flags) ( register exceptions -- register' )
+ drop ;
+
+M: ppc-vmx-env (get-fp-traps) ( register -- exceptions )
+ drop { } ; inline
+M: ppc-vmx-env (set-fp-traps) ( register exceptions -- register' )
+ drop ;
+
+M: ppc-vmx-env (get-rounding-mode) ( register -- mode )
+ drop +round-nearest+ ;
+M: ppc-vmx-env (set-rounding-mode) ( register mode -- register' )
+ drop ;
+
+M: ppc-vmx-env (get-denormal-mode) ( register -- mode )
+ vscr>> vmx-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
+M: ppc-vmx-env (set-denormal-mode) ( register mode -- register )
+ [
+ {
+ { +denormal-keep+ [ vmx-denormal-mode-bits unmask ] }
+ { +denormal-flush+ [ vmx-denormal-mode-bits bitor ] }
+ } case
+ ] curry change-vscr ; inline
+
--- /dev/null
+unportable
--- /dev/null
+IEEE 754 floating-point environment querying and control (exceptions, rounding mode, and denormals)
--- /dev/null
+unportable
--- /dev/null
+USING: accessors alien.c-types alien.syntax arrays assocs
+biassocs classes.struct combinators cpu.x86.features kernel
+literals math math.bitwise math.floats.env
+math.floats.env.private system ;
+IN: math.floats.env.x86
+
+STRUCT: sse-env
+ { mxcsr uint } ;
+
+STRUCT: x87-env
+ { status ushort }
+ { control ushort } ;
+
+! defined in the vm, cpu-x86*.S
+FUNCTION: void get_sse_env ( sse-env* env ) ;
+FUNCTION: void set_sse_env ( sse-env* env ) ;
+
+FUNCTION: void get_x87_env ( x87-env* env ) ;
+FUNCTION: void set_x87_env ( x87-env* env ) ;
+
+: <sse-env> ( -- sse-env )
+ sse-env (struct) [ get_sse_env ] keep ;
+
+M: sse-env (set-fp-env-register)
+ set_sse_env ;
+
+: <x87-env> ( -- x87-env )
+ x87-env (struct) [ get_x87_env ] keep ;
+
+M: x87-env (set-fp-env-register)
+ set_x87_env ;
+
+M: x86 (fp-env-registers)
+ sse2? [ <sse-env> <x87-env> 2array ] [ <x87-env> 1array ] if ;
+
+CONSTANT: sse-exception-flag-bits HEX: 3f
+CONSTANT: sse-exception-flag>bit
+ H{
+ { +fp-invalid-operation+ HEX: 01 }
+ { +fp-overflow+ HEX: 08 }
+ { +fp-underflow+ HEX: 10 }
+ { +fp-zero-divide+ HEX: 04 }
+ { +fp-inexact+ HEX: 20 }
+ }
+
+CONSTANT: sse-fp-traps-bits HEX: 1f80
+CONSTANT: sse-fp-traps>bit
+ H{
+ { +fp-invalid-operation+ HEX: 0080 }
+ { +fp-overflow+ HEX: 0400 }
+ { +fp-underflow+ HEX: 0800 }
+ { +fp-zero-divide+ HEX: 0200 }
+ { +fp-inexact+ HEX: 1000 }
+ }
+
+CONSTANT: sse-rounding-mode-bits HEX: 6000
+CONSTANT: sse-rounding-mode>bit
+ $[ H{
+ { +round-nearest+ HEX: 0000 }
+ { +round-down+ HEX: 2000 }
+ { +round-up+ HEX: 4000 }
+ { +round-zero+ HEX: 6000 }
+ } >biassoc ]
+
+CONSTANT: sse-denormal-mode-bits HEX: 8040
+
+M: sse-env (get-exception-flags) ( register -- exceptions )
+ mxcsr>> sse-exception-flag>bit mask> ; inline
+M: sse-env (set-exception-flags) ( register exceptions -- register' )
+ [ sse-exception-flag>bit >mask sse-exception-flag-bits remask ] curry change-mxcsr ; inline
+
+M: sse-env (get-fp-traps) ( register -- exceptions )
+ mxcsr>> bitnot sse-fp-traps>bit mask> ; inline
+M: sse-env (set-fp-traps) ( register exceptions -- register' )
+ [ sse-fp-traps>bit >mask bitnot sse-fp-traps-bits remask ] curry change-mxcsr ; inline
+
+M: sse-env (get-rounding-mode) ( register -- mode )
+ mxcsr>> sse-rounding-mode-bits mask sse-rounding-mode>bit value-at ; inline
+M: sse-env (set-rounding-mode) ( register mode -- register' )
+ [ sse-rounding-mode>bit at sse-rounding-mode-bits remask ] curry change-mxcsr ; inline
+
+M: sse-env (get-denormal-mode) ( register -- mode )
+ mxcsr>> sse-denormal-mode-bits mask zero? +denormal-keep+ +denormal-flush+ ? ; inline
+M: sse-env (set-denormal-mode) ( register mode -- register' )
+ [
+ {
+ { +denormal-keep+ [ sse-denormal-mode-bits unmask ] }
+ { +denormal-flush+ [ sse-denormal-mode-bits bitor ] }
+ } case
+ ] curry change-mxcsr ; inline
+
+CONSTANT: x87-exception-bits HEX: 3f
+CONSTANT: x87-exception>bit
+ H{
+ { +fp-invalid-operation+ HEX: 01 }
+ { +fp-overflow+ HEX: 08 }
+ { +fp-underflow+ HEX: 10 }
+ { +fp-zero-divide+ HEX: 04 }
+ { +fp-inexact+ HEX: 20 }
+ }
+
+CONSTANT: x87-rounding-mode-bits HEX: 0c00
+CONSTANT: x87-rounding-mode>bit
+ $[ H{
+ { +round-nearest+ HEX: 0000 }
+ { +round-down+ HEX: 0400 }
+ { +round-up+ HEX: 0800 }
+ { +round-zero+ HEX: 0c00 }
+ } >biassoc ]
+
+M: x87-env (get-exception-flags) ( register -- exceptions )
+ status>> x87-exception>bit mask> ; inline
+M: x87-env (set-exception-flags) ( register exceptions -- register' )
+ drop ;
+
+M: x87-env (get-fp-traps) ( register -- exceptions )
+ control>> bitnot x87-exception>bit mask> ; inline
+M: x87-env (set-fp-traps) ( register exceptions -- register' )
+ [ x87-exception>bit >mask bitnot x87-exception-bits remask ] curry change-control ; inline
+
+M: x87-env (get-rounding-mode) ( register -- mode )
+ control>> x87-rounding-mode-bits mask x87-rounding-mode>bit value-at ; inline
+M: x87-env (set-rounding-mode) ( register mode -- register' )
+ [ x87-rounding-mode>bit at x87-rounding-mode-bits remask ] curry change-control ; inline
+
+M: x87-env (get-denormal-mode) ( register -- mode )
+ drop +denormal-keep+ ; inline
+M: x87-env (set-denormal-mode) ( register mode -- register' )
+ drop ;
+
IN: math.functions
ARTICLE: "integer-functions" "Integer functions"
-{ $subsection align }
-{ $subsection gcd }
-{ $subsection log2 }
-{ $subsection next-power-of-2 }
+{ $subsections
+ align
+ gcd
+ log2
+ next-power-of-2
+}
"Modular exponentiation:"
-{ $subsection ^mod }
-{ $subsection mod-inv }
+{ $subsections ^mod mod-inv }
"Tests:"
-{ $subsection power-of-2? }
-{ $subsection even? }
-{ $subsection odd? }
-{ $subsection divisor? } ;
+{ $subsections
+ power-of-2?
+ even?
+ odd?
+ divisor?
+} ;
ARTICLE: "arithmetic-functions" "Arithmetic functions"
"Computing additive and multiplicative inverses:"
-{ $subsection neg }
-{ $subsection recip }
-"Minimum, maximum, clamping:"
-{ $subsection min }
-{ $subsection max }
-{ $subsection clamp }
+{ $subsections neg recip }
"Complex conjugation:"
-{ $subsection conjugate }
+{ $subsections conjugate }
"Tests:"
-{ $subsection zero? }
-{ $subsection between? }
+{ $subsections zero? between? }
"Control flow:"
-{ $subsection if-zero }
-{ $subsection when-zero }
-{ $subsection unless-zero }
+{ $subsections
+ if-zero
+ when-zero
+ unless-zero
+}
"Sign:"
-{ $subsection sgn }
+{ $subsections sgn }
"Rounding:"
-{ $subsection ceiling }
-{ $subsection floor }
-{ $subsection truncate }
-{ $subsection round }
+{ $subsections
+ ceiling
+ floor
+ truncate
+ round
+}
"Inexact comparison:"
-{ $subsection ~ } ;
+{ $subsections ~ }
+"Numbers implement the " { $link "math.order" } ", therefore operations such as " { $link min } " and " { $link max } " can be used with numbers." ;
ARTICLE: "power-functions" "Powers and logarithms"
"Squares:"
-{ $subsection sq }
-{ $subsection sqrt }
+{ $subsections sq sqrt }
"Exponential and natural logarithm:"
-{ $subsection exp }
-{ $subsection cis }
-{ $subsection log }
-{ $subsection log10 }
+{ $subsections exp cis log }
+"Other logarithms:"
+{ $subsections log1+ log10 }
"Raising a number to a power:"
-{ $subsection ^ }
-{ $subsection 10^ }
+{ $subsections ^ 10^ }
"Converting between rectangular and polar form:"
-{ $subsection abs }
-{ $subsection absq }
-{ $subsection arg }
-{ $subsection >polar }
-{ $subsection polar> } ;
+{ $subsections
+ abs
+ absq
+ arg
+ >polar
+ polar>
+} ;
ARTICLE: "trig-hyp-functions" "Trigonometric and hyperbolic functions"
"Trigonometric functions:"
-{ $subsection cos }
-{ $subsection sin }
-{ $subsection tan }
+{ $subsections cos sin tan }
"Reciprocals:"
-{ $subsection sec }
-{ $subsection cosec }
-{ $subsection cot }
+{ $subsections sec cosec cot }
"Inverses:"
-{ $subsection acos }
-{ $subsection asin }
-{ $subsection atan }
+{ $subsections acos asin atan }
"Inverse reciprocals:"
-{ $subsection asec }
-{ $subsection acosec }
-{ $subsection acot }
+{ $subsections asec acosec acot }
"Hyperbolic functions:"
-{ $subsection cosh }
-{ $subsection sinh }
-{ $subsection tanh }
+{ $subsections cosh sinh tanh }
"Reciprocals:"
-{ $subsection sech }
-{ $subsection cosech }
-{ $subsection coth }
+{ $subsections sech cosech coth }
"Inverses:"
-{ $subsection acosh }
-{ $subsection asinh }
-{ $subsection atanh }
+{ $subsections acosh asinh atanh }
"Inverse reciprocals:"
-{ $subsection asech }
-{ $subsection acosech }
-{ $subsection acoth } ;
+{ $subsections asech acosech acoth } ;
ARTICLE: "math-functions" "Mathematical functions"
-{ $subsection "integer-functions" }
-{ $subsection "arithmetic-functions" }
-{ $subsection "power-functions" }
-{ $subsection "trig-hyp-functions" } ;
+{ $subsections
+ "integer-functions"
+ "arithmetic-functions"
+ "power-functions"
+ "trig-hyp-functions"
+} ;
ABOUT: "math-functions"
{ $values { "x" number } { "y" number } }
{ $description "Natural logarithm function. Outputs negative infinity if " { $snippet "x" } " is 0." } ;
+HELP: log1+
+{ $values { "x" number } { "y" number } }
+{ $description "Takes the natural logarithm of " { $snippet "1 + x" } ". Outputs negative infinity if " { $snippet "1 + x" } " is zero. This word may be more accurate than " { $snippet "1 + log" } " for very small values of " { $snippet "x" } "." } ;
+
HELP: log10
{ $values { "x" number } { "y" number } }
{ $description "Logarithm function base 10. Outputs negative infinity if " { $snippet "x" } " is 0." } ;
[ t ] [ 4.0000001 4.0000001 .000001 ~ ] unit-test
[ f ] [ -4.0000001 4.0000001 .00001 ~ ] unit-test
[ t ] [ -.0000000000001 0 .0000000001 ~ ] unit-test
+[ t ] [ 100 101 -.9 ~ ] unit-test
+[ f ] [ 100 120 -.09 ~ ] unit-test
+[ t ] [ 0 0 -.9 ~ ] unit-test
+[ f ] [ 0 10 -.9 ~ ] unit-test
! Lets get the argument order correct, eh?
[ 0.0 ] [ 0.0 1.0 fatan2 ] unit-test
[ 0 ] [ 0 3 ^ ] unit-test
[ 0.0 ] [ 1 log ] unit-test
+[ 0.0 ] [ 1.0 log ] unit-test
+[ 1.0 ] [ e log ] unit-test
+
+[ 0.0 ] [ 1.0 log10 ] unit-test
+[ 1.0 ] [ 10.0 log10 ] unit-test
+[ 2.0 ] [ 100.0 log10 ] unit-test
+[ 3.0 ] [ 1000.0 log10 ] unit-test
+[ 4.0 ] [ 10000.0 log10 ] unit-test
+
+[ t ] [ 1 exp e 1.e-10 ~ ] unit-test
+[ f ] [ 1 exp 0/0. 1.e-10 ~ ] unit-test
+[ f ] [ 0/0. 1 exp 1.e-10 ~ ] unit-test
+[ t ] [ 1.0 exp e 1.e-10 ~ ] unit-test
+[ t ] [ -1 exp e * 1.0 1.e-10 ~ ] unit-test
+[ f ] [ 1/0. 1/0. 1.e-10 ~ ] unit-test
+[ f ] [ 1/0. -1/0. 1.e-10 ~ ] unit-test
+[ f ] [ 1/0. 0/0. 1.e-10 ~ ] unit-test
+[ f ] [ 0/0. -1/0. 1.e-10 ~ ] unit-test
[ 1.0 ] [ 0 cosh ] unit-test
+[ 1.0 ] [ 0.0 cosh ] unit-test
[ 0.0 ] [ 1 acosh ] unit-test
+[ 0.0 ] [ 1.0 acosh ] unit-test
[ 1.0 ] [ 0 cos ] unit-test
+[ 1.0 ] [ 0.0 cos ] unit-test
[ 0.0 ] [ 1 acos ] unit-test
+[ 0.0 ] [ 1.0 acos ] unit-test
[ 0.0 ] [ 0 sinh ] unit-test
+[ 0.0 ] [ 0.0 sinh ] unit-test
[ 0.0 ] [ 0 asinh ] unit-test
+[ 0.0 ] [ 0.0 asinh ] unit-test
[ 0.0 ] [ 0 sin ] unit-test
+[ 0.0 ] [ 0.0 sin ] unit-test
[ 0.0 ] [ 0 asin ] unit-test
+[ 0.0 ] [ 0.0 asin ] unit-test
+
+[ 0.0 ] [ 0 tan ] unit-test
+[ t ] [ pi 2 / tan 1.e10 > ] unit-test
[ t ] [ 10 atan real? ] unit-test
+[ t ] [ 10.0 atan real? ] unit-test
[ f ] [ 10 atanh real? ] unit-test
+[ f ] [ 10.0 atanh real? ] unit-test
[ t ] [ 10 asin sin 10 1.e-10 ~ ] unit-test
[ t ] [ -1 sqrt neg dup acos cos 1.e-10 ~ ] unit-test
: >polar ( z -- abs arg )
>float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ; inline
-: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
+: cis ( arg -- z ) >float [ fcos ] [ fsin ] bi rect> ; inline
: polar> ( abs arg -- z ) cis * ; inline
+GENERIC: exp ( x -- y )
+
+M: float exp fexp ; inline
+
+M: real exp >float exp ; inline
+
+M: complex exp >rect swap fexp swap polar> ; inline
+
<PRIVATE
: ^mag ( w abs arg -- magnitude )
- [ >float-rect swap ] [ swap fpow ] [ rot * fexp /f ] tri* ; inline
+ [ >float-rect swap ]
+ [ >float swap >float fpow ]
+ [ rot * exp /f ]
+ tri* ; inline
: ^theta ( w abs arg -- theta )
[ >float-rect ] [ flog * swap ] [ * + ] tri* ; inline
{
{ [ over 0 = ] [ nip 0^ ] }
{ [ dup integer? ] [ integer^ ] }
- { [ 2dup real^? ] [ fpow ] }
+ { [ 2dup real^? ] [ [ >float ] bi@ fpow ] }
[ ^complex ]
} cond ; inline
[ - abs ] dip < ;
: ~rel ( x y epsilon -- ? )
- [ [ - abs ] 2keep [ abs ] bi@ + ] dip * < ;
+ [ [ - abs ] 2keep [ abs ] bi@ + ] dip * <= ;
: ~ ( x y epsilon -- ? )
{
- { [ 2over [ fp-nan? ] either? ] [ 3drop f ] }
{ [ dup zero? ] [ drop number= ] }
- { [ dup 0 < ] [ ~rel ] }
+ { [ dup 0 < ] [ neg ~rel ] }
[ ~abs ]
} cond ;
: >=1? ( x -- ? )
dup complex? [ drop f ] [ 1 >= ] if ; inline
-GENERIC: exp ( x -- y )
+GENERIC: log ( x -- y )
-M: real exp fexp ; inline
+M: float log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ; inline
-M: complex exp >rect swap fexp swap polar> ;
+M: real log >float log ; inline
-GENERIC: log ( x -- y )
+M: complex log >polar [ flog ] dip rect> ; inline
+
+GENERIC: log1+ ( x -- y )
-M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ; inline
+M: object log1+ 1 + log ; inline
-M: complex log >polar swap flog swap rect> ;
+M: float log1+ dup -1.0 >= [ flog1+ ] [ 1.0 + 0.0 rect> log ] if ; inline
: 10^ ( x -- y ) 10 swap ^ ; inline
-: log10 ( x -- y ) log 10 log / ; inline
+GENERIC: log10 ( x -- y ) foldable
+
+M: real log10 >float flog10 ; inline
+
+M: complex log10 log 10 log / ; inline
GENERIC: cos ( x -- y ) foldable
[ [ fcos ] [ fcosh ] bi* * ]
[ [ fsin neg ] [ fsinh ] bi* * ] 2bi rect> ;
-M: real cos fcos ; inline
+M: float cos fcos ; inline
+
+M: real cos >float cos ; inline
: sec ( x -- y ) cos recip ; inline
[ [ fcosh ] [ fcos ] bi* * ]
[ [ fsinh ] [ fsin ] bi* * ] 2bi rect> ;
-M: real cosh fcosh ; inline
+M: float cosh fcosh ; inline
+
+M: real cosh >float cosh ; inline
: sech ( x -- y ) cosh recip ; inline
[ [ fsin ] [ fcosh ] bi* * ]
[ [ fcos ] [ fsinh ] bi* * ] 2bi rect> ;
-M: real sin fsin ; inline
+M: float sin fsin ; inline
+
+M: real sin >float sin ; inline
: cosec ( x -- y ) sin recip ; inline
[ [ fsinh ] [ fcos ] bi* * ]
[ [ fcosh ] [ fsin ] bi* * ] 2bi rect> ;
-M: real sinh fsinh ; inline
+M: float sinh fsinh ; inline
+
+M: real sinh >float sinh ; inline
: cosech ( x -- y ) sinh recip ; inline
M: complex tan [ sin ] [ cos ] bi / ;
-M: real tan ftan ; inline
+M: float tan ftan ; inline
+
+M: real tan >float tan ; inline
GENERIC: tanh ( x -- y ) foldable
M: complex tanh [ sinh ] [ cosh ] bi / ;
-M: real tanh ftanh ; inline
+M: float tanh ftanh ; inline
+
+M: real tanh >float tanh ; inline
: cot ( x -- y ) tan recip ; inline
: -i* ( x -- y ) >rect swap neg rect> ;
: asin ( x -- y )
- dup [-1,1]? [ fasin ] [ i* asinh -i* ] if ; inline
+ dup [-1,1]? [ >float fasin ] [ i* asinh -i* ] if ; inline
: acos ( x -- y )
- dup [-1,1]? [ facos ] [ asin pi 2 / swap - ] if ;
+ dup [-1,1]? [ >float facos ] [ asin pi 2 / swap - ] if ;
inline
GENERIC: atan ( x -- y ) foldable
-M: complex atan i* atanh i* ;
+M: complex atan i* atanh i* ; inline
+
+M: float atan fatan ; inline
-M: real atan fatan ; inline
+M: real atan >float atan ; inline
: asec ( x -- y ) recip acos ; inline
ARTICLE: "math-intervals-new" "Creating intervals"
"Standard constructors:"
-{ $subsection [a,b] }
-{ $subsection (a,b) }
-{ $subsection [a,b) }
-{ $subsection (a,b] }
+{ $subsections
+ [a,b]
+ (a,b)
+ [a,b)
+ (a,b]
+}
"One-point interval constructor:"
-{ $subsection [a,a] }
+{ $subsections [a,a] }
"Open-ended interval constructors:"
-{ $subsection [-inf,a] }
-{ $subsection [-inf,a) }
-{ $subsection [a,inf] }
-{ $subsection (a,inf] }
+{ $subsections
+ [-inf,a]
+ [-inf,a)
+ [a,inf]
+ (a,inf]
+}
"The set of all real numbers with infinities:"
-{ $subsection [-inf,inf] }
+{ $subsections [-inf,inf] }
"The empty set:"
-{ $subsection empty-interval }
+{ $subsections empty-interval }
"Another constructor:"
-{ $subsection points>interval } ;
+{ $subsections points>interval } ;
ARTICLE: "math-intervals-arithmetic" "Interval arithmetic"
"Binary operations on intervals:"
-{ $subsection interval+ }
-{ $subsection interval- }
-{ $subsection interval* }
-{ $subsection interval/ }
-{ $subsection interval/i }
-{ $subsection interval-mod }
-{ $subsection interval-rem }
-{ $subsection interval-min }
-{ $subsection interval-max }
+{ $subsections
+ interval+
+ interval-
+ interval*
+ interval/
+ interval/i
+ interval-mod
+ interval-rem
+ interval-min
+ interval-max
+}
"Bitwise operations on intervals:"
-{ $subsection interval-shift }
-{ $subsection interval-bitand }
-{ $subsection interval-bitor }
-{ $subsection interval-bitxor }
+{ $subsections
+ interval-shift
+ interval-bitand
+ interval-bitor
+ interval-bitxor
+}
"Unary operations on intervals:"
-{ $subsection interval-1+ }
-{ $subsection interval-1- }
-{ $subsection interval-neg }
-{ $subsection interval-bitnot }
-{ $subsection interval-recip }
-{ $subsection interval-2/ }
-{ $subsection interval-abs }
-{ $subsection interval-log2 } ;
+{ $subsections
+ interval-1+
+ interval-1-
+ interval-neg
+ interval-bitnot
+ interval-recip
+ interval-2/
+ interval-abs
+ interval-log2
+} ;
ARTICLE: "math-intervals-sets" "Set-theoretic operations on intervals"
-{ $subsection interval-contains? }
-{ $subsection interval-subset? }
-{ $subsection interval-intersect }
-{ $subsection interval-union }
-{ $subsection interval-closure }
-{ $subsection integral-closure } ;
+{ $subsections
+ interval-contains?
+ interval-subset?
+ interval-intersect
+ interval-union
+ interval-closure
+ integral-closure
+} ;
ARTICLE: "math-intervals-compare" "Comparing intervals"
-{ $subsection interval< }
-{ $subsection interval<= }
-{ $subsection interval> }
-{ $subsection interval>= }
-{ $subsection assume< }
-{ $subsection assume<= }
-{ $subsection assume> }
-{ $subsection assume>= } ;
+{ $subsections
+ interval<
+ interval<=
+ interval>
+ interval>=
+ assume<
+ assume<=
+ assume>
+ assume>=
+} ;
ARTICLE: "math-interval-properties" "Properties of interval arithmetic"
"For some operations, interval arithmetic yields inaccurate results, either because the result of lifting some operations to intervals does not result in intervals (bitwise operations, for example) or for the sake of simplicity of implementation."
ARTICLE: "math-intervals" "Intervals"
"Interval arithmetic is performed on ranges of real numbers, rather than exact values. It is used by the Factor compiler to convert arbitrary-precision arithmetic to machine arithmetic, by inferring bounds for integer calculations."
-{ $subsection "math-interval-properties" }
+{ $subsections "math-interval-properties" }
"The class of intervals:"
-{ $subsection interval }
-{ $subsection interval? }
+{ $subsections
+ interval
+ interval?
+}
"Interval operations:"
-{ $subsection "math-intervals-new" }
-{ $subsection "math-intervals-arithmetic" }
-{ $subsection "math-intervals-sets" }
-{ $subsection "math-intervals-compare" } ;
+{ $subsections
+ "math-intervals-new"
+ "math-intervals-arithmetic"
+ "math-intervals-sets"
+ "math-intervals-compare"
+} ;
ABOUT: "math-intervals"
ARTICLE: "math.libm" "C standard library math functions"
"The words in the " { $vocab-link "math.libm" } " vocabulary call C standard library math functions. They are used to implement words in the " { $vocab-link "math.functions" } " vocabulary."
-$nl
-"They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
-{ $example "USE: math.functions" "2 acos ." "C{ 0.0 1.316957896924817 }" }
-{ $unchecked-example "USE: math.libm" "2 facos ." "0/0." }
+{ $warning
+"These functions are unsafe. The compiler special-cases them to operate on floats only. They can be called directly, however there is little reason to do so, since they only implement real-valued functions, and in some cases place restrictions on the domain:"
+{ $example "USE: math.functions" "2.0 acos ." "C{ 0.0 1.316957896924817 }" }
+{ $unchecked-example "USE: math.libm" "2.0 facos ." "0/0." } }
"Trigonometric functions:"
-{ $subsection fcos }
-{ $subsection fsin }
-{ $subsection facos }
-{ $subsection fasin }
-{ $subsection fatan }
-{ $subsection fatan2 }
+{ $subsections
+ fcos
+ fsin
+ facos
+ fasin
+ fatan
+ fatan2
+}
"Hyperbolic functions:"
-{ $subsection fcosh }
-{ $subsection fsinh }
+{ $subsections
+ fcosh
+ fsinh
+}
"Exponentials and logarithms:"
-{ $subsection fexp }
-{ $subsection flog }
+{ $subsections
+ fexp
+ flog
+ flog10
+}
"Powers:"
-{ $subsection fpow }
-{ $subsection fsqrt } ;
+{ $subsections
+ fpow
+ fsqrt
+} ;
ABOUT: "math.libm"
{ $values { "x" real } { "y" real } }
{ $description "Calls the natural logarithm function from the C standard library. User code should call " { $link log } " instead." } ;
+HELP: flog10
+{ $values { "x" real } { "y" real } }
+{ $description "Calls the base 10 logarithm function from the C standard library. User code should call " { $link log10 } " instead." } ;
+
HELP: fpow
{ $values { "x" real } { "y" real } { "z" real } }
{ $description "Calls the power function (" { $snippet "z=x^y" } ") from the C standard library. User code should call " { $link ^ } " instead." } ;
! Copyright (C) 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien ;
+USING: alien alien.c-types ;
IN: math.libm
: facos ( x -- y )
- "double" "libm" "acos" { "double" } alien-invoke ; inline
+ double "libm" "acos" { double } alien-invoke ;
: fasin ( x -- y )
- "double" "libm" "asin" { "double" } alien-invoke ; inline
+ double "libm" "asin" { double } alien-invoke ;
: fatan ( x -- y )
- "double" "libm" "atan" { "double" } alien-invoke ; inline
+ double "libm" "atan" { double } alien-invoke ;
: fatan2 ( x y -- z )
- "double" "libm" "atan2" { "double" "double" } alien-invoke ; inline
+ double "libm" "atan2" { double double } alien-invoke ;
: fcos ( x -- y )
- "double" "libm" "cos" { "double" } alien-invoke ; inline
+ double "libm" "cos" { double } alien-invoke ;
: fsin ( x -- y )
- "double" "libm" "sin" { "double" } alien-invoke ; inline
+ double "libm" "sin" { double } alien-invoke ;
: ftan ( x -- y )
- "double" "libm" "tan" { "double" } alien-invoke ; inline
+ double "libm" "tan" { double } alien-invoke ;
: fcosh ( x -- y )
- "double" "libm" "cosh" { "double" } alien-invoke ; inline
+ double "libm" "cosh" { double } alien-invoke ;
: fsinh ( x -- y )
- "double" "libm" "sinh" { "double" } alien-invoke ; inline
+ double "libm" "sinh" { double } alien-invoke ;
: ftanh ( x -- y )
- "double" "libm" "tanh" { "double" } alien-invoke ; inline
+ double "libm" "tanh" { double } alien-invoke ;
: fexp ( x -- y )
- "double" "libm" "exp" { "double" } alien-invoke ; inline
+ double "libm" "exp" { double } alien-invoke ;
: flog ( x -- y )
- "double" "libm" "log" { "double" } alien-invoke ; inline
+ double "libm" "log" { double } alien-invoke ;
+
+: flog10 ( x -- y )
+ double "libm" "log10" { double } alien-invoke ;
: fpow ( x y -- z )
- "double" "libm" "pow" { "double" "double" } alien-invoke ; inline
+ double "libm" "pow" { double double } alien-invoke ;
-! Don't inline fsqrt -- its an intrinsic!
: fsqrt ( x -- y )
- "double" "libm" "sqrt" { "double" } alien-invoke ;
+ double "libm" "sqrt" { double } alien-invoke ;
! Windows doesn't have these...
+: flog1+ ( x -- y )
+ double "libm" "log1p" { double } alien-invoke ;
+
: facosh ( x -- y )
- "double" "libm" "acosh" { "double" } alien-invoke ; inline
+ double "libm" "acosh" { double } alien-invoke ;
: fasinh ( x -- y )
- "double" "libm" "asinh" { "double" } alien-invoke ; inline
+ double "libm" "asinh" { double } alien-invoke ;
: fatanh ( x -- y )
- "double" "libm" "atanh" { "double" } alien-invoke ; inline
+ double "libm" "atanh" { double } alien-invoke ;
: m.v ( m v -- v ) [ v. ] curry map ;
: m. ( m m -- m ) flip [ swap m.v ] curry map ;
+: m~ ( m m epsilon -- ? ) [ v~ ] curry 2all? ;
+
: mmin ( m -- n ) [ 1/0. ] dip [ [ min ] each ] each ;
: mmax ( m -- n ) [ -1/0. ] dip [ [ max ] each ] each ;
: mnorm ( m -- n ) dup mmax abs m/n ;
: m^n ( m n -- n )
make-bits over first length identity-matrix
- [ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
\ No newline at end of file
+ [ [ dupd m. ] when [ dup m. ] dip ] reduce nip ;
: math-both-known? ( word left right -- ? )
3dup math-op
[ 2drop 2drop t ]
- [ drop math-class-max swap specific-method >boolean ] if ;
+ [ drop math-class-max swap method-for-class >boolean ] if ;
: (derived-ops) ( word assoc -- words )
swap '[ swap first _ eq? nip ] assoc-filter ;
\ <= define-math-ops
\ > define-math-ops
\ >= define-math-ops
+
+ \ u< define-math-ops
+ \ u<= define-math-ops
+ \ u> define-math-ops
+ \ u>= define-math-ops
+
\ number= define-math-ops
{ { shift bignum bignum } bignum-shift } ,
"A polynomial is a vector with the highest powers on the right:"
{ $code "{ 1 1 0 1 } -> 1 + x + x^3" "{ } -> 0" }
"Numerous words are defined to help with polynomial arithmetic:"
-{ $subsection p= }
-{ $subsection p+ }
-{ $subsection p- }
-{ $subsection p* }
-{ $subsection p-sq }
-{ $subsection powers }
-{ $subsection n*p }
-{ $subsection p/mod }
-{ $subsection pgcd }
-{ $subsection polyval }
-{ $subsection pdiff }
-{ $subsection pextend-conv }
-{ $subsection ptrim }
-{ $subsection 2ptrim } ;
+{ $subsections
+ p=
+ p+
+ p-
+ p*
+ p-sq
+ powers
+ n*p
+ p/mod
+ pgcd
+ polyval
+ pdiff
+ pextend-conv
+ ptrim
+ 2ptrim
+} ;
ABOUT: "polynomials"
{ { 13 4253 15823 32472893749823741 } } [ 28408516453955558205925627 factors ] unit-test
{ { 1 2 3 4 6 8 12 24 } } [ 24 divisors ] unit-test
{ 24 } [ 360 divisors length ] unit-test
+{ { 1 } } [ 1 divisors ] unit-test
} cond ; foldable
: divisors ( n -- seq )
- group-factors [ first2 [0,b] [ ^ ] with map ] map
- [ product ] product-map natural-sort ;
+ dup 1 = [
+ 1array
+ ] [
+ group-factors [ first2 [0,b] [ ^ ] with map ] map
+ [ product ] product-map natural-sort
+ ] if ;
ARTICLE: "math.primes.lucas-lehmer" "Lucas-Lehmer Mersenne Primality test"
"The " { $vocab-link "math.primes.lucas-lehmer" } " vocabulary tests numbers of the form " { $snippet "(2 ^ p) - 1" } " for primality, where " { $snippet "p" } " is prime." $nl
"Run the Lucas-Lehmer test:"
-{ $subsection lucas-lehmer } ;
+{ $subsections lucas-lehmer } ;
ABOUT: "math.primes.lucas-lehmer"
ARTICLE: "math.primes.miller-rabin" "Miller-Rabin probabilistic primality test"
"The " { $vocab-link "math.primes.miller-rabin" } " vocabulary implements the Miller-Rabin probabilistic primality test and utility words that use it in order to generate random prime numbers." $nl
"The Miller-Rabin probabilistic primality test:"
-{ $subsection miller-rabin }
-{ $subsection miller-rabin* } ;
+{ $subsections
+ miller-rabin
+ miller-rabin*
+} ;
ABOUT: "math.primes.miller-rabin"
ARTICLE: "math.primes" "Prime numbers"
"The " { $vocab-link "math.primes" } " vocabulary implements words related to prime numbers. Serveral useful vocabularies exist for testing primality. The Sieve of Eratosthenes in " { $vocab-link "math.primes.erato" } " is useful for testing primality below five million. For larger integers, " { $vocab-link "math.primes.miller-rabin" } " is a fast probabilstic primality test. The " { $vocab-link "math.primes.lucas-lehmer" } " vocabulary implements an algorithm for finding huge Mersenne prime numbers." $nl
"Testing if a number is prime:"
-{ $subsection prime? }
+{ $subsections prime? }
"Generating prime numbers:"
-{ $subsection next-prime }
-{ $subsection primes-upto }
-{ $subsection primes-between }
-{ $subsection random-prime }
+{ $subsections
+ next-prime
+ primes-upto
+ primes-between
+ random-prime
+}
"Generating relative prime numbers:"
-{ $subsection find-relative-prime }
-{ $subsection find-relative-prime* }
+{ $subsections
+ find-relative-prime
+ find-relative-prime*
+}
"Make a sequence of random prime numbers:"
-{ $subsection unique-primes } ;
+{ $subsections unique-primes } ;
ABOUT: "math.primes"
: (find-relative-prime) ( n guess -- p )
over 1 <= [ over no-relative-prime ] when
dup 1 <= [ drop 3 ] when
- 2dup gcd nip 1 > [ 2 + (find-relative-prime) ] [ nip ] if ;
+ [ 2dup coprime? ] [ 2 + ] until nip ;
PRIVATE>
"The " { $vocab-link "math.primes.safe" } " vocabulary implements words to calculate safe prime numbers. Safe primes are of the form p = 2q + 1, where p,q are prime. Safe primes have desirable qualities for cryptographic applications." $nl
"Testing if a number is a safe prime:"
-{ $subsection safe-prime? }
+{ $subsections safe-prime? }
"Generating safe prime numbers:"
-{ $subsection next-safe-prime }
-{ $subsection random-safe-prime } ;
+{ $subsections
+ next-safe-prime
+ random-safe-prime
+} ;
ABOUT: "math.primes.safe"
"ranging from " { $emphasis "a" } " to " { $emphasis "b" } " by " { $emphasis "step" } ". Ascending as well as descending ranges are supported."
$nl
"The class of ranges:"
-{ $subsection range }
+{ $subsections range }
"Creating ranges with integer end-points. The standard mathematical convention is used, where " { $snippet "(" } " or " { $snippet ")" } " denotes that the end-point itself " { $emphasis "is not" } " part of the range; " { $snippet "[" } " or " { $snippet "]" } " denotes that the end-point " { $emphasis "is" } " part of the range:"
-{ $subsection [a,b] }
-{ $subsection (a,b] }
-{ $subsection [a,b) }
-{ $subsection (a,b) }
-{ $subsection [0,b] }
-{ $subsection [1,b] }
-{ $subsection [0,b) }
+{ $subsections
+ [a,b]
+ (a,b]
+ [a,b)
+ (a,b)
+ [0,b]
+ [1,b]
+ [0,b)
+}
"Creating general ranges:"
-{ $subsection <range> }
+{ $subsections <range> }
"Ranges are most frequently used with sequence combinators as a means of iterating over integers. For example,"
{ $code "3 10 [a,b] [ sqrt ] map" }
"Computing the factorial of 100 with a descending range:"
IN: math.ratios
ARTICLE: "rationals" "Rational numbers"
-{ $subsection ratio }
+{ $subsections ratio }
"When we add, subtract or multiply any two integers, the result is always an integer. However, dividing a numerator by a denominator that is not an integral divisor of the denominator yields a ratio:"
{ $example "1210 11 / ." "110" }
{ $example "100 330 / ." "10/33" }
{ $example "1/2 1/3 + ." "5/6" }
{ $example "100 6 / 3 * ." "50" }
"Ratios can be taken apart:"
-{ $subsection numerator }
-{ $subsection denominator }
-{ $subsection >fraction }
+{ $subsections
+ numerator
+ denominator
+ >fraction
+}
{ $see-also "syntax-ratios" } ;
ABOUT: "rationals"
--- /dev/null
+USING: help.markup help.syntax math.rectangles ;
+IN: math.rectangles.positioning
+
+HELP: popup-rect
+{ $values { "visible-rect" rect } { "popup-dim" "a pair of real numbers" } { "screen-dim" "a pair of real numbers" } { "rect" rect } }
+{ $description "Calculates the position of a popup with a heuristic:"
+ { $list
+ { "The new rectangle must fit inside " { $snippet "screen-dim" } }
+ { "The new rectangle must not obscure " { $snippet "visible-rect" } }
+ { "The child must otherwise be as close as possible to the edges of " { $snippet "visible-rect" } }
+ }
+ "For example, when displaying a menu, " { $snippet "visible-rect" } " is a single point at the mouse location, and when displaying a completion popup, " { $snippet "visible-rect" } " contains the bounds of the text element being completed."
+} ;
IN: math.rectangles.positioning.tests
[ T{ rect f { 0 1 } { 30 30 } } ] [
- { 0 0 } { 1 1 } <rect>
+ T{ rect f { 0 0 } { 1 1 } }
{ 30 30 }
{ 100 100 }
popup-rect
] unit-test
[ T{ rect f { 10 21 } { 30 30 } } ] [
- { 10 20 } { 1 1 } <rect>
+ T{ rect f { 10 20 } { 1 1 } }
{ 30 30 }
{ 100 100 }
popup-rect
] unit-test
[ T{ rect f { 10 30 } { 30 30 } } ] [
- { 10 20 } { 1 10 } <rect>
+ T{ rect f { 10 20 } { 1 10 } }
{ 30 30 }
{ 100 100 }
popup-rect
] unit-test
[ T{ rect f { 20 20 } { 80 30 } } ] [
- { 40 10 } { 1 10 } <rect>
+ T{ rect f { 40 10 } { 1 10 } }
{ 80 30 }
{ 100 100 }
popup-rect
] unit-test
[ T{ rect f { 50 20 } { 50 50 } } ] [
- { 50 70 } { 0 0 } <rect>
+ T{ rect f { 50 70 } { 0 0 } }
{ 50 50 }
{ 100 100 }
popup-rect
] unit-test
[ T{ rect f { 0 20 } { 50 50 } } ] [
- { -50 70 } { 0 0 } <rect>
+ T{ rect f { -50 70 } { 0 0 } }
{ 50 50 }
{ 100 100 }
popup-rect
] unit-test
[ T{ rect f { 0 50 } { 50 50 } } ] [
- { 0 50 } { 0 0 } <rect>
+ T{ rect f { 0 50 } { 0 0 } }
{ 50 60 }
{ 100 100 }
popup-rect
+] unit-test
+
+[ T{ rect f { 0 90 } { 10 10 } } ] [
+ T{ rect f { 0 1000 } { 0 0 } }
+ { 10 10 }
+ { 100 100 }
+ popup-rect
] unit-test
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences kernel accessors math math.vectors
-math.rectangles math.order arrays locals
+math.rectangles math.order arrays locals fry
combinators.short-circuit ;
IN: math.rectangles.positioning
! Some geometry code for positioning popups and menus
! in a semi-intelligent manner
+<PRIVATE
+
+: adjust-visible-rect ( visible-rect popup-dim screen-dim -- visible-rect' )
+ [ drop clone ] dip '[ _ vmin ] change-loc ;
+
: popup-x ( visible-rect popup-dim screen-dim -- x )
[ loc>> first ] 2dip swap [ first ] bi@ - min 0 max ;
:: popup-dim ( loc popup-dim screen-dim -- dim )
screen-dim loc v- popup-dim vmin ;
+PRIVATE>
+
: popup-rect ( visible-rect popup-dim screen-dim -- rect )
+ [ adjust-visible-rect ] 2keep
[ popup-loc dup ] 2keep popup-dim <rect> ;
\ No newline at end of file
ARTICLE: "math.rectangles" "Rectangles"
"The " { $vocab-link "math.rectangles" } " vocabulary defines a rectangle data type and operations on them."
-{ $subsection rect }
+{ $subsections rect }
"Rectangles can be taken apart:"
-{ $subsection rect-bounds }
-{ $subsection rect-extent }
+{ $subsections
+ rect-bounds
+ rect-extent
+}
"New rectangles can be created:"
-{ $subsection <zero-rect> }
-{ $subsection <rect> }
-{ $subsection <extent-rect> }
+{ $subsections
+ <zero-rect>
+ <rect>
+ <extent-rect>
+}
"Set-theoretic operations on rectangles:"
-{ $subsection rect-intersect }
-{ $subsection rect-union }
-{ $subsection contains-rect? }
-{ $subsection contains-point? }
+{ $subsections
+ rect-intersect
+ rect-union
+ contains-rect?
+ contains-point?
+}
"A utility word:"
-{ $subsection offset-rect } ;
+{ $subsections offset-rect } ;
ABOUT: "math.rectangles"
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors assocs byte-arrays classes classes.algebra effects fry
+functors generalizations kernel literals locals math math.functions
+math.vectors math.vectors.private math.vectors.simd.intrinsics
+math.vectors.specialization parser prettyprint.custom sequences
+sequences.private strings words definitions macros cpu.architecture
+namespaces arrays quotations combinators combinators.short-circuit sets
+layouts ;
+QUALIFIED-WITH: alien.c-types c
+QUALIFIED: math.private
+IN: math.vectors.simd.functor
+
+ERROR: bad-length got expected ;
+
+: vector-true-value ( class -- value )
+ {
+ { [ dup integer class<= ] [ drop -1 ] }
+ { [ dup float class<= ] [ drop -1 bits>double ] }
+ } cond ; foldable
+
+: vector-false-value ( class -- value )
+ {
+ { [ dup integer class<= ] [ drop 0 ] }
+ { [ dup float class<= ] [ drop 0.0 ] }
+ } cond ; foldable
+
+: boolean>element ( bool/elt class -- elt )
+ swap {
+ { t [ vector-true-value ] }
+ { f [ vector-false-value ] }
+ [ nip ]
+ } case ; inline
+
+MACRO: simd-boa ( rep class -- simd-array )
+ [ rep-components ] [ new ] bi* '[ _ _ nsequence ] ;
+
+: can-be-unboxed? ( type -- ? )
+ {
+ { c:float [ \ math.private:float+ "intrinsic" word-prop ] }
+ { c:double [ \ math.private:float+ "intrinsic" word-prop ] }
+ [ c:heap-size cell < ]
+ } case ;
+
+: simd-boa-fast? ( rep -- ? )
+ [ dup rep-gather-word supported-simd-op? ]
+ [ rep-component-type can-be-unboxed? ]
+ bi and ;
+
+:: define-boa-custom-inlining ( word rep class -- )
+ word [
+ drop
+ rep simd-boa-fast? [
+ [ rep (simd-boa) class boa ]
+ ] [ word def>> ] if
+ ] "custom-inlining" set-word-prop ;
+
+: simd-with ( rep class x -- simd-array )
+ [ rep-components ] [ new ] [ '[ _ ] ] tri* swap replicate-as ; inline
+
+: simd-with/nth-fast? ( rep -- ? )
+ [ \ (simd-vshuffle) supported-simd-op? ]
+ [ rep-component-type can-be-unboxed? ]
+ bi and ;
+
+:: define-with-custom-inlining ( word rep class -- )
+ word [
+ drop
+ rep simd-with/nth-fast? [
+ [ rep rep-coerce rep (simd-with) class boa ]
+ ] [ word def>> ] if
+ ] "custom-inlining" set-word-prop ;
+
+: simd-nth-fast ( rep -- quot )
+ [ rep-components ] keep
+ '[ swap _ '[ _ _ (simd-select) ] 2array ] map-index
+ '[ swap >fixnum _ case ] ;
+
+: simd-nth-slow ( rep -- quot )
+ rep-component-type dup c:c-type-getter-boxer c:array-accessor ;
+
+MACRO: simd-nth ( rep -- x )
+ dup simd-with/nth-fast? [ simd-nth-fast ] [ simd-nth-slow ] if ;
+
+: boa-effect ( rep n -- effect )
+ [ rep-components ] dip *
+ [ CHAR: a + 1string ] map
+ { "simd-vector" } <effect> ;
+
+: supported-simd-ops ( assoc rep -- assoc' )
+ [ simd-ops get ] dip
+ '[ nip _ swap supported-simd-op? ] assoc-filter
+ '[ drop _ key? ] assoc-filter ;
+
+ERROR: bad-schema op schema ;
+
+:: op-wrapper ( op specials schemas -- wrapper )
+ op {
+ [ specials at ]
+ [ word-schema schemas at ]
+ [ dup word-schema bad-schema ]
+ } 1|| ;
+
+: low-level-ops ( simd-ops specials schemas -- alist )
+ '[ 1quotation over _ _ op-wrapper [ ] 2sequence ] assoc-map ;
+
+:: high-level-ops ( ctor elt-class -- assoc )
+ ! Some SIMD operations are defined in terms of others.
+ {
+ { vbroadcast [ swap nth ctor execute ] }
+ { vneg [ [ dup vbitxor ] keep v- ] }
+ { n+v [ [ ctor execute ] dip v+ ] }
+ { v+n [ ctor execute v+ ] }
+ { n-v [ [ ctor execute ] dip v- ] }
+ { v-n [ ctor execute v- ] }
+ { n*v [ [ ctor execute ] dip v* ] }
+ { v*n [ ctor execute v* ] }
+ { n/v [ [ ctor execute ] dip v/ ] }
+ { v/n [ ctor execute v/ ] }
+ { norm-sq [ dup v. assert-positive ] }
+ { norm [ norm-sq sqrt ] }
+ { normalize [ dup norm v/n ] }
+ }
+ ! To compute dot product and distance with integer vectors, we
+ ! have to do things less efficiently, with integer overflow checks,
+ ! in the general case.
+ elt-class float = [ { distance [ v- norm ] } suffix ] when ;
+
+TUPLE: simd class elt-class ops special-wrappers schema-wrappers ctor rep ;
+
+: define-simd ( simd -- )
+ dup rep>> rep-component-type c:c-type-boxed-class >>elt-class
+ {
+ [ class>> ]
+ [ elt-class>> ]
+ [ [ ops>> ] [ special-wrappers>> ] [ schema-wrappers>> ] tri low-level-ops ]
+ [ rep>> supported-simd-ops ]
+ [ [ ctor>> ] [ elt-class>> ] bi high-level-ops assoc-union ]
+ } cleave
+ specialize-vector-words ;
+
+:: define-simd-128-type ( class rep -- )
+ c:<c-type>
+ byte-array >>class
+ class >>boxed-class
+ [ rep alien-vector class boa ] >>getter
+ [ [ underlying>> ] 2dip rep set-alien-vector ] >>setter
+ 16 >>size
+ 8 >>align
+ rep >>rep
+ class c:typedef ;
+
+: (define-simd-128) ( simd -- )
+ simd-ops get >>ops
+ [ define-simd ]
+ [ [ class>> ] [ rep>> ] bi define-simd-128-type ] bi ;
+
+FUNCTOR: define-simd-128 ( T -- )
+
+N [ 16 T c:heap-size /i ]
+
+A DEFINES-CLASS ${T}-${N}
+A-boa DEFINES ${A}-boa
+A-with DEFINES ${A}-with
+A-cast DEFINES ${A}-cast
+>A DEFINES >${A}
+A{ DEFINES ${A}{
+
+SET-NTH [ T dup c:c-setter c:array-accessor ]
+
+A-rep [ A name>> "-rep" append "cpu.architecture" lookup ]
+A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
+A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op
+A-vv->n-op DEFINES-PRIVATE ${A}-vv->n-op
+A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
+A-v->n-op DEFINES-PRIVATE ${A}-v->n-op
+
+A-element-class [ A-rep rep-component-type c:c-type-boxed-class ]
+
+WHERE
+
+TUPLE: A
+{ underlying byte-array read-only initial: $[ 16 <byte-array> ] } ;
+
+M: A clone underlying>> clone \ A boa ; inline
+
+M: A length drop N ; inline
+
+M: A equal?
+ over \ A instance? [ v= vall? ] [ 2drop f ] if ;
+
+M: A nth-unsafe underlying>> A-rep simd-nth ; inline
+
+M: A set-nth-unsafe
+ [ A-element-class boolean>element ] 2dip
+ underlying>> SET-NTH call ; inline
+
+: >A ( seq -- simd-array ) \ A new clone-like ;
+
+M: A like drop dup \ A instance? [ >A ] unless ; inline
+
+M: A new-underlying drop \ A boa ; inline
+
+M: A new-sequence
+ drop dup N =
+ [ drop 16 <byte-array> \ A boa ]
+ [ N bad-length ]
+ if ; inline
+
+M: A c:byte-length underlying>> length ; inline
+
+M: A element-type drop A-rep rep-component-type ;
+
+M: A pprint-delims drop \ A{ \ } ;
+
+M: A >pprint-sequence ;
+
+M: A pprint* pprint-object ;
+
+SYNTAX: A{ \ } [ >A ] parse-literal ;
+
+: A-with ( x -- simd-array ) [ A-rep A ] dip simd-with ;
+
+\ A-with \ A-rep \ A define-with-custom-inlining
+
+\ A-boa [ \ A-rep \ A simd-boa ] \ A-rep 1 boa-effect define-declared
+
+\ A-rep rep-gather-word [
+ \ A-boa \ A-rep \ A define-boa-custom-inlining
+] when
+
+: A-cast ( simd-array -- simd-array' )
+ underlying>> \ A boa ; inline
+
+INSTANCE: A sequence
+
+<PRIVATE
+
+: A-vv->v-op ( v1 v2 quot -- v3 )
+ [ [ underlying>> ] bi@ A-rep ] dip call \ A boa ; inline
+
+: A-vn->v-op ( v1 v2 quot -- v3 )
+ [ [ underlying>> ] dip A-rep ] dip call \ A boa ; inline
+
+: A-vv->n-op ( v1 v2 quot -- n )
+ [ [ underlying>> ] bi@ A-rep ] dip call ; inline
+
+: A-v->v-op ( v1 quot -- v2 )
+ [ underlying>> A-rep ] dip call \ A boa ; inline
+
+: A-v->n-op ( v quot -- n )
+ [ underlying>> A-rep ] dip call ; inline
+
+simd new
+ \ A >>class
+ \ A-with >>ctor
+ \ A-rep >>rep
+ {
+ { { +vector+ +vector+ -> +vector+ } A-vv->v-op }
+ { { +vector+ +scalar+ -> +vector+ } A-vn->v-op }
+ { { +vector+ +literal+ -> +vector+ } A-vn->v-op }
+ { { +vector+ +vector+ -> +scalar+ } A-vv->n-op }
+ { { +vector+ -> +vector+ } A-v->v-op }
+ { { +vector+ -> +scalar+ } A-v->n-op }
+ { { +vector+ -> +nonnegative+ } A-v->n-op }
+ } >>schema-wrappers
+(define-simd-128)
+
+PRIVATE>
+
+;FUNCTOR
+
+! Synthesize 256-bit vectors from a pair of 128-bit vectors
+SLOT: underlying1
+SLOT: underlying2
+
+:: define-simd-256-type ( class rep -- )
+ c:<c-type>
+ class >>class
+ class >>boxed-class
+ [
+ [ rep alien-vector ]
+ [ 16 + >fixnum rep alien-vector ] 2bi
+ class boa
+ ] >>getter
+ [
+ [ [ underlying1>> ] 2dip rep set-alien-vector ]
+ [ [ underlying2>> ] 2dip 16 + >fixnum rep set-alien-vector ]
+ 3bi
+ ] >>setter
+ 32 >>size
+ 8 >>align
+ rep >>rep
+ class c:typedef ;
+
+: (define-simd-256) ( simd -- )
+ simd-ops get { vshuffle hlshift hrshift } unique assoc-diff >>ops
+ [ define-simd ]
+ [ [ class>> ] [ rep>> ] bi define-simd-256-type ] bi ;
+
+FUNCTOR: define-simd-256 ( T -- )
+
+N [ 32 T c:heap-size /i ]
+
+N/2 [ N 2 / ]
+A/2 IS ${T}-${N/2}
+A/2-boa IS ${A/2}-boa
+A/2-with IS ${A/2}-with
+
+A DEFINES-CLASS ${T}-${N}
+A-boa DEFINES ${A}-boa
+A-with DEFINES ${A}-with
+A-cast DEFINES ${A}-cast
+>A DEFINES >${A}
+A{ DEFINES ${A}{
+
+A-deref DEFINES-PRIVATE ${A}-deref
+
+A-rep [ A/2 name>> "-rep" append "cpu.architecture" lookup ]
+A-vv->v-op DEFINES-PRIVATE ${A}-vv->v-op
+A-vn->v-op DEFINES-PRIVATE ${A}-vn->v-op
+A-v->v-op DEFINES-PRIVATE ${A}-v->v-op
+A-v.-op DEFINES-PRIVATE ${A}-v.-op
+(A-v->n-op) DEFINES-PRIVATE (${A}-v->v-op)
+A-sum-op DEFINES-PRIVATE ${A}-sum-op
+A-vany-op DEFINES-PRIVATE ${A}-vany-op
+A-vall-op DEFINES-PRIVATE ${A}-vall-op
+A-vmerge-head-op DEFINES-PRIVATE ${A}-vmerge-head-op
+A-vmerge-tail-op DEFINES-PRIVATE ${A}-vmerge-tail-op
+
+WHERE
+
+SLOT: underlying1
+SLOT: underlying2
+
+TUPLE: A
+{ underlying1 byte-array initial: $[ 16 <byte-array> ] read-only }
+{ underlying2 byte-array initial: $[ 16 <byte-array> ] read-only } ;
+
+M: A clone
+ [ underlying1>> clone ] [ underlying2>> clone ] bi
+ \ A boa ; inline
+
+M: A length drop N ; inline
+
+M: A equal?
+ over \ A instance? [ v= vall? ] [ 2drop f ] if ;
+
+: A-deref ( n seq -- n' seq' )
+ over N/2 < [ underlying1>> ] [ [ N/2 - ] dip underlying2>> ] if \ A/2 boa ; inline
+
+M: A nth-unsafe A-deref nth-unsafe ; inline
+
+M: A set-nth-unsafe A-deref set-nth-unsafe ; inline
+
+: >A ( seq -- simd-array ) \ A new clone-like ;
+
+M: A like drop dup \ A instance? [ >A ] unless ; inline
+
+M: A new-sequence
+ drop dup N =
+ [ drop 16 <byte-array> 16 <byte-array> \ A boa ]
+ [ N bad-length ]
+ if ; inline
+
+M: A c:byte-length drop 32 ; inline
+
+M: A element-type drop A-rep rep-component-type ;
+
+SYNTAX: A{ \ } [ >A ] parse-literal ;
+
+M: A pprint-delims drop \ A{ \ } ;
+
+M: A >pprint-sequence ;
+
+M: A pprint* pprint-object ;
+
+: A-with ( x -- simd-array )
+ [ A/2-with ] [ A/2-with ] bi [ underlying>> ] bi@
+ \ A boa ; inline
+
+: A-boa ( ... -- simd-array )
+ [ A/2-boa ] N/2 ndip A/2-boa [ underlying>> ] bi@
+ \ A boa ; inline
+
+\ A-rep 2 boa-effect \ A-boa set-stack-effect
+
+: A-cast ( simd-array -- simd-array' )
+ [ underlying1>> ] [ underlying2>> ] bi \ A boa ; inline
+
+INSTANCE: A sequence
+
+: A-vv->v-op ( v1 v2 quot -- v3 )
+ [ [ [ underlying1>> ] bi@ A-rep ] dip call ]
+ [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
+ \ A boa ; inline
+
+: A-vn->v-op ( v1 v2 quot -- v3 )
+ [ [ [ underlying1>> ] dip A-rep ] dip call ]
+ [ [ [ underlying2>> ] dip A-rep ] dip call ] 3bi
+ \ A boa ; inline
+
+: A-v->v-op ( v1 combine-quot -- v2 )
+ [ [ underlying1>> A-rep ] dip call ]
+ [ [ underlying2>> A-rep ] dip call ] 2bi
+ \ A boa ; inline
+
+: A-v.-op ( v1 v2 quot -- n )
+ [ [ [ underlying1>> ] bi@ A-rep ] dip call ]
+ [ [ [ underlying2>> ] bi@ A-rep ] dip call ] 3bi
+ + ; inline
+
+: (A-v->n-op) ( v1 quot reduce-quot -- n )
+ '[ [ underlying1>> ] [ underlying2>> ] bi A-rep @ A-rep ] dip call ; inline
+
+: A-sum-op ( v1 quot -- n )
+ [ (simd-v+) ] (A-v->n-op) ; inline
+
+: A-vany-op ( v1 quot -- n )
+ [ (simd-vbitor) ] (A-v->n-op) ; inline
+: A-vall-op ( v1 quot -- n )
+ [ (simd-vbitand) ] (A-v->n-op) ; inline
+
+: A-vmerge-head-op ( v1 v2 quot -- v )
+ drop
+ [ underlying1>> ] bi@
+ [ A-rep (simd-(vmerge-head)) ]
+ [ A-rep (simd-(vmerge-tail)) ] 2bi
+ \ A boa ;
+
+: A-vmerge-tail-op ( v1 v2 quot -- v )
+ drop
+ [ underlying2>> ] bi@
+ [ A-rep (simd-(vmerge-head)) ]
+ [ A-rep (simd-(vmerge-tail)) ] 2bi
+ \ A boa ;
+
+simd new
+ \ A >>class
+ \ A-with >>ctor
+ \ A-rep >>rep
+ {
+ { v. A-v.-op }
+ { sum A-sum-op }
+ { vnone? A-vany-op }
+ { vany? A-vany-op }
+ { vall? A-vall-op }
+ { (vmerge-head) A-vmerge-head-op }
+ { (vmerge-tail) A-vmerge-tail-op }
+ } >>special-wrappers
+ {
+ { { +vector+ +vector+ -> +vector+ } A-vv->v-op }
+ { { +vector+ +scalar+ -> +vector+ } A-vn->v-op }
+ { { +vector+ +literal+ -> +vector+ } A-vn->v-op }
+ { { +vector+ -> +vector+ } A-v->v-op }
+ } >>schema-wrappers
+(define-simd-256)
+
+;FUNCTOR
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+IN: math.vectors.simd.intrinsics.tests
+USING: math.vectors.simd.intrinsics cpu.architecture tools.test ;
+
+[ 16 ] [ uchar-16-rep rep-components ] unit-test
+[ 16 ] [ char-16-rep rep-components ] unit-test
+[ 8 ] [ ushort-8-rep rep-components ] unit-test
+[ 8 ] [ short-8-rep rep-components ] unit-test
+[ 4 ] [ uint-4-rep rep-components ] unit-test
+[ 4 ] [ int-4-rep rep-components ] unit-test
+[ 4 ] [ float-4-rep rep-components ] unit-test
+[ 2 ] [ double-2-rep rep-components ] unit-test
+
+{ 4 1 } [ uint-4-rep (simd-boa) ] must-infer-as
+{ 4 1 } [ int-4-rep (simd-boa) ] must-infer-as
+{ 4 1 } [ float-4-rep (simd-boa) ] must-infer-as
+{ 2 1 } [ double-2-rep (simd-boa) ] must-infer-as
+
+
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.data assocs combinators
+cpu.architecture compiler.cfg.comparisons fry generalizations
+kernel libc macros math sequences effects accessors namespaces
+lexer parser vocabs.parser words arrays math.vectors ;
+IN: math.vectors.simd.intrinsics
+
+ERROR: bad-simd-call ;
+
+<<
+
+: simd-effect ( word -- effect )
+ stack-effect [ in>> "rep" suffix ] [ out>> ] bi <effect> ;
+
+SYMBOL: simd-ops
+
+V{ } clone simd-ops set-global
+
+SYNTAX: SIMD-OP:
+ scan-word dup name>> "(simd-" ")" surround create-in
+ [ nip [ bad-simd-call ] define ]
+ [ [ simd-effect ] dip set-stack-effect ]
+ [ 2array simd-ops get push ]
+ 2tri ;
+
+>>
+
+SIMD-OP: v+
+SIMD-OP: v-
+SIMD-OP: v+-
+SIMD-OP: vs+
+SIMD-OP: vs-
+SIMD-OP: vs*
+SIMD-OP: v*
+SIMD-OP: v/
+SIMD-OP: vmin
+SIMD-OP: vmax
+SIMD-OP: v.
+SIMD-OP: vsqrt
+SIMD-OP: sum
+SIMD-OP: vabs
+SIMD-OP: vbitand
+SIMD-OP: vbitandn
+SIMD-OP: vbitor
+SIMD-OP: vbitxor
+SIMD-OP: vbitnot
+SIMD-OP: vand
+SIMD-OP: vandn
+SIMD-OP: vor
+SIMD-OP: vxor
+SIMD-OP: vnot
+SIMD-OP: vlshift
+SIMD-OP: vrshift
+SIMD-OP: hlshift
+SIMD-OP: hrshift
+SIMD-OP: vshuffle
+SIMD-OP: (vmerge-head)
+SIMD-OP: (vmerge-tail)
+SIMD-OP: v<=
+SIMD-OP: v<
+SIMD-OP: v=
+SIMD-OP: v>
+SIMD-OP: v>=
+SIMD-OP: vunordered?
+SIMD-OP: vany?
+SIMD-OP: vall?
+SIMD-OP: vnone?
+
+: (simd-with) ( x rep -- v ) bad-simd-call ;
+: (simd-gather-2) ( a b rep -- v ) bad-simd-call ;
+: (simd-gather-4) ( a b c d rep -- v ) bad-simd-call ;
+: (simd-select) ( v n rep -- x ) bad-simd-call ;
+
+: assert-positive ( x -- y ) ;
+
+: alien-vector ( c-ptr n rep -- value )
+ ! Inefficient version for when intrinsics are missing
+ [ swap <displaced-alien> ] dip rep-size memory>byte-array ;
+
+: set-alien-vector ( value c-ptr n rep -- )
+ ! Inefficient version for when intrinsics are missing
+ [ swap <displaced-alien> swap ] dip rep-size memcpy ;
+
+<<
+
+: rep-components ( rep -- n )
+ 16 swap rep-component-type heap-size /i ; foldable
+
+: rep-coercer ( rep -- quot )
+ {
+ { [ dup int-vector-rep? ] [ [ >fixnum ] ] }
+ { [ dup float-vector-rep? ] [ [ >float ] ] }
+ } cond nip ; foldable
+
+: rep-coerce ( value rep -- value' )
+ rep-coercer call( value -- value' ) ; inline
+
+CONSTANT: rep-gather-words
+ {
+ { 2 (simd-gather-2) }
+ { 4 (simd-gather-4) }
+ }
+
+: rep-gather-word ( rep -- word )
+ rep-components rep-gather-words at ;
+
+>>
+
+MACRO: (simd-boa) ( rep -- quot )
+ {
+ [ rep-coercer ]
+ [ rep-components ]
+ [ ]
+ [ rep-gather-word ]
+ } cleave
+ '[ _ _ napply _ _ execute ] ;
+
+GENERIC# supported-simd-op? 1 ( rep intrinsic -- ? )
+
+M: vector-rep supported-simd-op?
+ {
+ { \ (simd-v+) [ %add-vector-reps ] }
+ { \ (simd-vs+) [ %saturated-add-vector-reps ] }
+ { \ (simd-v+-) [ %add-sub-vector-reps ] }
+ { \ (simd-v-) [ %sub-vector-reps ] }
+ { \ (simd-vs-) [ %saturated-sub-vector-reps ] }
+ { \ (simd-v*) [ %mul-vector-reps ] }
+ { \ (simd-vs*) [ %saturated-mul-vector-reps ] }
+ { \ (simd-v/) [ %div-vector-reps ] }
+ { \ (simd-vmin) [ %min-vector-reps ] }
+ { \ (simd-vmax) [ %max-vector-reps ] }
+ { \ (simd-v.) [ %dot-vector-reps ] }
+ { \ (simd-vsqrt) [ %sqrt-vector-reps ] }
+ { \ (simd-sum) [ %horizontal-add-vector-reps ] }
+ { \ (simd-vabs) [ %abs-vector-reps ] }
+ { \ (simd-vbitand) [ %and-vector-reps ] }
+ { \ (simd-vbitandn) [ %andn-vector-reps ] }
+ { \ (simd-vbitor) [ %or-vector-reps ] }
+ { \ (simd-vbitxor) [ %xor-vector-reps ] }
+ { \ (simd-vbitnot) [ %not-vector-reps ] }
+ { \ (simd-vand) [ %and-vector-reps ] }
+ { \ (simd-vandn) [ %andn-vector-reps ] }
+ { \ (simd-vor) [ %or-vector-reps ] }
+ { \ (simd-vxor) [ %xor-vector-reps ] }
+ { \ (simd-vnot) [ %not-vector-reps ] }
+ { \ (simd-vlshift) [ %shl-vector-reps ] }
+ { \ (simd-vrshift) [ %shr-vector-reps ] }
+ { \ (simd-hlshift) [ %horizontal-shl-vector-reps ] }
+ { \ (simd-hrshift) [ %horizontal-shr-vector-reps ] }
+ { \ (simd-vshuffle) [ %shuffle-vector-reps ] }
+ { \ (simd-(vmerge-head)) [ %merge-vector-reps ] }
+ { \ (simd-(vmerge-tail)) [ %merge-vector-reps ] }
+ { \ (simd-v<=) [ cc<= %compare-vector-reps ] }
+ { \ (simd-v<) [ cc< %compare-vector-reps ] }
+ { \ (simd-v=) [ cc= %compare-vector-reps ] }
+ { \ (simd-v>) [ cc> %compare-vector-reps ] }
+ { \ (simd-v>=) [ cc>= %compare-vector-reps ] }
+ { \ (simd-vunordered?) [ cc/<>= %compare-vector-reps ] }
+ { \ (simd-gather-2) [ %gather-vector-2-reps ] }
+ { \ (simd-gather-4) [ %gather-vector-4-reps ] }
+ { \ (simd-vany?) [ %test-vector-reps ] }
+ { \ (simd-vall?) [ %test-vector-reps ] }
+ { \ (simd-vnone?) [ %test-vector-reps ] }
+ } case member? ;
--- /dev/null
+USING: classes.tuple.private cpu.architecture help.markup
+help.syntax kernel.private math math.vectors
+math.vectors.simd.intrinsics sequences ;
+IN: math.vectors.simd
+
+ARTICLE: "math.vectors.simd.intro" "Introduction to SIMD support"
+"Modern CPUs support a form of data-level parallelism, where arithmetic operations on fixed-size short vectors can be done on all components in parallel. This is known as single-instruction-multiple-data (SIMD)."
+$nl
+"SIMD support in the processor takes the form of instruction sets which operate on vector registers. By operating on multiple scalar values at the same time, code which operates on points, colors, and other vector data can be sped up."
+$nl
+"In Factor, SIMD support is exposed in the form of special-purpose SIMD " { $link "sequence-protocol" } " implementations. These are fixed-length, homogeneous sequences. They are referred to as vectors, but should not be confused with Factor's " { $link "vectors" } ", which can hold any type of object and can be resized.)."
+$nl
+"The words in the " { $vocab-link "math.vectors" } " vocabulary, which can be used with any sequence of numbers, are special-cased by the compiler. If the compiler can prove that only SIMD vectors are used, it expands " { $link "math-vectors" } " into " { $link "math.vectors.simd.intrinsics" } ". While in the general case, SIMD intrinsics operate on heap-allocated SIMD vectors, that too can be optimized since in many cases the compiler unbox SIMD vectors, storing them directly in registers."
+$nl
+"Since the only difference between ordinary code and SIMD-accelerated code is that the latter uses special fixed-length SIMD sequences, the SIMD library is very easy to use. To ensure your code compiles to use vector instructions without boxing and unboxing overhead, follow the guidelines for " { $link "math.vectors.simd.efficiency" } "."
+$nl
+"There should never be any reason to use " { $link "math.vectors.simd.intrinsics" } " directly, but they too have a straightforward, but lower-level, interface." ;
+
+ARTICLE: "math.vectors.simd.support" "Supported SIMD instruction sets and operations"
+"At present, the SIMD support makes use of a subset of SSE up to SSE4.1. The subset used depends on the current CPU type."
+$nl
+"SSE1 only supports single-precision SIMD (" { $snippet "float-4" } " and " { $snippet "float-8" } ")."
+$nl
+"SSE2 introduces double-precision SIMD (" { $snippet "double-2" } " and " { $snippet "double-4" } ") and integer SIMD (all types). Integer SIMD is missing a few features, in particular the " { $link vmin } " and " { $link vmax } " operations only work on " { $snippet "uchar-16" } " and " { $snippet "short-8" } "."
+$nl
+"SSE3 introduces horizontal adds (summing all components of a single vector register), which is useful for computing dot products. Where available, SSE3 operations are used to speed up " { $link sum } ", " { $link v. } ", " { $link norm-sq } ", " { $link norm } ", and " { $link distance } "."
+$nl
+"SSSE3 introduces " { $link vabs } " for " { $snippet "char-16" } ", " { $snippet "short-8" } " and " { $snippet "int-4" } "."
+$nl
+"SSE4.1 introduces " { $link vmin } " and " { $link vmax } " for all remaining integer types, a faster instruction for " { $link v. } ", and a few other things."
+$nl
+"On PowerPC, or older x86 chips without SSE, software fallbacks are used for all high-level vector operations. SIMD code can run with no loss in functionality, just decreased performance."
+$nl
+"The primities in the " { $vocab-link "math.vectors.simd.intrinsics" } " vocabulary do not have software fallbacks, but they should not be called directly in any case." ;
+
+ARTICLE: "math.vectors.simd.types" "SIMD vector types"
+"Each SIMD vector type is named " { $snippet "scalar-count" } ", where " { $snippet "scalar" } " is a scalar C type and " { $snippet "count" } " is a vector dimension."
+$nl
+"To use a SIMD vector type, a parsing word is used to generate the relevant code and bring it into the vocabulary search path; this is the same idea as with " { $link "specialized-arrays" } ":"
+{ $subsections POSTPONE: SIMD: }
+"The following vector types are supported:"
+{ $code
+ "char-16"
+ "uchar-16"
+ "char-32"
+ "uchar-32"
+ "short-8"
+ "ushort-8"
+ "short-16"
+ "ushort-16"
+ "int-4"
+ "uint-4"
+ "int-8"
+ "uint-8"
+ "longlong-2"
+ "ulonglong-2"
+ "longlong-4"
+ "ulonglong-4"
+ "float-4"
+ "float-8"
+ "double-2"
+ "double-4"
+} ;
+
+ARTICLE: "math.vectors.simd.words" "SIMD vector words"
+"For each SIMD vector type, several words are defined, where " { $snippet "type" } " is the type in question:"
+{ $table
+ { "Word" "Stack effect" "Description" }
+ { { $snippet "type-with" } { $snippet "( x -- simd-array )" } "creates a new instance where all components are set to a single scalar" }
+ { { $snippet "type-boa" } { $snippet "( ... -- simd-array )" } "creates a new instance where components are read from the stack" }
+ { { $snippet "type-cast" } { $snippet "( simd-array -- simd-array' )" } "creates a new SIMD array where the underlying data is taken from another SIMD array, with no format conversion" }
+ { { $snippet ">type" } { $snippet "( seq -- simd-array )" } "creates a new instance initialized with the elements of an existing sequence, which must have the correct length" }
+ { { $snippet "type{" } { $snippet "type{ elements... }" } "parsing word defining literal syntax for an SIMD vector; the correct number of elements must be given" }
+}
+"To actually perform vector arithmetic on SIMD vectors, use " { $link "math-vectors" } " words."
+{ $see-also "c-types-specs" } ;
+
+ARTICLE: "math.vectors.simd.efficiency" "Writing efficient SIMD code"
+"Since SIMD vectors are heap-allocated objects, it is important to write code in a style which is conducive to the compiler being able to inline generic dispatch and eliminate allocation."
+$nl
+"If the inputs to a " { $vocab-link "math.vectors" } " word are statically known to be SIMD vectors, the call is converted into an SIMD primitive, and the output is then also known to be an SIMD vector (or scalar, depending on the operation); this information propagates forward within a single word (together with any inlined words and macro expansions). Any intermediate values which are not stored into collections, or returned from the word, are furthermore unboxed."
+$nl
+"To check if optimizations are being performed, pass a quotation to the " { $snippet "optimizer-report." } " and " { $snippet "optimized." } " words in the " { $vocab-link "compiler.tree.debugger" } " vocabulary, and look for calls to " { $link "math.vectors.simd.intrinsics" } " as opposed to high-level " { $link "math-vectors" } "."
+$nl
+"For example, in the following, no SIMD operations are used at all, because the compiler's propagation pass does not consider dynamic variable usage:"
+{ $code
+"""USING: compiler.tree.debugger math.vectors
+math.vectors.simd ;
+SYMBOLS: x y ;
+
+[
+ double-4{ 1.5 2.0 3.7 0.4 } x set
+ double-4{ 1.5 2.0 3.7 0.4 } y set
+ x get y get v+
+] optimizer-report.""" }
+"The following word benefits from SIMD optimization, because it begins with an unsafe declaration:"
+{ $code
+"""USING: compiler.tree.debugger kernel.private
+math.vectors math.vectors.simd ;
+SIMD: float
+IN: simd-demo
+
+: interpolate ( v a b -- w )
+ { float-4 float-4 float-4 } declare
+ [ v* ] [ [ 1.0 ] dip n-v v* ] bi-curry* bi v+ ;
+
+\ interpolate optimizer-report.""" }
+"Note that using " { $link declare } " is not recommended. Safer ways of getting type information for the input parameters to a word include defining methods on a generic word (the value being dispatched upon has a statically known type in the method body), as well as using " { $link "hints" } " and " { $link POSTPONE: inline } " declarations."
+$nl
+"Here is a better version of the " { $snippet "interpolate" } " words above that uses hints:"
+{ $code
+"""USING: compiler.tree.debugger hints
+math.vectors math.vectors.simd ;
+SIMD: float
+IN: simd-demo
+
+: interpolate ( v a b -- w )
+ [ v* ] [ [ 1.0 ] dip n-v v* ] bi-curry* bi v+ ;
+
+HINTS: interpolate float-4 float-4 float-4 ;
+
+\ interpolate optimizer-report. """ }
+"This time, the optimizer report lists calls to both SIMD primitives and high-level vector words, because hints cause two code paths to be generated. The " { $snippet "optimized." } " word can be used to make sure that the fast code path consists entirely of calls to primitives."
+$nl
+"If the " { $snippet "interpolate" } " word was to be used in several places with different types of vectors, it would be best to declare it " { $link POSTPONE: inline } "."
+$nl
+"In the " { $snippet "interpolate" } " word, there is still a call to the " { $link <tuple-boa> } " primitive, because the return value at the end is being boxed on the heap. In the next example, no memory allocation occurs at all because the SIMD vectors are stored inside a struct class (see " { $link "classes.struct" } "); also note the use of inlining:"
+{ $code
+"""USING: compiler.tree.debugger math.vectors math.vectors.simd ;
+SIMD: float
+IN: simd-demo
+
+STRUCT: actor
+{ id int }
+{ position float-4 }
+{ velocity float-4 }
+{ acceleration float-4 } ;
+
+GENERIC: advance ( dt object -- )
+
+: update-velocity ( dt actor -- )
+ [ acceleration>> n*v ] [ velocity>> v+ ] [ ] tri
+ (>>velocity) ; inline
+
+: update-position ( dt actor -- )
+ [ velocity>> n*v ] [ position>> v+ ] [ ] tri
+ (>>position) ; inline
+
+M: actor advance ( dt actor -- )
+ [ >float ] dip
+ [ update-velocity ] [ update-position ] 2bi ;
+
+M\ actor advance optimized."""
+}
+"The " { $vocab-link "compiler.cfg.debugger" } " vocabulary can give a lower-level picture of the generated code, that includes register assignments and other low-level details. To look at low-level optimizer output, call " { $snippet "test-mr mr." } " on a word or quotation:"
+{ $code
+"""USE: compiler.tree.debugger
+
+M\ actor advance test-mr mr.""" }
+"An example of a high-performance algorithm that uses SIMD primitives can be found in the " { $vocab-link "benchmark.nbody-simd" } " vocabulary." ;
+
+ARTICLE: "math.vectors.simd.intrinsics" "Low-level SIMD primitives"
+"The words in the " { $vocab-link "math.vectors.simd.intrinsics" } " vocabulary are used to implement SIMD support. These words have three disadvantages compared to the higher-level " { $link "math-vectors" } " words:"
+{ $list
+ "They operate on raw byte arrays, with a separate “representation” parameter passed in to determine the type of the operands and result."
+ "They are unsafe; passing values which are not byte arrays, or byte arrays with the wrong size, will dereference invalid memory and possibly crash Factor."
+ { "They do not have software fallbacks; if the current CPU does not have SIMD support, a " { $link bad-simd-call } " error will be thrown." }
+}
+"The compiler converts " { $link "math-vectors" } " into SIMD primitives automatically in cases where it is safe; this means that the input types are known to be SIMD vectors, and the CPU supports SIMD."
+$nl
+"It is best to avoid calling SIMD primitives directly. To write efficient high-level code that compiles down to primitives and avoids memory allocation, see " { $link "math.vectors.simd.efficiency" } "."
+$nl
+"There are two primitives which are used to implement accessing SIMD vector fields of " { $link "classes.struct" } ":"
+{ $subsections
+ alien-vector
+ set-alien-vector
+}
+"For the most part, the above primitives correspond directly to vector arithmetic words. They take a representation parameter, which is one of the singleton members of the " { $link vector-rep } " union in the " { $vocab-link "cpu.architecture" } " vocabulary." ;
+
+ARTICLE: "math.vectors.simd.alien" "SIMD data in struct classes"
+"Struct classes may contain fields which store SIMD data; for each SIMD vector type listed in " { $snippet "math.vectors.simd.types" } " there is a C type with the same name."
+$nl
+"Only SIMD struct fields are allowed at the moment; passing SIMD data as function parameters is not yet supported." ;
+
+ARTICLE: "math.vectors.simd.accuracy" "Numerical accuracy of SIMD primitives"
+"No guarantees are made that " { $vocab-link "math.vectors.simd" } " words will give identical results on different SSE versions, or between the hardware intrinsics and the software fallbacks."
+$nl
+"In particular, horizontal operations on " { $snippet "float-4" } " and " { $snippet "float-8" } " are affected by this. They are computed with lower precision in intrinsics than the software fallback. Horizontal operations include anything involving adding together the components of a vector, such as " { $link sum } " or " { $link normalize } "." ;
+
+ARTICLE: "math.vectors.simd" "Hardware vector arithmetic (SIMD)"
+"The " { $vocab-link "math.vectors.simd" } " vocabulary extends the " { $vocab-link "math.vectors" } " vocabulary to support efficient vector arithmetic on small, fixed-size vectors."
+{ $subsections
+ "math.vectors.simd.intro"
+ "math.vectors.simd.types"
+ "math.vectors.simd.words"
+ "math.vectors.simd.support"
+ "math.vectors.simd.accuracy"
+ "math.vectors.simd.efficiency"
+ "math.vectors.simd.alien"
+ "math.vectors.simd.intrinsics"
+} ;
+
+HELP: SIMD:
+{ $syntax "SIMD: type" }
+{ $values { "type" "a scalar C type" } }
+{ $description "Defines 128-bit and 256-bit SIMD arrays for holding elements of " { $snippet "type" } " into the vocabulary search path. The possible type/length combinations are listed in " { $link "math.vectors.simd.types" } " and the generated words are documented in " { $link "math.vectors.simd.words" } "." } ;
+
+ABOUT: "math.vectors.simd"
--- /dev/null
+USING: accessors arrays classes compiler compiler.tree.debugger
+effects fry io kernel kernel.private math math.functions
+math.private math.vectors math.vectors.simd
+math.vectors.simd.private prettyprint random sequences system
+tools.test vocabs assocs compiler.cfg.debugger words
+locals math.vectors.specialization combinators cpu.architecture
+math.vectors.simd.intrinsics namespaces byte-arrays alien
+specialized-arrays classes.struct eval classes.algebra sets
+quotations math.constants compiler.units ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
+SIMD: c:char
+SIMD: c:uchar
+SIMD: c:short
+SIMD: c:ushort
+SIMD: c:int
+SIMD: c:uint
+SIMD: c:longlong
+SIMD: c:ulonglong
+SIMD: c:float
+SIMD: c:double
+IN: math.vectors.simd.tests
+
+! Make sure the functor doesn't generate bogus vocabularies
+2 [ [ "USE: math.vectors.simd SIMD: rubinius" eval( -- ) ] must-fail ] times
+
+[ f ] [ "math.vectors.simd.instances.rubinius" vocab ] unit-test
+
+! Test type propagation
+[ V{ float } ] [ [ { float-4 } declare norm-sq ] final-classes ] unit-test
+
+[ V{ float } ] [ [ { float-4 } declare norm ] final-classes ] unit-test
+
+[ V{ float-4 } ] [ [ { float-4 } declare normalize ] final-classes ] unit-test
+
+[ V{ float-4 } ] [ [ { float-4 float-4 } declare v+ ] final-classes ] unit-test
+
+[ V{ float } ] [ [ { float-4 } declare second ] final-classes ] unit-test
+
+[ V{ int-4 } ] [ [ { int-4 int-4 } declare v+ ] final-classes ] unit-test
+
+[ t ] [ [ { int-4 } declare second ] final-classes first integer class<= ] unit-test
+
+[ V{ longlong-2 } ] [ [ { longlong-2 longlong-2 } declare v+ ] final-classes ] unit-test
+
+[ V{ integer } ] [ [ { longlong-2 } declare second ] final-classes ] unit-test
+
+[ V{ int-8 } ] [ [ { int-8 int-8 } declare v+ ] final-classes ] unit-test
+
+[ t ] [ [ { int-8 } declare second ] final-classes first integer class<= ] unit-test
+
+! Test puns; only on x86
+cpu x86? [
+ [ double-2{ 4 1024 } ] [
+ float-4{ 0 1 0 2 }
+ [ { float-4 } declare dup v+ underlying>> double-2 boa dup v+ ] compile-call
+ ] unit-test
+
+ [ 33.0 ] [
+ double-2{ 1 2 } double-2{ 10 20 }
+ [ { double-2 double-2 } declare v+ underlying>> 3.0 float* ] compile-call
+ ] unit-test
+] when
+
+! Fuzz testing
+CONSTANT: simd-classes
+ {
+ char-16
+ uchar-16
+ char-32
+ uchar-32
+ short-8
+ ushort-8
+ short-16
+ ushort-16
+ int-4
+ uint-4
+ int-8
+ uint-8
+ longlong-2
+ ulonglong-2
+ longlong-4
+ ulonglong-4
+ float-4
+ float-8
+ double-2
+ double-4
+ }
+
+: with-ctors ( -- seq )
+ simd-classes [ [ name>> "-with" append ] [ vocabulary>> ] bi lookup ] map ;
+
+: boa-ctors ( -- seq )
+ simd-classes [ [ name>> "-boa" append ] [ vocabulary>> ] bi lookup ] map ;
+
+: check-optimizer ( seq quot eq-quot -- failures )
+ '[
+ @
+ [ dup [ class ] { } map-as ] dip '[ _ declare @ ]
+ {
+ [ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
+ [ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
+ [ [ call ] dip call ]
+ [ [ call ] dip compile-call ]
+ } 2cleave
+ @ not
+ ] filter ; inline
+
+"== Checking -new constructors" print
+
+[ { } ] [
+ simd-classes [ [ [ ] ] dip '[ _ new ] ] [ = ] check-optimizer
+] unit-test
+
+[ { } ] [
+ simd-classes [ '[ _ new ] compile-call [ zero? ] all? not ] filter
+] unit-test
+
+"== Checking -with constructors" print
+
+[ { } ] [
+ with-ctors [
+ [ 1000 random '[ _ ] ] dip '[ _ execute ]
+ ] [ = ] check-optimizer
+] unit-test
+
+[ HEX: ffffffff ] [ HEX: ffffffff uint-4-with first ] unit-test
+
+[ HEX: ffffffff ] [ HEX: ffffffff [ uint-4-with ] compile-call first ] unit-test
+
+"== Checking -boa constructors" print
+
+[ { } ] [
+ boa-ctors [
+ [ stack-effect in>> length [ 1000 random ] [ ] replicate-as ] keep
+ '[ _ execute ]
+ ] [ = ] check-optimizer
+] unit-test
+
+[ HEX: ffffffff ] [ HEX: ffffffff 2 3 4 [ uint-4-boa ] compile-call first ] unit-test
+
+"== Checking vector operations" print
+
+: random-int-vector ( class -- vec )
+ new [ drop 1,000 random ] map ;
+: random-float-vector ( class -- vec )
+ new [
+ drop
+ 1000 random
+ 10 swap <array> 0/0. suffix random
+ ] map ;
+
+: random-vector ( class elt-class -- vec )
+ float =
+ [ random-float-vector ]
+ [ random-int-vector ] if ;
+
+:: check-vector-op ( word inputs class elt-class -- inputs quot )
+ inputs [
+ {
+ { +vector+ [ class elt-class random-vector ] }
+ { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
+ } case
+ ] [ ] map-as
+ word '[ _ execute ] ;
+
+: remove-float-words ( alist -- alist' )
+ { vsqrt n/v v/n v/ normalize } unique assoc-diff ;
+
+: remove-integer-words ( alist -- alist' )
+ { vlshift vrshift } unique assoc-diff ;
+
+: boolean-ops ( -- words )
+ { vand vandn vor vxor vnot } ;
+
+: remove-boolean-words ( alist -- alist' )
+ boolean-ops unique assoc-diff ;
+
+: remove-special-words ( alist -- alist' )
+ ! These have their own tests later
+ {
+ hlshift hrshift vshuffle vbroadcast
+ vany? vall? vnone?
+ } unique assoc-diff ;
+
+: ops-to-check ( elt-class -- alist )
+ [ vector-words >alist ] dip
+ float = [ remove-integer-words ] [ remove-float-words ] if
+ remove-boolean-words
+ remove-special-words ;
+
+: check-vector-ops ( class elt-class compare-quot -- )
+ [
+ [ nip ops-to-check ] 2keep
+ '[ first2 inputs _ _ check-vector-op ]
+ ] dip check-optimizer ; inline
+
+: approx= ( x y -- ? )
+ {
+ { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
+ { [ 2dup [ float? ] both? ] [ -1.e8 ~ ] }
+ { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
+ { [ 2dup [ sequence? ] both? ] [
+ [
+ {
+ { [ 2dup [ fp-nan? ] both? ] [ 2drop t ] }
+ { [ 2dup [ fp-infinity? ] either? ] [ fp-bitwise= ] }
+ { [ 2dup [ fp-nan? ] either? not ] [ -1.e8 ~ ] }
+ } cond
+ ] 2all?
+ ] }
+ } cond ;
+
+: exact= ( x y -- ? )
+ {
+ { [ 2dup [ float? ] both? ] [ fp-bitwise= ] }
+ { [ 2dup [ sequence? ] both? ] [ [ fp-bitwise= ] 2all? ] }
+ } cond ;
+
+: simd-classes&reps ( -- alist )
+ simd-classes [
+ {
+ { [ dup name>> "float" head? ] [ float [ approx= ] ] }
+ { [ dup name>> "double" head? ] [ float [ exact= ] ] }
+ [ fixnum [ = ] ]
+ } cond 3array
+ ] map ;
+
+simd-classes&reps [
+ [ [ { } ] ] dip first3 '[ _ _ _ check-vector-ops ] unit-test
+] each
+
+"== Checking boolean operations" print
+
+: random-boolean-vector ( class -- vec )
+ new [ drop 2 random zero? ] map ;
+
+:: check-boolean-op ( word inputs class elt-class -- inputs quot )
+ inputs [
+ {
+ { +vector+ [ class random-boolean-vector ] }
+ { +scalar+ [ 1000 random elt-class float = [ >float ] when ] }
+ } case
+ ] [ ] map-as
+ word '[ _ execute ] ;
+
+: check-boolean-ops ( class elt-class compare-quot -- )
+ [
+ [ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
+ '[ first2 inputs _ _ check-boolean-op ]
+ ] dip check-optimizer ; inline
+
+simd-classes&reps [
+ [ [ { } ] ] dip first3 '[ _ _ _ check-boolean-ops ] unit-test
+] each
+
+"== Checking vector blend" print
+
+[ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
+[
+ char-16{ t t f f t t t f t f f f t f t t }
+ char-16{ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 }
+ char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 } v?
+] unit-test
+
+[ char-16{ 0 1 22 33 4 5 6 77 8 99 110 121 12 143 14 15 } ]
+[
+ char-16{ t t f f t t t f t f f f t f t t }
+ char-16{ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 }
+ char-16{ 0 11 22 33 44 55 66 77 88 99 110 121 132 143 154 165 }
+ [ { char-16 char-16 char-16 } declare v? ] compile-call
+] unit-test
+
+[ int-4{ 1 22 33 4 } ]
+[ int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 } v? ] unit-test
+
+[ int-4{ 1 22 33 4 } ]
+[
+ int-4{ t f f t } int-4{ 1 2 3 4 } int-4{ 11 22 33 44 }
+ [ { int-4 int-4 int-4 } declare v? ] compile-call
+] unit-test
+
+[ float-4{ 1.0 22.0 33.0 4.0 } ]
+[ float-4{ t f f t } float-4{ 1.0 2.0 3.0 4.0 } float-4{ 11.0 22.0 33.0 44.0 } v? ] unit-test
+
+[ float-4{ 1.0 22.0 33.0 4.0 } ]
+[
+ float-4{ t f f t } float-4{ 1.0 2.0 3.0 4.0 } float-4{ 11.0 22.0 33.0 44.0 }
+ [ { float-4 float-4 float-4 } declare v? ] compile-call
+] unit-test
+
+"== Checking shifts and permutations" print
+
+[ int-4{ 256 512 1024 2048 } ]
+[ int-4{ 1 2 4 8 } 1 hlshift ] unit-test
+
+[ int-4{ 256 512 1024 2048 } ]
+[ int-4{ 1 2 4 8 } [ { int-4 } declare 1 hlshift ] compile-call ] unit-test
+
+[ int-4{ 256 512 1024 2048 } ]
+[ int-4{ 1 2 4 8 } 1 [ { int-4 fixnum } declare hlshift ] compile-call ] unit-test
+
+[ int-4{ 1 2 4 8 } ]
+[ int-4{ 256 512 1024 2048 } 1 hrshift ] unit-test
+
+[ int-4{ 1 2 4 8 } ]
+[ int-4{ 256 512 1024 2048 } [ { int-4 } declare 1 hrshift ] compile-call ] unit-test
+
+[ int-4{ 1 2 4 8 } ]
+[ int-4{ 256 512 1024 2048 } 1 [ { int-4 fixnum } declare hrshift ] compile-call ] unit-test
+
+! Invalid inputs should not cause the compiler to throw errors
+[ ] [
+ [ [ { int-4 } declare t hrshift ] (( a -- b )) define-temp drop ] with-compilation-unit
+] unit-test
+
+[ ] [
+ [ [ { int-4 } declare { 3 2 1 } vshuffle ] (( a -- b )) define-temp drop ] with-compilation-unit
+] unit-test
+
+! Shuffles
+: shuffles-for ( n -- shuffles )
+ {
+ { 2 [
+ {
+ { 0 1 }
+ { 1 1 }
+ { 1 0 }
+ { 0 0 }
+ }
+ ] }
+ { 4 [
+ {
+ { 1 2 3 0 }
+ { 0 1 2 3 }
+ { 1 1 2 2 }
+ { 0 0 1 1 }
+ { 2 2 3 3 }
+ { 0 1 0 1 }
+ { 2 3 2 3 }
+ { 0 0 2 2 }
+ { 1 1 3 3 }
+ { 0 1 0 1 }
+ { 2 2 3 3 }
+ }
+ ] }
+ { 8 [
+ 4 shuffles-for
+ 4 shuffles-for
+ [ [ 4 + ] map ] map
+ [ append ] 2map
+ ] }
+ [ dup '[ _ random ] replicate 1array ]
+ } case ;
+
+simd-classes [
+ [ [ { } ] ] dip
+ [ new length shuffles-for ] keep
+ '[
+ _ [ [ _ new [ length iota ] keep like 1quotation ] dip '[ _ vshuffle ] ]
+ [ = ] check-optimizer
+ ] unit-test
+] each
+
+"== Checking vector tests" print
+
+:: test-vector-tests-bool ( vector declaration -- none? any? all? )
+ vector
+ [ [ declaration declare vnone? ] compile-call ]
+ [ [ declaration declare vany? ] compile-call ]
+ [ [ declaration declare vall? ] compile-call ] tri ; inline
+
+: yes ( -- x ) t ;
+: no ( -- x ) f ;
+
+:: test-vector-tests-branch ( vector declaration -- none? any? all? )
+ vector
+ [ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
+ [ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ]
+ [ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri ; inline
+
+SYMBOL: !!inconsistent!!
+
+: ?inconsistent ( a b -- ab/inconsistent )
+ 2dup = [ drop ] [ 2drop !!inconsistent!! ] if ;
+
+:: test-vector-tests ( vector decl -- none? any? all? )
+ vector decl test-vector-tests-bool :> bool-all :> bool-any :> bool-none
+ vector decl test-vector-tests-branch :> branch-all :> branch-any :> branch-none
+
+ bool-none branch-none ?inconsistent
+ bool-any branch-any ?inconsistent
+ bool-all branch-all ?inconsistent ; inline
+
+[ f t t ]
+[ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test
+[ f t f ]
+[ float-4{ f t t t } { float-4 } test-vector-tests ] unit-test
+[ t f f ]
+[ float-4{ f f f f } { float-4 } test-vector-tests ] unit-test
+
+[ f t t ]
+[ double-2{ t t } { double-2 } test-vector-tests ] unit-test
+[ f t f ]
+[ double-2{ f t } { double-2 } test-vector-tests ] unit-test
+[ t f f ]
+[ double-2{ f f } { double-2 } test-vector-tests ] unit-test
+
+[ f t t ]
+[ int-4{ t t t t } { int-4 } test-vector-tests ] unit-test
+[ f t f ]
+[ int-4{ f t t t } { int-4 } test-vector-tests ] unit-test
+[ t f f ]
+[ int-4{ f f f f } { int-4 } test-vector-tests ] unit-test
+
+[ f t t ]
+[ float-8{ t t t t t t t t } { float-8 } test-vector-tests ] unit-test
+[ f t f ]
+[ float-8{ f t t t t f t t } { float-8 } test-vector-tests ] unit-test
+[ t f f ]
+[ float-8{ f f f f f f f f } { float-8 } test-vector-tests ] unit-test
+
+[ f t t ]
+[ double-4{ t t t t } { double-4 } test-vector-tests ] unit-test
+[ f t f ]
+[ double-4{ f t t f } { double-4 } test-vector-tests ] unit-test
+[ t f f ]
+[ double-4{ f f f f } { double-4 } test-vector-tests ] unit-test
+
+[ f t t ]
+[ int-8{ t t t t t t t t } { int-8 } test-vector-tests ] unit-test
+[ f t f ]
+[ int-8{ f t t t t f f f } { int-8 } test-vector-tests ] unit-test
+[ t f f ]
+[ int-8{ f f f f f f f f } { int-8 } test-vector-tests ] unit-test
+
+"== Checking element access" print
+
+! Test element access -- it should box bignums for int-4 on x86
+: test-accesses ( seq -- failures )
+ [ length >array ] keep
+ '[ [ _ 1quotation ] dip '[ _ swap nth ] ] [ = ] check-optimizer ; inline
+
+[ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
+[ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-accesses ] unit-test
+[ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-accesses ] unit-test
+
+[ HEX: 7fffffff ] [ int-4{ HEX: 7fffffff 3 4 -8 } first ] unit-test
+[ -8 ] [ int-4{ HEX: 7fffffff 3 4 -8 } last ] unit-test
+[ HEX: ffffffff ] [ uint-4{ HEX: ffffffff 2 3 4 } first ] unit-test
+
+[ { } ] [ double-2{ 1.0 2.0 } test-accesses ] unit-test
+[ { } ] [ longlong-2{ 1 2 } test-accesses ] unit-test
+[ { } ] [ ulonglong-2{ 1 2 } test-accesses ] unit-test
+
+[ { } ] [ float-8{ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 } test-accesses ] unit-test
+[ { } ] [ int-8{ 1 2 3 4 5 6 7 8 } test-accesses ] unit-test
+[ { } ] [ uint-8{ 1 2 3 4 5 6 7 8 } test-accesses ] unit-test
+
+[ { } ] [ double-4{ 1.0 2.0 3.0 4.0 } test-accesses ] unit-test
+[ { } ] [ longlong-4{ 1 2 3 4 } test-accesses ] unit-test
+[ { } ] [ ulonglong-4{ 1 2 3 4 } test-accesses ] unit-test
+
+"== Checking broadcast" print
+: test-broadcast ( seq -- failures )
+ [ length >array ] keep
+ '[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; inline
+
+[ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
+[ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test
+[ { } ] [ uint-4{ HEX: ffffffff 2 3 4 } test-broadcast ] unit-test
+
+[ { } ] [ double-2{ 1.0 2.0 } test-broadcast ] unit-test
+[ { } ] [ longlong-2{ 1 2 } test-broadcast ] unit-test
+[ { } ] [ ulonglong-2{ 1 2 } test-broadcast ] unit-test
+
+[ { } ] [ float-8{ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 } test-broadcast ] unit-test
+[ { } ] [ int-8{ 1 2 3 4 5 6 7 8 } test-broadcast ] unit-test
+[ { } ] [ uint-8{ 1 2 3 4 5 6 7 8 } test-broadcast ] unit-test
+
+[ { } ] [ double-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
+[ { } ] [ longlong-4{ 1 2 3 4 } test-broadcast ] unit-test
+[ { } ] [ ulonglong-4{ 1 2 3 4 } test-broadcast ] unit-test
+
+! Make sure we use the fallback in the correct situations
+[ int-4{ 3 3 3 3 } ] [ int-4{ 12 34 3 17 } 2 [ { int-4 fixnum } declare vbroadcast ] compile-call ] unit-test
+
+"== Checking alien operations" print
+
+[ float-4{ 1 2 3 4 } ] [
+ [
+ float-4{ 1 2 3 4 }
+ underlying>> 0 float-4-rep alien-vector
+ ] compile-call float-4 boa
+] unit-test
+
+[ B{ 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 } ] [
+ 16 [ 1 ] B{ } replicate-as 16 <byte-array>
+ [
+ 0 [
+ { byte-array c-ptr fixnum } declare
+ float-4-rep set-alien-vector
+ ] compile-call
+ ] keep
+] unit-test
+
+[ float-array{ 1 2 3 4 } ] [
+ [
+ float-array{ 1 2 3 4 } underlying>>
+ float-array{ 4 3 2 1 } clone
+ [ underlying>> 0 float-4-rep set-alien-vector ] keep
+ ] compile-call
+] unit-test
+
+STRUCT: simd-struct
+{ x float-4 }
+{ y double-2 }
+{ z double-4 }
+{ w float-8 } ;
+
+[ t ] [ [ simd-struct <struct> ] compile-call >c-ptr [ 0 = ] all? ] unit-test
+
+[
+ float-4{ 1 2 3 4 }
+ double-2{ 2 1 }
+ double-4{ 4 3 2 1 }
+ float-8{ 1 2 3 4 5 6 7 8 }
+] [
+ simd-struct <struct>
+ float-4{ 1 2 3 4 } >>x
+ double-2{ 2 1 } >>y
+ double-4{ 4 3 2 1 } >>z
+ float-8{ 1 2 3 4 5 6 7 8 } >>w
+ { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
+] unit-test
+
+[
+ float-4{ 1 2 3 4 }
+ double-2{ 2 1 }
+ double-4{ 4 3 2 1 }
+ float-8{ 1 2 3 4 5 6 7 8 }
+] [
+ [
+ simd-struct <struct>
+ float-4{ 1 2 3 4 } >>x
+ double-2{ 2 1 } >>y
+ double-4{ 4 3 2 1 } >>z
+ float-8{ 1 2 3 4 5 6 7 8 } >>w
+ { [ x>> ] [ y>> ] [ z>> ] [ w>> ] } cleave
+ ] compile-call
+] unit-test
+
+"== Misc tests" print
+
+[ ] [ char-16 new 1array stack. ] unit-test
+
+! CSSA bug
+[ 8000000 ] [
+ int-8{ 1000 1000 1000 1000 1000 1000 1000 1000 }
+ [ { int-8 } declare dup [ * ] [ + ] 2map-reduce ] compile-call
+] unit-test
+
+! Coalescing was too aggressive
+:: broken ( axis theta -- a b c )
+ axis { float-4 } declare drop
+ theta { float } declare drop
+
+ theta cos float-4-with :> cc
+ theta sin float-4-with :> ss
+
+ axis cc v+ :> diagonal
+
+ diagonal cc ss ; inline
+
+[ t ] [
+ float-4{ 1.0 0.0 1.0 0.0 } pi [ broken 3array ]
+ [ compile-call ] [ call ] 3bi =
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types combinators fry kernel parser math math.parser
+math.vectors.simd.functor sequences splitting vocabs.generated
+vocabs.loader vocabs.parser words accessors vocabs compiler.units
+definitions ;
+QUALIFIED-WITH: alien.c-types c
+IN: math.vectors.simd
+
+ERROR: bad-base-type type ;
+
+<PRIVATE
+
+: simd-vocab ( base-type -- vocab )
+ name>> "math.vectors.simd.instances." prepend ;
+
+: parse-base-type ( c-type -- c-type )
+ dup { c:char c:uchar c:short c:ushort c:int c:uint c:longlong c:ulonglong c:float c:double } memq?
+ [ bad-base-type ] unless ;
+
+: forget-instances ( -- )
+ [
+ "math.vectors.simd.instances" child-vocabs
+ [ forget-vocab ] each
+ ] with-compilation-unit ;
+
+PRIVATE>
+
+: define-simd-vocab ( type -- vocab )
+ parse-base-type
+ [ simd-vocab ] keep '[
+ _
+ [ define-simd-128 ]
+ [ define-simd-256 ] bi
+ ] generate-vocab ;
+
+SYNTAX: SIMD:
+ scan-word define-simd-vocab use-vocab ;
+
--- /dev/null
+Single-instruction-multiple-data parallel vector operations
IN: math.vectors.specialization.tests
USING: compiler.tree.debugger math.vectors tools.test kernel
-kernel.private math specialized-arrays.double
-specialized-arrays.complex-float
-specialized-arrays.float ;
+kernel.private math specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+QUALIFIED-WITH: alien.complex c
+SPECIALIZED-ARRAY: c:double
+SPECIALIZED-ARRAY: c:complex-float
+SPECIALIZED-ARRAY: c:float
[ V{ t } ] [
[ { double-array double-array } declare distance 0.0 < not ] final-literals
[ { float-array float } declare v*n norm ] final-classes
] unit-test
-[ V{ number } ] [
+[ V{ complex } ] [
[ { complex-float-array complex-float-array } declare v. ] final-classes
] unit-test
-[ V{ real } ] [
+[ V{ float } ] [
+ [ { float-array float } declare v*n norm ] final-classes
+] unit-test
+
+[ V{ float } ] [
[ { complex-float-array complex } declare v*n norm ] final-classes
] unit-test
\ No newline at end of file
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: words kernel make sequences effects kernel.private accessors
-combinators math math.intervals math.vectors namespaces assocs fry
-splitting classes.algebra generalizations
-compiler.tree.propagation.info ;
+USING: words kernel make sequences effects sets kernel.private
+accessors combinators math math.intervals math.vectors
+namespaces assocs fry splitting classes.algebra generalizations
+locals compiler.tree.propagation.info ;
IN: math.vectors.specialization
-SYMBOLS: -> +vector+ +scalar+ +nonnegative+ ;
+SYMBOLS: -> +vector+ +scalar+ +nonnegative+ +literal+ ;
: signature-for-schema ( array-type elt-type schema -- signature )
[
{ +vector+ [ drop ] }
{ +scalar+ [ nip ] }
{ +nonnegative+ [ nip ] }
+ { +literal+ [ 2drop f ] }
} case
] with with map ;
{
{ +vector+ [ drop <class-info> ] }
{ +scalar+ [ nip <class-info> ] }
- { +nonnegative+ [ nip real class-and [0,inf] <class/interval-info> ] }
+ {
+ +nonnegative+
+ [
+ nip
+ dup complex class<= [ drop float ] when
+ [0,inf] <class/interval-info>
+ ]
+ }
} case
] with with map ;
{ norm-sq { +vector+ -> +nonnegative+ } }
{ normalize { +vector+ -> +vector+ } }
{ v* { +vector+ +vector+ -> +vector+ } }
+ { vs* { +vector+ +vector+ -> +vector+ } }
{ v*n { +vector+ +scalar+ -> +vector+ } }
{ v+ { +vector+ +vector+ -> +vector+ } }
+ { vs+ { +vector+ +vector+ -> +vector+ } }
+ { v+- { +vector+ +vector+ -> +vector+ } }
{ v+n { +vector+ +scalar+ -> +vector+ } }
{ v- { +vector+ +vector+ -> +vector+ } }
+ { vs- { +vector+ +vector+ -> +vector+ } }
{ v-n { +vector+ +scalar+ -> +vector+ } }
{ v. { +vector+ +vector+ -> +scalar+ } }
{ v/ { +vector+ +vector+ -> +vector+ } }
{ vmin { +vector+ +vector+ -> +vector+ } }
{ vneg { +vector+ -> +vector+ } }
{ vtruncate { +vector+ -> +vector+ } }
+ { sum { +vector+ -> +scalar+ } }
+ { vabs { +vector+ -> +vector+ } }
+ { vsqrt { +vector+ -> +vector+ } }
+ { vbitand { +vector+ +vector+ -> +vector+ } }
+ { vbitandn { +vector+ +vector+ -> +vector+ } }
+ { vbitor { +vector+ +vector+ -> +vector+ } }
+ { vbitxor { +vector+ +vector+ -> +vector+ } }
+ { vbitnot { +vector+ -> +vector+ } }
+ { vand { +vector+ +vector+ -> +vector+ } }
+ { vandn { +vector+ +vector+ -> +vector+ } }
+ { vor { +vector+ +vector+ -> +vector+ } }
+ { vxor { +vector+ +vector+ -> +vector+ } }
+ { vnot { +vector+ -> +vector+ } }
+ { vlshift { +vector+ +scalar+ -> +vector+ } }
+ { vrshift { +vector+ +scalar+ -> +vector+ } }
+ { hlshift { +vector+ +literal+ -> +vector+ } }
+ { hrshift { +vector+ +literal+ -> +vector+ } }
+ { vshuffle { +vector+ +literal+ -> +vector+ } }
+ { vbroadcast { +vector+ +literal+ -> +vector+ } }
+ { (vmerge-head) { +vector+ +vector+ -> +vector+ } }
+ { (vmerge-tail) { +vector+ +vector+ -> +vector+ } }
+ { v<= { +vector+ +vector+ -> +vector+ } }
+ { v< { +vector+ +vector+ -> +vector+ } }
+ { v= { +vector+ +vector+ -> +vector+ } }
+ { v> { +vector+ +vector+ -> +vector+ } }
+ { v>= { +vector+ +vector+ -> +vector+ } }
+ { vunordered? { +vector+ +vector+ -> +vector+ } }
+ { vany? { +vector+ -> +scalar+ } }
+ { vall? { +vector+ -> +scalar+ } }
+ { vnone? { +vector+ -> +scalar+ } }
}
-SYMBOL: specializations
+PREDICATE: vector-word < word vector-words key? ;
-specializations [ vector-words keys [ V{ } clone ] H{ } map>assoc ] initialize
+: specializations ( word -- assoc )
+ dup "specializations" word-prop
+ [ ] [ V{ } clone [ "specializations" set-word-prop ] keep ] ?if ;
+
+M: vector-word subwords specializations values [ word? ] filter ;
: add-specialization ( new-word signature word -- )
- specializations get at set-at ;
+ specializations set-at ;
+
+ERROR: bad-vector-word word ;
-: word-schema ( word -- schema ) vector-words at ;
+: word-schema ( word -- schema )
+ vector-words ?at [ bad-vector-word ] unless ;
: inputs ( schema -- seq ) { -> } split first ;
: outputs ( schema -- seq ) { -> } split second ;
-: specialize-vector-word ( word array-type elt-type -- word' )
+: loop-vector-op ( word array-type elt-type -- word' )
pick word-schema
[ inputs (specialize-vector-word) ]
[ outputs record-output-signature ] 3bi ;
-: input-signature ( word -- signature ) def>> first ;
-
-: specialize-vector-words ( array-type elt-type -- )
- [ vector-words keys ] 2dip
- '[
- [ _ _ specialize-vector-word ] keep
- [ dup input-signature ] dip
- add-specialization
+:: specialize-vector-word ( word array-type elt-type simd -- word/quot' )
+ word simd key? [ word simd at ] [ word array-type elt-type loop-vector-op ] if ;
+
+:: input-signature ( word array-type elt-type -- signature )
+ array-type elt-type word word-schema inputs signature-for-schema ;
+
+: vector-words-for-type ( elt-type -- words )
+ {
+ ! Can't do shifts on floats
+ { [ dup float class<= ] [ vector-words keys { vlshift vrshift } diff ] }
+ ! Can't divide integers
+ { [ dup integer class<= ] [ vector-words keys { vsqrt n/v v/n v/ normalize } diff ] }
+ ! Can't compute square root of complex numbers (vsqrt uses fsqrt not sqrt)
+ { [ dup complex class<= ] [ vector-words keys { vsqrt } diff ] }
+ [ { } ]
+ } cond
+ ! Don't specialize horizontal shifts or shuffles at all, they're only for SIMD
+ { hlshift hrshift vshuffle vbroadcast } diff
+ nip ;
+
+:: specialize-vector-words ( array-type elt-type simd -- )
+ elt-type vector-words-for-type simd keys union [
+ [ array-type elt-type simd specialize-vector-word ]
+ [ array-type elt-type input-signature ]
+ [ ]
+ tri add-specialization
] each ;
+: specialization-matches? ( value-infos signature -- ? )
+ [ [ [ class>> ] dip class<= ] [ literal?>> ] if* ] 2all? ;
+
: find-specialization ( classes word -- word/f )
- specializations get at
- [ first [ class<= ] 2all? ] with find
+ specializations
+ [ first specialization-matches? ] with find
swap [ second ] when ;
: vector-word-custom-inlining ( #call -- word/f )
- [ in-d>> [ value-info class>> ] map ] [ word>> ] bi
+ [ in-d>> [ value-info ] map ] [ word>> ] bi
find-specialization ;
vector-words keys [
[ vector-word-custom-inlining ]
"custom-inlining" set-word-prop
-] each
\ No newline at end of file
+] each
-USING: help.markup help.syntax math sequences ;
+USING: help.markup help.syntax math math.functions sequences ;
IN: math.vectors
-ARTICLE: "math-vectors" "Vector arithmetic"
-"Any Factor sequence can be used to represent a mathematical vector."
-$nl
-"Acting on vectors by a scalar:"
-{ $subsection vneg }
-{ $subsection v*n }
-{ $subsection n*v }
-{ $subsection v/n }
-{ $subsection n/v }
-"Combining two vectors to form another vector with " { $link 2map } ":"
-{ $subsection v+ }
-{ $subsection v- }
-{ $subsection v* }
-{ $subsection v/ }
-{ $subsection vmax }
-{ $subsection vmin }
+ARTICLE: "math-vectors-arithmetic" "Vector arithmetic"
+"Vector/vector binary operations:"
+{ $subsections
+ v+
+ v-
+ v+-
+ v*
+ v/
+}
+"Vector unary operations:"
+{ $subsections
+ vneg
+ vabs
+ vsqrt
+ vfloor
+ vceiling
+ vtruncate
+}
+"Vector/scalar and scalar/vector binary operations:"
+{ $subsections
+ vneg
+ v*n
+ n*v
+ v/n
+ n/v
+ v+n
+ n+v
+ v-n
+ n-v
+}
+"Saturated arithmetic (only on " { $link "specialized-arrays" } "):"
+{ $subsections
+ vs+
+ vs-
+ vs*
+}
"Inner product and norm:"
-{ $subsection v. }
-{ $subsection norm }
-{ $subsection norm-sq }
-{ $subsection normalize } ;
+{ $subsections
+ v.
+ norm
+ norm-sq
+ normalize
+}
+"Comparing entire vectors:"
+{ $subsections
+ distance
+ v~
+} ;
+
+ARTICLE: "math-vectors-shuffle" "Vector shuffling, packing, and unpacking"
+{ $notes
+"These operations are primarily meant to be used with " { $vocab-link "math.vectors.simd" } " types. The software fallbacks for types not supported by hardware will not perform well."
+}
+$nl
+{ $subsection vshuffle }
+{ $subsection vbroadcast }
+{ $subsection hlshift }
+{ $subsection hrshift }
+{ $subsection vmerge }
+{ $subsection (vmerge) } ;
+
+ARTICLE: "math-vectors-logic" "Vector component- and bit-wise logic"
+{ $notes
+"See " { $link "math-vectors-simd-logic" } " for notes about using comparison and logical operations with SIMD vector types."
+}
+$nl
+"Element comparisons:"
+{ $subsections
+ v<
+ v<=
+ v=
+ v>=
+ v>
+ vunordered?
+ vmax
+ vmin
+ vsupremum
+ vinfimum
+}
+"Bitwise operations:"
+{ $subsections
+ vbitand
+ vbitandn
+ vbitor
+ vbitxor
+ vbitnot
+ vlshift
+ vrshift
+}
+"Element logical operations:"
+{ $subsections
+ vand
+ vandn
+ vor
+ vxor
+ vnot
+ v?
+}
+"Entire vector tests:"
+{ $subsections
+ vall?
+ vany?
+ vnone?
+}
+"Element shuffling:"
+{ $subsections vshuffle } ;
+
+ARTICLE: "math-vectors-misc" "Miscellaneous vector functions"
+{ $subsections
+ trilerp
+ bilerp
+ vlerp
+ vnlerp
+ vbilerp
+} ;
+
+ARTICLE: "math-vectors-simd-logic" "Componentwise logic with SIMD vectors"
+"Processor SIMD units supported by the " { $vocab-link "math.vectors.simd" } " vocabulary represent boolean values as bitmasks, where a true result's binary representation is all ones and a false representation is all zeroes. This is the format in which results from comparison words such as " { $link v= } " return their results and in which logic and test words such as " { $link vand } " and " { $link vall? } " take their inputs when working with SIMD types. For a float vector, false will manifest itself as " { $snippet "0.0" } " and true as a " { $link POSTPONE: NAN: } " literal with a string of set bits in its payload:"
+{ $example
+"""USING: math.vectors math.vectors.simd prettyprint ;
+FROM: alien.c-types => float ;
+SIMD: float
+
+float-4{ 1.0 2.0 3.0 0/0. } float-4{ 1.0 -2.0 3.0 0/0. } v= ."""
+"""float-4{ NAN: fffffe0000000 0.0 NAN: fffffe0000000 0.0 }"""
+}
+"For an integer vector, false will manifest as " { $snippet "0" } " and true as " { $snippet "-1" } " (for signed vectors) or the largest representable value of the element type (for unsigned vectors):"
+{ $example
+"""USING: math.vectors math.vectors.simd prettyprint alien.c-types ;
+SIMD: int
+SIMD: uchar
+
+int-4{ 1 2 3 0 } int-4{ 1 -2 3 4 } v=
+uchar-16{ 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 }
+uchar-16{ 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 0 } v<
+[ . ] bi@"""
+"""int-4{ -1 0 -1 0 }
+uchar-16{ 255 255 255 255 255 255 255 255 0 0 0 0 0 0 0 0 }"""
+}
+"This differs from Factor's native representation of boolean values, where " { $link f } " is false and every other value (including " { $snippet "0" } " and " { $snippet "0.0" } ") is true. To make it easy to construct literal SIMD masks, " { $link t } " and " { $link f } " are accepted inside SIMD literal syntax and expand to the proper true or false representation for the underlying type:"
+{ $example
+"""USING: math.vectors math.vectors.simd prettyprint alien.c-types ;
+SIMD: int
+
+int-4{ f f t f } ."""
+"""int-4{ 0 0 -1 0 }""" }
+"However, extracting an element from a boolean SIMD vector with " { $link nth } " will not yield a valid Factor boolean. This is not generally a problem, since the results of vector comparisons are meant to be consumed by subsequent vector logical and test operations, which will accept SIMD values in the native boolean format."
+$nl
+"Providing a SIMD boolean vector with element values other than the proper true and false representations as an input to the vector logical or test operations is undefined. Do not count on operations such as " { $link vall? } " or " { $link v? } " using bitwise operations to construct their results."
+$nl
+"This applies to the output of the following element comparison words: "
+{ $list
+{ $link v< }
+{ $link v<= }
+{ $link v= }
+{ $link v>= }
+{ $link v> }
+{ $link vunordered? }
+}
+"This likewise applies to the " { $snippet "mask" } " argument of " { $link v? } " and to the inputs and outputs of the following element logic words:"
+{ $list
+{ $link vand }
+{ $link vandn }
+{ $link vor }
+{ $link vxor }
+{ $link vnot }
+}
+"Finally, this applies to the inputs of these vector test words:"
+{ $list
+{ $link vall? }
+{ $link vany? }
+{ $link vnone? }
+} ;
+
+ARTICLE: "math-vectors" "Vector operations"
+"Any Factor sequence can be used to represent a mathematical vector, however for best performance, the sequences defined by the " { $vocab-link "specialized-arrays" } " and " { $vocab-link "math.vectors.simd" } " vocabularies should be used."
+{ $subsections
+ "math-vectors-arithmetic"
+ "math-vectors-logic"
+ "math-vectors-shuffle"
+ "math-vectors-misc"
+} ;
ABOUT: "math-vectors"
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } }
{ $description "Negates each element of " { $snippet "u" } "." } ;
+HELP: vabs
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of non-negative real numbers" } }
+{ $description "Takes the absolute value of each element of " { $snippet "u" } "." } ;
+
+HELP: vsqrt
+{ $values { "u" "a sequence of non-negative real numbers" } { "v" "a sequence of non-negative real numbers" } }
+{ $description "Takes the square root of each element of " { $snippet "u" } "." }
+{ $warning "For performance reasons, this does not work with negative inputs, unlike " { $link sqrt } "." } ;
+
+HELP: vfloor
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } }
+{ $description "Takes the " { $link floor } " of each element of " { $snippet "u" } "." } ;
+
+HELP: vceiling
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } }
+{ $description "Takes the " { $link ceiling } " of each element of " { $snippet "u" } "." } ;
+
+HELP: vtruncate
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } }
+{ $description "Truncates each element of " { $snippet "u" } "." } ;
+
+HELP: n+v
+{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } }
+{ $description "Adds " { $snippet "n" } " to each element of " { $snippet "u" } "." } ;
+
+HELP: v+n
+{ $values { "u" "a sequence of numbers" } { "n" "a number" } { "v" "a sequence of numbers" } }
+{ $description "Adds " { $snippet "n" } " to each element of " { $snippet "u" } "." } ;
+
+HELP: n-v
+{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } }
+{ $description "Subtracts each element of " { $snippet "u" } " from " { $snippet "n" } "." } ;
+
+HELP: v-n
+{ $values { "u" "a sequence of numbers" } { "n" "a number" } { "v" "a sequence of numbers" } }
+{ $description "Subtracts " { $snippet "n" } " from each element of " { $snippet "u" } "." } ;
+
HELP: n*v
{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } }
{ $description "Multiplies each element of " { $snippet "u" } " by " { $snippet "n" } "." } ;
HELP: n/v
{ $values { "n" "a number" } { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } }
-{ $description "Divides " { $snippet "n" } " by each element of " { $snippet "u" } "." } ;
+{ $description "Divides " { $snippet "n" } " by each element of " { $snippet "u" } "." }
+{ $errors "May throw an error if a division by zero occurs; see " { $link "division-by-zero" } "." } ;
HELP: v/n
{ $values { "u" "a sequence of numbers" } { "n" "a number" } { "v" "a sequence of numbers" } }
-{ $description "Divides each element of " { $snippet "u" } " by " { $snippet "n" } "." } ;
+{ $description "Divides each element of " { $snippet "u" } " by " { $snippet "n" } "." }
+{ $errors "May throw an error if a division by zero occurs; see " { $link "division-by-zero" } "." } ;
HELP: v+
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
{ $description "Subtracts " { $snippet "v" } " from " { $snippet "u" } " component-wise." } ;
+HELP: v+-
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
+{ $description "Adds and subtracts alternate elements of " { $snippet "v" } " and " { $snippet "u" } " component-wise." }
+{ $examples
+ { $example
+ "USING: math.vectors prettyprint ;"
+ "{ 1 2 3 } { 2 3 2 } v+- ."
+ "{ -1 5 1 }"
+ }
+} ;
+
HELP: [v-]
{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
{ $description "Subtracts " { $snippet "v" } " from " { $snippet "u" } " component-wise; any components which become negative are set to zero." } ;
HELP: v/
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
{ $description "Divides " { $snippet "u" } " by " { $snippet "v" } " component-wise." }
-{ $errors "Throws an error if an integer division by zero occurs." } ;
+{ $errors "May throw an error if a division by zero occurs; see " { $link "division-by-zero" } "." } ;
HELP: vmax
{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
-{ $description "Creates a sequence where each element is the maximum of the corresponding elements from " { $snippet "u" } " andd " { $snippet "v" } "." }
+{ $description "Creates a sequence where each element is the maximum of the corresponding elements from " { $snippet "u" } " and " { $snippet "v" } "." }
{ $examples { $example "USING: math.vectors prettyprint ;" "{ 1 2 5 } { -7 6 3 } vmax ." "{ 1 6 5 }" } } ;
HELP: vmin
{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
-{ $description "Creates a sequence where each element is the minimum of the corresponding elements from " { $snippet "u" } " andd " { $snippet "v" } "." }
+{ $description "Creates a sequence where each element is the minimum of the corresponding elements from " { $snippet "u" } " and " { $snippet "v" } "." }
{ $examples { $example "USING: math.vectors prettyprint ;" "{ 1 2 5 } { -7 6 3 } vmin ." "{ -7 2 3 }" } } ;
HELP: v.
{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "x" "a real number" } }
-{ $description "Computes the real-valued dot product." }
-{ $notes
- "This word can also take complex number sequences as input, however mathematically it will compute the wrong result. The complex-valued dot product is defined differently:"
- { $snippet "0 [ conjugate * + ] 2reduce" }
+{ $description "Computes the dot product of two vectors." } ;
+
+HELP: vs+
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
+{ $description "Adds " { $snippet "u" } " and " { $snippet "v" } " component-wise with saturation." }
+{ $examples
+ "With saturation:"
+ { $example
+ "USING: alien.c-types math.vectors prettyprint specialized-arrays ;"
+ "SPECIALIZED-ARRAY: uchar"
+ "uchar-array{ 100 200 150 } uchar-array{ 70 70 70 } vs+ ."
+ "uchar-array{ 170 255 220 }"
+ }
+ "Without saturation:"
+ { $example
+ "USING: alien.c-types math.vectors prettyprint specialized-arrays ;"
+ "SPECIALIZED-ARRAY: uchar"
+ "uchar-array{ 100 200 150 } uchar-array{ 70 70 70 } v+ ."
+ "uchar-array{ 170 14 220 }"
+ }
+} ;
+
+HELP: vs-
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
+{ $description "Subtracts " { $snippet "v" } " from " { $snippet "u" } " component-wise with saturation." } ;
+
+HELP: vs*
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of numbers" } }
+{ $description "Multiplies " { $snippet "u" } " and " { $snippet "v" } " component-wise with saturation." } ;
+
+HELP: vbitand
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
+{ $description "Takes the bitwise and of " { $snippet "u" } " and " { $snippet "v" } " component-wise." }
+{ $notes "Unlike " { $link bitand } ", this word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
+
+HELP: vbitandn
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
+{ $description "Takes the bitwise and-not of " { $snippet "u" } " and " { $snippet "v" } " component-wise, where " { $snippet "x and-not y" } " is defined as " { $snippet "not(x) and y" } "." }
+{ $notes "This word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
+
+HELP: vbitor
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
+{ $description "Takes the bitwise or of " { $snippet "u" } " and " { $snippet "v" } " component-wise." }
+{ $notes "Unlike " { $link bitor } ", this word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
+
+HELP: vbitxor
+{ $values { "u" "a sequence of real numbers" } { "v" "a sequence of real numbers" } { "w" "a sequence of real numbers" } }
+{ $description "Takes the bitwise exclusive or of " { $snippet "u" } " and " { $snippet "v" } " component-wise." }
+{ $notes "Unlike " { $link bitxor } ", this word may be used on a specialized array of floats or doubles, in which case the bitwise representation of the floating point numbers is operated upon." } ;
+
+HELP: vlshift
+{ $values { "u" "a sequence of integers" } { "n" "a non-negative integer" } { "w" "a sequence of integers" } }
+{ $description "Shifts each element of " { $snippet "u" } " to the left by " { $snippet "n" } " bits." }
+{ $notes "Undefined behavior will result if " { $snippet "n" } " is negative." } ;
+
+HELP: vrshift
+{ $values { "u" "a sequence of integers" } { "n" "a non-negative integer" } { "w" "a sequence of integers" } }
+{ $description "Shifts each element of " { $snippet "u" } " to the right by " { $snippet "n" } " bits." }
+{ $notes "Undefined behavior will result if " { $snippet "n" } " is negative." } ;
+
+HELP: hlshift
+{ $values { "u" "a SIMD array" } { "n" "a non-negative integer" } { "w" "a SIMD array" } }
+{ $description "Shifts the entire SIMD array to the left by " { $snippet "n" } " bytes, filling the vacated right-hand bits with zeroes. This word may only be used in a context where the compiler can statically infer that the input is a SIMD array." } ;
+
+HELP: hrshift
+{ $values { "u" "a SIMD array" } { "n" "a non-negative integer" } { "w" "a SIMD array" } }
+{ $description "Shifts the entire SIMD array to the right by " { $snippet "n" } " bytes, filling the vacated left-hand bits with zeroes. This word may only be used in a context where the compiler can statically infer that the input is a SIMD array." } ;
+
+HELP: vmerge
+{ $values { "u" "a sequence" } { "v" "a sequence" } { "w" "a sequence" } }
+{ $description "Creates a new sequence of the same type as and twice the length of " { $snippet "u" } " and " { $snippet "v" } " by interleaving the elements of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $examples
+{ $example """USING: kernel math.vectors prettyprint ;
+
+{ "A" "B" "C" "D" } { "1" "2" "3" "4" } vmerge ."""
+"""{ "A" "1" "B" "2" "C" "3" "D" "4" }"""
+} } ;
+
+HELP: (vmerge)
+{ $values { "u" "a sequence" } { "v" "a sequence" } { "h" "a sequence" } { "t" "a sequence" } }
+{ $description "Creates two new sequences of the same type and size as " { $snippet "u" } " and " { $snippet "v" } " by interleaving the elements of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $notes "For hardware-supported SIMD vector types this word compiles to a single instruction per output value." }
+{ $examples
+{ $example """USING: kernel math.vectors prettyprint ;
+
+{ "A" "B" "C" "D" } { "1" "2" "3" "4" } (vmerge) [ . ] bi@"""
+"""{ "A" "1" "B" "2" }
+{ "C" "3" "D" "4" }"""
+} } ;
+
+HELP: (vmerge-head)
+{ $values { "u" "a sequence" } { "v" "a sequence" } { "h" "a sequence" } }
+{ $description "Creates a new sequence of the same type and size as " { $snippet "u" } " and " { $snippet "v" } " by interleaving the elements from the first half of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $notes "For hardware-supported SIMD vector types this word compiles to a single instruction." }
+{ $examples
+{ $example """USING: kernel math.vectors prettyprint ;
+
+{ "A" "B" "C" "D" } { "1" "2" "3" "4" } (vmerge-head) ."""
+"""{ "A" "1" "B" "2" }"""
+} } ;
+
+HELP: (vmerge-tail)
+{ $values { "u" "a sequence" } { "v" "a sequence" } { "t" "a sequence" } }
+{ $description "Creates a new sequence of the same type and size as " { $snippet "u" } " and " { $snippet "v" } " by interleaving the elements from the tail half of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $notes "For hardware-supported SIMD vector types this word compiles to a single instruction." }
+{ $examples
+{ $example """USING: kernel math.vectors prettyprint ;
+
+{ "A" "B" "C" "D" } { "1" "2" "3" "4" } (vmerge-tail) ."""
+"""{ "C" "3" "D" "4" }"""
+} } ;
+
+{ vmerge (vmerge) (vmerge-head) (vmerge-tail) } related-words
+
+HELP: vbroadcast
+{ $values { "u" "a SIMD array" } { "n" "a non-negative integer" } { "v" "a SIMD array" } }
+{ $description "Outputs a new SIMD array of the same type as " { $snippet "u" } " where every element is equal to the " { $snippet "n" } "th element of " { $snippet "u" } "." }
+{ $examples
+ { $example
+ "USING: alien.c-types math.vectors math.vectors.simd" "prettyprint ;"
+ "SIMD: int"
+ "int-4{ 69 42 911 13 } 2 vbroadcast ."
+ "int-4{ 911 911 911 911 }"
+ }
+} ;
+
+HELP: vshuffle
+{ $values { "u" "a SIMD array" } { "perm" "an array of integers" } { "v" "a SIMD array" } }
+{ $description "Permutes the elements of a SIMD array. Duplicate entries are allowed in the permutation." }
+{ $examples
+ { $example
+ "USING: alien.c-types math.vectors math.vectors.simd" "prettyprint ;"
+ "SIMD: int"
+ "int-4{ 69 42 911 13 } { 1 3 2 3 } vshuffle ."
+ "int-4{ 42 13 911 13 }"
+ }
} ;
HELP: norm-sq
{ $values { "u" "a sequence of numbers, not all zero" } { "v" "a sequence of numbers" } }
{ $description "Outputs a vector with the same direction as " { $snippet "u" } " but length 1." } ;
+HELP: distance
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "x" "a non-negative real number" } }
+{ $description "Outputs the Euclidean distance between two vectors." } ;
+
HELP: set-axis
{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "axis" "a sequence of 0/1" } { "w" "a sequence of numbers" } }
{ $description "Using " { $snippet "w" } " as a template, creates a new sequence containing corresponding elements from " { $snippet "u" } " in place of 0, and corresponding elements from " { $snippet "v" } " in place of 1." }
{ $examples { $example "USING: math.vectors prettyprint ;" "{ 1 2 3 } { 4 5 6 } { 0 1 0 } set-axis ." "{ 1 5 3 }" } } ;
+HELP: v<
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of booleans" } }
+{ $description "Compares each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", returning " { $link t } " in the result vector when the former is less than the latter or " { $link f } " otherwise." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean results when using SIMD types." } ;
+
+HELP: v<=
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of booleans" } }
+{ $description "Compares each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", returning " { $link t } " in the result vector when the former is less than or equal to the latter or " { $link f } " otherwise." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean results when using SIMD types." } ;
+
+HELP: v=
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of booleans" } }
+{ $description "Compares each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", returning " { $link t } " in the result vector when they are equal or " { $link f } " otherwise." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean results when using SIMD types." } ;
+
+HELP: v>
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of booleans" } }
+{ $description "Compares each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", returning " { $link t } " in the result vector when the former is greater than the latter or " { $link f } " otherwise." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean results when using SIMD types." } ;
+
+HELP: v>=
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of booleans" } }
+{ $description "Compares each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", returning " { $link t } " in the result vector when the former is greater than or equal to the latter or " { $link f } " otherwise." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean results when using SIMD types." } ;
+
+HELP: vunordered?
+{ $values { "u" "a sequence of numbers" } { "v" "a sequence of numbers" } { "w" "a sequence of booleans" } }
+{ $description "Compares each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", returning " { $link t } " in the result vector when either value is Not-a-Number or " { $link f } " otherwise." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean results when using SIMD types." } ;
+
+HELP: vand
+{ $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } }
+{ $description "Takes the logical AND of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ;
+
+HELP: vandn
+{ $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } }
+{ $description "Takes the logical AND-NOT of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } ", where " { $snippet "x AND-NOT y" } " is defined as " { $snippet "NOT(x) AND y" } "." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ;
+
+HELP: vor
+{ $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } }
+{ $description "Takes the logical OR of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ;
+
+HELP: vxor
+{ $values { "u" "a sequence of booleans" } { "v" "a sequence of booleans" } { "w" "a sequence of booleans" } }
+{ $description "Takes the logical XOR of each corresponding element of " { $snippet "u" } " and " { $snippet "v" } "." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ;
+
+HELP: vnot
+{ $values { "u" "a sequence of booleans" } { "w" "a sequence of booleans" } }
+{ $description "Takes the logical NOT of each element of " { $snippet "u" } "." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ;
+
+HELP: v?
+{ $values { "mask" "a sequence of booleans" } { "true" "a sequence of numbers" } { "false" "a sequence of numbers" } { "w" "a sequence of numbers" } }
+{ $description "Creates a new sequence by selecting elements from the " { $snippet "true" } " and " { $snippet "false" } " sequences based on whether the corresponding bits of the " { $snippet "mask" } " sequence are set or not." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs and results when using SIMD types." } ;
+
+HELP: vany?
+{ $values { "v" "a sequence of booleans" } { "?" "a boolean" } }
+{ $description "Returns true if any element of " { $snippet "v" } " is true." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs when using SIMD types." } ;
+
+HELP: vall?
+{ $values { "v" "a sequence of booleans" } { "?" "a boolean" } }
+{ $description "Returns true if every element of " { $snippet "v" } " is true." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs when using SIMD types." } ;
+
+HELP: vnone?
+{ $values { "v" "a sequence of booleans" } { "?" "a boolean" } }
+{ $description "Returns true if every element of " { $snippet "v" } " is false." }
+{ $notes "See " { $link "math-vectors-simd-logic" } " for notes on dealing with vector boolean inputs when using SIMD types." } ;
+
{ 2map v+ v- v* v/ } related-words
{ 2reduce v. } related-words
+
+{ vs+ vs- vs* } related-words
+
+{ v< v<= v= v> v>= vunordered? vand vor vxor vnot vany? vall? vnone? v? } related-words
+
+{ vbitand vbitandn vbitor vbitxor vbitnot } related-words
IN: math.vectors.tests
-USING: math.vectors tools.test ;
+USING: math.vectors tools.test kernel specialized-arrays compiler
+kernel.private alien.c-types ;
+SPECIALIZED-ARRAY: int
[ { 1 2 3 } ] [ 1/2 { 2 4 6 } n*v ] unit-test
[ { 1 2 3 } ] [ { 2 4 6 } 1/2 v*n ] unit-test
[ 1.125 ] [ 0.0 1.0 2.0 4.0 { 0.5 0.25 } bilerp ] unit-test
-[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test
\ No newline at end of file
+[ 17 ] [ 0 1 2 3 4 5 6 7 { 1 2 3 } trilerp ] unit-test
+
+[ { 0 3 2 5 4 } ] [ { 1 2 3 4 5 } { 1 1 1 1 1 } v+- ] unit-test
+
+[ 1 ] [ { C{ 0 1 } } dup v. ] unit-test
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel sequences math math.functions hints
-math.order ;
+USING: arrays alien.c-types assocs kernel sequences math math.functions
+hints math.order math.libm fry combinators byte-arrays accessors
+locals ;
+QUALIFIED-WITH: alien.c-types c
IN: math.vectors
+GENERIC: element-type ( obj -- c-type )
+M: object element-type drop f ; inline
+
: vneg ( u -- v ) [ neg ] map ;
: v+n ( u n -- v ) [ + ] curry map ;
: vmax ( u v -- w ) [ max ] 2map ;
: vmin ( u v -- w ) [ min ] 2map ;
-: vfloor ( v -- _v_ ) [ floor ] map ;
-: vceiling ( v -- ^v^ ) [ ceiling ] map ;
-: vtruncate ( v -- -v- ) [ truncate ] map ;
+: v+- ( u v -- w )
+ [ t ] 2dip
+ [ [ not ] 2dip pick [ + ] [ - ] if ] 2map
+ nip ;
+
+<PRIVATE
+
+: 2saturate-map ( u v quot -- w )
+ pick element-type '[ @ _ c-type-clamp ] 2map ; inline
+
+PRIVATE>
+
+: vs+ ( u v -- w ) [ + ] 2saturate-map ;
+: vs- ( u v -- w ) [ - ] 2saturate-map ;
+: vs* ( u v -- w ) [ * ] 2saturate-map ;
+
+: vabs ( u -- v ) [ abs ] map ;
+: vsqrt ( u -- v ) [ >float fsqrt ] map ;
+
+<PRIVATE
+
+: fp-bitwise-op ( x y seq quot -- z )
+ swap element-type {
+ { c:double [ [ [ double>bits ] bi@ ] dip call bits>double ] }
+ { c:float [ [ [ float>bits ] bi@ ] dip call bits>float ] }
+ [ drop call ]
+ } case ; inline
+
+: fp-bitwise-unary ( x seq quot -- z )
+ swap element-type {
+ { c:double [ [ double>bits ] dip call bits>double ] }
+ { c:float [ [ float>bits ] dip call bits>float ] }
+ [ drop call ]
+ } case ; inline
+
+: element>bool ( x seq -- ? )
+ element-type [ [ f ] when-zero ] when ; inline
+
+: bitandn ( x y -- z ) [ bitnot ] dip bitand ; inline
+
+GENERIC: new-underlying ( underlying seq -- seq' )
+
+: change-underlying ( seq quot -- seq' )
+ '[ underlying>> @ ] keep new-underlying ; inline
+
+PRIVATE>
+
+: vbitand ( u v -- w ) over '[ _ [ bitand ] fp-bitwise-op ] 2map ;
+: vbitandn ( u v -- w ) over '[ _ [ bitandn ] fp-bitwise-op ] 2map ;
+: vbitor ( u v -- w ) over '[ _ [ bitor ] fp-bitwise-op ] 2map ;
+: vbitxor ( u v -- w ) over '[ _ [ bitxor ] fp-bitwise-op ] 2map ;
+: vbitnot ( u -- w ) dup '[ _ [ bitnot ] fp-bitwise-unary ] map ;
+
+:: vbroadcast ( u n -- v ) u length n u nth <repetition> u like ;
+: vshuffle ( u perm -- v ) swap [ '[ _ nth ] ] keep map-as ;
+
+: vlshift ( u n -- w ) '[ _ shift ] map ;
+: vrshift ( u n -- w ) neg '[ _ shift ] map ;
+
+: hlshift ( u n -- w ) '[ _ <byte-array> prepend 16 head ] change-underlying ;
+: hrshift ( u n -- w ) '[ _ <byte-array> append 16 tail* ] change-underlying ;
+
+: (vmerge-head) ( u v -- h )
+ over length 2 /i '[ _ head-slice ] bi@ [ zip ] keep concat-as ;
+: (vmerge-tail) ( u v -- t )
+ over length 2 /i '[ _ tail-slice ] bi@ [ zip ] keep concat-as ;
+
+: (vmerge) ( u v -- h t )
+ [ (vmerge-head) ] [ (vmerge-tail) ] 2bi ; inline
+
+: vmerge ( u v -- w ) [ zip ] keep concat-as ;
+
+: vand ( u v -- w ) over '[ [ _ element>bool ] bi@ and ] 2map ;
+: vandn ( u v -- w ) over '[ [ _ element>bool ] bi@ [ not ] dip and ] 2map ;
+: vor ( u v -- w ) over '[ [ _ element>bool ] bi@ or ] 2map ;
+: vxor ( u v -- w ) over '[ [ _ element>bool ] bi@ xor ] 2map ;
+: vnot ( u -- w ) dup '[ _ element>bool not ] map ;
+
+: vall? ( v -- ? ) [ ] all? ;
+: vany? ( v -- ? ) [ ] any? ;
+: vnone? ( v -- ? ) [ not ] all? ;
+
+: v< ( u v -- w ) [ < ] 2map ;
+: v<= ( u v -- w ) [ <= ] 2map ;
+: v>= ( u v -- w ) [ >= ] 2map ;
+: v> ( u v -- w ) [ > ] 2map ;
+: vunordered? ( u v -- w ) [ unordered? ] 2map ;
+: v= ( u v -- w ) [ = ] 2map ;
+
+: v? ( mask true false -- w )
+ [ vand ] [ vandn ] bi-curry* bi vor ; inline
+
+: vfloor ( u -- v ) [ floor ] map ;
+: vceiling ( u -- v ) [ ceiling ] map ;
+: vtruncate ( u -- v ) [ truncate ] map ;
: vsupremum ( seq -- vmax ) [ ] [ vmax ] map-reduce ;
: vinfimum ( seq -- vmin ) [ ] [ vmin ] map-reduce ;
-: v. ( u v -- x ) [ * ] [ + ] 2map-reduce ;
+: v. ( u v -- x ) [ conjugate * ] [ + ] 2map-reduce ;
: norm-sq ( v -- x ) [ absq ] [ + ] map-reduce ;
: norm ( v -- x ) norm-sq sqrt ;
: normalize ( u -- v ) dup norm v/n ;
"Memoization is useful in situations where the set of possible inputs is small, but the results are expensive to compute and should be cached. Memoized words should not have any side effects."
$nl
"Defining a memoized word at parse time:"
-{ $subsection POSTPONE: MEMO: }
+{ $subsections POSTPONE: MEMO: }
"Defining a memoized word at run time:"
-{ $subsection define-memoized }
+{ $subsections define-memoized }
"Clearing memoized results:"
-{ $subsection reset-memoized } ;
+{ $subsections reset-memoized } ;
ABOUT: "memoize"
ARTICLE: "mime.types" "MIME types"
"The " { $vocab-link "mime.types" } " vocabulary loads a file of MIME types and provides a word to look up the MIME type based on a file extension." $nl
"Looking up a MIME type:"
-{ $subsection mime-type } ;
+{ $subsections mime-type } ;
ABOUT: "mime.types"
"The " { $vocab-link "mirrors" } " vocabulary defines data types which present an object's slots and slot values as an associative structure. This enables idioms such as iteration over all slots in a tuple, or editing of tuples, sequences and assocs in a generic fashion. This functionality is used by developer tools and meta-programming utilities."
$nl
"A mirror provides such a view of a tuple:"
-{ $subsection mirror }
-{ $subsection <mirror> }
+{ $subsections
+ mirror
+ <mirror>
+}
"Utility word used by developer tools which inspect objects:"
-{ $subsection make-mirror }
+{ $subsections make-mirror }
{ $see-also "slots" } ;
ABOUT: "mirrors"
USING: assocs hashtables kernel sequences generic words
arrays classes slots slots.private classes.tuple
classes.tuple.private math vectors quotations accessors
-combinators ;
+combinators byte-arrays specialized-arrays ;
IN: mirrors
TUPLE: mirror { object read-only } ;
INSTANCE: mirror assoc
+MIXIN: enumerated-sequence
+INSTANCE: array enumerated-sequence
+INSTANCE: vector enumerated-sequence
+INSTANCE: callable enumerated-sequence
+INSTANCE: byte-array enumerated-sequence
+INSTANCE: specialized-array enumerated-sequence
+
GENERIC: make-mirror ( obj -- assoc )
M: hashtable make-mirror ;
M: integer make-mirror drop f ;
-M: array make-mirror <enum> ;
-M: vector make-mirror <enum> ;
-M: quotation make-mirror <enum> ;
+M: enumerated-sequence make-mirror <enum> ;
M: object make-mirror <mirror> ;
\r
ARTICLE: "models.arrow" "Arrow models"\r
"Arrow model values are computed by applying a quotation to the value of another model."\r
-{ $subsection arrow }\r
-{ $subsection <arrow> } ;\r
+{ $subsections\r
+ arrow\r
+ <arrow>\r
+} ;\r
\r
ABOUT: "models.arrow"\r
ARTICLE: "models.arrow.smart" "Smart arrow models"
"The " { $vocab-link "models.arrow.smart" } " vocabulary generalizes arrows to arbitrary input arity. They're called “smart” because they resemble " { $link "combinators.smart" } "."
-{ $subsection <smart-arrow> } ;
+{ $subsections <smart-arrow> } ;
ABOUT: "models.arrow.smart"
\ No newline at end of file
\r
ARTICLE: "models-delay" "Delay models"\r
"Delay models are used to implement delayed updating of gadgets in response to user input."\r
-{ $subsection delay }\r
-{ $subsection <delay> } ;\r
+{ $subsections\r
+ delay\r
+ <delay>\r
+} ;\r
\r
ABOUT: "models-delay"\r
"The " { $vocab-link "models" } " vocabulary provides basic support for dataflow programming. A model is an observable value. Changing a model's value notifies other objects which depend on the model automatically, and models may depend on each other's values."
$nl
"The class of models:"
-{ $subsection model }
+{ $subsections model }
"Creating models:"
-{ $subsection <model> }
+{ $subsections <model> }
"Adding and removing connections:"
-{ $subsection add-connection }
-{ $subsection remove-connection }
+{ $subsections
+ add-connection
+ remove-connection
+}
"Generic word called on model connections when the model value changes:"
-{ $subsection model-changed }
+{ $subsections model-changed }
"When using models which are not associated with controls (or when unit testing controls), you must activate and deactivate models manually:"
-{ $subsection activate-model }
-{ $subsection deactivate-model }
-{ $subsection "models-impl" }
-{ $subsection "models.arrow" }
-{ $subsection "models.product" }
-{ $subsection "models-range" }
-{ $subsection "models-delay" } ;
+{ $subsections
+ activate-model
+ deactivate-model
+ "models-impl"
+ "models.arrow"
+ "models.product"
+ "models-range"
+ "models-delay"
+} ;
ARTICLE: "models-impl" "Implementing models"
"New types of models can be defined, for example see " { $vocab-link "models.arrow" } "."
$nl
"Models can execute hooks when activated:"
-{ $subsection model-activated }
+{ $subsections model-activated }
"Models can override requests to change their value, for example to perform validation:"
-{ $subsection set-model } ;
+{ $subsections set-model } ;
ABOUT: "models"
\r
ARTICLE: "models.product" "Product models"\r
"Product model values are computed by collecting the values from a sequence of underlying models into a new sequence."\r
-{ $subsection product }\r
-{ $subsection <product> } ;\r
+{ $subsections\r
+ product\r
+ <product>\r
+} ;\r
\r
ABOUT: "models.product"\r
\r
ARTICLE: "models-range" "Range models"\r
"Range models ensure their value is a real number within a fixed range."\r
-{ $subsection range }\r
-{ $subsection <range> }\r
+{ $subsections\r
+ range\r
+ <range>\r
+}\r
"Range models conform to a protocol for getting and setting the current value, as well as the endpoints of the range."\r
-{ $subsection "range-model-protocol" } ;\r
+{ $subsections "range-model-protocol" } ;\r
\r
ARTICLE: "range-model-protocol" "Range model protocol"\r
"The range model protocol is implemented by the " { $link range } " and " { $link compose } " classes. User-defined models may implement it too."\r
-{ $subsection range-value }\r
-{ $subsection range-page-value } \r
-{ $subsection range-min-value } \r
-{ $subsection range-max-value } \r
-{ $subsection range-max-value* } \r
-{ $subsection set-range-value } \r
-{ $subsection set-range-page-value } \r
-{ $subsection set-range-min-value } \r
-{ $subsection set-range-max-value } ;\r
+{ $subsections\r
+ range-value\r
+ range-page-value\r
+ range-min-value\r
+ range-max-value\r
+ range-max-value*\r
+ set-range-value\r
+ set-range-page-value\r
+ set-range-min-value \r
+ set-range-max-value \r
+} ;\r
\r
ABOUT: "models-range"\r
{ $syntax "STRING: name\nfoo\n;" }
{ $description "Forms a multiline string literal, or 'here document' stored in the word called name. A semicolon is used to signify the end, and that semicolon must be on a line by itself, not preceeded or followed by any whitespace. The string will have newlines in between lines but not at the end, unless there is a blank line before the semicolon." } ;
-HELP: <"
-{ $syntax "<\" text \">" }
-{ $description "This forms a multiline string literal ending in \">. Unlike the " { $link POSTPONE: STRING: } " form, you can end it in the middle of a line. This construct is non-nesting. In the example above, the string would be parsed as \"text\"." } ;
-
HELP: /*
{ $syntax "/* comment */" }
{ $description "Provides C-like comments that can span multiple lines. One caveat is that " { $snippet "/*" } " and " { $snippet "*/" } " are still tokens and must not abut the comment text itself." }
}
} ;
-{ POSTPONE: <" POSTPONE: STRING: } related-words
-
HELP: parse-multiline-string
{ $values { "end-text" "a string delineating the end" } { "str" "the parsed string" } }
{ $description "Parses the input stream until the " { $snippet "end-text" } " is reached and returns the parsed text as a string." }
-{ $notes "Used to implement " { $link POSTPONE: /* } " and " { $link POSTPONE: <" } "." } ;
+{ $notes "Used to implement " { $link POSTPONE: /* } "." } ;
ARTICLE: "multiline" "Multiline"
"Multiline strings:"
-{ $subsection POSTPONE: STRING: }
-{ $subsection POSTPONE: <" }
-{ $subsection POSTPONE: HEREDOC: }
-{ $subsection POSTPONE: DELIMITED: }
+{ $subsections
+ POSTPONE: STRING:
+ POSTPONE: HEREDOC:
+ POSTPONE: DELIMITED:
+}
"Multiline comments:"
-{ $subsection POSTPONE: /* }
+{ $subsections POSTPONE: /* }
"Writing new multiline parsing words:"
-{ $subsection parse-multiline-string }
+{ $subsections parse-multiline-string }
;
ABOUT: "multiline"
;
[ "foo\nbar\n" ] [ test-it ] unit-test
-[ "foo\nbar\n" ] [ <" foo
-bar
-"> ] unit-test
-
-[ "hello\nworld" ] [ <" hello
-world"> ] unit-test
-
-[ "hello" "world" ] [ <" hello"> <" world"> ] unit-test
-
-[ "\nhi" ] [ <"
-hi"> ] unit-test
! HEREDOC:
: parse-multiline-string ( end-text -- str )
1 (parse-multiline-string) ;
-SYNTAX: <"
- "\">" parse-multiline-string parsed ;
-
-SYNTAX: <'
- "'>" parse-multiline-string parsed ;
-
-SYNTAX: {'
- "'}" parse-multiline-string parsed ;
-
-SYNTAX: {"
- "\"}" parse-multiline-string parsed ;
-
SYNTAX: /* "*/" parse-multiline-string drop ;
SYNTAX: HEREDOC:
ARTICLE: "opengl.annotations" "OpenGL error reporting"
"The " { $vocab-link "opengl.annotations" } " vocabulary provides some tools for tracking down GL errors:"
-{ $subsection throw-gl-errors }
-{ $subsection log-gl-errors }
-{ $subsection clear-gl-error-log }
-{ $subsection reset-gl-functions } ;
+{ $subsections
+ throw-gl-errors
+ log-gl-errors
+ clear-gl-error-log
+ reset-gl-functions
+} ;
ABOUT: "opengl.annotations"
\ No newline at end of file
USING: help.markup help.syntax io kernel math quotations
-opengl.gl multiline assocs ;
+opengl.gl assocs ;
IN: opengl.capabilities
HELP: gl-version
{ $values { "extensions" "A sequence of extension name strings" } { "?" "A boolean value" } }
{ $description "Returns true if the set of " { $snippet "extensions" } " is a subset of the implementation-supported extensions returned by " { $link gl-extensions } ". Elements of " { $snippet "extensions" } " can be sequences, in which case true will be returned if any one of the extensions in the subsequence are available." }
{ $examples "Testing for framebuffer object and pixel buffer support:"
- { $code <" {
+ { $code """{
{ "GL_EXT_framebuffer_object" "GL_ARB_framebuffer_object" }
"GL_ARB_pixel_buffer_object"
-} has-gl-extensions? "> }
+} has-gl-extensions?""" }
} ;
HELP: has-gl-version-or-extensions?
! (c)2009 Joe Groff bsd license
-USING: help.markup help.syntax multiline tools.continuations ;
+USING: help.markup help.syntax tools.continuations ;
IN: opengl.debug
HELP: G
{ $description "Makes the OpenGL context associated with " { $link G-world } " active for subsequent OpenGL calls. This is intended to be used from the listener, where interactively entered OpenGL calls can be directed to any window. Note that the Factor UI resets the OpenGL context every time a window is updated, so every code snippet entered in the listener must be prefixed with " { $snippet "G" } " in this use case." }
-{ $examples { $code <" USING: opengl.debug ui ;
+{ $examples { $code """USING: opengl.debug ui ;
[ drop t ] find-window G-world set
G 0.0 0.0 1.0 1.0 glClearColor
-G GL_COLOR_BUFFER_BIT glClear
-"> } } ;
+G GL_COLOR_BUFFER_BIT glClear""" } } ;
HELP: F
{ $description "Flushes the OpenGL context associated with " { $link G-world } ", thereby committing any outstanding drawing operations." } ;
ARTICLE: "opengl.debug" "Interactive debugging of OpenGL applications"
"The " { $vocab-link "opengl.debug" } " vocabulary provides words to assist with interactive debugging of OpenGL applications in the Factor UI."
-{ $subsection G-world }
-{ $subsection G }
-{ $subsection F }
-{ $subsection GB }
-{ $subsection gl-break } ;
+{ $subsections
+ G-world
+ G
+ F
+ GB
+ gl-break
+} ;
ABOUT: "opengl.debug"
IN: opengl.gl
ARTICLE: "opengl-low-level" "OpenGL binding"
- { $subsection "opengl-specifying-vertices" }
- { $subsection "opengl-geometric-primitives" }
- { $subsection "opengl-modeling-transformations" } ;
+{ $subsections
+ "opengl-specifying-vertices"
+ "opengl-geometric-primitives"
+ "opengl-modeling-transformations"
+} ;
ARTICLE: "opengl-specifying-vertices" "Specifying vertices"
+{ $subsections
+ glVertex2d
+ glVertex2f
+ glVertex2i
+ glVertex2s
+ glVertex3d
+ glVertex3f
+ glVertex3i
+ glVertex3s
+ glVertex4d
+ glVertex4f
+ glVertex4i
+ glVertex4s
+ glVertex2dv
+ glVertex2fv
+ glVertex2iv
+ glVertex2sv
+ glVertex3dv
+ glVertex3fv
+ glVertex3iv
+ glVertex3sv
+ glVertex4dv
+ glVertex4fv
+ glVertex4iv
+ glVertex4sv
+} ;
- { $subsection glVertex2d }
- { $subsection glVertex2f }
- { $subsection glVertex2i }
- { $subsection glVertex2s }
- { $subsection glVertex3d }
- { $subsection glVertex3f }
- { $subsection glVertex3i }
- { $subsection glVertex3s }
- { $subsection glVertex4d }
- { $subsection glVertex4f }
- { $subsection glVertex4i }
- { $subsection glVertex4s }
- { $subsection glVertex2dv }
- { $subsection glVertex2fv }
- { $subsection glVertex2iv }
- { $subsection glVertex2sv }
- { $subsection glVertex3dv }
- { $subsection glVertex3fv }
- { $subsection glVertex3iv }
- { $subsection glVertex3sv }
- { $subsection glVertex4dv }
- { $subsection glVertex4fv }
- { $subsection glVertex4iv }
- { $subsection glVertex4sv } ;
ARTICLE: "opengl-geometric-primitives" "OpenGL geometric primitives"
{ $link GL_FILL } } } } } ;
ARTICLE: "opengl-modeling-transformations" "Modeling transformations"
- { $subsection glTranslatef }
- { $subsection glTranslated }
- { $subsection glRotatef }
- { $subsection glRotated }
- { $subsection glScalef }
- { $subsection glScaled } ;
+{ $subsections
+ glTranslatef
+ glTranslated
+ glRotatef
+ glRotated
+ glScalef
+ glScaled
+} ;
{ glTranslatef glTranslated glRotatef glRotated glScalef glScaled }
! This file is based on the gl.h that comes with xorg-x11 6.8.2
-USING: alien alien.syntax combinators kernel parser sequences
-system words opengl.gl.extensions ;
-
+USING: alien alien.c-types alien.syntax combinators kernel parser
+sequences system words opengl.gl.extensions ;
+FROM: alien.c-types => short ;
IN: opengl.gl
TYPEDEF: uint GLenum
-USING: alien.syntax kernel windows.types ;
+USING: alien.c-types alien.syntax kernel windows.types ;
IN: opengl.gl.windows
LIBRARY: gl
"The " { $vocab-link "opengl" } " vocabulary implements some utility words to give OpenGL a more Factor-like feel."
$nl
"The " { $vocab-link "opengl.gl" } " and " { $vocab-link "opengl.glu" } " vocabularies have the actual OpenGL bindings."
-{ $subsection "opengl-low-level" }
+{ $subsections "opengl-low-level" }
"Error reporting:"
-{ $subsection gl-error }
+{ $subsections gl-error }
"Wrappers:"
-{ $subsection gl-color }
-{ $subsection gl-translate }
-{ $subsection bind-texture-unit }
+{ $subsections
+ gl-color
+ gl-translate
+ bind-texture-unit
+}
"Combinators:"
-{ $subsection do-enabled }
-{ $subsection do-attribs }
-{ $subsection do-matrix }
-{ $subsection with-translation }
-{ $subsection make-dlist }
+{ $subsections
+ do-enabled
+ do-attribs
+ do-matrix
+ with-translation
+ make-dlist
+}
"Rendering geometric shapes:"
-{ $subsection gl-line }
-{ $subsection gl-fill-rect }
-{ $subsection gl-rect }
-;
+{ $subsections
+ gl-line
+ gl-fill-rect
+ gl-rect
+} ;
ABOUT: "gl-utilities"
math.parser opengl.gl combinators combinators.smart arrays
sequences splitting words byte-arrays assocs vocabs
colors colors.constants accessors generalizations locals fry
-specialized-arrays.float specialized-arrays.uint ;
+specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: uint
IN: opengl
: gl-color ( color -- ) >rgba-components glColor4d ; inline
! Copyright (C) 2008 Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces
-assocs alien alien.strings libc opengl math sequences combinators
-macros arrays io.encodings.ascii fry specialized-arrays.uint
+assocs alien alien.data alien.strings libc opengl math sequences combinators
+macros arrays io.encodings.ascii fry specialized-arrays
destructors accessors ;
+SPECIALIZED-ARRAY: uint
IN: opengl.shaders
: with-gl-shader-source-ptr ( string quot -- )
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs cache colors.constants destructors kernel
-opengl opengl.gl opengl.capabilities combinators images
-images.tesselation grouping specialized-arrays.float sequences math
-math.vectors math.matrices generalizations fry arrays namespaces
-system locals literals ;
+USING: accessors assocs cache colors.constants destructors
+kernel opengl opengl.gl opengl.capabilities combinators images
+images.tesselation grouping sequences math math.vectors
+math.matrices generalizations fry arrays namespaces system
+locals literals specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: opengl.textures
SYMBOL: non-power-of-2-textures?
!
! export LD_LIBRARY_PATH=/opt/local/lib
-USING: alien alien.syntax combinators kernel system
-alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators kernel system
+alien.libraries classes.struct ;
IN: openssl.libcrypto
} cond
>>
-C-STRUCT: bio-method
- { "int" "type" }
- { "void*" "name" }
- { "void*" "bwrite" }
- { "void*" "bread" }
- { "void*" "bputs" }
- { "void*" "bgets" }
- { "void*" "ctrl" }
- { "void*" "create" }
- { "void*" "destroy" }
- { "void*" "callback-ctrl" } ;
-
-C-STRUCT: bio
- { "void*" "method" }
- { "void*" "callback" }
- { "void*" "cb-arg" }
- { "int" "init" }
- { "int" "shutdown" }
- { "int" "flags" }
- { "int" "retry-reason" }
- { "int" "num" }
- { "void*" "ptr" }
- { "void*" "next-bio" }
- { "void*" "prev-bio" }
- { "int" "references" }
- { "ulong" "num-read" }
- { "ulong" "num-write" }
- { "void*" "crypto-ex-data-stack" }
- { "int" "crypto-ex-data-dummy" } ;
+STRUCT: bio-method
+ { type int }
+ { name void* }
+ { bwrite void* }
+ { bread void* }
+ { bputs void* }
+ { bgets void* }
+ { ctrl void* }
+ { create void* }
+ { destroy void* }
+ { callback-ctrl void* } ;
+
+STRUCT: bio
+ { method void* }
+ { callback void* }
+ { cb-arg void* }
+ { init int }
+ { shutdown int }
+ { flags int }
+ { retry-reason int }
+ { num int }
+ { ptr void* }
+ { next-bio void* }
+ { prev-bio void* }
+ { references int }
+ { num-read ulong }
+ { num-write ulong }
+ { crypto-ex-data-stack void* }
+ { crypto-ex-data-dummy int } ;
CONSTANT: BIO_NOCLOSE HEX: 00
CONSTANT: BIO_CLOSE HEX: 01
CONSTANT: EVP_MAX_MD_SIZE 64
-C-STRUCT: EVP_MD_CTX
- { "EVP_MD*" "digest" }
- { "ENGINE*" "engine" }
- { "ulong" "flags" }
- { "void*" "md_data" } ;
-
TYPEDEF: void* EVP_MD*
-TYPEDEF: void* ENGINE*
+C-TYPE: ENGINE
+
+STRUCT: EVP_MD_CTX
+ { digest EVP_MD* }
+ { engine ENGINE* }
+ { flags ulong }
+ { md_data void* } ;
! Initialize ciphers and digest tables
FUNCTION: void OpenSSL_add_all_ciphers ( ) ;
! Copyright (C) 2007 Elie CHAFTARI
! Portions copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax combinators kernel system namespaces
-assocs parser lexer sequences words quotations math.bitwise
-alien.libraries ;
+USING: alien alien.c-types alien.syntax combinators kernel
+system namespaces assocs parser lexer sequences words
+quotations math.bitwise alien.libraries ;
IN: openssl.libssl
TYPEDEF: void* ssl-method
TYPEDEF: void* SSL_CTX*
TYPEDEF: void* SSL_SESSION*
-TYPEDEF: void* SSL*
+C-TYPE: SSL
LIBRARY: libssl
+! ===============================================
+! x509.h
+! ===============================================
+
+TYPEDEF: void* X509_NAME*
+
+C-TYPE: X509
+
+FUNCTION: int X509_NAME_get_text_by_NID ( X509_NAME* name, int nid, void* buf, int len ) ;
+FUNCTION: X509_NAME* X509_get_subject_name ( X509* a ) ;
+
! ===============================================
! ssl.h
! ===============================================
: SSL_SESS_CACHE_NO_INTERNAL ( -- n )
{ SSL_SESS_CACHE_NO_INTERNAL_LOOKUP SSL_SESS_CACHE_NO_INTERNAL_STORE } flags ; inline
-! ===============================================
-! x509.h
-! ===============================================
-
-TYPEDEF: void* X509_NAME*
-
-TYPEDEF: void* X509*
-
-FUNCTION: int X509_NAME_get_text_by_NID ( X509_NAME* name, int nid, void* buf, int len ) ;
-FUNCTION: X509_NAME* X509_get_subject_name ( X509* a ) ;
-
! ===============================================
! x509_vfy.h
! ===============================================
! See http://factorcode.org/license.txt for BSD license.
!
! pangocairo bindings, from pango/pangocairo.h
-USING: alien alien.syntax combinators system cairo.ffi
-alien.libraries ;
+USING: arrays sequences alien alien.c-types alien.destructors
+alien.libraries alien.syntax math math.functions math.vectors
+destructors combinators colors fonts accessors assocs namespaces
+kernel pango pango.fonts pango.layouts glib unicode.data images
+cache init system math.rectangles fry memoize io.encodings.utf8
+classes.struct cairo cairo.ffi ;
IN: pango.cairo
<< {
LIBRARY: pangocairo
+C-TYPE: PangoCairoFontMap
+C-TYPE: PangoCairoFont
+
FUNCTION: PangoFontMap*
pango_cairo_font_map_new ( ) ;
FUNCTION: void
pango_cairo_error_underline_path ( cairo_t* cr, double x, double y, double width, double height ) ;
+
+TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
+
+SYMBOL: dpi
+
+72 dpi set-global
+
+: set-layout-font ( font layout -- )
+ swap cache-font-description pango_layout_set_font_description ;
+
+: set-layout-text ( str layout -- )
+ #! Replace nulls with something else since Pango uses null-terminated
+ #! strings
+ swap -1 pango_layout_set_text ;
+
+: layout-extents ( layout -- ink-rect logical-rect )
+ PangoRectangle <struct>
+ PangoRectangle <struct>
+ [ pango_layout_get_extents ] 2keep
+ [ PangoRectangle>rect ] bi@ ;
+
+: layout-baseline ( layout -- baseline )
+ pango_layout_get_iter &pango_layout_iter_free
+ pango_layout_iter_get_baseline
+ pango>float ;
+
+: set-foreground ( cr font -- )
+ foreground>> set-source-color ;
+
+: fill-background ( cr font dim -- )
+ [ background>> set-source-color ]
+ [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
+
+: rect-translate-x ( rect x -- rect' )
+ '[ _ 0 2array v- ] change-loc ;
+
+: first-line ( layout -- line )
+ layout>> 0 pango_layout_get_line_readonly ;
+
+: line-offset>x ( layout n -- x )
+ #! n is an index into the UTF8 encoding of the text
+ [ drop first-line ] [ swap string>> >utf8-index ] 2bi
+ 0 0 <int> [ pango_layout_line_index_to_x ] keep
+ *int pango>float ;
+
+: x>line-offset ( layout x -- n )
+ #! n is an index into the UTF8 encoding of the text
+ [
+ [ first-line ] dip
+ float>pango 0 <int> 0 <int>
+ [ pango_layout_line_x_to_index drop ] 2keep
+ [ *int ] bi@ swap
+ ] [ drop string>> ] 2bi utf8-index> + ;
+
+: selection-start/end ( selection -- start end )
+ selection>> [ start>> ] [ end>> ] bi ;
+
+: selection-rect ( layout -- rect )
+ [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
+ [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
+
+: fill-selection-background ( cr layout -- )
+ dup selection>> [
+ [ selection>> color>> set-source-color ]
+ [
+ [ selection-rect ] [ ink-rect>> loc>> first ] bi
+ rect-translate-x
+ fill-rect
+ ] 2bi
+ ] [ 2drop ] if ;
+
+: text-position ( layout -- loc )
+ [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
+
+: set-text-position ( cr loc -- )
+ first2 cairo_move_to ;
+
+: draw-layout ( layout -- image )
+ dup ink-rect>> dim>> [ >fixnum ] map [
+ swap {
+ [ layout>> pango_cairo_update_layout ]
+ [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
+ [ fill-selection-background ]
+ [ text-position set-text-position ]
+ [ font>> set-foreground ]
+ [ layout>> pango_cairo_show_layout ]
+ } 2cleave
+ ] make-bitmap-image ;
+
+: escape-nulls ( str -- str' )
+ { { 0 CHAR: zero-width-no-break-space } } substitute ;
+
+: unpack-selection ( layout string/selection -- layout )
+ dup selection? [
+ [ string>> escape-nulls >>string ] [ >>selection ] bi
+ ] [ escape-nulls >>string ] if ; inline
+
+: set-layout-resolution ( layout -- )
+ pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
+
+: <PangoLayout> ( text font -- layout )
+ dummy-cairo pango_cairo_create_layout |g_object_unref
+ [ set-layout-resolution ] keep
+ [ set-layout-font ] keep
+ [ set-layout-text ] keep ;
+
+: glyph-height ( font string -- y )
+ swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
+
+MEMO: missing-font-metrics ( font -- metrics )
+ #! Pango doesn't provide x-height and cap-height but Core Text does, so we
+ #! simulate them on Pango.
+ [
+ [ metrics new ] dip
+ [ "x" glyph-height >>x-height ]
+ [ "Y" glyph-height >>cap-height ] bi
+ ] with-destructors ;
+
+: layout-metrics ( layout -- metrics )
+ dup font>> missing-font-metrics clone
+ swap
+ [ layout>> layout-baseline >>ascent ]
+ [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
+ dup [ height>> ] [ ascent>> ] bi - >>descent ;
+
+: <layout> ( font string -- line )
+ [
+ layout new-disposable
+ swap unpack-selection
+ swap >>font
+ dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
+ dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
+ dup layout-metrics >>metrics
+ dup draw-layout >>image
+ ] with-destructors ;
+
+M: layout dispose* layout>> g_object_unref ;
+
+SYMBOL: cached-layouts
+
+: cached-layout ( font string -- layout )
+ cached-layouts get [ <layout> ] 2cache ;
+
+: cached-line ( font string -- line )
+ cached-layout layout>> first-line ;
+
+[ <cache-assoc> cached-layouts set-global ] "pango.cairo" add-init-hook
PANGO_STYLE_ITALIC ;
TYPEDEF: int PangoWeight
+C-TYPE: PangoFont
+C-TYPE: PangoFontFamily
+C-TYPE: PangoFontFace
+C-TYPE: PangoFontMap
+C-TYPE: PangoFontMetrics
+C-TYPE: PangoFontDescription
+C-TYPE: PangoGlyphString
+C-TYPE: PangoLanguage
+
CONSTANT: PANGO_WEIGHT_THIN 100
CONSTANT: PANGO_WEIGHT_ULTRALIGHT 200
CONSTANT: PANGO_WEIGHT_LIGHT 300
: cache-font-description ( font -- description )
strip-font-colors (cache-font-description) ;
-[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-init-hook
\ No newline at end of file
+[ \ (cache-font-description) reset-memoized ] "pango.fonts" add-init-hook
IN: pango.layouts.tests
-USING: pango.layouts tools.test glib fonts accessors
+USING: pango.layouts pango.cairo tools.test glib fonts accessors
sequences combinators.short-circuit math destructors ;
[ t ] [
USING: arrays sequences alien alien.c-types alien.destructors
alien.syntax math math.functions math.vectors destructors combinators
colors fonts accessors assocs namespaces kernel pango pango.fonts
-pango.cairo cairo cairo.ffi glib unicode.data images cache init
-math.rectangles fry memoize io.encodings.utf8 ;
+glib unicode.data images cache init
+math.rectangles fry memoize io.encodings.utf8 classes.struct ;
IN: pango.layouts
LIBRARY: pango
+C-TYPE: PangoLayout
+C-TYPE: PangoLayoutIter
+C-TYPE: PangoLayoutLine
+
FUNCTION: PangoLayout*
pango_layout_new ( PangoContext* context ) ;
DESTRUCTOR: pango_layout_iter_free
-TUPLE: layout < disposable font string selection layout metrics ink-rect logical-rect image ;
-
-SYMBOL: dpi
-
-72 dpi set-global
-
-: set-layout-font ( font layout -- )
- swap cache-font-description pango_layout_set_font_description ;
-
-: set-layout-text ( str layout -- )
- #! Replace nulls with something else since Pango uses null-terminated
- #! strings
- swap -1 pango_layout_set_text ;
-
-: set-layout-resolution ( layout -- )
- pango_layout_get_context dpi get pango_cairo_context_set_resolution ;
-
-: <PangoLayout> ( text font -- layout )
- dummy-cairo pango_cairo_create_layout |g_object_unref
- [ set-layout-resolution ] keep
- [ set-layout-font ] keep
- [ set-layout-text ] keep ;
-
-: layout-extents ( layout -- ink-rect logical-rect )
- "PangoRectangle" <c-object>
- "PangoRectangle" <c-object>
- [ pango_layout_get_extents ] 2keep
- [ PangoRectangle>rect ] bi@ ;
-
-: glyph-height ( font string -- y )
- swap <PangoLayout> &g_object_unref layout-extents drop dim>> second ;
-
-MEMO: missing-font-metrics ( font -- metrics )
- #! Pango doesn't provide x-height and cap-height but Core Text does, so we
- #! simulate them on Pango.
- [
- [ metrics new ] dip
- [ "x" glyph-height >>x-height ]
- [ "Y" glyph-height >>cap-height ] bi
- ] with-destructors ;
-
-: layout-baseline ( layout -- baseline )
- pango_layout_get_iter &pango_layout_iter_free
- pango_layout_iter_get_baseline
- pango>float ;
-
-: set-foreground ( cr font -- )
- foreground>> set-source-color ;
-
-: fill-background ( cr font dim -- )
- [ background>> set-source-color ]
- [ [ { 0 0 } ] dip <rect> fill-rect ] bi-curry* bi ;
-
-: rect-translate-x ( rect x -- rect' )
- '[ _ 0 2array v- ] change-loc ;
-
-: first-line ( layout -- line )
- layout>> 0 pango_layout_get_line_readonly ;
-
-: line-offset>x ( layout n -- x )
- #! n is an index into the UTF8 encoding of the text
- [ drop first-line ] [ swap string>> >utf8-index ] 2bi
- 0 0 <int> [ pango_layout_line_index_to_x ] keep
- *int pango>float ;
-
-: x>line-offset ( layout x -- n )
- #! n is an index into the UTF8 encoding of the text
- [
- [ first-line ] dip
- float>pango 0 <int> 0 <int>
- [ pango_layout_line_x_to_index drop ] 2keep
- [ *int ] bi@ swap
- ] [ drop string>> ] 2bi utf8-index> + ;
-
-: selection-start/end ( selection -- start end )
- selection>> [ start>> ] [ end>> ] bi ;
-
-: selection-rect ( layout -- rect )
- [ ink-rect>> dim>> ] [ ] [ selection-start/end ] tri [ line-offset>x ] bi-curry@ bi
- [ drop nip 0 2array ] [ swap - swap second 2array ] 3bi <rect> ;
-
-: fill-selection-background ( cr layout -- )
- dup selection>> [
- [ selection>> color>> set-source-color ]
- [
- [ selection-rect ] [ ink-rect>> loc>> first ] bi
- rect-translate-x
- fill-rect
- ] 2bi
- ] [ 2drop ] if ;
-
-: text-position ( layout -- loc )
- [ logical-rect>> ] [ ink-rect>> ] bi [ loc>> ] bi@ v- ;
-
-: set-text-position ( cr loc -- )
- first2 cairo_move_to ;
-
-: layout-metrics ( layout -- metrics )
- dup font>> missing-font-metrics clone
- swap
- [ layout>> layout-baseline >>ascent ]
- [ logical-rect>> dim>> [ first >>width ] [ second >>height ] bi ] bi
- dup [ height>> ] [ ascent>> ] bi - >>descent ;
-
-: draw-layout ( layout -- image )
- dup ink-rect>> dim>> [ >fixnum ] map [
- swap {
- [ layout>> pango_cairo_update_layout ]
- [ [ font>> ] [ ink-rect>> dim>> ] bi fill-background ]
- [ fill-selection-background ]
- [ text-position set-text-position ]
- [ font>> set-foreground ]
- [ layout>> pango_cairo_show_layout ]
- } 2cleave
- ] make-bitmap-image ;
-
-: escape-nulls ( str -- str' )
- { { 0 CHAR: zero-width-no-break-space } } substitute ;
-
-: unpack-selection ( layout string/selection -- layout )
- dup selection? [
- [ string>> escape-nulls >>string ] [ >>selection ] bi
- ] [ escape-nulls >>string ] if ; inline
-
-: <layout> ( font string -- line )
- [
- layout new-disposable
- swap unpack-selection
- swap >>font
- dup [ string>> ] [ font>> ] bi <PangoLayout> >>layout
- dup layout>> layout-extents [ >>ink-rect ] [ >>logical-rect ] bi*
- dup layout-metrics >>metrics
- dup draw-layout >>image
- ] with-destructors ;
-
-M: layout dispose* layout>> g_object_unref ;
-
-SYMBOL: cached-layouts
-
-: cached-layout ( font string -- layout )
- cached-layouts get [ <layout> ] 2cache ;
-
-: cached-line ( font string -- line )
- cached-layout layout>> first-line ;
-
-[ <cache-assoc> cached-layouts set-global ] "pango.layouts" add-init-hook
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license
USING: arrays system alien.destructors alien.c-types alien.syntax alien
-combinators math.rectangles kernel math alien.libraries ;
+combinators math.rectangles kernel math alien.libraries classes.struct
+accessors ;
IN: pango
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: pango>float ( n -- x ) PANGO_SCALE /f ; inline
: float>pango ( x -- n ) PANGO_SCALE * >integer ; inline
-FUNCTION: PangoContext*
-pango_context_new ( ) ;
+C-TYPE: PangoContext
-C-STRUCT: PangoRectangle
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" } ;
+FUNCTION: PangoContext* pango_context_new ( ) ;
+
+STRUCT: PangoRectangle
+ { x int }
+ { y int }
+ { width int }
+ { height int } ;
: PangoRectangle>rect ( PangoRectangle -- rect )
- [ [ PangoRectangle-x pango>float ] [ PangoRectangle-y pango>float ] bi 2array ]
- [ [ PangoRectangle-width pango>float ] [ PangoRectangle-height pango>float ] bi 2array ] bi
+ [ [ x>> pango>float ] [ y>> pango>float ] bi 2array ]
+ [ [ width>> pango>float ] [ height>> pango>float ] bi 2array ] bi
<rect> ;
[ "USE: peg.ebnf [EBNF EBNF]" eval( -- ) ] must-fail
-[ <" USE: peg.ebnf [EBNF
+[ """USE: peg.ebnf [EBNF
lol = a
lol = b
- EBNF] "> eval( -- )
+ EBNF]""" eval( -- )
] [
error>> [ redefined-rule? ] [ name>> "lol" = ] bi and
] must-fail-with
"This vocabulary provides a deque implementation which is persistent and purely functional: old versions of deques are not modified by operations. Instead, each push and pop operation creates a new deque based off the old one."
$nl
"The class of persistent deques:"
-{ $subsection deque }
+{ $subsections deque }
"To create a deque:"
-{ $subsection <deque> }
-{ $subsection sequence>deque }
+{ $subsections
+ <deque>
+ sequence>deque
+}
"To test if a deque is empty:"
-{ $subsection deque-empty? }
+{ $subsections deque-empty? }
"To manipulate deques:"
-{ $subsection push-front }
-{ $subsection push-back }
-{ $subsection pop-front }
-{ $subsection pop-back }
-{ $subsection deque>sequence } ;
+{ $subsections
+ push-front
+ push-back
+ pop-front
+ pop-back
+ deque>sequence
+} ;
HELP: deque
{ $class-description "This is the class of persistent (functional) double-ended queues. All deque operations can be done in O(1) amortized time for single-threaded access while maintaining the old version. For more information, see " { $link "persistent.deques" } "." } ;
ARTICLE: "persistent-heaps" "Persistent heaps"
"This vocabulary implements persistent minheaps, aka priority queues. They are purely functional and support efficient O(log n) operations of pushing and popping, with O(1) time access to the minimum element. To create heaps, use the following words:"
-{ $subsection <persistent-heap> }
-{ $subsection <singleton-heap> }
+{ $subsections
+ <persistent-heap>
+ <singleton-heap>
+}
"To manipulate them:"
-{ $subsection pheap-peek }
-{ $subsection pheap-push }
-{ $subsection pheap-pop }
-{ $subsection pheap-pop* }
-{ $subsection pheap-empty? }
-{ $subsection assoc>pheap }
-{ $subsection pheap>alist }
-{ $subsection pheap>values } ;
+{ $subsections
+ pheap-peek
+ pheap-push
+ pheap-pop
+ pheap-pop*
+ pheap-empty?
+ assoc>pheap
+ pheap>alist
+ pheap>values
+} ;
ABOUT: "persistent-heaps"
ARTICLE: "persistent.sequences" "Persistent sequence protocol"
"The persistent sequence protocol consists of the non-mutating sequence protocol words, such as " { $link length } " and " { $link nth } ", together with the following operations:"
-{ $subsection new-nth }
-{ $subsection ppush }
-{ $subsection ppop }
+{ $subsections
+ new-nth
+ ppush
+ ppop
+}
"The default implementations of the above run in " { $snippet "O(n)" } " time; the " { $vocab-link "persistent.vectors" } " vocabulary provides an implementation of these operations in " { $snippet "O(1)" } " time." ;
ABOUT: "persistent.sequences"
"A " { $emphasis "persistent vector" } " differs from an ordinary vector (" { $link "vectors" } ") in that it is immutable, and all operations yield new persistent vectors instead of modifying inputs. Unlike immutable operations on ordinary sequences, persistent vector operations are efficient and run in sub-linear time."
$nl
"The class of persistent vectors:"
-{ $subsection persistent-vector }
+{ $subsections persistent-vector }
"Converting a sequence into a persistent vector:"
-{ $subsection >persistent-vector }
+{ $subsections >persistent-vector }
"Persistent vectors have a literal syntax:"
-{ $subsection POSTPONE: PV{ }
+{ $subsections POSTPONE: PV{ }
"The empty persistent vector, written " { $snippet "PV{ }" } ", is used for building up all other persistent vectors."
$nl
"This implementation of persistent vectors is based on the " { $snippet "clojure.lang.PersistentVector" } " class from Rich Hickey's Clojure language for the JVM (" { $url "http://clojure.org" } ")." ;
"A detailed description of the algorithm, along with implementations in various languages, can be at in " { $url "http://www.tartarus.org/~martin/PorterStemmer" } "."
$nl
"The main word of the algorithm takes an English word as input and outputs its stem:"
-{ $subsection stem }
+{ $subsections stem }
"The algorithm consists of a number of steps:"
-{ $subsection step1a }
-{ $subsection step1b }
-{ $subsection step1c }
-{ $subsection step2 }
-{ $subsection step3 }
-{ $subsection step4 }
-{ $subsection step5 } ;
+{ $subsections
+ step1a
+ step1b
+ step1c
+ step2
+ step3
+ step4
+ step5
+} ;
ABOUT: "porter-stemmer"
ARTICLE: "present" "Converting objects to human-readable strings"
"A word for converting an object into a human-readable string:"
-{ $subsection present } ;
+{ $subsections present } ;
HELP: present
{ $values { "object" object } { "string" string } }
! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays byte-arrays byte-vectors generic hashtables
-assocs kernel math namespaces make sequences strings sbufs vectors
-words prettyprint.config prettyprint.custom prettyprint.sections
-quotations io io.pathnames io.styles math.parser effects classes.tuple
-math.order classes.tuple.private classes combinators colors ;
+USING: accessors arrays assocs byte-arrays byte-vectors classes
+classes.tuple classes.tuple.private colors colors.constants
+combinators continuations effects generic hashtables io
+io.pathnames io.styles kernel make math math.order math.parser
+namespaces prettyprint.config prettyprint.custom
+prettyprint.sections prettyprint.stylesheet quotations sbufs
+sequences strings vectors words words.symbol ;
IN: prettyprint.backend
M: effect pprint* effect>string "(" ")" surround text ;
?effect-height 0 < [ end-group ] when ;
! Atoms
-: word-style ( word -- style )
- dup "word-style" word-prop >hashtable [
- [
- [ presented set ]
- [
- [ parsing-word? ] [ delimiter? ] [ t eq? ] tri or or
- [ bold font-style set ] when
- ] bi
- ] bind
- ] keep ;
-
: word-name* ( word -- str )
name>> "( no name )" or ;
] "" make
] [ word-style ] bi styled-text ;
-M: real pprint* number>string text ;
+M: real pprint*
+ number-base get {
+ { 16 [ \ HEX: [ 16 >base text ] pprint-prefix ] }
+ { 8 [ \ OCT: [ 8 >base text ] pprint-prefix ] }
+ { 2 [ \ BIN: [ 2 >base text ] pprint-prefix ] }
+ [ drop number>string text ]
+ } case ;
+
+M: float pprint*
+ dup fp-nan? [
+ \ NAN: [ fp-nan-payload >hex text ] pprint-prefix
+ ] [
+ number-base get {
+ { 16 [ \ HEX: [ 16 >base text ] pprint-prefix ] }
+ [ drop number>string text ]
+ } case
+ ] if ;
M: f pprint* drop \ f pprint-word ;
+: pprint-effect ( effect -- )
+ [ effect>string ] [ effect-style ] bi styled-text ;
+
! Strings
: ch>ascii-escape ( ch -- str )
H{
] when
] when ;
-: string-style ( obj -- hash )
- [
- presented set
- T{ rgba f 0.3 0.3 0.3 1.0 } foreground set
- ] H{ } make-assoc ;
-
: unparse-string ( str prefix suffix -- str )
[ [ % do-string-limit [ unparse-ch ] each ] dip % ] "" make ;
M: tuple pprint*
pprint-tuple ;
+: recover-pprint ( try recovery -- )
+ pprinter-stack get clone
+ [ pprinter-stack set ] curry prepose recover ; inline
+
+: pprint-c-object ( object content-quot pointer-quot -- )
+ [ c-object-pointers? get ] 2dip
+ [ nip ]
+ [ [ drop ] prepose [ recover-pprint ] 2curry ] 2bi if ; inline
+
: do-length-limit ( seq -- trimmed n/f )
length-limit get dup [
over length over [-]
- dup zero? [ 2drop f ] [ [ head ] dip ] if
+ dup zero? [ 2drop f ] [ [ head-slice ] dip ] if
] when ;
: pprint-elements ( seq -- )
HELP: line-limit
{ $var-description "The maximum number of lines output by the prettyprinter before output is truncated with \"...\". The default is " { $link f } ", denoting unlimited line count." } ;
+HELP: number-base
+{ $var-description "The number base in which the prettyprinter will output numeric literals. A value of " { $snippet "2" } " will print integers and ratios in binary with " { $link POSTPONE: BIN: } ", and " { $snippet "8" } " will print them in octal with " { $link POSTPONE: OCT: } ". A value of " { $snippet "16" } " will print all integers, ratios, and floating-point values in hexadecimal with " { $link POSTPONE: HEX: } ". Other values of " { $snippet "number-base" } " will print numbers in decimal, which is the default." } ;
+
HELP: string-limit?
{ $var-description "Toggles whether printed strings are truncated to the margin." } ;
HELP: boa-tuples?
-{ $var-description "Toggles whether tuples print in BOA-form or assoc-form." }
+{ $var-description "Toggles whether tuples and structs print in BOA-form or assoc-form." }
{ $notes "See " { $link POSTPONE: T{ } " for a description of both literal tuple forms." } ;
+
+HELP: c-object-pointers?
+{ $var-description "Toggles whether C objects such as structs and direct arrays only print their underlying address. If this flag isn't set, C objects will attempt to print their contents. If a C object points to invalid memory, it will display only its address regardless." } ;
! Copyright (C) 2003, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays generic assocs io kernel math
-namespaces sequences strings io.styles vectors words
+namespaces sequences strings vectors words
continuations ;
IN: prettyprint.config
SYMBOL: nesting-limit
SYMBOL: length-limit
SYMBOL: line-limit
+SYMBOL: number-base
SYMBOL: string-limit?
SYMBOL: boa-tuples?
+SYMBOL: c-object-pointers?
4 tab-size set-global
64 margin set-global
+10 number-base set-global
ARTICLE: "prettyprint-numbers" "Prettyprinting numbers"
"The " { $link . } " word prints numbers in decimal. A set of words in the " { $vocab-link "prettyprint" } " vocabulary is provided to print integers using another base."
-{ $subsection .b }
-{ $subsection .o }
-{ $subsection .h } ;
+{ $subsections
+ .b
+ .o
+ .h
+} ;
ARTICLE: "prettyprint-stacks" "Prettyprinting stacks"
"Prettyprinting the current data, retain, call stacks:"
-{ $subsection .s }
-{ $subsection .r }
-{ $subsection .c }
+{ $subsections
+ .s
+ .r
+ .c
+}
"Prettyprinting any stack:"
-{ $subsection stack. }
+{ $subsections stack. }
"Prettyprinting any call stack:"
-{ $subsection callstack. }
+{ $subsections callstack. }
"Note that calls to " { $link .s } " can also be included inside words as a debugging aid, however a more convenient way to achieve this is to use the annotation facility. See " { $link "tools.annotations" } "." ;
ARTICLE: "prettyprint-variables" "Prettyprint control variables"
"The following variables affect the " { $link . } " and " { $link pprint } " words if set in the current dynamic scope:"
-{ $subsection tab-size }
-{ $subsection margin }
-{ $subsection nesting-limit }
-{ $subsection length-limit }
-{ $subsection line-limit }
-{ $subsection string-limit? }
-{ $subsection boa-tuples? }
+{ $subsections
+ tab-size
+ margin
+ nesting-limit
+ length-limit
+ line-limit
+ number-base
+ string-limit?
+ boa-tuples?
+ c-object-pointers?
+}
"Note that the " { $link short. } " and " { $link pprint-short } " variables override some of these variables."
{
$warning "Treat the global variables as essentially being constants. Only ever rebind them in a nested scope."
"Prettyprinter sections must subclass " { $link section } ", and they must also obey a protocol."
$nl
"Layout queries:"
-{ $subsection section-fits? }
-{ $subsection indent-section? }
-{ $subsection unindent-first-line? }
-{ $subsection newline-after? }
-{ $subsection short-section? }
+{ $subsections
+ section-fits?
+ indent-section?
+ unindent-first-line?
+ newline-after?
+ short-section?
+}
"Printing sections:"
-{ $subsection short-section }
-{ $subsection long-section }
+{ $subsections
+ short-section
+ long-section
+}
"Utilities to use when implementing sections:"
-{ $subsection new-section }
-{ $subsection new-block }
-{ $subsection add-section } ;
+{ $subsections
+ new-section
+ new-block
+ add-section
+} ;
ARTICLE: "prettyprint-sections" "Prettyprinter sections"
"The prettyprinter's formatting engine can be used directly:"
-{ $subsection with-pprint }
+{ $subsections with-pprint }
"Code in a " { $link with-pprint } " block or a method on " { $link pprint* } " can build up a tree of " { $emphasis "sections" } ". A section is either a text node or a " { $emphasis "block" } " which itself consists of sections."
$nl
"Once the output sections have been generated, the tree of sections is traversed and intelligent decisions are made about indentation and line breaks. Finally, text is output."
-{ $subsection section }
+{ $subsections section }
"Adding leaf sections:"
-{ $subsection line-break }
-{ $subsection text }
-{ $subsection styled-text }
+{ $subsections
+ line-break
+ text
+ styled-text
+}
"Nesting and denesting sections:"
-{ $subsection <object }
-{ $subsection <block }
-{ $subsection <inset }
-{ $subsection <flow }
-{ $subsection <colon }
-{ $subsection block> }
+{ $subsections
+ <object
+ <block
+ <inset
+ <flow
+ <colon
+ block>
+}
"New types of sections can be defined."
-{ $subsection "prettyprint-section-protocol" } ;
+{ $subsections "prettyprint-section-protocol" } ;
ARTICLE: "prettyprint-literal" "Literal prettyprinting protocol"
"Most custom data types have a literal syntax which resembles a sequence. An easy way to define such a syntax is to add a method to the " { $link pprint* } " generic word which calls " { $link pprint-object } ", and then to provide methods on two other generic words:"
-{ $subsection pprint-delims }
-{ $subsection >pprint-sequence }
+{ $subsections
+ pprint-delims
+ >pprint-sequence
+}
"For example, consider the following data type, together with a parsing word for creating literals:"
{ $code
"TUPLE: rect w h ;"
ARTICLE: "prettyprint-literal-more" "Prettyprinting more complex literals"
"If the " { $link "prettyprint-literal" } " is insufficient, a method can be defined to control prettyprinting directly:"
-{ $subsection pprint* }
+{ $subsections pprint* }
"Some utilities which can be called from methods on " { $link pprint* } ":"
-{ $subsection pprint-object }
-{ $subsection pprint-word }
-{ $subsection pprint-elements }
-{ $subsection pprint-string }
-{ $subsection pprint-prefix }
+{ $subsections
+ pprint-object
+ pprint-word
+ pprint-elements
+ pprint-string
+ pprint-prefix
+}
"Custom methods defined on " { $link pprint* } " do not perform I/O directly, instead they call prettyprinter words to construct " { $emphasis "sections" } " of output. See " { $link "prettyprint-sections" } "." ;
ARTICLE: "prettyprint-extension" "Extending the prettyprinter"
"One can define literal syntax for a new class using the " { $link "parser" } " together with corresponding prettyprinting methods which print instances of the class using this syntax."
-{ $subsection "prettyprint-literal" }
-{ $subsection "prettyprint-literal-more" }
+{ $subsections
+ "prettyprint-literal"
+ "prettyprint-literal-more"
+}
"The prettyprinter actually exposes a general source code output engine and is not limited to printing object structure."
-{ $subsection "prettyprint-sections" } ;
+{ $subsections "prettyprint-sections" } ;
ARTICLE: "prettyprint" "The prettyprinter"
"One of Factor's key features is the ability to print almost any object as a valid source literal expression. This greatly aids debugging and provides the building blocks for light-weight object serialization facilities."
"Prettyprinter words are found in the " { $vocab-link "prettyprint" } " vocabulary."
$nl
"The key words to print an object to " { $link output-stream } "; the first two emit a trailing newline, the second two do not:"
-{ $subsection . }
-{ $subsection short. }
-{ $subsection pprint }
-{ $subsection pprint-short }
-{ $subsection pprint-use }
+{ $subsections
+ .
+ short.
+ pprint
+ pprint-short
+ pprint-use
+}
"The string representation of an object can be requested:"
-{ $subsection unparse }
-{ $subsection unparse-use }
+{ $subsections
+ unparse
+ unparse-use
+}
"Utility for tabular output:"
-{ $subsection pprint-cell }
+{ $subsections pprint-cell }
"More prettyprinter usage:"
-{ $subsection "prettyprint-numbers" }
-{ $subsection "prettyprint-stacks" }
+{ $subsections
+ "prettyprint-numbers"
+ "prettyprint-stacks"
+}
"Prettyprinter customization:"
-{ $subsection "prettyprint-variables" }
-{ $subsection "prettyprint-extension" }
-{ $subsection "prettyprint-limitations" }
+{ $subsections
+ "prettyprint-variables"
+ "prettyprint-extension"
+ "prettyprint-limitations"
+}
{ $see-also "number-strings" "see" } ;
ABOUT: "prettyprint"
{ $description "Outputs an integer in octal." } ;
HELP: .h
-{ $values { "n" "an integer" } }
-{ $description "Outputs an integer in hexadecimal." } ;
+{ $values { "n" "an integer or floating-point value" } }
+{ $description "Outputs an integer or floating-point value in hexadecimal." } ;
HELP: stack.
{ $values { "seq" "a sequence" } }
IN: prettyprint.tests
[ "4" ] [ 4 unparse ] unit-test
+[ "4096" ] [ 4096 unparse ] unit-test
+[ "BIN: 1000000000000" ] [ 2 number-base [ 4096 unparse ] with-variable ] unit-test
+[ "OCT: 10000" ] [ 8 number-base [ 4096 unparse ] with-variable ] unit-test
+[ "HEX: 1000" ] [ 16 number-base [ 4096 unparse ] with-variable ] unit-test
[ "1.0" ] [ 1.0 unparse ] unit-test
+[ "8.0" ] [ 8.0 unparse ] unit-test
+[ "8.0" ] [ 2 number-base [ 8.0 unparse ] with-variable ] unit-test
+[ "8.0" ] [ 8 number-base [ 8.0 unparse ] with-variable ] unit-test
+[ "HEX: 1.0p3" ] [ 16 number-base [ 8.0 unparse ] with-variable ] unit-test
[ "1267650600228229401496703205376" ] [ 1 100 shift unparse ] unit-test
[ "+" ] [ \ + unparse ] unit-test
--- /dev/null
+! Copyright (C) 2009 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel words ;
+IN: prettyprint.stylesheet
+
+HELP: effect-style
+{ $values
+ { "effect" "an effect" }
+ { "style" "a style assoc" }
+}
+{ $description "The styling hook for stack effects" } ;
+
+HELP: string-style
+{ $values
+ { "str" "a string" }
+ { "style" "a style assoc" }
+}
+{ $description "The styling hook for string literals" } ;
+
+HELP: vocab-style
+{ $values
+ { "vocab" "a vocabulary specifier" }
+ { "style" "a style assoc" }
+}
+{ $description "The styling hook for vocab names" } ;
+
+HELP: word-style
+{ $values
+ { "word" "a word" }
+ { "style" "a style assoc" }
+}
+{ $description "The styling hook for word names" } ;
+
+ARTICLE: "prettyprint.stylesheet" "Prettyprinter Formatted Output"
+{ $vocab-link "prettyprint.stylesheet" }
+$nl
+"Control the way that the prettyprinter formats output based on object type. These hooks form a basic \"syntax\" highlighting system."
+{ $subsections
+ word-style
+ string-style
+ vocab-style
+ effect-style
+}
+;
+
+ABOUT: "prettyprint.stylesheet"
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs colors colors.constants combinators
+combinators.short-circuit hashtables io.styles kernel literals
+namespaces sequences words words.symbol ;
+IN: prettyprint.stylesheet
+
+<PRIVATE
+
+CONSTANT: dim-color COLOR: gray35
+
+{ POSTPONE: USING: POSTPONE: USE: POSTPONE: IN: }
+[
+ { { foreground $ dim-color } }
+ "word-style" set-word-prop
+] each
+
+PREDICATE: highlighted-word < word [ parsing-word? ] [ delimiter? ] bi or ;
+
+PRIVATE>
+
+GENERIC: word-style ( word -- style )
+
+M: word word-style
+ [ presented associate ]
+ [ "word-style" word-prop >hashtable ] bi assoc-union ;
+
+M: highlighted-word word-style
+ call-next-method COLOR: DarkSlateGray foreground associate
+ swap assoc-union ;
+
+<PRIVATE
+
+: colored-presentation-style ( obj color -- style )
+ [ presented associate ] [ foreground associate ] bi* assoc-union ;
+
+PRIVATE>
+
+: string-style ( str -- style )
+ COLOR: LightSalmon4 colored-presentation-style ;
+
+: vocab-style ( vocab -- style )
+ dim-color colored-presentation-style ;
+
+: effect-style ( effect -- style )
+ presented associate stack-effect-style get assoc-union ;
--- /dev/null
+prettyprinter syntax highlighting and formatted output
ARTICLE: "quoted-printable" "Quoted printable encoding"
"The " { $vocab-link "quoted-printable" } " vocabulary implements RFC 2045 part 6.7, providing words for reading and generating quotable printed text."
-{ $subsection >quoted }
-{ $subsection >quoted-lines }
-{ $subsection quoted> } ;
+{ $subsections
+ >quoted
+ >quoted-lines
+ quoted>
+} ;
HELP: >quoted
{ $values { "byte-array" byte-array } { "string" string } }
! Copyright (C) 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test quoted-printable multiline io.encodings.string
+USING: tools.test quoted-printable io.encodings.string
sequences io.encodings.8-bit splitting kernel ;
IN: quoted-printable.tests
-[ <" José was the
+[ """José was the
person who knew how to write the letters:
ő and ü
-and we didn't know hów tö do thât"> ]
-[ <" Jos=E9 was the
+and we didn't know hów tö do thât""" ]
+[ """Jos=E9 was the
person who knew how to write the letters:
=F5 and =FC=20
and w=
-e didn't know h=F3w t=F6 do th=E2t"> quoted> latin2 decode ] unit-test
+e didn't know h=F3w t=F6 do th=E2t""" quoted> latin2 decode ] unit-test
-[ <" Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t"> ]
-[ <" José was the
+[ """Jos=E9 was the=0Aperson who knew how to write the letters:=0A =F5 and =FC=0Aand we didn't know h=F3w t=F6 do th=E2t""" ]
+[ """José was the
person who knew how to write the letters:
ő and ü
-and we didn't know hów tö do thât"> latin2 encode >quoted ] unit-test
+and we didn't know hów tö do thât""" latin2 encode >quoted ] unit-test
: message ( -- str )
55 [ "hello" ] replicate concat ;
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: random random.dummy tools.test ;
+IN: random.dummy.tests
+
+[ 10 ] [ 10 <random-dummy> random-32* ] unit-test
+[ 100 ] [ 10 <random-dummy> 100 seed-random random-32* ] unit-test
TUPLE: random-dummy i ;
C: <random-dummy> random-dummy
-M: random-dummy seed-random ( seed obj -- )
- (>>i) ;
+M: random-dummy seed-random ( obj seed -- obj )
+ >>i ;
M: random-dummy random-32* ( obj -- r )
[ dup 1 + ] change-i drop ;
[ 3 ] [ 101 [ 3 random-bytes length ] test-rng ] unit-test
[ 33 ] [ 101 [ 33 random-bytes length ] test-rng ] unit-test
[ t ] [ 101 [ 100 random-bits log2 90 > ] test-rng ] unit-test
+
+[ t ]
+[
+ 1234 <mersenne-twister>
+ [ random-32* ] [ 1234 seed-random random-32* ] bi =
+] unit-test
! See http://factorcode.org/license.txt for BSD license.
! mersenne twister based on
! http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
-USING: kernel math namespaces sequences sequences.private system
-init accessors math.ranges random math.bitwise combinators
-specialized-arrays.uint fry ;
+USING: alien.c-types kernel math namespaces sequences
+sequences.private system init accessors math.ranges random
+math.bitwise combinators specialized-arrays fry ;
+SPECIALIZED-ARRAY: uint
IN: random.mersenne-twister
<PRIVATE
init-mt-seq 0 mersenne-twister boa
dup mt-generate ;
-M: mersenne-twister seed-random ( mt seed -- )
- init-mt-seq >>seq drop ;
+M: mersenne-twister seed-random ( mt seed -- mt' )
+ init-mt-seq >>seq
+ [ mt-generate ]
+ [ 0 >>i drop ]
+ [ ] tri ;
M: mersenne-twister random-32* ( mt -- r )
[ next-index ]
[ seq>> nth-unsafe mt-temper ]
[ [ 1 + ] change-i drop ] tri ;
-[
+: default-mersenne-twister ( -- mersenne-twister )
[ 32 random-bits ] with-system-random
- <mersenne-twister> random-generator set-global
+ <mersenne-twister> ;
+
+[
+ default-mersenne-twister random-generator set-global
] "bootstrap.random" add-init-hook
IN: random
HELP: seed-random
-{ $values { "tuple" "a random number generator" } { "seed" "an integer between 0 and 2^32-1" } }
-{ $description "Seed the random number generator." }
+{ $values
+ { "tuple" "a random number generator" }
+ { "seed" "a seed specific to the random number generator" }
+ { "tuple'" "a random number generator" }
+}
+{ $description "Seed the random number generator. Repeatedly seeding the random number generator should provide the same sequence of random numbers." }
{ $notes "Not supported on all random number generators." } ;
HELP: random-32*
"heads" }
} ;
+HELP: random-32
+{ $values { "n" "a 32-bit random integer" } }
+{ $description "Outputs 32 random bits. This word is more efficient than calling " { $link random } " because no scaling is done on the output." } ;
+
HELP: random-bytes
{ $values { "n" "an integer" } { "byte-array" "a random integer" } }
{ $description "Outputs an integer with n bytes worth of bits." }
}
{ $description "Randomizes a sequence in-place with the Fisher-Yates algorithm and returns the sequence." } ;
+HELP: sample
+{ $values
+ { "seq" sequence } { "n" integer }
+ { "seq'" sequence }
+}
+{ $description "Takes " { $snippet "n" } " samples at random without replacement from a sequence. Throws an error if " { $snippet "n" } " is longer than the sequence." }
+{ $examples
+ { $unchecked-example "USING: random prettyprint ; { 1 2 3 } 2 sample ."
+ "{ 3 2 }"
+ }
+} ;
+
HELP: delete-random
{ $values
{ "seq" sequence }
ARTICLE: "random-protocol" "Random protocol"
"A random number generator must implement one of these two words:"
-{ $subsection random-32* }
-{ $subsection random-bytes* }
+{ $subsections
+ random-32*
+ random-bytes*
+}
"Optional, to seed a random number generator:"
-{ $subsection seed-random } ;
+{ $subsections seed-random } ;
ARTICLE: "random" "Generating random integers"
"The " { $vocab-link "random" } " vocabulary contains a protocol for generating random or pseudorandom numbers."
"The “Mersenne Twister” pseudorandom number generator algorithm is the default generator stored in " { $link random-generator } "."
$nl
"Generate a random object:"
-{ $subsection random }
+{ $subsections random }
+"Efficient 32-bit random numbers:"
+{ $subsections random-32 }
"Combinators to change the random number generator:"
-{ $subsection with-random }
-{ $subsection with-system-random }
-{ $subsection with-secure-random }
+{ $subsections
+ with-random
+ with-system-random
+ with-secure-random
+}
"Implementation:"
-{ $subsection "random-protocol" }
+{ $subsections "random-protocol" }
"Randomizing a sequence:"
-{ $subsection randomize }
+{ $subsections randomize }
+"Sampling a sequences:"
+{ $subsections sample }
"Deleting a random element from a sequence:"
-{ $subsection delete-random }
+{ $subsections delete-random }
"Random numbers with " { $snippet "n" } " bits:"
-{ $subsection random-bits }
-{ $subsection random-bits* } ;
+{ $subsections
+ random-bits
+ random-bits*
+} ;
ABOUT: "random"
[ 100 [ { 0 1 } random ] replicate all-equal? ] unit-test
[ 49 ] [ 50 random-bits* log2 ] unit-test
+
+[ { 1 2 } 3 sample ] [ too-many-samples? ] must-fail-with
+
+[ 3 ] [ { 1 2 3 4 } 3 sample prune length ] unit-test
+[ 99 ] [ 100 99 sample prune length ] unit-test
+
+[ ]
+[ [ 100 random-bytes ] with-system-random drop ] unit-test
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel math namespaces sequences
-io.backend io.binary combinators system vocabs.loader
-summary math.bitwise byte-vectors fry byte-arrays
-math.ranges math.constants math.functions accessors ;
+USING: accessors alien.c-types assocs byte-arrays byte-vectors
+combinators fry io.backend io.binary kernel locals math
+math.bitwise math.constants math.functions math.ranges
+namespaces sequences sets summary system vocabs.loader ;
IN: random
SYMBOL: system-random-generator
SYMBOL: secure-random-generator
SYMBOL: random-generator
-GENERIC: seed-random ( tuple seed -- )
+GENERIC# seed-random 1 ( tuple seed -- tuple' )
GENERIC: random-32* ( tuple -- r )
GENERIC: random-bytes* ( n tuple -- byte-array )
[ 2drop ] [ random-32* 4 >le swap head over push-all ] if
] bi-curry bi* ;
-M: object random-32* ( tuple -- r ) 4 random-bytes* le> ;
+M: object random-32* ( tuple -- r ) 4 swap random-bytes* le> ;
ERROR: no-random-number-generator ;
[ length random-integer ] keep nth
] if-empty ;
+: random-32 ( -- n ) random-generator get random-32* ;
+
: randomize ( seq -- seq )
dup length [ dup 1 > ]
[ [ iota random ] [ 1 - ] bi [ pick exchange ] keep ]
while drop ;
+ERROR: too-many-samples seq n ;
+
+<PRIVATE
+
+:: next-sample ( length n seq hashtable -- elt )
+ n hashtable key? [
+ length n 1 + length mod seq hashtable next-sample
+ ] [
+ n hashtable conjoin
+ n seq nth
+ ] if ;
+
+PRIVATE>
+
+: sample ( seq n -- seq' )
+ 2dup [ length ] dip < [ too-many-samples ] when
+ swap [ length ] [ ] bi H{ } clone
+ '[ _ dup random _ _ next-sample ] replicate ;
+
: delete-random ( seq -- elt )
[ length random-integer ] keep [ nth ] 2keep delete-nth ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel random random.sfmt random.sfmt.private
+sequences tools.test ;
+IN: random.sfmt.tests
+
+[ ] [ 100 <sfmt-19937> drop ] unit-test
+
+[ 1096298955 ]
+[ 100 <sfmt-19937> dup generate dup generate uint-array>> first ] unit-test
+
+[ 2556114782 ]
+[ 100 <sfmt-19937> random-32* ] unit-test
+
+[ t ]
+[
+ 100 <sfmt-19937>
+ [ random-32* ]
+ [ 100 seed-random random-32* ] bi =
+] unit-test
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types kernel locals math math.ranges
+math.bitwise math.vectors math.vectors.simd random
+sequences specialized-arrays sequences.private classes.struct ;
+SIMD: uint
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: uint-4
+IN: random.sfmt
+
+<PRIVATE
+
+CONSTANT: state-multiplier 1812433253
+
+STRUCT: sfmt-state
+ { seed uint }
+ { n uint }
+ { m uint }
+ { ix uint }
+ { mask uint-4 }
+ { r1 uint-4 }
+ { r2 uint-4 } ;
+
+TUPLE: sfmt
+ { state sfmt-state }
+ { uint-array uint-array }
+ { uint-4-array uint-4-array } ;
+
+: wA ( w -- wA )
+ dup 1 hlshift vbitxor ; inline
+
+: wB ( w mask -- wB )
+ [ 11 vrshift ] dip vbitand ; inline
+
+: wC ( w -- wC )
+ 1 hrshift ; inline
+
+: wD ( w -- wD )
+ 18 vlshift ; inline
+
+: formula ( a b mask c d -- r )
+ [ wC ] dip wD vbitxor
+ [ wB ] dip vbitxor
+ [ wA ] dip vbitxor ; inline
+
+GENERIC: generate ( sfmt -- )
+
+M:: sfmt generate ( sfmt -- )
+ sfmt state>> :> state
+ sfmt uint-4-array>> :> array
+ state n>> 2 - array nth state (>>r1)
+ state n>> 1 - array nth state (>>r2)
+ state m>> :> m
+ state n>> :> n
+ state mask>> :> mask
+
+ n m - >fixnum iota [| i |
+ i array nth-unsafe
+ i m + array nth-unsafe
+ mask state r1>> state r2>> formula :> r
+
+ r i array set-nth-unsafe
+ state r2>> state (>>r1)
+ r state (>>r2)
+ ] each
+
+ ! n m - 1 + n [a,b) [
+ m 1 - iota [
+ n m - 1 + + >fixnum :> i
+ i array nth-unsafe
+ m n - i + array nth-unsafe
+ mask state r1>> state r2>> formula :> r
+
+ r i array set-nth-unsafe
+ state r2>> state (>>r1)
+ r state (>>r2)
+ ] each
+
+ 0 state (>>ix) ;
+
+: <sfmt-array> ( sfmt -- uint-array uint-4-array )
+ state>>
+ [ n>> 4 * iota >uint-array ] [ seed>> ] bi
+ [
+ [
+ [
+ [ -30 shift ] [ ] bi bitxor
+ state-multiplier * 32 bits
+ ] dip +
+ ] unless-zero 32 bits
+ ] uint-array{ } accumulate-as nip
+ dup underlying>> byte-array>uint-4-array ;
+
+: <sfmt-state> ( seed n m mask -- sfmt )
+ sfmt-state <struct>
+ swap >>mask
+ swap >>m
+ swap >>n
+ swap >>seed
+ 0 >>ix ;
+
+: init-sfmt ( sfmt -- sfmt' )
+ dup <sfmt-array> [ >>uint-array ] [ >>uint-4-array ] bi*
+ [ generate ] keep ; inline
+
+: <sfmt> ( seed n m mask -- sfmt )
+ <sfmt-state>
+ sfmt new
+ swap >>state
+ init-sfmt ; inline
+
+: refill-sfmt? ( sfmt -- ? )
+ state>> [ ix>> ] [ n>> 4 * ] bi >= ;
+
+: next-ix ( sfmt -- ix )
+ state>> [ dup 1 + ] change-ix drop ; inline
+
+: next ( sfmt -- n )
+ [ next-ix ] [ uint-array>> ] bi nth-unsafe ; inline
+
+PRIVATE>
+
+M: sfmt random-32* ( sfmt -- n )
+ dup refill-sfmt? [ dup generate ] when next ; inline
+
+M: sfmt seed-random ( sfmt seed -- sfmt )
+ [ [ state>> ] dip >>seed drop ]
+ [ drop init-sfmt ] 2bi ;
+
+: <sfmt-19937> ( seed -- sfmt )
+ 348 330 uint-4{ HEX: BFFFFFF6 HEX: BFFAFFFF HEX: DDFECB7F HEX: DFFFFFEF }
+ <sfmt> ; inline
-USING: accessors alien.c-types byte-arrays
+USING: accessors alien.c-types alien.data byte-arrays
combinators.short-circuit continuations destructors init kernel
locals namespaces random windows.advapi32 windows.errors
windows.kernel32 math.bitwise ;
ARTICLE: "refs" "References"
"References provide a uniform way of accessing and changing values. Some examples of referenced values are variables, tuple slots, and keys or values of assocs. References can be read, written, and deleted. References are defined in the " { $vocab-link "refs" } " vocabulary, and new reference types can be made by implementing a protocol."
-{ $subsection "refs-protocol" }
-{ $subsection "refs-impls" }
-{ $subsection "refs-utils" }
+{ $subsections
+ "refs-protocol"
+ "refs-impls"
+ "refs-utils"
+}
"References are used by the " { $link "ui-inspector" } "." ;
ABOUT: "refs"
ARTICLE: "refs-impls" "Reference implementations"
"References to objects:"
-{ $subsection obj-ref }
-{ $subsection <obj-ref> }
+{ $subsections
+ obj-ref
+ <obj-ref>
+}
"References to assoc keys:"
-{ $subsection key-ref }
-{ $subsection <key-ref> }
+{ $subsections
+ key-ref
+ <key-ref>
+}
"References to assoc values:"
-{ $subsection value-ref }
-{ $subsection <value-ref> }
+{ $subsections
+ value-ref
+ <value-ref>
+}
"References to variables:"
-{ $subsection var-ref }
-{ $subsection <var-ref> }
-{ $subsection global-var-ref }
-{ $subsection <global-var-ref> }
+{ $subsections
+ var-ref
+ <var-ref>
+ global-var-ref
+ <global-var-ref>
+}
"References to tuple slots:"
-{ $subsection slot-ref }
-{ $subsection <slot-ref> }
+{ $subsections
+ slot-ref
+ <slot-ref>
+}
"Using boxes as references:"
-{ $subsection "box-refs" } ;
+{ $subsections "box-refs" } ;
ARTICLE: "refs-utils" "Reference utilities"
-{ $subsection ref-on }
-{ $subsection ref-off }
-{ $subsection ref-inc }
-{ $subsection ref-dec }
-{ $subsection set-ref* } ;
+{ $subsections
+ ref-on
+ ref-off
+ ref-inc
+ ref-dec
+ set-ref*
+} ;
ARTICLE: "refs-protocol" "Reference protocol"
"To use a class of objects as references you must implement the reference protocol for that class, and mark your class as an instance of the " { $link ref } " mixin class. All references must implement these two words:"
-{ $subsection get-ref }
-{ $subsection set-ref }
+{ $subsections
+ get-ref
+ set-ref
+}
"References may also implement:"
-{ $subsection delete-ref } ;
+{ $subsections delete-ref } ;
ARTICLE: "box-refs" "Boxes as references"
{ $link "boxes" } " are elements of the " { $link ref } " mixin class, so any box may be used as a reference. Bear in mind that boxes will still throw an error if you call " { $link get-ref } " on an empty box." ;
ARTICLE: "regexp.combinators" "Regular expression combinators"
"The " { $vocab-link "regexp.combinators" } " vocabulary defines combinators which can be used to build up regular expressions to match strings. This complements the traditional syntax defined in the " { $vocab-link "regexp" } " vocabulary."
-{ $subsection "regexp.combinators.intro" }
+{ $subsections "regexp.combinators.intro" }
"Basic combinators:"
-{ $subsection <literal> }
-{ $subsection <nothing> }
+{ $subsections <literal> <nothing> }
"Higher-order combinators for building new regular expressions from existing ones:"
-{ $subsection <or> }
-{ $subsection <and> }
-{ $subsection <not> }
-{ $subsection <sequence> }
-{ $subsection <zero-or-more> }
+{ $subsections
+ <or>
+ <and>
+ <not>
+ <sequence>
+ <zero-or-more>
+}
"Derived combinators implemented in terms of the above:"
-{ $subsection <one-or-more> }
+{ $subsections <one-or-more> }
"Setting options:"
-{ $subsection <option> } ;
+{ $subsections <option> } ;
HELP: <literal>
{ $values { "string" string } { "regexp" regexp } }
! Copyright (C) 2008, 2009 Doug Coleman, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel strings help.markup help.syntax math regexp.parser
-regexp.ast multiline ;
+regexp.ast ;
IN: regexp
ABOUT: "regexp"
ARTICLE: "regexp" "Regular expressions"
"The " { $vocab-link "regexp" } " vocabulary provides word for creating and using regular expressions."
-{ $subsection { "regexp" "intro" } }
+{ $subsections { "regexp" "intro" } }
"The class of regular expressions:"
-{ $subsection regexp }
+{ $subsections regexp }
"Basic usage:"
-{ $subsection { "regexp" "syntax" } }
-{ $subsection { "regexp" "options" } }
-{ $subsection { "regexp" "construction" } }
-{ $subsection { "regexp" "operations" } }
+{ $subsections
+ { "regexp" "syntax" }
+ { "regexp" "options" }
+ { "regexp" "construction" }
+ { "regexp" "operations" }
+}
"Advanced topics:"
{ $vocab-subsection "Regular expression combinators" "regexp.combinators" }
-{ $subsection { "regexp" "theory" } }
-{ $subsection { "regexp" "deploy" } } ;
+{ $subsections
+ { "regexp" "theory" }
+ { "regexp" "deploy" }
+} ;
ARTICLE: { "regexp" "intro" } "A quick introduction to regular expressions"
"Regular expressions are a terse way to do certain simple string processing tasks. For example, to replace all instances of " { $snippet "foo" } " in one string with " { $snippet "bar" } ", the following can be used:"
"The " { $snippet "+" } " operator matches one or more occurrences of the previous expression; in this case " { $snippet "o" } ". Another useful feature is alternation. Say we want to do this replacement with fooooo or boooo. Then we could use the code"
{ $code "R/ (f|b)oo+/ \"bar\" re-replace" }
"To search a file for all lines that match a given regular expression, you could use code like this:"
-{ $code <" "file.txt" ascii file-lines [ R/ (f|b)oo+/ re-contains? ] filter "> }
+{ $code """"file.txt" ascii file-lines [ R/ (f|b)oo+/ re-contains? ] filter""" }
"To test if a string in its entirety matches a regular expression, the following can be used:"
-{ $example <" USE: regexp "fooo" R/ (b|f)oo+/ matches? . "> "t" }
+{ $example """USE: regexp "fooo" R/ (b|f)oo+/ matches? .""" "t" }
"Regular expressions can't be used for all parsing tasks. For example, they are not powerful enough to match balancing parentheses." ;
ARTICLE: { "regexp" "construction" } "Constructing regular expressions"
"Most of the time, regular expressions are literals and the parsing word should be used, to construct them at parse time. This ensures that they are only compiled once, and gives parse time syntax checking."
-{ $subsection POSTPONE: R/ }
+{ $subsections POSTPONE: R/ }
"Sometimes, regular expressions need to be constructed at run time instead; for example, in a text editor, the user might input a regular expression to search for in a document."
-{ $subsection <regexp> }
-{ $subsection <optioned-regexp> }
+{ $subsections <regexp> <optioned-regexp> }
"Another approach is to use " { $vocab-link "regexp.combinators" } "." ;
ARTICLE: { "regexp" "syntax" } "Regular expression syntax"
ARTICLE: { "regexp" "operations" } "Matching operations with regular expressions"
"Testing if a string matches a regular expression:"
-{ $subsection matches? }
+{ $subsections matches? }
"Finding a match inside a string:"
-{ $subsection re-contains? }
-{ $subsection first-match }
+{ $subsections re-contains? first-match }
"Finding all matches inside a string:"
-{ $subsection count-matches }
-{ $subsection all-matching-slices }
-{ $subsection all-matching-subseqs }
+{ $subsections
+ count-matches
+ all-matching-slices
+ all-matching-subseqs
+}
"Splitting a string into tokens delimited by a regular expression:"
-{ $subsection re-split }
+{ $subsections re-split }
"Replacing occurrences of a regular expression with a string:"
-{ $subsection re-replace } ;
+{ $subsections re-replace } ;
ARTICLE: { "regexp" "deploy" } "Regular expressions and the deploy tool"
"The " { $link "tools.deploy" } " tool has the option to strip out the optimizing compiler from the resulting image. Since regular expressions compile to Factor code, this creates a minor performance-related caveat."
ARTICLE: "roman" "Roman numerals"
"The " { $vocab-link "roman" } " vocabulary can convert numbers to and from the Roman numeral system and can perform arithmetic given Roman numerals as input." $nl
"A parsing word for literal Roman numerals:"
-{ $subsection POSTPONE: ROMAN: }
+{ $subsections POSTPONE: ROMAN: }
"Converting to Roman numerals:"
-{ $subsection >roman }
-{ $subsection >ROMAN }
+{ $subsections
+ >roman
+ >ROMAN
+}
"Converting Roman numerals to integers:"
-{ $subsection roman> }
+{ $subsections roman> }
"Roman numeral arithmetic:"
-{ $subsection roman+ }
-{ $subsection roman- }
-{ $subsection roman* }
-{ $subsection roman/i }
-{ $subsection roman/mod } ;
+{ $subsections
+ roman+
+ roman-
+ roman*
+ roman/i
+ roman/mod
+} ;
ABOUT: "roman"
"A search deque is a data structure with constant-time insertion and removal of elements at both ends, and constant-time membership tests. Inserting an element more than once has no effect. Search deques implement all deque operations in terms of an underlying deque, and membership testing with " { $link deque-member? } " is implemented with an underlying assoc. Search deques are defined in the " { $vocab-link "search-deques" } " vocabulary."
$nl
"Creating a search deque:"
-{ $subsection <search-deque> } ;
+{ $subsections <search-deque> } ;
ABOUT: "search-deques"
"The " { $vocab-link "see" } " vocabulary implements support for printing out " { $link "definitions" } " in the image."
$nl
"Printing a definition:"
-{ $subsection see }
+{ $subsections see }
"Printing the methods defined on a generic word or class (see " { $link "objects" } "):"
-{ $subsection see-methods }
+{ $subsections see-methods }
"Definition specifiers implementing the " { $link "definition-protocol" } " should also implement the " { $emphasis "see protocol" } ":"
-{ $subsection see* }
-{ $subsection synopsis* } ;
+{ $subsections
+ see*
+ synopsis*
+} ;
ABOUT: "see"
\ No newline at end of file
io.streams.string io.styles kernel make namespaces prettyprint
prettyprint.backend prettyprint.config prettyprint.custom
prettyprint.sections sequences sets sorting strings summary words
-words.symbol words.constant words.alias vocabs ;
+words.symbol words.constant words.alias vocabs slots ;
IN: see
GENERIC: synopsis* ( defspec -- )
: stack-effect. ( word -- )
[ print-stack-effect? ] [ stack-effect ] bi and
- [ effect>string comment. ] when* ;
+ [ pprint-effect ] when* ;
<PRIVATE
] tri ;
: seeing-implementors ( class -- seq )
- dup implementors [ method ] with map natural-sort ;
+ dup implementors
+ [ [ reader? ] [ writer? ] bi or not ] filter
+ [ method ] with map
+ natural-sort ;
: seeing-methods ( generic -- seq )
"methods" word-prop values natural-sort ;
-USING: help.markup help.syntax math multiline
+USING: help.markup help.syntax math
sequences sequences.complex-components ;
IN: sequences.complex-components
ARTICLE: "sequences.complex-components" "Complex component virtual sequences"
"The " { $link complex-components } " class wraps a sequence of " { $link complex } " number values, presenting a sequence of " { $link real } " values made by interleaving the real and imaginary parts of the complex values in the original sequence."
-{ $subsection complex-components }
-{ $subsection <complex-components> } ;
+{ $subsections
+ complex-components
+ <complex-components>
+} ;
ABOUT: "sequences.complex-components"
HELP: complex-components
{ $class-description "Sequence wrapper class that transforms a sequence of " { $link complex } " number values into a sequence of " { $link real } " values, interleaving the real and imaginary parts of the complex values in the original sequence." }
-{ $examples { $example <"
-USING: prettyprint sequences arrays sequences.complex-components ;
-{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> >array .
-"> "{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ;
+{ $examples { $example """USING: prettyprint sequences arrays sequences.complex-components ;
+{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> >array ."""
+"{ 1.0 -1.0 -2.0 0 3.0 1.0 }" } } ;
HELP: <complex-components>
{ $values { "sequence" sequence } { "complex-components" complex-components } }
{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-components } " wrapper." }
{ $examples
-{ $example <"
-USING: prettyprint sequences arrays
+{ $example """USING: prettyprint sequences arrays
sequences.complex-components ;
-{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> third .
-"> "-2.0" }
-{ $example <"
-USING: prettyprint sequences arrays
+{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> third ."""
+"-2.0" }
+{ $example """USING: prettyprint sequences arrays
sequences.complex-components ;
-{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> fourth .
-"> "0" }
+{ C{ 1.0 -1.0 } -2.0 C{ 3.0 1.0 } } <complex-components> fourth ."""
+"0" }
} ;
{ complex-components <complex-components> } related-words
-USING: help.markup help.syntax math multiline
-sequences sequences.complex ;
+USING: help.markup help.syntax math sequences
+sequences.complex ;
IN: sequences.complex
ARTICLE: "sequences.complex" "Complex virtual sequences"
"The " { $link complex-sequence } " class wraps a sequence of " { $link real } " number values, presenting a sequence of " { $link complex } " values made by treating the underlying sequence as pairs of alternating real and imaginary values."
-{ $subsection complex-sequence }
-{ $subsection <complex-sequence> } ;
+{ $subsections
+ complex-sequence
+ <complex-sequence>
+} ;
ABOUT: "sequences.complex"
HELP: complex-sequence
{ $class-description "Sequence wrapper class that transforms a sequence of " { $link real } " number values into a sequence of " { $link complex } " values, treating the underlying sequence as pairs of alternating real and imaginary values." }
-{ $examples { $example <"
-USING: prettyprint
-specialized-arrays.double sequences.complex
-sequences arrays ;
-double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array .
-"> "{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
+{ $examples { $example """USING: prettyprint specialized-arrays
+sequences.complex sequences alien.c-types arrays ;
+SPECIALIZED-ARRAY: double
+double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> >array ."""
+"{ C{ 1.0 -1.0 } C{ -2.0 2.0 } C{ 3.0 0.0 } }" } } ;
HELP: <complex-sequence>
{ $values { "sequence" sequence } { "complex-sequence" complex-sequence } }
{ $description "Wraps " { $snippet "sequence" } " in a " { $link complex-sequence } "." }
-{ $examples { $example <"
-USING: prettyprint
-specialized-arrays.double sequences.complex
-sequences arrays ;
-double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second .
-"> "C{ -2.0 2.0 }" } } ;
+{ $examples { $example """USING: prettyprint specialized-arrays
+sequences.complex sequences alien.c-types arrays ;
+SPECIALIZED-ARRAY: double
+double-array{ 1.0 -1.0 -2.0 2.0 3.0 0.0 } <complex-sequence> second ."""
+"C{ -2.0 2.0 }" } } ;
{ complex-sequence <complex-sequence> } related-words
-USING: specialized-arrays.float sequences.complex
+USING: specialized-arrays sequences.complex
kernel sequences tools.test arrays accessors ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
IN: sequences.complex.tests
: test-array ( -- x )
ARTICLE: "sequences.deep" "Deep sequence combinators"
"The combinators in the " { $vocab-link "sequences.deep" } " vocabulary are variants of standard sequence combinators which traverse nested subsequences."
-{ $subsection deep-each }
-{ $subsection deep-map }
-{ $subsection deep-filter }
-{ $subsection deep-find }
-{ $subsection deep-any? }
-{ $subsection deep-change-each }
+{ $subsections
+ deep-each
+ deep-map
+ deep-filter
+ deep-find
+ deep-any?
+ deep-change-each
+}
"A utility word to collapse nested subsequences:"
-{ $subsection flatten } ;
+{ $subsections flatten } ;
ABOUT: "sequences.deep"
"The " { $vocab-link "serialize" } " vocabulary implements binary serialization for all Factor data types except for continuations. Unlike the prettyprinter, shared structure and circularity is preserved."
$nl
"Storing objects on streams:"
-{ $subsection serialize }
-{ $subsection deserialize }
+{ $subsections
+ serialize
+ deserialize
+}
"Storing objects as byte arrays:"
-{ $subsection object>bytes }
-{ $subsection bytes>object } ;
+{ $subsections
+ object>bytes
+ bytes>object
+} ;
ABOUT: "serialize"
! See http://factorcode.org/license.txt for BSD license.
!
USING: tools.test kernel serialize io io.streams.byte-array
-alien arrays byte-arrays bit-arrays specialized-arrays.double
+alien arrays byte-arrays bit-arrays specialized-arrays
sequences math prettyprint parser classes math.constants
-io.encodings.binary random assocs serialize.private ;
+io.encodings.binary random assocs serialize.private alien.c-types ;
+SPECIALIZED-ARRAY: double
IN: serialize.tests
: test-serialize-cell ( a -- ? )
ARTICLE: "simple-flat-file" "Parsing simple flat files"
"The " { $vocab-link "simple-flat-file" } " vocabulary provides words for loading and parsing simple flat files in a particular format which is common for encoding and Unicode tasks."
-{ $subsection flat-file>biassoc }
-{ $subsection load-interval-file }
-{ $subsection data } ;
+{ $subsections
+ flat-file>biassoc
+ load-interval-file
+ data
+} ;
HELP: load-interval-file
{ $values { "filename" string } { "table" "an interval map" } }
"The " { $vocab-link "smtp" } " vocabulary sends e-mail via an SMTP server."
$nl
"This library is configured by a set of dynamically-scoped variables:"
-{ $subsection smtp-server }
-{ $subsection smtp-tls? }
-{ $subsection smtp-read-timeout }
-{ $subsection smtp-domain }
-{ $subsection smtp-auth }
+{ $subsections
+ smtp-server
+ smtp-tls?
+ smtp-read-timeout
+ smtp-domain
+ smtp-auth
+}
"The latter is set to an instance of one of the following:"
-{ $subsection no-auth }
-{ $subsection plain-auth }
+{ $subsections
+ no-auth
+ plain-auth
+}
"Constructing an e-mail:"
-{ $subsection email }
-{ $subsection <email> }
+{ $subsections
+ email
+ <email>
+}
"Sending an email:"
-{ $subsection send-email }
+{ $subsections send-email }
"More topics:"
-{ $subsection "smtp-gmail" } ;
+{ $subsections "smtp-gmail" } ;
ABOUT: "smtp"
ARTICLE: "sorting.human" "Human-friendly sorting"
"The " { $vocab-link "sorting.human" } " vocabulary sorts by numbers as a human would -- by comparing their magnitudes -- rather than in a lexicographic way. For example, sorting a1, a10, a03, a2 with human sort returns a1, a2, a03, a10, while sorting with natural sort returns a03, a1, a10, a2." $nl
"Comparing two objects:"
-{ $subsection human<=> }
-{ $subsection human>=< }
+{ $subsections
+ human<=>
+ human>=<
+}
"Splitting a string into substrings and integers:"
-{ $subsection find-numbers } ;
+{ $subsections find-numbers } ;
ABOUT: "sorting.human"
ARTICLE: "sorting.slots" "Sorting by slots"
"The " { $vocab-link "sorting.slots" } " vocabulary can sort tuples by slot in ascending or descending order, using subsequent slots as tie-breakers." $nl
"Comparing two objects by a sequence of slots:"
-{ $subsection compare-slots }
+{ $subsections compare-slots }
"Sorting a sequence of tuples by a slot/comparator pairs:"
-{ $subsection sort-by }
-{ $subsection sort-keys-by }
-{ $subsection sort-values-by } ;
+{ $subsections
+ sort-by
+ sort-keys-by
+ sort-values-by
+} ;
ABOUT: "sorting.slots"
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.alien
-
-<< "void*" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.bool
-
-<< "bool" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.char
-
-<< "char" define-array >>
\ No newline at end of file
+++ /dev/null
-USING: kernel sequences specialized-arrays.complex-double tools.test ;
-IN: specialized-arrays.complex-double.tests
-
-[ C{ 3.0 2.0 } ]
-[ complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 } second ] unit-test
-
-[ C{ 1.0 0.0 } ]
-[ complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 } first ] unit-test
-
-[ complex-double-array{ 1.0 C{ 6.0 -7.0 } 5.0 } ] [
- complex-double-array{ 1.0 C{ 3.0 2.0 } 5.0 }
- dup [ C{ 6.0 -7.0 } 1 ] dip set-nth
-] unit-test
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.complex-double
-
-<< "complex-double" define-array >>
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.complex-float
-
-<< "complex-float" define-array >>
+++ /dev/null
-USING: specialized-arrays.alien specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.alien
-
-<< "void*" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.bool specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.bool
-
-<< "bool" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.char specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.char
-
-<< "char" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.complex-double specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.complex-double
-
-<< "complex-double" define-direct-array >>
+++ /dev/null
-USING: specialized-arrays.complex-float specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.complex-float
-
-<< "complex-float" define-direct-array >>
+++ /dev/null
-USING: help.markup help.syntax byte-arrays alien ;
-IN: specialized-arrays.direct
-
-ARTICLE: "specialized-arrays.direct" "Direct-mapped specialized arrays"
-"The " { $vocab-link "specialized-arrays.direct" } " vocabulary implements fixed-length sequence types for storing machine values in unmanaged C memory."
-$nl
-"For each primitive C type " { $snippet "T" } ", a set of words are defined:"
-{ $table
- { { $snippet "direct-T-array" } { "The class of direct arrays with elements of type " { $snippet "T" } } }
- { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( alien len -- array )" } } }
-}
-"Each direct array has a " { $slot "underlying" } " slot holding an " { $link simple-alien } " pointer to the raw data. This data can be passed to C functions."
-$nl
-"The primitive C types for which direct arrays exist:"
-{ $list
- { $snippet "char" }
- { $snippet "uchar" }
- { $snippet "short" }
- { $snippet "ushort" }
- { $snippet "int" }
- { $snippet "uint" }
- { $snippet "long" }
- { $snippet "ulong" }
- { $snippet "longlong" }
- { $snippet "ulonglong" }
- { $snippet "float" }
- { $snippet "double" }
- { $snippet "void*" }
- { $snippet "bool" }
-}
-"Direct arrays are generated with a functor in the " { $vocab-link "specialized-arrays.direct.functor" } " vocabulary." ;
-
-ABOUT: "specialized-arrays.direct"
+++ /dev/null
-IN: specialized-arrays.direct.tests
-USING: specialized-arrays.direct.ushort tools.test
-specialized-arrays.ushort alien.syntax sequences ;
-
-[ ushort-array{ 0 0 0 } ] [
- 3 ALIEN: 123 100 <direct-ushort-array> new-sequence
-] unit-test
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-IN: specialized-arrays.direct
+++ /dev/null
-USING: specialized-arrays.double specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.double
-
-<< "double" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.float specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.float
-
-<< "float" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: functors sequences sequences.private kernel words classes
-math alien alien.c-types byte-arrays accessors
-specialized-arrays prettyprint.custom ;
-IN: specialized-arrays.direct.functor
-
-FUNCTOR: define-direct-array ( T -- )
-
-A' IS ${T}-array
-S IS ${T}-sequence
->A' IS >${T}-array
-<A'> IS <${A'}>
-A'{ IS ${A'}{
-
-A DEFINES-CLASS direct-${T}-array
-<A> DEFINES <${A}>
-
-NTH [ T dup c-type-getter-boxer array-accessor ]
-SET-NTH [ T dup c-setter array-accessor ]
-
-WHERE
-
-TUPLE: A
-{ underlying c-ptr read-only }
-{ length fixnum read-only } ;
-
-: <A> ( alien len -- direct-array ) A boa ; inline
-M: A length length>> ; inline
-M: A nth-unsafe underlying>> NTH call ; inline
-M: A set-nth-unsafe underlying>> SET-NTH call ; inline
-M: A like drop dup A instance? [ >A' ] unless ; inline
-M: A new-sequence drop <A'> ; inline
-
-M: A byte-length length>> T heap-size * ; inline
-
-M: A pprint-delims drop \ A'{ \ } ;
-
-M: A >pprint-sequence ;
-
-M: A pprint* pprint-object ;
-
-INSTANCE: A sequence
-INSTANCE: A S
-
-T c-type
- \ A >>direct-array-class
- \ <A> >>direct-array-constructor
- drop
-
-;FUNCTOR
+++ /dev/null
-Code generation for direct specialized arrays
+++ /dev/null
-USING: specialized-arrays.int specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.int
-
-<< "int" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.long specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.long
-
-<< "long" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.longlong specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.longlong
-
-<< "longlong" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.short specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.short
-
-<< "short" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.uchar specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.uchar
-
-<< "uchar" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.uint specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.uint
-
-<< "uint" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.ulong specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.ulong
-
-<< "ulong" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.ulonglong specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.ulonglong
-
-<< "ulonglong" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-arrays.ushort specialized-arrays.direct.functor ;
-IN: specialized-arrays.direct.ushort
-
-<< "ushort" define-direct-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.double
-
-<< "double" define-array >>
-
-! Specializer hints. These should really be generalized, and placed
-! somewhere else
-USING: hints math.vectors arrays kernel math accessors sequences ;
-
-HINTS: <double-array> { 2 } { 3 } ;
-
-HINTS: (double-array) { 2 } { 3 } ;
-
-! Type functions
-USING: words classes.algebra compiler.tree.propagation.info
-math.intervals ;
-
-\ norm-sq [
- class>> double-array class<= [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
-] "outputs" set-word-prop
-
-\ distance [
- [ class>> double-array class<= ] both?
- [ float 0. 1/0. [a,b] <class/interval-info> ] [ object-info ] if
-] "outputs" set-word-prop
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.float
-
-<< "float" define-array >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: functors sequences sequences.private prettyprint.custom
-kernel words classes math math.vectors.specialization parser
-alien.c-types byte-arrays accessors summary ;
-IN: specialized-arrays.functor
-
-ERROR: bad-byte-array-length byte-array type ;
-
-M: bad-byte-array-length summary
- drop "Byte array length doesn't divide type width" ;
-
-: (c-array) ( n c-type -- array )
- heap-size * (byte-array) ; inline
-
-: <c-array> ( n type -- array )
- heap-size * <byte-array> ; inline
-
-FUNCTOR: define-array ( T -- )
-
-A DEFINES-CLASS ${T}-array
-S DEFINES-CLASS ${T}-sequence
-<A> DEFINES <${A}>
-(A) DEFINES (${A})
->A DEFINES >${A}
-byte-array>A DEFINES byte-array>${A}
-A{ DEFINES ${A}{
-
-NTH [ T dup c-type-getter-boxer array-accessor ]
-SET-NTH [ T dup c-setter array-accessor ]
-
-WHERE
-
-MIXIN: S
-
-TUPLE: A
-{ length array-capacity read-only }
-{ underlying byte-array read-only } ;
-
-: <A> ( n -- specialized-array ) dup T <c-array> A boa ; inline
-
-: (A) ( n -- specialized-array ) dup T (c-array) A boa ; inline
-
-: byte-array>A ( byte-array -- specialized-array )
- dup length T heap-size /mod 0 = [ drop T bad-byte-array-length ] unless
- swap A boa ; inline
-
-M: A clone [ length>> ] [ underlying>> clone ] bi A boa ; inline
-
-M: A length length>> ; inline
-
-M: A nth-unsafe underlying>> NTH call ; inline
-
-M: A set-nth-unsafe underlying>> SET-NTH call ; inline
-
-: >A ( seq -- specialized-array ) A new clone-like ;
-
-M: A like drop dup A instance? [ >A ] unless ; inline
-
-M: A new-sequence drop (A) ; inline
-
-M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
-
-M: A resize
- [ drop ] [
- [ T heap-size * ] [ underlying>> ] bi*
- resize-byte-array
- ] 2bi
- A boa ; inline
-
-M: A byte-length underlying>> length ; inline
-
-M: A pprint-delims drop \ A{ \ } ;
-
-M: A >pprint-sequence ;
-
-M: A pprint* pprint-object ;
-
-SYNTAX: A{ \ } [ >A ] parse-literal ;
-
-INSTANCE: A sequence
-INSTANCE: A S
-
-A T c-type-boxed-class specialize-vector-words
-
-T c-type
- \ A >>array-class
- \ <A> >>array-constructor
- \ S >>sequence-mixin-class
- drop
-
-;FUNCTOR
+++ /dev/null
-Code generation for specialized arrays
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.int
-
-<< "int" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.long
-
-<< "long" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.longlong
-
-<< "longlong" define-array >>
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel prettyprint.backend
+prettyprint.sections prettyprint.custom
+specialized-arrays ;
+IN: specialized-arrays.prettyprint
+
+: pprint-direct-array ( direct-array -- )
+ dup direct-array-syntax
+ [ [ underlying>> ] [ length>> ] bi [ pprint* ] bi@ ] pprint-prefix ;
+
+M: specialized-array pprint*
+ [ pprint-object ] [ pprint-direct-array ] pprint-c-object ;
+
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.alien
-
-<< "ptrdiff_t" define-array >>
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.short
-
-<< "short" define-array >>
\ No newline at end of file
-USING: help.markup help.syntax byte-arrays ;
+USING: help.markup help.syntax byte-arrays alien ;
IN: specialized-arrays
-ARTICLE: "specialized-arrays" "Specialized arrays"
-"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
-$nl
-"For each primitive C type " { $snippet "T" } ", a set of words are defined in the vocabulary named " { $snippet "specialized-arrays.T" } ":"
+HELP: SPECIALIZED-ARRAY:
+{ $syntax "SPECIALIZED-ARRAY: type" }
+{ $values { "type" "a C type" } }
+{ $description "Brings a specialized array for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-array-words" } "." } ;
+
+ARTICLE: "specialized-array-words" "Specialized array words"
+"The " { $link POSTPONE: SPECIALIZED-ARRAY: } " parsing word generates the specialized array type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
{ $table
{ { $snippet "T-array" } { "The class of arrays with elements of type " { $snippet "T" } } }
{ { $snippet "<T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- array )" } } }
- { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
+ { { $snippet "(T-array)" } { "Constructor for arrays with elements of type " { $snippet "T" } ", where the initial contents are uninitialized; stack effect " { $snippet "( len -- array )" } } }
+ { { $snippet "malloc-T-array" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by newly-allocated unmanaged memory; stack effect " { $snippet "( alien len -- array )" } } }
+ { { $snippet "<direct-T-array>" } { "Constructor for arrays with elements of type " { $snippet "T" } " backed by raw memory; stack effect " { $snippet "( alien len -- array )" } } }
{ { $snippet "byte-array>T-array" } { "Converts a byte array into a specialized array by interpreting the bytes in as machine-specific values. Code which uses this word is unportable" } }
+ { { $snippet ">T-array" } { "Converts a sequence into a specialized array of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- array )" } } }
{ { $snippet "T-array{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
}
-"Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. This data can be passed to C functions."
+"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-arrays.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-ARRAY: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
+
+ARTICLE: "specialized-array-c" "Passing specialized arrays to C functions"
+"If a C function is declared as taking a parameter with a pointer or an array type (for example, " { $snippet "float*" } " or " { $snippet "int[3]" } "), instances of the relevant specialized array can be passed in."
$nl
-"The primitive C types for which specialized arrays exist:"
-{ $list
- { $snippet "char" }
- { $snippet "uchar" }
- { $snippet "short" }
- { $snippet "ushort" }
- { $snippet "int" }
- { $snippet "uint" }
- { $snippet "long" }
- { $snippet "ulong" }
- { $snippet "longlong" }
- { $snippet "ulonglong" }
- { $snippet "float" }
- { $snippet "double" }
- { $snippet "complex-float" }
- { $snippet "complex-double" }
- { $snippet "void*" }
- { $snippet "bool" }
+"C type specifiers for array types are documented in " { $link "c-types-specs" } "."
+$nl
+"Here is an example; as is common with C functions, the array length is passed in separately, since C does not offer a runtime facility to determine the array length of a base pointer:"
+{ $code
+ "USING: alien.syntax specialized-arrays ;"
+ "SPECIALIZED-ARRAY: int"
+ "FUNCTION: void process_data ( int* data, int len ) ;"
+ "int-array{ 10 20 30 } dup length process_data"
}
-"Note that " { $vocab-link "specialized-arrays.bool" } " behaves like a C " { $snippet "bool[]" } " array, and each element takes up 8 bits of space. For a more space-efficient boolean array, see " { $link "bit-arrays" } "."
+"Literal specialized arrays, as well as specialized arrays created with " { $snippet "<T-array>" } " and " { $snippet ">T-array" } " are backed by a " { $link byte-array } " in the Factor heap, and can move as a result of garbage collection. If this is unsuitable, the array can be allocated in unmanaged memory instead."
$nl
-"Specialized arrays are generated with a functor in the " { $vocab-link "specialized-arrays.functor" } " vocabulary."
+"In the following example, it is presumed that the C library holds on to a pointer to the array's data after the " { $snippet "init_with_data()" } " call returns; this is one situation where unmanaged memory has to be used instead. Note the use of destructors to ensure the memory is deallocated after the block ends:"
+{ $code
+ "USING: alien.syntax specialized-arrays ;"
+ "SPECIALIZED-ARRAY: float"
+ "FUNCTION: void init_with_data ( float* data, int len ) ;"
+ "FUNCTION: float compute_result ( ) ;"
+ "["
+ " 100 malloc-float-array &free"
+ " dup length init_with_data"
+ " compute_result"
+ "] with-destructors"
+}
+"Finally, sometimes a C library returns a pointer to an array in unmanaged memory, together with a length. In this case, a specialized array can be constructed to view this memory using " { $snippet "<direct-T-array>" } ":"
+{ $code
+ "USING: alien.c-types classes.struct ;"
+ ""
+ "STRUCT: device_info"
+ " { id int }"
+ " { name char* } ;"
+ ""
+ "FUNCTION: void get_device_info ( int* length ) ;"
+ ""
+ "0 <int> [ get_device_info ] keep <direct-int-array> ."
+}
+"For a full discussion of Factor heap allocation versus unmanaged memory allocation, see " { $link "byte-arrays-gc" } "."
+$nl
+"Each specialized array has a " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized array as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized array." ;
+
+ARTICLE: "specialized-array-math" "Vector arithmetic with specialized arrays"
+"Each specialized array with a numeric type generates specialized versions of the " { $link "math-vectors" } " words. The compiler substitutes calls for these words if it can statically determine input types. The " { $snippet "optimized." } " word in the " { $vocab-link "compiler.tree.debugger" } " vocabulary can be used to determine if this optimization is being performed for a particular piece of code." ;
+
+ARTICLE: "specialized-array-examples" "Specialized array examples"
+"Let's import specialized float arrays:"
+{ $code "USING: specialized-arrays math.constants math.functions ;" "SPECIALIZED-ARRAY: float" }
+"Creating a float array with 3 elements:"
+{ $code "1.0 [ sin ] [ cos ] [ tan ] tri float-array{ } 3sequence ." }
+"Create a float array and sum the elements:"
+{ $code
+ "1000 iota [ 1000 /f pi * sin ] float-array{ } map-as"
+ "0.0 [ + ] reduce ."
+} ;
+
+ARTICLE: "specialized-arrays" "Specialized arrays"
+"The " { $vocab-link "specialized-arrays" } " vocabulary implements fixed-length sequence types for storing machine values in a space-efficient manner without boxing."
$nl
-"The " { $vocab-link "specialized-vectors" } " vocabulary provides resizable versions of the above." ;
+"A specialized array type needs to be generated for each element type. This is done with a parsing word:"
+{ $subsections POSTPONE: SPECIALIZED-ARRAY: }
+"This parsing word adds new words to the search path, documented in the next section."
+{ $subsections
+ "specialized-array-words"
+ "specialized-array-c"
+ "specialized-array-math"
+ "specialized-array-examples"
+}
+"The " { $vocab-link "specialized-vectors" } " vocabulary provides a resizable version of this abstraction." ;
ABOUT: "specialized-arrays"
IN: specialized-arrays.tests
-USING: tools.test specialized-arrays sequences
-specialized-arrays.int specialized-arrays.bool
-specialized-arrays.ushort alien.c-types accessors kernel
-specialized-arrays.direct.int specialized-arrays.char
-specialized-arrays.uint arrays combinators ;
+USING: tools.test alien.syntax specialized-arrays
+specialized-arrays.private sequences alien.c-types accessors
+kernel arrays combinators compiler compiler.units classes.struct
+combinators.smart compiler.tree.debugger math libc destructors
+sequences.private multiline eval words vocabs namespaces
+assocs prettyprint alien.data math.vectors ;
+FROM: alien.c-types => float ;
+
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: bool
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: char
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: ulonglong
+
+[ ulonglong ] [ ulonglong-array{ } element-type ] unit-test
[ t ] [ { 1 2 3 } >int-array int-array? ] unit-test
[ { 3 1 3 3 7 } ] [
int-array{ 3 1 3 3 7 } malloc-byte-array 5 <direct-int-array> >array
-] unit-test
\ No newline at end of file
+] unit-test
+
+[ f ] [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] unit-test
+
+[ f ] [ [ float-array{ 4 3 2 1 } dup clone [ underlying>> ] bi@ eq? ] compile-call ] unit-test
+
+[ ushort-array{ 0 0 0 } ] [
+ 3 ALIEN: 123 100 <direct-ushort-array> new-sequence
+ dup [ drop 0 ] change-each
+] unit-test
+
+STRUCT: test-struct
+ { x int }
+ { y int } ;
+
+SPECIALIZED-ARRAY: test-struct
+
+[ 1 ] [
+ 1 test-struct-array{ } new-sequence length
+] unit-test
+
+[ V{ test-struct } ] [
+ [ [ test-struct-array <struct> ] test-struct-array{ } output>sequence first ] final-classes
+] unit-test
+
+: make-point ( x y -- struct )
+ test-struct <struct-boa> ;
+
+[ 5/4 ] [
+ 2 <test-struct-array>
+ 1 2 make-point over set-first
+ 3 4 make-point over set-second
+ 0 [ [ x>> ] [ y>> ] bi / + ] reduce
+] unit-test
+
+[ 5/4 ] [
+ [
+ 2 malloc-test-struct-array
+ dup &free drop
+ 1 2 make-point over set-first
+ 3 4 make-point over set-second
+ 0 [ [ x>> ] [ y>> ] bi / + ] reduce
+ ] with-destructors
+] unit-test
+
+[ ] [ ALIEN: 123 10 <direct-test-struct-array> drop ] unit-test
+
+[ ] [
+ [
+ 10 malloc-test-struct-array
+ &free drop
+ ] with-destructors
+] unit-test
+
+[ 15 ] [ 15 10 <test-struct-array> resize length ] unit-test
+
+[ S{ test-struct f 12 20 } ] [
+ test-struct-array{
+ S{ test-struct f 4 20 }
+ S{ test-struct f 12 20 }
+ S{ test-struct f 20 20 }
+ } second
+] unit-test
+
+! Regression
+STRUCT: fixed-string { text char[64] } ;
+
+SPECIALIZED-ARRAY: fixed-string
+
+[ { ALIEN: 100 ALIEN: 140 ALIEN: 180 ALIEN: 1c0 } ] [
+ ALIEN: 100 4 <direct-fixed-string-array> [ (underlying)>> ] { } map-as
+] unit-test
+
+! Ensure that byte-length works with direct arrays
+[ 400 ] [
+ ALIEN: 123 100 <direct-int-array> byte-length
+] unit-test
+
+! Test prettyprinting
+[ "int-array{ 1 2 3 }" ] [ int-array{ 1 2 3 } unparse ] unit-test
+[ "int-array@ f 100" ] [ f 100 <direct-int-array> unparse ] unit-test
+
+! If the C type doesn't exist, don't generate a vocab
+[ ] [
+ [ "__does_not_exist__" specialized-array-vocab forget-vocab ] with-compilation-unit
+ "__does_not_exist__" c-types get delete-at
+] unit-test
+
+[
+ """
+IN: specialized-arrays.tests
+USING: specialized-arrays ;
+
+SPECIALIZED-ARRAY: __does_not_exist__ """ eval( -- )
+] must-fail
+
+[ ] [
+ """
+IN: specialized-arrays.tests
+USING: alien.c-types classes.struct specialized-arrays ;
+
+STRUCT: __does_not_exist__ { x int } ;
+
+SPECIALIZED-ARRAY: __does_not_exist__
+""" eval( -- )
+] unit-test
+
+[ f ] [
+ "__does_not_exist__-array{"
+ "__does_not_exist__" specialized-array-vocab lookup
+ deferred?
+] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.data alien.parser
+assocs byte-arrays classes compiler.units functors kernel lexer
+libc math math.vectors math.vectors.specialization namespaces
+parser prettyprint.custom sequences sequences.private strings
+summary vocabs vocabs.loader vocabs.parser vocabs.generated
+words fry combinators present ;
IN: specialized-arrays
+
+MIXIN: specialized-array
+
+INSTANCE: specialized-array sequence
+
+GENERIC: direct-array-syntax ( obj -- word )
+
+ERROR: bad-byte-array-length byte-array type ;
+
+M: bad-byte-array-length summary
+ drop "Byte array length doesn't divide type width" ;
+
+: (underlying) ( n c-type -- array )
+ heap-size * (byte-array) ; inline
+
+: <underlying> ( n type -- array )
+ heap-size * <byte-array> ; inline
+
+<PRIVATE
+
+FUNCTOR: define-array ( T -- )
+
+A DEFINES-CLASS ${T}-array
+S DEFINES-CLASS ${T}-sequence
+<A> DEFINES <${A}>
+(A) DEFINES (${A})
+<direct-A> DEFINES <direct-${A}>
+malloc-A DEFINES malloc-${A}
+>A DEFINES >${A}
+byte-array>A DEFINES byte-array>${A}
+
+A{ DEFINES ${A}{
+A@ DEFINES ${A}@
+
+NTH [ T dup c-type-getter-boxer array-accessor ]
+SET-NTH [ T dup c-setter array-accessor ]
+
+WHERE
+
+MIXIN: S
+
+TUPLE: A
+{ underlying c-ptr read-only }
+{ length array-capacity read-only } ;
+
+: <direct-A> ( alien len -- specialized-array ) A boa ; inline
+
+: <A> ( n -- specialized-array )
+ [ \ T <underlying> ] keep <direct-A> ; inline
+
+: (A) ( n -- specialized-array )
+ [ \ T (underlying) ] keep <direct-A> ; inline
+
+: malloc-A ( len -- specialized-array )
+ [ \ T heap-size calloc ] keep <direct-A> ; inline
+
+: byte-array>A ( byte-array -- specialized-array )
+ >c-ptr dup length \ T heap-size /mod 0 =
+ [ drop \ T bad-byte-array-length ] unless
+ <direct-A> ; inline
+
+M: A clone [ underlying>> clone ] [ length>> ] bi <direct-A> ; inline
+
+M: A length length>> ; inline
+
+M: A nth-unsafe underlying>> NTH call ; inline
+
+M: A set-nth-unsafe underlying>> SET-NTH call ; inline
+
+: >A ( seq -- specialized-array ) A new clone-like ;
+
+M: A like drop dup A instance? [ >A ] unless ; inline
+
+M: A new-sequence drop (A) ; inline
+
+M: A equal? over A instance? [ sequence= ] [ 2drop f ] if ;
+
+M: A resize
+ [
+ [ \ T heap-size * ] [ underlying>> ] bi*
+ resize-byte-array
+ ] [ drop ] 2bi
+ <direct-A> ; inline
+
+M: A byte-length length \ T heap-size * ; inline
+
+M: A element-type drop \ T ; inline
+
+M: A direct-array-syntax drop \ A@ ;
+
+M: A pprint-delims drop \ A{ \ } ;
+
+M: A >pprint-sequence ;
+
+SYNTAX: A{ \ } [ >A ] parse-literal ;
+SYNTAX: A@ scan-object scan-object <direct-A> parsed ;
+
+INSTANCE: A specialized-array
+
+A T c-type-boxed-class f specialize-vector-words
+
+;FUNCTOR
+
+GENERIC: (underlying-type) ( c-type -- c-type' )
+
+M: string (underlying-type) c-types get at ;
+M: word (underlying-type) "c-type" word-prop ;
+
+: underlying-type ( c-type -- c-type' )
+ dup (underlying-type) {
+ { [ dup not ] [ drop no-c-type ] }
+ { [ dup c-type-name? ] [ nip underlying-type ] }
+ [ drop ]
+ } cond ;
+
+: underlying-type-name ( c-type -- name )
+ underlying-type present ;
+
+: specialized-array-vocab ( c-type -- vocab )
+ present "specialized-arrays.instances." prepend ;
+
+PRIVATE>
+
+: define-array-vocab ( type -- vocab )
+ underlying-type
+ [ specialized-array-vocab ] [ '[ _ define-array ] ] bi
+ generate-vocab ;
+
+M: c-type-name require-c-array define-array-vocab drop ;
+
+ERROR: specialized-array-vocab-not-loaded c-type ;
+
+M: c-type-name c-array-constructor
+ underlying-type-name
+ dup [ "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+M: c-type-name c-(array)-constructor
+ underlying-type-name
+ dup [ "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+M: c-type-name c-direct-array-constructor
+ underlying-type-name
+ dup [ "<direct-" "-array>" surround ] [ specialized-array-vocab ] bi lookup
+ [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable
+
+SYNTAX: SPECIALIZED-ARRAY:
+ scan-c-type define-array-vocab use-vocab ;
+
+"prettyprint" vocab [
+ "specialized-arrays.prettyprint" require
+] when
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.uchar
-
-<< "uchar" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.uint
-
-<< "uint" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.ulong
-
-<< "ulong" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.ulonglong
-
-<< "ulonglong" define-array >>
\ No newline at end of file
+++ /dev/null
-USE: specialized-arrays.functor
-IN: specialized-arrays.ushort
-
-<< "ushort" define-array >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.alien ;
-IN: specialized-vectors.alien
-
-<< "void*" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.bool ;
-IN: specialized-vectors.bool
-
-<< "bool" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.char ;
-IN: specialized-vectors.char
-
-<< "char" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.double ;
-IN: specialized-vectors.double
-
-<< "double" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.float ;
-IN: specialized-vectors.float
-
-<< "float" define-vector >>
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2008, 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types functors sequences sequences.private growable
-prettyprint.custom kernel words classes math parser ;
-QUALIFIED: vectors.functor
-IN: specialized-vectors.functor
-
-FUNCTOR: define-vector ( T -- )
-
-V DEFINES-CLASS ${T}-vector
-
-A IS ${T}-array
-S IS ${T}-sequence
-<A> IS <${A}>
-
->V DEFERS >${V}
-V{ DEFINES ${V}{
-
-WHERE
-
-V A <A> vectors.functor:define-vector
-
-M: V contract 2drop ;
-
-M: V byte-length underlying>> byte-length ;
-
-M: V pprint-delims drop \ V{ \ } ;
-
-M: V >pprint-sequence ;
-
-M: V pprint* pprint-object ;
-
-SYNTAX: V{ \ } [ >V ] parse-literal ;
-
-INSTANCE: V growable
-INSTANCE: V S
-
-;FUNCTOR
+++ /dev/null
-Code generation for specialized vectors
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.int ;
-IN: specialized-vectors.int
-
-<< "int" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.long ;
-IN: specialized-vectors.long
-
-<< "long" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.longlong ;
-IN: specialized-vectors.longlong
-
-<< "longlong" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.short ;
-IN: specialized-vectors.short
-
-<< "short" define-vector >>
\ No newline at end of file
-USING: help.markup help.syntax byte-vectors ;
+USING: help.markup help.syntax byte-vectors alien byte-arrays ;
IN: specialized-vectors
-ARTICLE: "specialized-vectors" "Specialized vectors"
-"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
-$nl
-"For each primitive C type " { $snippet "T" } ", a set of words are defined:"
+HELP: SPECIALIZED-VECTOR:
+{ $syntax "SPECIALIZED-VECTOR: type" }
+{ $values { "type" "a C type" } }
+{ $description "Brings a specialized vector for holding values of " { $snippet "type" } " into the vocabulary search path. The generated words are documented in " { $link "specialized-vector-words" } "." } ;
+
+ARTICLE: "specialized-vector-words" "Specialized vector words"
+"The " { $link POSTPONE: SPECIALIZED-VECTOR: } " parsing word generates the specialized vector type if it hasn't been generated already, and adds the following words to the vocabulary search path, where " { $snippet "T" } " is the C type in question:"
{ $table
{ { $snippet "T-vector" } { "The class of vectors with elements of type " { $snippet "T" } } }
{ { $snippet "<T-vector>" } { "Constructor for vectors with elements of type " { $snippet "T" } "; stack effect " { $snippet "( len -- vector )" } } }
{ { $snippet ">T-vector" } { "Converts a sequence into a specialized vector of type " { $snippet "T" } "; stack effect " { $snippet "( seq -- vector )" } } }
{ { $snippet "T-vector{" } { "Literal syntax, consists of a series of values terminated by " { $snippet "}" } } }
}
-"The primitive C types for which specialized vectors exist:"
-{ $list
- { $snippet "char" }
- { $snippet "uchar" }
- { $snippet "short" }
- { $snippet "ushort" }
- { $snippet "int" }
- { $snippet "uint" }
- { $snippet "long" }
- { $snippet "ulong" }
- { $snippet "longlong" }
- { $snippet "ulonglong" }
- { $snippet "float" }
- { $snippet "double" }
- { $snippet "void*" }
- { $snippet "bool" }
+"Behind the scenes, these words are placed in a vocabulary named " { $snippet "specialized-vectors.instances.T" } ", however this vocabulary should not be placed in a " { $link POSTPONE: USING: } " form directly. Instead, always use " { $link POSTPONE: SPECIALIZED-VECTOR: } ". This ensures that the vocabulary can get generated the first time it is needed." ;
+
+ARTICLE: "specialized-vector-c" "Passing specialized vectors to C functions"
+"Each specialized vector has a " { $slot "underlying" } " slot holding a specialized array, which in turn has an " { $slot "underlying" } " slot holding a " { $link byte-array } " with the raw data. Passing a specialized vector as a parameter to a C function call will automatically extract the underlying data. To get at the underlying data directly, call the " { $link >c-ptr } " word on a specialized vector." ;
+
+ARTICLE: "specialized-vectors" "Specialized vectors"
+"The " { $vocab-link "specialized-vectors" } " vocabulary implements resizable sequence types for storing machine values in a space-efficient manner without boxing."
+{ $subsections
+ "specialized-vector-words"
+ "specialized-vector-c"
}
-"Specialized vectors are generated with a functor in the " { $vocab-link "specialized-vectors.functor" } " vocabulary."
-$nl
-"The " { $vocab-link "specialized-arrays" } " vocabulary provides fixed-length versions of the above." ;
+"The " { $vocab-link "specialized-arrays" } " vocabulary provides a fixed-length version of this abstraction." ;
ABOUT: "specialized-vectors"
IN: specialized-vectors.tests
-USING: specialized-arrays.float
-specialized-vectors.float
-specialized-vectors.double
-tools.test kernel sequences ;
+USING: specialized-arrays specialized-vectors
+tools.test kernel sequences alien.c-types ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-VECTOR: float
+SPECIALIZED-VECTOR: double
[ 3 ] [ double-vector{ 1 2 } 3 over push length ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types assocs compiler.units functors
+growable kernel lexer namespaces parser prettyprint.custom
+sequences specialized-arrays specialized-arrays.private strings
+vocabs vocabs.parser vocabs.generated fry ;
+QUALIFIED: vectors.functor
IN: specialized-vectors
+
+<PRIVATE
+
+FUNCTOR: define-vector ( T -- )
+
+V DEFINES-CLASS ${T}-vector
+
+A IS ${T}-array
+S IS ${T}-sequence
+<A> IS <${A}>
+
+>V DEFERS >${V}
+V{ DEFINES ${V}{
+
+WHERE
+
+V A <A> vectors.functor:define-vector
+
+M: V contract 2drop ;
+
+M: V byte-length underlying>> byte-length ;
+
+M: V pprint-delims drop \ V{ \ } ;
+
+M: V >pprint-sequence ;
+
+M: V pprint* pprint-object ;
+
+SYNTAX: V{ \ } [ >V ] parse-literal ;
+
+INSTANCE: V growable
+INSTANCE: V S
+
+;FUNCTOR
+
+: specialized-vector-vocab ( type -- vocab )
+ "specialized-vectors.instances." prepend ;
+
+PRIVATE>
+
+: define-vector-vocab ( type -- vocab )
+ underlying-type
+ [ specialized-vector-vocab ] [ '[ _ define-vector ] ] bi
+ generate-vocab ;
+
+SYNTAX: SPECIALIZED-VECTOR:
+ scan
+ [ define-array-vocab use-vocab ]
+ [ define-vector-vocab use-vocab ] bi ;
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.uchar ;
-IN: specialized-vectors.uchar
-
-<< "uchar" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.uint ;
-IN: specialized-vectors.uint
-
-<< "uint" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.ulong ;
-IN: specialized-vectors.ulong
-
-<< "ulong" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.ulonglong ;
-IN: specialized-vectors.ulonglong
-
-<< "ulonglong" define-vector >>
\ No newline at end of file
+++ /dev/null
-USING: specialized-vectors.functor specialized-arrays.ushort ;
-IN: specialized-vectors.ushort
-
-<< "ushort" define-vector >>
\ No newline at end of file
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations classes sequences
-multiline ;
+USING: help.markup help.syntax kernel quotations classes sequences ;
IN: splitting.monotonic
HELP: monotonic-slice
{ $example
"USING: splitting.monotonic math prettyprint ;"
"{ 1 2 3 2 3 4 } [ < ] upward-slice monotonic-slice ."
- <" {
+ """{
T{ upward-slice
{ from 0 }
{ to 3 }
{ to 6 }
{ seq { 1 2 3 2 3 4 } }
}
-}">
+}"""
}
} ;
{ $example
"USING: splitting.monotonic math prettyprint ;"
"{ 1 2 3 3 2 1 } trends ."
- <" {
+ """{
T{ upward-slice
{ from 0 }
{ to 3 }
{ to 6 }
{ seq { 1 2 3 3 2 1 } }
}
-}">
+}"""
}
} ;
ARTICLE: "splitting.monotonic" "Splitting trending sequences"
"The " { $vocab-link "splitting.monotonic" } " vocabulary splits sequences that are trending downwards, upwards, or stably." $nl
"Splitting into sequences:"
-{ $subsection monotonic-split }
+{ $subsections monotonic-split }
"Splitting into slices:"
-{ $subsection monotonic-slice }
+{ $subsections monotonic-slice }
"Trending:"
-{ $subsection downward-slices }
-{ $subsection stable-slices }
-{ $subsection upward-slices }
-{ $subsection trends } ;
+{ $subsections
+ downward-slices
+ stable-slices
+ upward-slices
+ trends
+} ;
ABOUT: "splitting.monotonic"
: alien-stack ( params extra -- )
over parameters>> length + consume-d >>in-d
- dup return>> "void" = 0 1 ? produce-d >>out-d
+ dup return>> void? 0 1 ? produce-d >>out-d
drop ;
: return-prep-quot ( node -- quot )
USING: help.markup help.syntax kernel effects sequences
-sequences.private words ;
+sequences.private words combinators ;
IN: stack-checker.errors
+HELP: do-not-compile
+{ $error-description "Thrown when inference encounters a macro being applied to a value which is not known to be a literal. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
+{ $examples
+ "In this example, " { $link cleave } " is being applied to an array that is constructed on the fly. This is not allowed and fails to compile with a " { $link do-not-compile } " error:"
+ { $code
+ ": cannot-compile-call-example ( x -- y z )"
+ " [ 1 + ] [ 1 - ] 2array cleave ;"
+ }
+} ;
+
HELP: literal-expected
{ $error-description "Thrown when inference encounters a combinator or macro being applied to a value which is not known to be a literal, or constructed in a manner which can be analyzed statically. Such code needs changes before it can compile and run. See " { $link "inference-combinators" } " and " { $link "inference-escape" } " for details." }
{ $examples
- "In this example, words calling " { $snippet "literal-expected-example" } " will have a static stac keffect, even if " { $snippet "literal-expected-example" } " does not:"
+ "In this example, the words being defined cannot be called, because they fail to compile with a " { $link literal-expected } " error:"
+ { $code
+ ": bad-example ( quot -- )"
+ " [ call ] [ call ] bi ;"
+ ""
+ ": usage ( -- )"
+ " 10 [ 2 * ] bad-example . ;"
+ }
+ "One fix is to declare the combinator as inline:"
{ $code
- ": literal-expected-example ( quot -- )"
+ ": good-example ( quot -- )"
" [ call ] [ call ] bi ; inline"
+ ""
+ ": usage ( -- )"
+ " 10 [ 2 * ] good-example . ;"
+ }
+ "Another fix is to use " { $link POSTPONE: call( } ":"
+ { $code
+ ": good-example ( quot -- )"
+ " [ call( x -- y ) ] [ call( x -- y ) ] bi ;"
+ ""
+ ": usage ( -- )"
+ " 10 [ 2 * ] good-example . ;"
}
} ;
{ { $link "tools.inference" } " throws them as errors" }
{ "The " { $link "compiler" } " reports them via " { $link "tools.errors" } }
}
-"Error thrown when insufficient information is available to calculate the stack effect of a combinator call (see " { $link "inference-combinators" } "):"
-{ $subsection literal-expected }
+"Errors thrown when insufficient information is available to calculate the stack effect of a call to a combinator or macro (see " { $link "inference-combinators" } "):"
+{ $subsections
+ do-not-compile
+ literal-expected
+}
"Error thrown when a word's stack effect declaration does not match the composition of the stack effects of its factors:"
-{ $subsection effect-error }
+{ $subsections effect-error }
"Error thrown when branches have incompatible stack effects (see " { $link "inference-branches" } "):"
-{ $subsection unbalanced-branches-error }
+{ $subsections unbalanced-branches-error }
"Inference errors for inline recursive words (see " { $link "inference-recursive-combinators" } "):"
-{ $subsection undeclared-recursion-error }
-{ $subsection diverging-recursion-error }
-{ $subsection unbalanced-recursion-error }
-{ $subsection inconsistent-recursive-call-error }
+{ $subsections
+ undeclared-recursion-error
+ diverging-recursion-error
+ unbalanced-recursion-error
+ inconsistent-recursive-call-error
+}
"More obscure errors that are unlikely to arise in ordinary code:"
-{ $subsection recursive-quotation-error }
-{ $subsection too-many->r }
-{ $subsection too-many-r> }
-{ $subsection missing-effect } ;
+{ $subsections
+ recursive-quotation-error
+ too-many->r
+ too-many-r>
+ missing-effect
+} ;
ABOUT: "inference-errors"
! Copyright (C) 2004, 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: fry accessors alien alien.accessors arrays byte-arrays classes
-continuations.private effects generic hashtables
+USING: fry accessors alien alien.accessors arrays byte-arrays
+classes continuations.private effects generic hashtables
hashtables.private io io.backend io.files io.files.private
io.streams.c kernel kernel.private math math.private
math.parser.private memory memory.private namespaces
namespaces.private parser quotations quotations.private sbufs
sbufs.private sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
-classes.tuple.private vectors vectors.private words definitions assocs
-summary compiler.units system.private combinators
-combinators.short-circuit locals locals.backend locals.types
-combinators.private stack-checker.values
-generic.single generic.single.private
+classes.tuple.private vectors vectors.private words
+words.private definitions assocs summary compiler.units
+system.private combinators combinators.short-circuit locals
+locals.backend locals.types combinators.private
+stack-checker.values generic.single generic.single.private
alien.libraries
stack-checker.alien
stack-checker.state
\ float/f { float float } { float } define-primitive
\ float/f make-foldable
-\ float< { float float } { object } define-primitive
-\ float< make-foldable
-
\ float-mod { float float } { float } define-primitive
\ float-mod make-foldable
+\ float< { float float } { object } define-primitive
+\ float< make-foldable
+
\ float<= { float float } { object } define-primitive
\ float<= make-foldable
\ float>= { float float } { object } define-primitive
\ float>= make-foldable
-\ <word> { object object } { word } define-primitive
-\ <word> make-flushable
+\ float-u< { float float } { object } define-primitive
+\ float-u< make-foldable
+
+\ float-u<= { float float } { object } define-primitive
+\ float-u<= make-foldable
+
+\ float-u> { float float } { object } define-primitive
+\ float-u> make-foldable
+
+\ float-u>= { float float } { object } define-primitive
+\ float-u>= make-foldable
+
+\ (word) { object object object } { word } define-primitive
+\ (word) make-flushable
\ word-xt { word } { integer integer } define-primitive
\ word-xt make-flushable
ARTICLE: "tools.inference" "Stack effect tools"
{ $link "inference" } " can be used interactively to print stack effects of quotations without running them. It can also be used from " { $link "combinators.smart" } "."
-{ $subsection infer }
-{ $subsection infer. }
+{ $subsections
+ infer
+ infer.
+}
"There are also some words for working with " { $link effect } " instances. Getting a word's declared stack effect:"
-{ $subsection stack-effect }
+{ $subsections stack-effect }
"Converting a stack effect to a string form:"
-{ $subsection effect>string }
+{ $subsections effect>string }
"Comparing effects:"
-{ $subsection effect-height }
-{ $subsection effect<= }
-{ $subsection effect= }
+{ $subsections
+ effect-height
+ effect<=
+ effect=
+}
"The class of stack effects:"
-{ $subsection effect }
-{ $subsection effect? } ;
+{ $subsections
+ effect
+ effect?
+} ;
ARTICLE: "inference-escape" "Stack effect checking escape hatches"
"In a static checking regime, sometimes it is necessary to step outside the boundaries and run some code which cannot be statically checked; perhaps this code is constructed at run-time. There are two ways to get around the static stack checker."
"If the stack effect of a word or quotation is known, but the word or quotation itself is not, " { $link POSTPONE: execute( } " or " { $link POSTPONE: call( } " can be used. See " { $link "call" } " for details."
$nl
"If the stack effect is not known, the code being called cannot manipulate the datastack directly. Instead, it must reflect the datastack into an array:"
-{ $subsection with-datastack }
+{ $subsections with-datastack }
"The surrounding code has a static stack effect since " { $link with-datastack } " has one. However, the array passed in as input may be transformed arbitrarily by calling this combinator." ;
ARTICLE: "inference" "Stack effect checking"
"If a word's stack effect cannot be inferred, a compile error is reported. See " { $link "compiler-errors" } "."
$nl
"The following articles describe how different control structures are handled by the stack checker."
-{ $subsection "inference-simple" }
-{ $subsection "inference-combinators" }
-{ $subsection "inference-recursive-combinators" }
-{ $subsection "inference-branches" }
+{ $subsections
+ "inference-simple"
+ "inference-combinators"
+ "inference-recursive-combinators"
+ "inference-branches"
+}
"Stack checking catches several classes of errors."
-{ $subsection "inference-errors" }
+{ $subsections "inference-errors" }
"Sometimes code with a dynamic stack effect has to be run."
-{ $subsection "inference-escape" }
+{ $subsections "inference-escape" }
{ $see-also "effects" "tools.inference" "tools.errors" } ;
ABOUT: "inference"
+++ /dev/null
-Slava Pestov
+++ /dev/null
-! (c)Joe Groff bsd license
-USING: accessors arrays kernel prettyprint.backend
-prettyprint.custom sequences struct-arrays ;
-IN: struct-arrays.prettyprint
-
-M: struct-array pprint-delims
- drop \ struct-array{ \ } ;
-
-M: struct-array >pprint-sequence
- [ >array ] [ class>> ] bi prefix ;
-
-M: struct-array pprint* pprint-object ;
-
+++ /dev/null
-IN: struct-arrays
-USING: help.markup help.syntax alien strings math ;
-
-HELP: struct-array
-{ $class-description "The class of C struct and union arrays."
-$nl
-"The " { $slot "underlying" } " slot holds a " { $link c-ptr } " with the raw data. This pointer can be passed to C functions." } ;
-
-HELP: <struct-array>
-{ $values { "length" integer } { "c-type" string } { "struct-array" struct-array } }
-{ $description "Creates a new array for holding values of the specified C type." } ;
-
-HELP: <direct-struct-array>
-{ $values { "alien" c-ptr } { "length" integer } { "c-type" string } { "struct-array" struct-array } }
-{ $description "Creates a new array for holding values of the specified C type, backed by the memory at " { $snippet "alien" } "." } ;
-
-ARTICLE: "struct-arrays" "C struct and union arrays"
-"The " { $vocab-link "struct-arrays" } " vocabulary implements arrays specialized for holding C struct and union values."
-{ $subsection struct-array }
-{ $subsection <struct-array> }
-{ $subsection <direct-struct-array> } ;
-
-ABOUT: "struct-arrays"
+++ /dev/null
-IN: struct-arrays.tests
-USING: classes.struct struct-arrays tools.test kernel math sequences
-alien.syntax alien.c-types destructors libc accessors sequences.private ;
-
-STRUCT: test-struct-array
- { x int }
- { y int } ;
-
-: make-point ( x y -- struct )
- test-struct-array <struct-boa> ;
-
-[ 5/4 ] [
- 2 test-struct-array <struct-array>
- 1 2 make-point over set-first
- 3 4 make-point over set-second
- 0 [ [ x>> ] [ y>> ] bi / + ] reduce
-] unit-test
-
-[ 5/4 ] [
- [
- 2 test-struct-array malloc-struct-array
- dup &free drop
- 1 2 make-point over set-first
- 3 4 make-point over set-second
- 0 [ [ x>> ] [ y>> ] bi / + ] reduce
- ] with-destructors
-] unit-test
-
-[ ] [ ALIEN: 123 10 test-struct-array <direct-struct-array> drop ] unit-test
-
-[ ] [
- [
- 10 test-struct-array malloc-struct-array
- &free drop
- ] with-destructors
-] unit-test
-
-[ 15 ] [ 15 10 test-struct-array <struct-array> resize length ] unit-test
-
-[ S{ test-struct-array f 12 20 } ] [
- struct-array{ test-struct-array
- S{ test-struct-array f 4 20 }
- S{ test-struct-array f 12 20 }
- S{ test-struct-array f 20 20 }
- } second
-] unit-test
+++ /dev/null
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.structs byte-arrays
-classes.struct kernel libc math parser sequences sequences.private ;
-IN: struct-arrays
-
-: c-type-struct-class ( c-type -- class )
- c-type boxed-class>> ; foldable
-
-TUPLE: struct-array
-{ underlying c-ptr read-only }
-{ length array-capacity read-only }
-{ element-size array-capacity read-only }
-{ class read-only } ;
-
-M: struct-array length length>> ; inline
-M: struct-array byte-length [ length>> ] [ element-size>> ] bi * ; inline
-
-: (nth-ptr) ( i struct-array -- alien )
- [ element-size>> * >fixnum ] [ underlying>> ] bi <displaced-alien> ; inline
-
-M: struct-array nth-unsafe
- [ (nth-ptr) ] [ class>> dup struct-class? ] bi [ memory>struct ] [ drop ] if ; inline
-
-M: struct-array set-nth-unsafe
- [ (nth-ptr) swap ] [ element-size>> ] bi memcpy ; inline
-
-M: struct-array new-sequence
- [ element-size>> [ * (byte-array) ] 2keep ]
- [ class>> ] bi struct-array boa ; inline
-
-M: struct-array resize ( n seq -- newseq )
- [ [ element-size>> * ] [ underlying>> ] bi resize ]
- [ [ element-size>> ] [ class>> ] bi ] 2bi
- struct-array boa ;
-
-: <struct-array> ( length c-type -- struct-array )
- [ heap-size [ * <byte-array> ] 2keep ]
- [ c-type-struct-class ] bi struct-array boa ; inline
-
-ERROR: bad-byte-array-length byte-array ;
-
-: byte-array>struct-array ( byte-array c-type -- struct-array )
- [ heap-size [
- [ dup length ] dip /mod 0 =
- [ drop bad-byte-array-length ] unless
- ] keep ] [ c-type-struct-class ] bi struct-array boa ; inline
-
-: <direct-struct-array> ( alien length c-type -- struct-array )
- [ heap-size ] [ c-type-struct-class ] bi struct-array boa ; inline
-
-: malloc-struct-array ( length c-type -- struct-array )
- [ heap-size calloc ] 2keep <direct-struct-array> ; inline
-
-INSTANCE: struct-array sequence
-
-M: struct-type <c-type-array> ( len c-type -- array )
- dup c-type-array-constructor
- [ execute( len -- array ) ]
- [ <struct-array> ] ?if ; inline
-
-M: struct-type <c-type-direct-array> ( alien len c-type -- array )
- dup c-type-direct-array-constructor
- [ execute( alien len -- array ) ]
- [ <direct-struct-array> ] ?if ; inline
-
-: >struct-array ( sequence class -- struct-array )
- [ dup length ] dip <struct-array>
- [ 0 swap copy ] keep ; inline
-
-SYNTAX: struct-array{
- \ } scan-word [ >struct-array ] curry parse-literal ;
-
-USING: vocabs vocabs.loader ;
-
-"prettyprint" vocab [ "struct-arrays.prettyprint" require ] when
+++ /dev/null
-Arrays of C structs and unions
+++ /dev/null
-collections
+++ /dev/null
-IN: struct-vectors
-USING: help.markup help.syntax alien strings math ;
-
-HELP: struct-vector
-{ $class-description "The class of growable C struct and union arrays." } ;
-
-HELP: <struct-vector>
-{ $values { "capacity" integer } { "c-type" string } { "struct-vector" struct-vector } }
-{ $description "Creates a new vector with the given initial capacity." } ;
-
-ARTICLE: "struct-vectors" "C struct and union vectors"
-"The " { $vocab-link "struct-vectors" } " vocabulary implements vectors specialized for holding C struct and union values. These are growable versions of " { $vocab-link "struct-arrays" } "."
-{ $subsection struct-vector }
-{ $subsection <struct-vector> } ;
-
-ABOUT: "struct-vectors"
+++ /dev/null
-IN: struct-vectors.tests
-USING: struct-vectors tools.test alien.c-types alien.syntax
-namespaces kernel sequences ;
-
-C-STRUCT: point
- { "float" "x" }
- { "float" "y" } ;
-
-: make-point ( x y -- point )
- "point" <c-object>
- [ set-point-y ] keep
- [ set-point-x ] keep ;
-
-[ ] [ 1 "point" <struct-vector> "v" set ] unit-test
-
-[ 1.5 6.0 ] [
- 1.0 2.0 make-point "v" get push
- 3.0 4.5 make-point "v" get push
- 1.5 6.0 make-point "v" get push
- "v" get pop [ point-x ] [ point-y ] bi
-] unit-test
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types byte-arrays growable kernel math sequences
-sequences.private struct-arrays ;
-IN: struct-vectors
-
-TUPLE: struct-vector
-{ underlying struct-array }
-{ length array-capacity }
-{ c-type read-only } ;
-
-: <struct-vector> ( capacity c-type -- struct-vector )
- [ <struct-array> 0 ] keep struct-vector boa ; inline
-
-M: struct-vector byte-length underlying>> byte-length ;
-M: struct-vector new-sequence
- [ c-type>> <struct-array> ] [ [ >fixnum ] [ c-type>> ] bi* ] 2bi
- struct-vector boa ;
-
-M: struct-vector contract 2drop ;
-
-M: struct-array new-resizable c-type>> <struct-vector> ;
-
-INSTANCE: struct-vector growable
"The " { $vocab-link "suffix-arrays" } " vocabulary implements the suffix array data structure for efficient lookup of subsequences. This suffix array implementation is a sorted array of suffixes. Querying it for matches uses binary search for efficiency." $nl
"Creating new suffix arrays:"
-{ $subsection >suffix-array }
+{ $subsections >suffix-array }
"Literal suffix arrays:"
-{ $subsection POSTPONE: SA{ }
+{ $subsections POSTPONE: SA{ }
"Querying suffix arrays:"
-{ $subsection query } ;
+{ $subsections query } ;
ABOUT: "suffix-arrays"
ARTICLE: "summary" "Converting objects to summary strings"
"A word for getting very brief descriptions of words and general objects:"
-{ $subsection summary } ;
+{ $subsections summary } ;
HELP: summary
{ $values { "object" object } { "string" string } }
GENERIC: summary ( object -- string )
: object-summary ( object -- string )
- class name>> " instance" append ;
+ class name>> ;
M: object summary object-summary ;
"The " { $vocab-link "syndication" } " vocabulary implements support for reading Atom and RSS feeds, and writing Atom feeds."
$nl
"Data types:"
-{ $subsection feed }
-{ $subsection <feed> }
-{ $subsection entry }
-{ $subsection <entry> }
+{ $subsections
+ feed
+ <feed>
+ entry
+ <entry>
+}
"Reading feeds:"
-{ $subsection download-feed }
-{ $subsection parse-feed }
-{ $subsection xml>feed }
+{ $subsections
+ download-feed
+ parse-feed
+ xml>feed
+}
"Writing feeds:"
-{ $subsection feed>xml }
+{ $subsections feed>xml }
"The " { $vocab-link "furnace.syndication" } " vocabulary builds on top of this vocabulary to enable easy generation of Atom feeds from web applications. The " { $vocab-link "webapps.planet" } " vocabulary is a complete example of a web application which reads and exports feeds."
{ $see-also "urls" } ;
--- /dev/null
+Doug Coleman
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: system ;
+IN: system-info.backend
+
+HOOK: cpus os ( -- n )
+HOOK: cpu-mhz os ( -- n )
+HOOK: memory-load os ( -- n )
+HOOK: physical-mem os ( -- n )
+HOOK: available-mem os ( -- n )
+HOOK: total-page-file os ( -- n )
+HOOK: available-page-file os ( -- n )
+HOOK: total-virtual-mem os ( -- n )
+HOOK: available-virtual-mem os ( -- n )
+HOOK: available-virtual-extended-mem os ( -- n )
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: unix alien alien.c-types kernel math sequences strings
+io.backend.unix splitting io.encodings.utf8 io.encodings.string
+specialized-arrays ;
+SPECIALIZED-ARRAY: char
+IN: system-info.linux
+
+: (uname) ( buf -- int )
+ "int" f "uname" { "char*" } alien-invoke ;
+
+: uname ( -- seq )
+ 65536 <char-array> [ (uname) io-error ] keep
+ "\0" split harvest [ utf8 decode ] map
+ 6 "" pad-tail ;
+
+: sysname ( -- string ) uname first ;
+: nodename ( -- string ) uname second ;
+: release ( -- string ) uname third ;
+: version ( -- string ) uname fourth ;
+: machine ( -- string ) uname 4 swap nth ;
+: domainname ( -- string ) uname 5 swap nth ;
+
+: kernel-version ( -- seq )
+ release ".-" split harvest 5 "" pad-tail ;
--- /dev/null
+unportable
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.strings alien.syntax
+byte-arrays kernel namespaces sequences unix
+system-info.backend system io.encodings.utf8 ;
+IN: system-info.macosx
+
+! See /usr/include/sys/sysctl.h for constants
+
+LIBRARY: libc
+FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, void* newp, size_t newlen ) ;
+
+: make-int-array ( seq -- byte-array )
+ [ <int> ] map concat ;
+
+: (sysctl-query) ( name namelen oldp oldlenp -- oldp )
+ over [ f 0 sysctl io-error ] dip ;
+
+: sysctl-query ( seq n -- byte-array )
+ [ [ make-int-array ] [ length ] bi ] dip
+ [ <byte-array> ] [ <uint> ] bi (sysctl-query) ;
+
+: sysctl-query-string ( seq -- n )
+ 4096 sysctl-query utf8 alien>string ;
+
+: sysctl-query-uint ( seq -- n )
+ 4 sysctl-query *uint ;
+
+: sysctl-query-ulonglong ( seq -- n )
+ 8 sysctl-query *ulonglong ;
+
+: machine ( -- str ) { 6 1 } sysctl-query-string ;
+: model ( -- str ) { 6 2 } sysctl-query-string ;
+M: macosx cpus ( -- n ) { 6 3 } sysctl-query-uint ;
+: byte-order ( -- n ) { 6 4 } sysctl-query-uint ;
+M: macosx physical-mem ( -- n ) { 6 5 } sysctl-query-uint ;
+: user-mem ( -- n ) { 6 6 } sysctl-query-uint ;
+: page-size ( -- n ) { 6 7 } sysctl-query-uint ;
+: disknames ( -- n ) { 6 8 } 8 sysctl-query ;
+: diskstats ( -- n ) { 6 9 } 8 sysctl-query ;
+: epoch ( -- n ) { 6 10 } sysctl-query-uint ;
+: floating-point ( -- n ) { 6 11 } sysctl-query-uint ;
+: machine-arch ( -- n ) { 6 12 } sysctl-query-string ;
+: vector-unit ( -- n ) { 6 13 } sysctl-query-uint ;
+: bus-frequency ( -- n ) { 6 14 } sysctl-query-uint ;
+M: macosx cpu-mhz ( -- n ) { 6 15 } sysctl-query-uint ;
+: cacheline-size ( -- n ) { 6 16 } sysctl-query-uint ;
+: l1-icache-size ( -- n ) { 6 17 } sysctl-query-uint ;
+: l1-dcache-size ( -- n ) { 6 18 } sysctl-query-uint ;
+: l2-cache-settings ( -- n ) { 6 19 } sysctl-query-uint ;
+: l2-cache-size ( -- n ) { 6 20 } sysctl-query-uint ;
+: l3-cache-settings ( -- n ) { 6 21 } sysctl-query-uint ;
+: l3-cache-size ( -- n ) { 6 22 } sysctl-query-uint ;
+: tb-frequency ( -- n ) { 6 23 } sysctl-query-uint ;
+: mem-size ( -- n ) { 6 24 } sysctl-query-ulonglong ;
+: available-cpus ( -- n ) { 6 25 } sysctl-query-uint ;
--- /dev/null
+unportable
--- /dev/null
+Query the operating system for hardware information in a platform-independent way
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.syntax kernel math prettyprint io math.parser
+combinators vocabs.loader system-info.backend system ;
+IN: system-info
+
+: write-unit ( x n str -- )
+ [ 2^ /f number>string write bl ] [ write ] bi* ;
+
+: kb ( x -- ) 10 "kB" write-unit ;
+: megs ( x -- ) 20 "MB" write-unit ;
+: gigs ( x -- ) 30 "GB" write-unit ;
+: ghz ( x -- ) 1000000000 /f number>string write bl "GHz" write ;
+
+<< {
+ { [ os windows? ] [ "system-info.windows" ] }
+ { [ os linux? ] [ "system-info.linux" ] }
+ { [ os macosx? ] [ "system-info.macosx" ] }
+ [ f ]
+} cond [ require ] when* >>
+
+: system-report. ( -- )
+ "CPUs: " write cpus number>string write nl
+ "CPU Speed: " write cpu-mhz ghz nl
+ "Physical RAM: " write physical-mem megs nl ;
--- /dev/null
+Doug Coleman
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.data system-info kernel math namespaces
+windows windows.kernel32 system-info.backend system ;
+IN: system-info.windows.ce
+
+: memory-status ( -- MEMORYSTATUS )
+ "MEMORYSTATUS" <c-object>
+ "MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength
+ dup GlobalMemoryStatus ;
+
+M: wince cpus ( -- n ) 1 ;
+
+M: wince memory-load ( -- n )
+ memory-status MEMORYSTATUS-dwMemoryLoad ;
+
+M: wince physical-mem ( -- n )
+ memory-status MEMORYSTATUS-dwTotalPhys ;
+
+M: wince available-mem ( -- n )
+ memory-status MEMORYSTATUS-dwAvailPhys ;
+
+M: wince total-page-file ( -- n )
+ memory-status MEMORYSTATUS-dwTotalPageFile ;
+
+M: wince available-page-file ( -- n )
+ memory-status MEMORYSTATUS-dwAvailPageFile ;
+
+M: wince total-virtual-mem ( -- n )
+ memory-status MEMORYSTATUS-dwTotalVirtual ;
+
+M: wince available-virtual-mem ( -- n )
+ memory-status MEMORYSTATUS-dwAvailVirtual ;
--- /dev/null
+unportable
--- /dev/null
+Doug Coleman
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types alien.strings
+kernel libc math namespaces system-info.backend
+system-info.windows windows windows.advapi32
+windows.kernel32 system byte-arrays windows.errors
+classes classes.struct accessors ;
+IN: system-info.windows.nt
+
+M: winnt cpus ( -- n )
+ system-info dwNumberOfProcessors>> ;
+
+: memory-status ( -- MEMORYSTATUSEX )
+ "MEMORYSTATUSEX" <struct>
+ dup class heap-size >>dwLength
+ dup GlobalMemoryStatusEx win32-error=0/f ;
+
+M: winnt memory-load ( -- n )
+ memory-status dwMemoryLoad>> ;
+
+M: winnt physical-mem ( -- n )
+ memory-status ullTotalPhys>> ;
+
+M: winnt available-mem ( -- n )
+ memory-status ullAvailPhys>> ;
+
+M: winnt total-page-file ( -- n )
+ memory-status ullTotalPageFile>> ;
+
+M: winnt available-page-file ( -- n )
+ memory-status ullAvailPageFile>> ;
+
+M: winnt total-virtual-mem ( -- n )
+ memory-status ullTotalVirtual>> ;
+
+M: winnt available-virtual-mem ( -- n )
+ memory-status ullAvailVirtual>> ;
+
+: computer-name ( -- string )
+ MAX_COMPUTERNAME_LENGTH 1 +
+ [ <byte-array> dup ] keep <uint>
+ GetComputerName win32-error=0/f alien>native-string ;
+
+: username ( -- string )
+ UNLEN 1 +
+ [ <byte-array> dup ] keep <uint>
+ GetUserName win32-error=0/f alien>native-string ;
--- /dev/null
+unportable
--- /dev/null
+unportable
--- /dev/null
+! Copyright (C) 2008 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien alien.c-types classes.struct accessors kernel
+math namespaces windows windows.kernel32 windows.advapi32 words
+combinators vocabs.loader system-info.backend system
+alien.strings windows.errors specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
+IN: system-info.windows
+
+: system-info ( -- SYSTEM_INFO )
+ SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
+
+: page-size ( -- n )
+ system-info dwPageSize>> ;
+
+! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
+: processor-type ( -- n )
+ system-info dwProcessorType>> ;
+
+! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
+: processor-architecture ( -- n )
+ system-info dwOemId>> HEX: ffff0000 bitand ;
+
+: os-version ( -- os-version )
+ OSVERSIONINFO <struct>
+ OSVERSIONINFO heap-size >>dwOSVersionInfoSize
+ dup GetVersionEx win32-error=0/f ;
+
+: windows-major ( -- n )
+ os-version dwMajorVersion>> ;
+
+: windows-minor ( -- n )
+ os-version dwMinorVersion>> ;
+
+: windows-build# ( -- n )
+ os-version dwBuildNumber>> ;
+
+: windows-platform-id ( -- n )
+ os-version dwPlatformId>> ;
+
+: windows-service-pack ( -- string )
+ os-version szCSDVersion>> alien>native-string ;
+
+: feature-present? ( n -- ? )
+ IsProcessorFeaturePresent zero? not ;
+
+: sse2? ( -- ? )
+ PF_XMMI64_INSTRUCTIONS_AVAILABLE feature-present? ;
+
+: sse3? ( -- ? )
+ PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
+
+: get-directory ( word -- str )
+ [ MAX_UNICODE_PATH [ <ushort-array> ] keep dupd ] dip
+ execute win32-error=0/f alien>native-string ; inline
+
+: windows-directory ( -- str )
+ \ GetWindowsDirectory get-directory ;
+
+: system-directory ( -- str )
+ \ GetSystemDirectory get-directory ;
+
+: system-windows-directory ( -- str )
+ \ GetSystemWindowsDirectory get-directory ;
+
+<<
+{
+ { [ os wince? ] [ "system-info.windows.ce" ] }
+ { [ os winnt? ] [ "system-info.windows.nt" ] }
+} cond require >>
ARTICLE: "threads-start/stop" "Starting and stopping threads"
"Spawning new threads:"
-{ $subsection spawn }
-{ $subsection spawn-server }
+{ $subsections
+ spawn
+ spawn-server
+}
"Creating and spawning a thread can be factored out into two separate steps:"
-{ $subsection <thread> }
-{ $subsection (spawn) }
+{ $subsections
+ <thread>
+ (spawn)
+}
"Threads stop either when the quotation given to " { $link spawn } " returns, or when the following word is called:"
-{ $subsection stop }
+{ $subsections stop }
"If the image is saved and started again, all runnable threads are stopped. Vocabularies wishing to have a background thread always running should use " { $link add-init-hook } "." ;
ARTICLE: "threads-yield" "Yielding and suspending threads"
"Yielding to other threads:"
-{ $subsection yield }
+{ $subsections yield }
"Sleeping for a period of time:"
-{ $subsection sleep }
+{ $subsections sleep }
"Interrupting sleep:"
-{ $subsection interrupt }
+{ $subsections interrupt }
"Threads can be suspended and woken up at some point in the future when a condition is satisfied:"
-{ $subsection suspend }
-{ $subsection resume }
-{ $subsection resume-with } ;
+{ $subsections
+ suspend
+ resume
+ resume-with
+} ;
ARTICLE: "thread-state" "Thread-local state and variables"
"Threads form a class of objects:"
-{ $subsection thread }
+{ $subsections thread }
"The current thread:"
-{ $subsection self }
+{ $subsections self }
"Thread-local variables:"
-{ $subsection tnamespace }
-{ $subsection tget }
-{ $subsection tset }
-{ $subsection tchange }
+{ $subsections
+ tnamespace
+ tget
+ tset
+ tchange
+}
"Each thread has its own independent set of thread-local variables and newly-spawned threads begin with an empty set."
$nl
"Global hashtable of all threads, keyed by " { $snippet "id" } ":"
-{ $subsection threads }
+{ $subsections threads }
"Threads have an identity independent of continuations. If a continuation is refied in one thread and then resumed in another thread, the code running in that continuation will observe a change in the value output by " { $link self } "." ;
ARTICLE: "thread-impl" "Thread implementation"
"Thread implementation:"
-{ $subsection run-queue }
-{ $subsection sleep-queue } ;
+{ $subsections
+ run-queue
+ sleep-queue
+} ;
ARTICLE: "threads" "Lightweight co-operative threads"
"Factor supports lightweight co-operative threads implemented on top of " { $link "continuations" } ". A thread will yield while waiting for input/output operations to complete, or when a yield has been explicitly requested."
"Factor threads are very lightweight. Each thread can take as little as 900 bytes of memory. This library has been tested running hundreds of thousands of simple threads."
$nl
"Words for working with threads are in the " { $vocab-link "threads" } " vocabulary."
-{ $subsection "threads-start/stop" }
-{ $subsection "threads-yield" }
-{ $subsection "thread-state" }
-{ $subsection "thread-impl" } ;
+{ $subsections
+ "threads-start/stop"
+ "threads-yield"
+ "thread-state"
+ "thread-impl"
+} ;
ABOUT: "threads"
"The word annotation feature modifies word definitions to add debugging code. You can restore the old definition by calling " { $link reset } " on the word in question."
$nl
"Printing messages when a word is called or returns:"
-{ $subsection watch }
-{ $subsection watch-vars }
-"Starting the walker when a word is called:"
-{ $subsection breakpoint }
-{ $subsection breakpoint-if }
+{ $subsections
+ watch
+ watch-vars
+}
"Timing words:"
-{ $subsection reset-word-timing }
-{ $subsection add-timing }
-{ $subsection word-timing. }
+{ $subsections
+ reset-word-timing
+ add-timing
+ word-timing.
+}
"All of the above words are implemented using a single combinator which applies a quotation to a word definition to yield a new definition:"
-{ $subsection annotate } ;
+{ $subsections annotate }
+{ $warning
+ "Certain internal words, such as words in the " { $vocab-link "math" } ", " { $vocab-link "sequences" } " and UI vocabularies, cannot be annotated, since the annotated code may end up recursively invoking the word in question. This may crash or hang Factor. It is safest to only define annotations on your own words."
+} ;
ABOUT: "tools.annotations"
{ watch watch-vars reset } related-words
-HELP: breakpoint
-{ $values { "word" word } }
-{ $description "Annotates a word definition to enter the single stepper when executed." } ;
-
-HELP: breakpoint-if
-{ $values { "quot" { $quotation "( -- ? )" } } { "word" word } }
-{ $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ;
-
HELP: reset
{ $values
{ "word" word } }
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel math sorting words parser io summary
quotations sequences prettyprint continuations effects
-definitions compiler.units namespaces assocs tools.walker
-tools.time generic inspector fry tools.continuations
-locals generalizations macros ;
+definitions compiler.units namespaces assocs tools.time generic
+inspector fry locals generalizations macros ;
IN: tools.annotations
<PRIVATE
: watch-vars ( word vars -- )
dupd '[ [ _ _ ] dip (watch-vars) ] annotate ;
-: breakpoint ( word -- )
- [ add-breakpoint ] annotate ;
-
-: breakpoint-if ( word quot -- )
- '[ [ _ [ [ break ] when ] ] dip 3append ] annotate ;
-
SYMBOL: word-timing
word-timing [ H{ } clone ] initialize
"Various developer tools make use of a general-purpose fuzzy completion algorithm."
$nl
"The main entry point:"
-{ $subsection completions }
+{ $subsections completions }
"The words used to implement the algorithm can be called as well, for finer control over fuzzy matching:"
-{ $subsection fuzzy }
-{ $subsection runs }
-{ $subsection score }
-{ $subsection complete }
-{ $subsection rank-completions } ;
+{ $subsections
+ fuzzy
+ runs
+ score
+ complete
+ rank-completions
+} ;
ABOUT: "tools.completion"
ARTICLE: "tools.crossref" "Definition cross referencing"
"Definitions can answer a sequence of definitions they directly depend on:"
-{ $subsection uses }
+{ $subsections uses }
"An inverted index of the above:"
-{ $subsection get-crossref }
+{ $subsections get-crossref }
"Words to access it:"
-{ $subsection usage }
-{ $subsection smart-usage }
+{ $subsections
+ usage
+ smart-usage
+}
"Tools for interactive use:"
-{ $subsection usage. }
-{ $subsection vocab-uses. }
-{ $subsection vocab-usage. }
+{ $subsections
+ usage.
+ vocab-uses.
+ vocab-usage.
+}
{ $see-also "definitions" "words" "see" } ;
ABOUT: "tools.crossref"
M: word uses def>> uses ;
-M: link uses { $subsection $link $see-also } article-links ;
+M: link uses { $subsection $subsections $link $see-also } article-links ;
M: pathname uses string>> source-file top-level-form>> [ uses ] [ { } ] if* ;
synopsis-alist sort-keys definitions. ;
: usage. ( word -- )
- smart-usage sorted-definitions. ;
+ smart-usage
+ [ "No usages." print ] [ sorted-definitions. ] if-empty ;
: vocab-xref ( vocab quot -- vocabs )
[ [ vocab-name ] [ words [ generic? not ] filter ] bi ] dip map
-USING: help.markup help.syntax words alien.c-types assocs
+USING: help.markup help.syntax words alien.c-types alien.data assocs
kernel math ;
IN: tools.deploy.config
ARTICLE: "deploy-flags" "Deployment flags"
"There are two sets of deployment flags. The first set controls the major subsystems which are to be included in the deployment image:"
-{ $subsection deploy-math? }
-{ $subsection deploy-unicode? }
-{ $subsection deploy-threads? }
-{ $subsection deploy-ui? }
+{ $subsections
+ deploy-math?
+ deploy-unicode?
+ deploy-threads?
+ deploy-ui?
+}
"The second set of flags controls the level of stripping to be performed on the deployment image; there is a trade-off between image size, and retaining functionality which is required by the application:"
-{ $subsection deploy-io }
-{ $subsection deploy-reflection }
-{ $subsection deploy-word-props? }
-{ $subsection deploy-c-types? } ;
+{ $subsections
+ deploy-io
+ deploy-reflection
+ deploy-word-props?
+ deploy-c-types?
+} ;
ABOUT: "deploy-flags"
ARTICLE: "deploy-config" "Deployment configuration"
"The deployment configuration is a key/value mapping stored in the " { $snippet "deploy.factor" } " file in the vocabulary's directory. If this file does not exist, the default deployment configuration is used:"
-{ $subsection default-config }
+{ $subsections default-config }
"The deployment configuration can be read and written with a pair of words:"
-{ $subsection deploy-config }
-{ $subsection set-deploy-config }
+{ $subsections
+ deploy-config
+ set-deploy-config
+}
"A utility word is provided to load the configuration, change a flag, and store it back to disk:"
-{ $subsection set-deploy-flag }
+{ $subsections set-deploy-flag }
"The " { $link "ui.tools.deploy" } " provides a graphical way of editing the configuration." ;
HELP: deploy-config
ARTICLE: "prepare-deploy" "Preparing to deploy an application"
"In order to deploy an application as a stand-alone image, the application's vocabulary must first be given a " { $link POSTPONE: MAIN: } " hook. Then, a " { $emphasis "deployment configuration" } " must be created."
-{ $subsection "deploy-config" }
-{ $subsection "deploy-flags" } ;
+{ $subsections
+ "deploy-config"
+ "deploy-flags"
+} ;
ARTICLE: "tools.deploy.usage" "Deploy tool usage"
"Once the necessary deployment flags have been set, the application can be deployed:"
-{ $subsection deploy }
+{ $subsections deploy }
"For example, you can deploy the " { $vocab-link "hello-ui" } " demo which comes with Factor. Note that this demo already has a deployment configuration, so nothing needs to be configured:"
{ $code "\"hello-ui\" deploy" }
{ $list
"Most of the time, the words in the " { $vocab-link "tools.deploy" } " vocabulary should not be used directly; instead, use " { $link "ui.tools.deploy" } "."
$nl
"You must explicitly specify major subsystems which are required, as well as the level of reflection support needed. This is done by modifying the deployment configuration prior to deployment."
-{ $subsection "prepare-deploy" }
-{ $subsection "tools.deploy.usage" }
-{ $subsection "tools.deploy.impl" }
-{ $subsection "tools.deploy.caveats" } ;
+{ $subsections
+ "prepare-deploy"
+ "tools.deploy.usage"
+ "tools.deploy.impl"
+ "tools.deploy.caveats"
+} ;
ABOUT: "tools.deploy"
+USING: tools.test system io io.encodings.ascii io.pathnames\r
+io.files io.files.info io.files.temp kernel tools.deploy.config\r
+tools.deploy.config.editor tools.deploy.backend math sequences\r
+io.launcher arrays namespaces continuations layouts accessors\r
+urls math.parser io.directories tools.deploy.test ;\r
IN: tools.deploy.tests\r
-USING: tools.test system io.pathnames io.files io.files.info\r
-io.files.temp kernel tools.deploy.config tools.deploy.config.editor\r
-tools.deploy.backend math sequences io.launcher arrays namespaces\r
-continuations layouts accessors io.encodings.ascii urls math.parser\r
-io.directories tools.deploy.test ;\r
\r
[ t ] [ "hello-world" shake-and-bake 500000 small-enough? ] unit-test\r
\r
\r
os windows? os macosx? or [\r
[ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test\r
-] when
\ No newline at end of file
+] when\r
+\r
+os macosx? [\r
+ [ ] [ "tools.deploy.test.14" shake-and-bake run-temp-image ] unit-test\r
+] when\r
+\r
+[ { "a" "b" "c" } ] [\r
+ "tools.deploy.test.15" shake-and-bake deploy-test-command\r
+ { "a" "b" "c" } append\r
+ ascii [ lines ] with-process-reader\r
+ rest\r
+] unit-test
\ No newline at end of file
system strings sets vectors quotations byte-arrays sorting
compiler.units definitions generic generic.standard
generic.single tools.deploy.config combinators classes
-classes.builtin slots.private grouping ;
+classes.builtin slots.private grouping command-line ;
QUALIFIED: bootstrap.stage2
-QUALIFIED: command-line
QUALIFIED: compiler.errors
QUALIFIED: continuations
QUALIFIED: definitions
! This file is some hairy shit.
+: add-command-line-hook ( -- )
+ [ (command-line) command-line set-global ] "command-line"
+ init-hooks get set-at ;
+
: strip-init-hooks ( -- )
"Stripping startup hooks" show
{
"alien.strings"
- "command-line"
"cpu.x86"
"destructors"
"environment"
] when ;
: strip-destructors ( -- )
- "libc" vocab [
- "Stripping destructor debug code" show
- "vocab:tools/deploy/shaker/strip-destructors.factor"
- run-file
- ] when ;
+ "Stripping destructor debug code" show
+ "vocab:tools/deploy/shaker/strip-destructors.factor"
+ run-file ;
: strip-call ( -- )
"Stripping stack effect checking from call( and execute(" show
"slots"
"special"
"specializer"
+ "specializations"
+ "struct-slots"
! UI needs this
! "superclass"
"transform-n"
"word-style"
} %
] when
+
+ deploy-c-types? get [
+ { "c-type" "struct-slots" "struct-align" } %
+ ] unless
] { } make ;
: strip-words ( props -- )
"disposables" "destructors" lookup ,
+ "functor-words" "functors.backend" lookup ,
+
deploy-threads? [
"initial-thread" "threads" lookup ,
] unless
classes-intersect-cache
implementors-map
update-map
- command-line:main-vocab-hook
+ main-vocab-hook
compiled-crossref
compiled-generic-crossref
compiler-impl
{ } { "math.partial-dispatch" } strip-vocab-globals %
- { } { "math.vectors.specialization" } strip-vocab-globals %
+ { } { "math.vectors.simd" } strip-vocab-globals %
{ } { "peg" } strip-vocab-globals %
] when
strip-debugger
compute-next-methods
strip-init-hooks
+ add-command-line-hook
strip-c-io
strip-default-methods
strip-compiler-classes
! Copyright (C) 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-IN: tools.deploy.shaker.call
-
+USING: combinators.private kernel ;
IN: combinators
-USE: combinators.private
-: call-effect ( word effect -- ) call-effect-unsafe ; inline
+: call-effect ( word effect -- ) call-effect-unsafe ;
+
+: execute-effect ( word effect -- ) execute-effect-unsafe ;
+
+IN: compiler.tree.propagation.call-effect
+
+: call-effect-unsafe? ( quot effect -- ? ) 2drop t ; inline
-: execute-effect ( word effect -- ) execute-effect-unsafe ; inline
\ No newline at end of file
+: execute-effect-unsafe? ( word effect -- ? ) 2drop t ; inline
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors classes.struct cocoa cocoa.classes
+cocoa.subclassing core-graphics.types kernel math ;
+IN: tools.deploy.test.14
+
+CLASS: {
+ { +superclass+ "NSObject" }
+ { +name+ "Bar" }
+} {
+ "bar:"
+ "float"
+ { "id" "SEL" "NSRect" }
+ [
+ [ origin>> [ x>> ] [ y>> ] bi + ]
+ [ size>> [ w>> ] [ h>> ] bi + ]
+ bi +
+ ]
+} ;
+
+: main ( -- )
+ Bar -> alloc -> init
+ S{ CGRect f S{ CGPoint f 1.0 2.0 } S{ CGSize f 3.0 4.0 } } -> bar:
+ 10.0 assert= ;
+
+MAIN: main
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+USING: tools.deploy.config ;
+H{
+ { deploy-math? t }
+ { deploy-io 2 }
+ { deploy-c-types? f }
+ { deploy-reflection 1 }
+ { deploy-word-defs? f }
+ { "stop-after-last-window?" t }
+ { deploy-word-props? f }
+ { deploy-threads? t }
+ { deploy-ui? f }
+ { deploy-unicode? f }
+ { deploy-name "tools.deploy.test.14" }
+}
--- /dev/null
+unportable
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: command-line io namespaces sequences ;
+IN: tools.deploy.test.15
+
+: main ( -- ) command-line get [ print ] each ;
+
+MAIN: main
: small-enough? ( n -- ? )
[ "test.image" temp-file file-info size>> ]
- [ cell 4 / * cpu ppc? [ 100000 + ] when ] bi*
+ [
+ cell 4 / *
+ cpu ppc? [ 100000 + ] when
+ os windows? [ 150000 + ] when
+ ] bi*
<= ;
-: run-temp-image ( -- )
+: deploy-test-command ( -- args )
os macosx?
"resource:Factor.app/Contents/MacOS/factor" normalize-path vm ?
- "-i=" "test.image" temp-file append 2array try-output-process ;
\ No newline at end of file
+ "-i=" "test.image" temp-file append 2array ;
+
+: run-temp-image ( -- )
+ deploy-test-command try-output-process ;
\ No newline at end of file
ARTICLE: "tools.deprecation" "Deprecation tracking"
"Factor's core syntax defines a " { $link POSTPONE: deprecated } " word that can be applied to words to mark them as deprecated. When the " { $vocab-link "tools.deprecation" } " vocabulary is loaded, notes will be collected and reported by the " { $link "tools.errors" } " mechanism when deprecated words are used to define other words."
-{ $subsection POSTPONE: deprecated }
-{ $subsection :deprecations } ;
+{ $subsections
+ POSTPONE: deprecated
+ :deprecations
+} ;
ABOUT: "tools.deprecation"
ARTICLE: "tools.destructors" "Destructor tools"
"The " { $vocab-link "tools.destructors" } " vocabulary provides words for tracking down resource leaks."
-{ $subsection debug-leaks? }
-{ $subsection disposables. }
-{ $subsection leaks }
+{ $subsections
+ debug-leaks?
+ disposables.
+ leaks
+}
{ $see-also "destructors" } ;
ABOUT: "tools.destructors"
\r
ARTICLE: "tools.disassembler" "Disassembling words"\r
"The " { $vocab-link "tools.disassembler" } " vocabulary provides support for disassembling compiled word definitions. It uses the " { $snippet "libudis86" } " library on x86-32 and x86-64, and " { $snippet "gdb" } " on PowerPC."\r
-{ $subsection disassemble } ;\r
+{ $subsections disassemble } ;\r
\r
ABOUT: "tools.disassembler"\r
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays byte-arrays combinators
destructors generic io kernel libc math sequences system tr
-vocabs.loader words ;
+vocabs.loader words alien.data ;
IN: tools.disassembler
GENERIC: disassemble ( obj -- )
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 ;
+tools.disassembler.utils splitting alien.data
+classes.struct ;
IN: tools.disassembler.udis
<<
LIBRARY: libudis86
-C-STRUCT: ud_operand
- { "int" "type" }
- { "uchar" "size" }
- { "ulonglong" "lval" }
- { "int" "base" }
- { "int" "index" }
- { "uchar" "offset" }
- { "uchar" "scale" } ;
-
-C-STRUCT: ud
- { "void*" "inp_hook" }
- { "uchar" "inp_curr" }
- { "uchar" "inp_fill" }
- { "FILE*" "inp_file" }
- { "uchar" "inp_ctr" }
- { "uchar*" "inp_buff" }
- { "uchar*" "inp_buff_end" }
- { "uchar" "inp_end" }
- { "void*" "translator" }
- { "ulonglong" "insn_offset" }
- { "char[32]" "insn_hexcode" }
- { "char[64]" "insn_buffer" }
- { "uint" "insn_fill" }
- { "uchar" "dis_mode" }
- { "ulonglong" "pc" }
- { "uchar" "vendor" }
- { "struct map_entry*" "mapen" }
- { "int" "mnemonic" }
- { "ud_operand[3]" "operand" }
- { "uchar" "error" }
- { "uchar" "pfx_rex" }
- { "uchar" "pfx_seg" }
- { "uchar" "pfx_opr" }
- { "uchar" "pfx_adr" }
- { "uchar" "pfx_lock" }
- { "uchar" "pfx_rep" }
- { "uchar" "pfx_repe" }
- { "uchar" "pfx_repne" }
- { "uchar" "pfx_insn" }
- { "uchar" "default64" }
- { "uchar" "opr_mode" }
- { "uchar" "adr_mode" }
- { "uchar" "br_far" }
- { "uchar" "br_near" }
- { "uchar" "implicit_addr" }
- { "uchar" "c1" }
- { "uchar" "c2" }
- { "uchar" "c3" }
- { "uchar[256]" "inp_cache" }
- { "uchar[64]" "inp_sess" }
- { "ud_itab_entry*" "itab_entry" } ;
+STRUCT: ud_operand
+ { type int }
+ { size uchar }
+ { lval ulonglong }
+ { base int }
+ { index int }
+ { offset uchar }
+ { scale uchar } ;
+
+STRUCT: ud
+ { inp_hook void* }
+ { inp_curr uchar }
+ { inp_fill uchar }
+ { inp_file void* }
+ { inp_ctr uchar }
+ { inp_buff uchar* }
+ { inp_buff_end uchar* }
+ { inp_end uchar }
+ { translator void* }
+ { insn_offset ulonglong }
+ { insn_hexcode char[32] }
+ { insn_buffer char[64] }
+ { insn_fill uint }
+ { dis_mode uchar }
+ { pc ulonglong }
+ { vendor uchar }
+ { mapen void* }
+ { mnemonic int }
+ { operand ud_operand[3] }
+ { error uchar }
+ { pfx_rex uchar }
+ { pfx_seg uchar }
+ { pfx_opr uchar }
+ { pfx_adr uchar }
+ { pfx_lock uchar }
+ { pfx_rep uchar }
+ { pfx_repe uchar }
+ { pfx_repne uchar }
+ { pfx_insn uchar }
+ { default64 uchar }
+ { opr_mode uchar }
+ { adr_mode uchar }
+ { br_far uchar }
+ { br_near uchar }
+ { implicit_addr uchar }
+ { c1 uchar }
+ { c2 uchar }
+ { c3 uchar }
+ { inp_cache uchar[256] }
+ { inp_sess uchar[64] }
+ { itab_entry void* } ;
FUNCTION: void ud_translate_intel ( ud* u ) ;
FUNCTION: void ud_translate_att ( ud* u ) ;
FUNCTION: char* ud_lookup_mnemonic ( int c ) ;
: <ud> ( -- ud )
- "ud" malloc-object &free
+ ud malloc-struct &free
dup ud_init
dup cell-bits ud_set_mode
dup UD_SYN_INTEL ud_set_syntax ;
"This indicates that some words did not pass the stack checker. Stack checker error conditions are documented in " { $link "inference-errors" } ", and the stack checker itself in " { $link "inference" } "."
$nl
"Words to view errors:"
-{ $subsection :errors }
-{ $subsection :linkage }
+{ $subsections
+ :errors
+ :linkage
+}
"Compiler errors are reported using the " { $link "tools.errors" } " mechanism, and as a result, they are also are shown in the " { $link "ui.tools.error-list" } "." ;
HELP: compiler-error
"Some tools, such as the " { $link "compiler" } ", " { $link "tools.test" } " and " { $link "help.lint" } " need to report multiple errors at a time. Each error is associated with a source file, line number, and optionally, a definition. " { $link "errors" } " cannot be used for this purpose, so the " { $vocab-link "source-files.errors" } " vocabulary provides an alternative mechanism. Note that the words in this vocabulary are used for implementation only; to actually list errors, consult the documentation for the relevant tools."
$nl
"Source file errors inherit from a class:"
-{ $subsection source-file-error }
+{ $subsections source-file-error }
"Printing an error summary:"
-{ $subsection error-summary }
+{ $subsections error-summary }
"Printing a list of errors:"
-{ $subsection errors. }
+{ $subsections errors. }
"Batch errors are reported in the " { $link "ui.tools.error-list" } "." ;
ABOUT: "tools.errors"
\ No newline at end of file
ARTICLE: "tools.files" "Files tools"
"The " { $vocab-link "tools.files" } " vocabulary implements directory files and file-systems listing in a cross-platform way." $nl
"Listing a directory:"
-{ $subsection directory. } ;
+{ $subsections directory. } ;
ABOUT: "tools.files"
ARTICLE: "tools.hexdump" "Hexdump"
"The " { $vocab-link "tools.hexdump" } " vocabulary provides a traditional hexdump view of a sequence." $nl
"Write hexdump to string:"
-{ $subsection hexdump }
+{ $subsections hexdump }
"Write the hexdump to the output stream:"
-{ $subsection hexdump. } ;
+{ $subsections hexdump. } ;
ABOUT: "tools.hexdump"
ARTICLE: "tools.memory" "Object memory tools"
"You can print object heap status information:"
-{ $subsection room. }
-{ $subsection heap-stats. }
-{ $subsection heap-stats }
+{ $subsections
+ room.
+ heap-stats.
+ heap-stats
+}
"You can query memory status:"
-{ $subsection data-room }
-{ $subsection code-room }
+{ $subsections
+ data-room
+ code-room
+}
"There are a pair of combinators, analogous to " { $link each } " and " { $link filter } ", which operate on the entire collection of objects in the object heap:"
-{ $subsection each-object }
-{ $subsection instances }
+{ $subsections
+ each-object
+ instances
+}
"You can check an object's the heap memory usage:"
-{ $subsection size }
+{ $subsections size }
"The garbage collector can be invoked manually:"
-{ $subsection gc }
+{ $subsections gc }
{ $see-also "images" } ;
ABOUT: "tools.memory"
"The " { $vocab-link "tools.profiler" } " vocabulary implements a simple call counting profiler."
$nl
"Quotations can be passed to a combinator which calls them with the profiler enabled:"
-{ $subsection profile }
+{ $subsections profile }
"After a quotation has been profiled, call counts can be presented in various ways:"
-{ $subsection profile. }
-{ $subsection vocab-profile. }
-{ $subsection usage-profile. }
-{ $subsection vocabs-profile. }
-{ $subsection method-profile. }
-{ $subsection "profiler-limitations" }
+{ $subsections
+ profile.
+ vocab-profile.
+ usage-profile.
+ vocabs-profile.
+ method-profile.
+ "profiler-limitations"
+}
{ $see-also "ui.tools.profiler" } ;
ABOUT: "profiling"
[ ] [ [ [ ] compile-call ] profile ] unit-test
[ [ gensym execute ] profile ] [ T{ undefined } = ] must-fail-with
+
+: crash-bug-1 ( -- x ) "hi" "bye" <word> ;
+: crash-bug-2 ( -- ) 100000 [ crash-bug-1 drop ] times ;
+
+[ ] [ [ crash-bug-2 ] profile ] unit-test
ARTICLE: "tools.scaffold" "Scaffold tool"
"Scaffold setup:"
-{ $subsection developer-name }
+{ $subsections developer-name }
"Generate new vocabs:"
-{ $subsection scaffold-vocab }
+{ $subsections scaffold-vocab }
"Generate help scaffolding:"
-{ $subsection scaffold-help }
-{ $subsection scaffold-undocumented }
-{ $subsection help. }
+{ $subsections
+ scaffold-help
+ scaffold-undocumented
+ help.
+}
"Types that are unrecognized by the scaffold generator will be of type " { $link null } ". The developer should change these to strings that describe the stack effect names instead." $nl
"Scaffolding a configuration file:"
-{ $subsection scaffold-rc }
-{ $subsection scaffold-factor-boot-rc }
-{ $subsection scaffold-factor-rc }
-{ $subsection scaffold-emacs }
+{ $subsections
+ scaffold-rc
+ scaffold-factor-boot-rc
+ scaffold-factor-rc
+ scaffold-emacs
+}
;
ABOUT: "tools.scaffold"
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test tools.scaffold unicode.case kernel
-multiline tools.scaffold.private io.streams.string ;
+tools.scaffold.private io.streams.string ;
IN: tools.scaffold.tests
: undocumented-word ( obj1 obj2 -- obj3 obj4 )
[ >lower ] [ >upper ] bi* ;
[
-<" HELP: undocumented-word
+"""HELP: undocumented-word
{ $values
{ "obj1" object } { "obj2" object }
{ "obj3" object } { "obj4" object }
}
{ $description "" } ;
-">
+"""
]
[
[ \ undocumented-word (help.) ] with-string-writer
ARTICLE: "tools.test.write" "Writing unit tests"
"Assert that a quotation outputs a specific set of values:"
-{ $subsection POSTPONE: unit-test }
+{ $subsections POSTPONE: unit-test }
"Assert that a quotation throws an error:"
-{ $subsection POSTPONE: must-fail }
-{ $subsection POSTPONE: must-fail-with }
+{ $subsections
+ POSTPONE: must-fail
+ POSTPONE: must-fail-with
+}
"Assert that a quotation or word has a specific static stack effect (see " { $link "inference" } "):"
-{ $subsection POSTPONE: must-infer }
-{ $subsection POSTPONE: must-infer-as }
+{ $subsections
+ POSTPONE: must-infer
+ POSTPONE: must-infer-as
+}
"All of the above are used like ordinary words but are actually parsing words. This ensures that parse-time state, namely the line number, can be associated with the test in question, and reported in test failures." ;
ARTICLE: "tools.test.run" "Running unit tests"
"The following words run test harness files; any test failures are collected and printed at the end:"
-{ $subsection test }
-{ $subsection test-all }
+{ $subsections
+ test
+ test-all
+}
"The following word prints failures:"
-{ $subsection :test-failures }
+{ $subsections :test-failures }
"Test failures are reported using the " { $link "tools.errors" } " mechanism and are shown in the " { $link "ui.tools.error-list" } "."
$nl
"Unit test failures are instances of a class, and are stored in a global variable:"
-{ $subsection test-failure }
-{ $subsection test-failures } ;
+{ $subsections
+ test-failure
+ test-failures
+} ;
ARTICLE: "tools.test" "Unit testing"
"A unit test is a piece of code which starts with known input values, then compares the output of a word with an expected output, where the expected output is defined by the word's contract."
"The latter is used for vocabularies with more extensive test suites."
$nl
"If the test harness needs to define words, they should be placed in a vocabulary named " { $snippet { $emphasis "vocab" } ".tests" } " where " { $emphasis "vocab" } " is the vocab being tested."
-{ $subsection "tools.test.write" }
-{ $subsection "tools.test.run" } ;
+{ $subsections
+ "tools.test.write"
+ "tools.test.run"
+} ;
ABOUT: "tools.test"
{ quot [ test-failures get ] }
} define-error-type
+SYMBOL: verbose-tests?
+t verbose-tests? set-global
+
<PRIVATE
: <test-failure> ( error experiment file line# -- triple )
SYMBOL: file
: file-failure ( error -- )
- f file get f failure ;
+ [ f file get ] keep error-line failure ;
:: (unit-test) ( output input -- error ? )
[ { } input with-datastack output assert-sequence= f f ] [ t ] recover ;
'[ _ ndup _ narray _ prefix ] ;
: experiment. ( seq -- )
- [ first write ": " write ] [ rest . flush ] bi ;
+ [ first write ": " write ]
+ [ rest verbose-tests? get [ . ] [ short. ] if flush ] bi ;
:: experiment ( word: ( -- error ? ) line# -- )
word <experiment> :> e
ARTICLE: "tools.threads" "Listing threads"
"Printing a list of running threads:"
-{ $subsection threads. } ;
+{ $subsections threads. } ;
ABOUT: "tools.threads"
ARTICLE: "timing" "Timing code"
"You can time the execution of a quotation in the listener:"
-{ $subsection time }
+{ $subsections time }
"A lower-level word puts timings on the stack, intead of printing:"
-{ $subsection benchmark }
+{ $subsections benchmark }
"You can also read the system clock and garbage collection statistics directly:"
-{ $subsection micros }
-{ $subsection gc-stats }
+{ $subsections
+ micros
+ gc-stats
+}
{ $see-also "profiling" } ;
ABOUT: "timing"
IN: tools.walker
-USING: help.syntax help.markup tools.continuations ;
+USING: help.syntax help.markup tools.continuations sequences math words ;
+
+HELP: breakpoint
+{ $values { "word" word } }
+{ $description "Annotates a word definition to enter the single stepper when executed." } ;
+
+HELP: breakpoint-if
+{ $values { "quot" { $quotation "( -- ? )" } } { "word" word } }
+{ $description "Annotates a word definition to enter the single stepper if the quotation yields true." } ;
HELP: B
-{ $description "An alias for " { $link break } ", defined in the " { $vocab-link "syntax" } " vocabulary so that it is always available." } ;
\ No newline at end of file
+{ $description "An alias for " { $link break } ", defined in the " { $vocab-link "syntax" } " vocabulary so that it is always available." } ;
+
+ARTICLE: "breakpoints" "Setting breakpoints"
+"In addition to invoking the walker explicitly through the UI, it is possible to set breakpoints on words using words in the " { $vocab-link "tools.walker" } " vocabulary."
+$nl
+"Annotating a word with a breakpoint (see " { $link "tools.annotations" } "):"
+{ $subsections
+ breakpoint
+ breakpoint-if
+}
+"Breakpoints can be inserted directly into code:"
+{ $subsections
+ break
+ POSTPONE: B
+}
+"Note that because the walker calls various core library and UI words while rendering its own user interface, setting a breakpoint on a word such as " { $link append } " or " { $link + } " will hang the UI." ;
+
+ABOUT: "breakpoints"
concurrency.messaging quotations kernel.private words
sequences.private assocs models models.arrow arrays accessors
generic generic.standard definitions make sbufs
-tools.continuations parser ;
+tools.continuations parser tools.annotations fry ;
IN: tools.walker
SYMBOL: show-walker-hook ! ( status continuation thread -- )
"Walker on " self name>> append spawn
[ associate-thread ] keep ;
+: breakpoint ( word -- )
+ [ add-breakpoint ] annotate ;
+
+: breakpoint-if ( word quot -- )
+ '[ [ _ [ [ break ] when ] ] dip 3append ] annotate ;
+
! For convenience
IN: syntax
"Since value semantics differ from reference semantics, it is best to use tuple arrays with tuples where all slots are declared " { $link read-only } "."
$nl
"Tuple arrays should not be used with inheritance; storing an instance of a subclass in a tuple array will slice off the subclass slots, and getting the same value out again will yield an instance of the superclass. Also, tuple arrays do not get updated if tuples are redefined to add or remove slots, so caution should be exercised when doing interactive development on code that uses tuple arrays."
-{ $subsection POSTPONE: TUPLE-ARRAY: }
+{ $subsections POSTPONE: TUPLE-ARRAY: }
"An example:"
{ $example
"USE: tuple-arrays"
core-foundation core-foundation.run-loop core-graphics
core-graphics.types destructors fry generalizations io.thread
kernel libc literals locals math math.bitwise math.rectangles memory
-namespaces sequences threads ui
+namespaces sequences threads ui colors
ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
ui.private words.symbol ;
{ resize-handles $ NSResizableWindowMask }
{ small-title-bar $[ NSTitledWindowMask NSUtilityWindowMask bitor ] }
{ normal-title-bar $ NSTitledWindowMask }
+ { textured-background $ NSTexturedBackgroundWindowMask }
}
: world>styleMask ( world -- n )
window-controls>> window-control>styleMask symbols>flags ;
+: make-context-transparent ( view -- )
+ -> openGLContext
+ 0 <int> NSOpenGLCPSurfaceOpacity -> setValues:forParameter: ;
+
M:: cocoa-ui-backend (open-window) ( world -- )
world [ [ dim>> ] dip <FactorView> ]
with-world-pixel-format :> view
+ world window-controls>> textured-background swap memq?
+ [ view make-context-transparent ] when
view world [ world>NSRect ] [ world>styleMask ] bi <ViewWindow> :> window
view -> release
world view register-window
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.strings arrays assocs
-cocoa kernel math cocoa.messages cocoa.subclassing cocoa.classes
-cocoa.views cocoa.application cocoa.pasteboard cocoa.types
-cocoa.windows sequences io.encodings.utf8 ui ui.private ui.gadgets
-ui.gadgets.private ui.gadgets.worlds ui.gestures
+USING: accessors alien alien.c-types alien.data alien.strings
+arrays assocs cocoa kernel math cocoa.messages cocoa.subclassing
+cocoa.classes cocoa.views cocoa.application cocoa.pasteboard
+cocoa.types cocoa.windows sequences io.encodings.utf8 ui ui.private
+ui.gadgets ui.gadgets.private ui.gadgets.worlds ui.gestures
core-foundation.strings core-graphics core-graphics.types threads
combinators math.rectangles ;
IN: ui.backend.cocoa.views
]
}
+{ "isOpaque" "char" { "id" "SEL" }
+ [
+ 2drop 0
+ ]
+}
+
{ "dealloc" "void" { "id" "SEL" }
[
drop
! Copyright (C) 2005, 2006 Doug Coleman.
! Portions copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings arrays assocs ui ui.private
-ui.gadgets ui.gadgets.private ui.backend ui.clipboards
-ui.gadgets.worlds ui.gestures ui.event-loop io kernel math
-math.vectors namespaces make sequences strings vectors words
-windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
-windows.messages windows.types windows.offscreen windows.nt
-threads libc combinators fry combinators.short-circuit continuations
-command-line shuffle opengl ui.render math.bitwise locals
-accessors math.rectangles math.order calendar ascii sets
-io.encodings.utf16n windows.errors literals ui.pixel-formats
-ui.pixel-formats.private memoize classes struct-arrays classes.struct ;
+USING: alien alien.c-types alien.strings arrays assocs ui
+ui.private ui.gadgets ui.gadgets.private ui.backend
+ui.clipboards ui.gadgets.worlds ui.gestures ui.event-loop io
+kernel math math.vectors namespaces make sequences strings
+vectors words windows.dwmapi system-info.windows windows.kernel32
+windows.gdi32 windows.user32 windows.opengl32 windows.messages
+windows.types windows.offscreen windows.nt threads libc combinators
+fry combinators.short-circuit continuations command-line shuffle
+opengl ui.render math.bitwise locals accessors math.rectangles
+math.order calendar ascii sets io.encodings.utf16n
+windows.errors literals ui.pixel-formats
+ui.pixel-formats.private memoize classes colors
+specialized-arrays classes.struct alien.data ;
+SPECIALIZED-ARRAY: POINT
IN: ui.backend.windows
SINGLETON: windows-ui-backend
CONSTANT: window-control>style
H{
{ close-button 0 }
+ { textured-background 0 }
{ minimize-button $ WS_MINIMIZEBOX }
{ maximize-button $ WS_MAXIMIZEBOX }
{ resize-handles $ WS_THICKFRAME }
CONSTANT: window-control>ex-style
H{
{ close-button 0 }
+ { textured-background 0 }
{ minimize-button 0 }
{ maximize-button 0 }
{ resize-handles $ WS_EX_WINDOWEDGE }
window-controls>> window-control>ex-style symbols>flags ;
: get-RECT-top-left ( RECT -- x y )
- [ RECT-left ] keep RECT-top ;
+ [ left>> ] [ top>> ] bi ;
+
+: get-RECT-width/height ( RECT -- width height )
+ [ [ right>> ] [ left>> ] bi - ]
+ [ [ bottom>> ] [ top>> ] bi - ] bi ;
: get-RECT-dimensions ( RECT -- x y width height )
- [ get-RECT-top-left ] keep
- [ RECT-right ] keep [ RECT-left - ] keep
- [ RECT-bottom ] keep RECT-top - ;
+ [ get-RECT-top-left ] [ get-RECT-width/height ] bi ;
: handle-wm-paint ( hWnd uMsg wParam lParam -- )
#! wParam and lParam are unused
] if ;
: make-TRACKMOUSEEVENT ( hWnd -- alien )
- "TRACKMOUSEEVENT" <c-object> [ set-TRACKMOUSEEVENT-hwndTrack ] keep
- "TRACKMOUSEEVENT" heap-size over set-TRACKMOUSEEVENT-cbSize ;
+ TRACKMOUSEEVENT <struct>
+ swap >>hwndTrack
+ TRACKMOUSEEVENT heap-size >>cbSize ;
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
2nip
over make-TRACKMOUSEEVENT
- TME_LEAVE over set-TRACKMOUSEEVENT-dwFlags
- 0 over set-TRACKMOUSEEVENT-dwHoverTime
+ TME_LEAVE >>dwFlags
+ 0 >>dwHoverTime
TrackMouseEvent drop
>lo-hi swap window move-hand fire-motion ;
#! message sent if mouse leaves main application
4drop forget-rollover ;
+: system-background-color ( -- color )
+ COLOR_BTNFACE GetSysColor RGB>color ;
+
+: ?make-glass ( world hwnd -- )
+ over window-controls>> textured-background swap memq? [
+ composition-enabled? [
+ full-window-margins DwmExtendFrameIntoClientArea drop
+ T{ rgba f 0.0 0.0 0.0 0.0 }
+ ] [ drop system-background-color ] if >>background-color
+ drop
+ ] [ 2drop ] if ;
+
+: handle-wm-dwmcompositionchanged ( hWnd uMsg wParam lParam -- )
+ 3drop [ window ] keep ?make-glass ;
+
SYMBOL: wm-handlers
H{ } clone wm-handlers set-global
[ handle-wm-buttonup 0 ] WM_LBUTTONUP add-wm-handler
[ handle-wm-buttonup 0 ] WM_MBUTTONUP add-wm-handler
[ handle-wm-buttonup 0 ] WM_RBUTTONUP add-wm-handler
+[ handle-wm-dwmcompositionchanged 0 ] WM_DWMCOMPOSITIONCHANGED add-wm-handler
[ 4dup handle-wm-ncbutton DefWindowProc ]
{ WM_NCLBUTTONDOWN WM_NCMBUTTONDOWN WM_NCRBUTTONDOWN
] if ;
:: register-window-class ( class-name-ptr -- )
- "WNDCLASSEX" <c-object> f GetModuleHandle
+ WNDCLASSEX <struct> f GetModuleHandle
class-name-ptr pick GetClassInfoEx 0 = [
- "WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
- { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
- ui-wndproc over set-WNDCLASSEX-lpfnWndProc
- 0 over set-WNDCLASSEX-cbClsExtra
- 0 over set-WNDCLASSEX-cbWndExtra
- f GetModuleHandle over set-WNDCLASSEX-hInstance
- f GetModuleHandle "fraptor" utf16n string>alien LoadIcon
- over set-WNDCLASSEX-hIcon
- f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
-
- class-name-ptr over set-WNDCLASSEX-lpszClassName
+ WNDCLASSEX heap-size >>cbSize
+ { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags >>style
+ ui-wndproc >>lpfnWndProc
+ 0 >>cbClsExtra
+ 0 >>cbWndExtra
+ f GetModuleHandle >>hInstance
+ f GetModuleHandle "fraptor" utf16n string>alien LoadIcon >>hIcon
+ f IDC_ARROW LoadCursor >>hCursor
+
+ class-name-ptr >>lpszClassName
RegisterClassEx win32-error=0/f
] [ drop ] if ;
: make-RECT ( world -- RECT )
[ window-loc>> ] [ dim>> ] bi <RECT> ;
-: default-position-RECT ( RECT -- )
- dup get-RECT-dimensions [ 2drop ] 2dip
- CW_USEDEFAULT + pick set-RECT-bottom
- CW_USEDEFAULT + over set-RECT-right
- CW_USEDEFAULT over set-RECT-left
- CW_USEDEFAULT swap set-RECT-top ;
+: default-position-RECT ( RECT -- RECT' )
+ dup get-RECT-width/height
+ [ CW_USEDEFAULT + >>right ] dip
+ CW_USEDEFAULT + >>bottom
+ CW_USEDEFAULT >>left
+ CW_USEDEFAULT >>top ;
: make-adjusted-RECT ( rect style ex-style -- RECT )
[
dup get-RECT-top-left [ zero? ] both? swap
dup
] 2dip adjust-RECT
- swap [ dup default-position-RECT ] when ;
+ swap [ default-position-RECT ] when ;
: get-window-class ( -- class-name )
class-name-ptr [
: init-win32-ui ( -- )
V{ } clone nc-buttons set-global
- "MSG" malloc-object msg-obj set-global
+ MSG malloc-struct msg-obj set-global
GetDoubleClickTime milliseconds double-click-timeout set-global ;
: cleanup-win32-ui ( -- )
[
dup
[ ] [ world>style ] [ world>ex-style ] tri create-window
+ [ ?make-glass ]
[ ?disable-close-button ]
- [ [ f f ] dip f f <win> >>handle setup-gl ] 2bi
+ [ [ f f ] dip f f <win> >>handle setup-gl ] 2tri
]
[ dup handle>> hWnd>> register-window ]
[ handle>> hWnd>> show-window ] tri ;
: fullscreen-RECT ( hwnd -- RECT )
MONITOR_DEFAULTTONEAREST MonitorFromWindow
- "MONITORINFOEX" <c-object> dup length over set-MONITORINFOEX-cbSize
- [ GetMonitorInfo win32-error=0/f ] keep MONITORINFOEX-rcMonitor ;
+ MONITORINFOEX <struct>
+ MONITORINFOEX heap-size >>cbSize
+ [ GetMonitorInfo win32-error=0/f ] keep rcMonitor>> ;
: client-area>RECT ( hwnd -- RECT )
- "RECT" <c-object>
+ RECT <struct>
[ GetClientRect win32-error=0/f ]
- [ "POINT" byte-array>struct-array [ ClientToScreen drop ] with each ]
+ [ >c-ptr byte-array>POINT-array [ ClientToScreen drop ] with each ]
[ nip ] 2tri ;
: hwnd>RECT ( hwnd -- RECT )
- "RECT" <c-object> [ GetWindowRect win32-error=0/f ] keep ;
+ RECT <struct> [ GetWindowRect win32-error=0/f ] keep ;
M: windows-ui-backend (grab-input) ( handle -- )
0 ShowCursor drop
! Copyright (C) 2005, 2009 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types arrays ui ui.private ui.gadgets
-ui.gadgets.private ui.gestures ui.backend ui.clipboards
-ui.gadgets.worlds ui.render ui.event-loop assocs kernel math
-namespaces opengl sequences strings x11 x11.xlib x11.events x11.xim
-x11.glx x11.clipboard x11.constants x11.windows x11.io
-io.encodings.string io.encodings.ascii io.encodings.utf8 combinators
-command-line math.vectors classes.tuple opengl.gl threads
-math.rectangles environment ascii literals
-ui.pixel-formats ui.pixel-formats.private ;
+USING: accessors alien.c-types arrays ascii assocs colors
+classes.struct combinators io.encodings.ascii
+io.encodings.string io.encodings.utf8 kernel literals math
+namespaces sequences strings ui ui.backend ui.clipboards
+ui.event-loop ui.gadgets ui.gadgets.private ui.gadgets.worlds
+ui.gestures ui.pixel-formats ui.pixel-formats.private
+ui.private x11 x11.clipboard x11.constants x11.events x11.glx
+x11.io x11.windows x11.xim x11.xlib environment command-line
+combinators.short-circuit ;
IN: ui.backend.x11
SINGLETON: x11-ui-backend
M: world expose-event nip relayout ;
M: world configure-event
- over configured-loc >>window-loc
- swap configured-dim >>dim
+ swap [ event-loc >>window-loc ] [ event-dim >>dim ] bi
! In case dimensions didn't change
relayout-1 ;
M: x11-ui-backend (make-pixel-format)
[ drop dpy get scr get ] dip
- >glx-visual-int-array glXChooseVisual ;
+ >glx-visual-int-array glXChooseVisual
+ XVisualInfo memory>struct ;
M: x11-ui-backend (free-pixel-format)
handle>> XFree ;
dup key-codes at [ t ] [ 1string f ] ?if ;
: event-modifiers ( event -- seq )
- XKeyEvent-state modifiers modifier ;
+ state>> modifiers modifier ;
: valid-input? ( string gesture -- ? )
over empty? [ 2drop f ] [
mods>> { f { S+ } } member? [
- [ [ 127 = not ] [ CHAR: \s >= ] bi and ] all?
+ [ { [ 127 = not ] [ CHAR: \s >= ] } 1&& ] all?
] [
- [ [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] tri and and ] all?
+ [ { [ 127 = not ] [ CHAR: \s >= ] [ alpha? not ] } 1&& ] all?
] if
] if ;
[ key-up-event>gesture ] dip propagate-key-gesture ;
: mouse-event>gesture ( event -- modifiers button loc )
- [ event-modifiers ]
- [ XButtonEvent-button ]
- [ mouse-event-loc ]
- tri ;
+ [ event-modifiers ] [ button>> ] [ event-loc ] tri ;
M: world button-down-event
[ mouse-event>gesture [ <button-down> ] dip ] dip
send-button-up ;
: mouse-event>scroll-direction ( event -- pair )
- XButtonEvent-button {
+ button>> {
{ 4 { 0 -1 } }
{ 5 { 0 1 } }
{ 6 { -1 0 } }
} at ;
M: world wheel-event
- [ [ mouse-event>scroll-direction ] [ mouse-event-loc ] bi ] dip
+ [ [ mouse-event>scroll-direction ] [ event-loc ] bi ] dip
send-wheel ;
M: world enter-event motion-event ;
M: world leave-event 2drop forget-rollover ;
M: world motion-event
- [ [ XMotionEvent-x ] [ XMotionEvent-y ] bi 2array ] dip
- move-hand fire-motion ;
+ [ event-loc ] dip move-hand fire-motion ;
M: world focus-in-event
- nip
- [ handle>> xic>> XSetICFocus ] [ focus-world ] bi ;
+ nip [ handle>> xic>> XSetICFocus ] [ focus-world ] bi ;
M: world focus-out-event
- nip
- [ handle>> xic>> XUnsetICFocus ] [ unfocus-world ] bi ;
+ nip [ handle>> xic>> XUnsetICFocus ] [ unfocus-world ] bi ;
M: world selection-notify-event
[ handle>> window>> selection-from-event ] keep
} case ;
: encode-clipboard ( string type -- bytes )
- XSelectionRequestEvent-target
- XA_UTF8_STRING = utf8 ascii ? encode ;
+ target>> XA_UTF8_STRING = utf8 ascii ? encode ;
: set-selection-prop ( evt -- )
dpy get swap
- [ XSelectionRequestEvent-requestor ] keep
- [ XSelectionRequestEvent-property ] keep
- [ XSelectionRequestEvent-target ] keep
- [ 8 PropModeReplace ] dip
- [
- XSelectionRequestEvent-selection
- clipboard-for-atom contents>>
- ] keep encode-clipboard dup length XChangeProperty drop ;
+ [ requestor>> ] keep
+ [ property>> ] keep
+ [ target>> 8 PropModeReplace ] keep
+ [ selection>> clipboard-for-atom contents>> ] keep
+ encode-clipboard dup length XChangeProperty drop ;
M: world selection-request-event
- drop dup XSelectionRequestEvent-target {
+ drop dup target>> {
{ [ dup supported-type? ] [ drop dup set-selection-prop send-notify-success ] }
{ [ dup "TARGETS" x-atom = ] [ drop dup set-targets-prop send-notify-success ] }
{ [ dup "TIMESTAMP" x-atom = ] [ drop dup set-timestamp-prop send-notify-success ] }
] [ wait-for-display wait-event ] if ;
M: x11-ui-backend do-events
- wait-event dup XAnyEvent-window window dup
+ wait-event dup XAnyEvent>> window>> window dup
[ handle-event ] [ 2drop ] if ;
: x-clipboard@ ( gadget clipboard -- prop win )
handle>> window>> swap
[ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
+: make-fullscreen-msg ( world ? -- msg )
+ XClientMessageEvent <struct>
+ ClientMessage >>type
+ dpy get >>display
+ "_NET_WM_STATE" x-atom >>message_type
+ swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ? >>data0
+ swap handle>> window>> >>window
+ 32 >>format
+ "_NET_WM_STATE_FULLSCREEN" x-atom >>data1 ;
+
M: x11-ui-backend (set-fullscreen) ( world ? -- )
- [
- handle>> window>> "XClientMessageEvent" <c-object>
- [ set-XClientMessageEvent-window ] keep
- ] dip
- _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
- over set-XClientMessageEvent-data0
- ClientMessage over set-XClientMessageEvent-type
- dpy get over set-XClientMessageEvent-display
- "_NET_WM_STATE" x-atom over set-XClientMessageEvent-message_type
- 32 over set-XClientMessageEvent-format
- "_NET_WM_STATE_FULLSCREEN" x-atom over set-XClientMessageEvent-data1
- [ dpy get root get 0 SubstructureNotifyMask ] dip XSendEvent drop ;
+ [ dpy get root get 0 SubstructureNotifyMask ] 2dip
+ make-fullscreen-msg XSendEvent drop ;
M: x11-ui-backend (open-window) ( world -- )
dup gadget-window
drop ;
M: x11-ui-backend (open-offscreen-buffer) ( world -- )
- dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ]
- with-world-pixel-format
+ dup [ [ dim>> ] [ handle>> ] bi* glx-pixmap ] with-world-pixel-format
<x11-pixmap-handle> >>handle drop ;
+
M: x11-ui-backend (close-offscreen-buffer) ( handle -- )
dpy get swap
[ glx-pixmap>> glXDestroyGLXPixmap ]
ARTICLE: "clipboard-protocol" "Clipboard protocol"
"Custom gadgets that wish to interact with the clipboard must use the following two generic words to read and write clipboard contents:"
-{ $subsection paste-clipboard }
-{ $subsection copy-clipboard }
+{ $subsections
+ paste-clipboard
+ copy-clipboard
+}
"UI backends can either implement the above two words in the case of an asynchronous clipboard model (for example, X11). If direct access to the clipboard is provided (Windows, Mac OS X), the following two generic words may be implemented instead:"
-{ $subsection clipboard-contents }
-{ $subsection set-clipboard-contents }
+{ $subsections
+ clipboard-contents
+ set-clipboard-contents
+}
"However, gadgets should not call these words, since they will fail if only the asynchronous method of clipboard access is supported by the backend in use."
$nl
"Access to two clipboards is provided:"
-{ $subsection clipboard }
-{ $subsection selection }
+{ $subsections
+ clipboard
+ selection
+}
"These variables may contain clipboard protocol implementations which transfer data to and from the native system clipboard. However an UI backend may leave one or both of these variables in their default state, which is a trivial clipboard implementation internal to the Factor UI." ;
ABOUT: "clipboard-protocol"
}
} ;
-HELP: command-string
-{ $values { "gesture" "a gesture" } { "command" "a command" } { "string" string } }
-{ $description "Outputs a string containing the command name followed by the gesture." }
-{ $examples
- { $unchecked-example
- "USING: io ui.commands ui.gestures ;"
- "IN: scratchpad"
- ": com-my-command ;"
- "T{ key-down f { C+ } \"s\" } \\ com-my-command command-string write"
- "My Command (C+s)"
- }
-} ;
-
ARTICLE: "ui-commands" "Commands"
"Commands are an abstraction layered on top of gestures. Their main advantage is that they are identified by words and can be organized into " { $emphasis "command maps" } ". This allows easy construction of buttons and tool bars for invoking commands."
-{ $subsection define-command }
+{ $subsections define-command }
"Command groups are defined on gadget classes:"
-{ $subsection define-command-map }
+{ $subsections define-command-map }
"Commands can be introspected and invoked:"
-{ $subsection commands }
-{ $subsection command-map }
-{ $subsection invoke-command }
+{ $subsections
+ commands
+ command-map
+ invoke-command
+}
"Gadgets for invoking commands are documented in " { $link "ui.gadgets.buttons" } "."
$nl
"When documenting gadgets, command documentation can be automatically generated:"
-{ $subsection $command-map }
-{ $subsection $command } ;
+{ $subsections
+ $command-map
+ $command
+} ;
ABOUT: "ui-commands"
M: word command-word ;
-M: f invoke-command ( target command -- ) 2drop ;
-
-: command-string ( gesture command -- string )
- [
- command-name %
- gesture>string [ " (" % % ")" % ] when*
- ] "" make ;
\ No newline at end of file
+M: f invoke-command ( target command -- ) 2drop ;
\ No newline at end of file
ARTICLE: "ui-book-layout" "Book layouts"
"Books can contain any number of children, and display one child at a time. The currently visible child is determined by the value of the model, which must be an integer."
-{ $subsection book }
-{ $subsection <book> }
-{ $subsection <empty-book> } ;
+{ $subsections
+ book
+ <book>
+ <empty-book>
+} ;
ABOUT: "ui-book-layout"
ARTICLE: "ui.gadgets.borders" "Border gadgets"
"The " { $vocab-link "ui.gadgets.borders" } " vocabulary implements border gadgets, which add empty space around a child gadget."
-{ $subsection border }
-{ $subsection <border> } ;
+{ $subsections
+ border
+ <border>
+} ;
ABOUT: "ui.gadgets.borders"
$nl
"A button's appearance can vary depending on the state of the mouse button if the " { $snippet "interior" } " or " { $snippet "boundary" } " slots are set to instances of " { $link button-pen } "."
$nl
-"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by " { $link checkbox } " instances to render themselves when they're checked." } ;
+"A button can be selected, which is distinct from being pressed. This state is held in the " { $snippet "selected?" } " slot, and is used by " { $link checkbox } " instances to render themselves when they're checked."
+$nl
+"A button can optionally display a message in the window's status bar whenever the mouse cursor hovers over the button. To enable this behavior, just set a string to the button's " { $snippet "tooltip" } " slot." } ;
HELP: <button>
{ $values { "label" gadget } { "quot" { $quotation "( button -- )" } } { "button" "a new " { $link button } } }
ARTICLE: "ui.gadgets.buttons" "Button gadgets"
"The " { $vocab-link "ui.gadgets.buttons" } " vocabulary implements buttons. Buttons respond to mouse clicks by invoking a quotation."
-{ $subsection button }
+{ $subsections button }
"There are many ways to create a new button:"
-{ $subsection <button> }
-{ $subsection <roll-button> }
-{ $subsection <border-button> }
-{ $subsection <repeat-button> }
+{ $subsections
+ <button>
+ <roll-button>
+ <border-button>
+ <repeat-button>
+}
"Gadgets for invoking commands:"
-{ $subsection <command-button> }
-{ $subsection <toolbar> }
+{ $subsections
+ <command-button>
+ <toolbar>
+}
"Button appearance can be customized:"
-{ $subsection button-pen }
+{ $subsections button-pen }
"Button constructors take " { $emphasis "label specifiers" } " as input. A label specifier is either a string, an array of strings, a gadget or " { $link f } "."
{ $see-also <command-button> "ui-commands" } ;
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel math models namespaces sequences
-strings quotations assocs combinators classes colors colors.constants
-classes.tuple opengl opengl.gl math.vectors ui.commands ui.gadgets
-ui.gadgets.borders ui.gadgets.labels ui.gadgets.tracks
-ui.gadgets.packs ui.gadgets.worlds ui.gestures ui.pens ui.pens.solid
-ui.pens.image ui.pens.tile math.rectangles locals fry
-combinators.smart ;
+USING: accessors arrays assocs classes classes.tuple colors
+colors.constants combinators combinators.short-circuit
+combinators.smart fry kernel locals math math.rectangles
+math.vectors models namespaces opengl opengl.gl quotations
+sequences strings ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.labels ui.gadgets.packs ui.gadgets.tracks
+ui.gadgets.worlds ui.gestures ui.pens ui.pens.image
+ui.pens.solid ui.pens.tile ;
FROM: models => change-model ;
IN: ui.gadgets.buttons
-TUPLE: button < border pressed? selected? quot ;
+TUPLE: button < border pressed? selected? quot tooltip ;
<PRIVATE
: button-update ( button -- )
dup
- [ mouse-clicked? ] [ button-rollover? ] bi and
+ { [ mouse-clicked? ] [ button-rollover? ] } 1&&
buttons-down? and
>>pressed?
relayout-1 ;
+: button-enter ( button -- )
+ dup dup tooltip>> [ swap show-status ] [ drop ] if* button-update ;
+
+: button-leave ( button -- )
+ dup "" swap show-status button-update ;
+
: button-clicked ( button -- )
- dup button-update
- dup button-rollover?
+ [ ]
+ [ button-update ]
+ [ button-rollover? ] tri
[ dup quot>> call( button -- ) ] [ drop ] if ;
button H{
{ T{ button-up } [ button-clicked ] }
{ T{ button-down } [ button-update ] }
- { mouse-leave [ button-update ] }
- { mouse-enter [ button-update ] }
+ { mouse-leave [ button-leave ] }
+ { mouse-enter [ button-enter ] }
} set-gestures
: new-button ( label quot class -- button )
: button-pen ( button pen -- button pen )
over find-button {
- { [ dup [ pressed?>> ] [ selected?>> ] bi and ] [ drop pressed-selected>> ] }
+ { [ dup { [ pressed?>> ] [ selected?>> ] } 1&& ] [
+ drop pressed-selected>>
+ ] }
{ [ dup pressed?>> ] [ drop pressed>> ] }
{ [ dup selected?>> ] [ drop selected>> ] }
{ [ dup button-rollover? ] [ drop rollover>> ] }
[ append theme-image ] tri-curry@ tri
] 2dip <tile-pen> ;
-CONSTANT: button-background
- T{ rgba
- f
- 0.8901960784313725
- 0.8862745098039215
- 0.8588235294117647
- 1.0
- }
-
-CONSTANT: button-clicked-background
- T{ rgba
- f
- 0.2156862745098039
- 0.2431372549019608
- 0.2823529411764706
- 1.0
- }
-
+CONSTANT: button-background COLOR: FactorTan
+CONSTANT: button-clicked-background COLOR: FactorDarkSlateBlue
+
: <border-button-pen> ( -- pen )
- "button" button-background COLOR: black <border-button-state-pen> dup
- "button-clicked" button-clicked-background COLOR: white <border-button-state-pen> dup dup
+ "button" button-background button-clicked-background
+ <border-button-state-pen> dup
+ "button-clicked" button-clicked-background COLOR: white
+ <border-button-state-pen> dup dup
<button-pen> ;
+: border-button-label-theme ( gadget -- )
+ dup label? [ [ clone t >>bold? ] change-font ] when drop ;
+
: border-button-theme ( gadget -- gadget )
+ dup children>> first border-button-label-theme
horizontal >>orientation
<border-button-pen> >>interior
dup dup interior>> pen-pref-dim >>min-dim
: command-button-quot ( target command -- quot )
'[ _ _ invoke-command ] ;
+: gesture>tooltip ( gesture -- str/f )
+ gesture>string dup [ "Shortcut: " prepend ] when ;
+
: <command-button> ( target gesture command -- button )
- [ command-string swap ] keep command-button-quot
- '[ drop @ ] <border-button> ;
+ swapd [ command-name swap ] keep command-button-quot
+ '[ drop @ ] <border-button> swap gesture>tooltip >>tooltip ;
: <toolbar> ( target -- toolbar )
<shelf>
ARTICLE: "gadgets-editors-selection" "The caret and mark"
"If there is no selection, the caret and the mark are at the same location; otherwise the mark delimits the end-point of the selection opposite the caret."
-{ $subsection editor-caret }
-{ $subsection editor-mark }
-{ $subsection change-caret }
-{ $subsection change-caret&mark }
-{ $subsection mark>caret }
+{ $subsections
+ editor-caret
+ editor-mark
+ change-caret
+ change-caret&mark
+ mark>caret
+}
"Getting the selected text:"
-{ $subsection gadget-selection? }
-{ $subsection gadget-selection }
+{ $subsections
+ gadget-selection?
+ gadget-selection
+}
"Removing selected text:"
-{ $subsection remove-selection }
+{ $subsections remove-selection }
"Scrolling to the caret location:"
-{ $subsection scroll>caret }
+{ $subsections scroll>caret }
"Use " { $link user-input* } " to change selected text." ;
ARTICLE: "gadgets-editors-contents" "Getting and setting editor contents"
-{ $subsection editor-string }
-{ $subsection set-editor-string }
-{ $subsection clear-editor } ;
+{ $subsections
+ editor-string
+ set-editor-string
+ clear-editor
+} ;
ARTICLE: "gadgets-editors-commands" "Editor gadget commands"
{ $command-map editor "editing" }
ARTICLE: "ui.gadgets.editors" "Editor gadgets"
"The " { $vocab-link "ui.gadgets.editors" } " vocabulary implements editor gadgets. An editor edits a passage of text. Editors display a " { $link document } ". Editors are built from and inherit all features of " { $link "ui.gadgets.line-support" } "."
-{ $subsection "gadgets-editors-commands" }
+{ $subsections "gadgets-editors-commands" }
"Editors:"
-{ $subsection editor }
-{ $subsection <editor> }
-{ $subsection "gadgets-editors-contents" }
-{ $subsection "gadgets-editors-selection" }
+{ $subsections
+ editor
+ <editor>
+ "gadgets-editors-contents"
+ "gadgets-editors-selection"
+}
"Multiline editors:"
-{ $subsection <multiline-editor> }
+{ $subsections <multiline-editor> }
"Fields:"
-{ $subsection <model-field> }
-{ $subsection <action-field> }
+{ $subsections
+ <model-field>
+ <action-field>
+}
"Editors edit " { $emphasis "documents" } ":"
-{ $subsection "documents" } ;
+{ $subsections "documents" } ;
TIP: "Editor gadgets support undo and redo; press " { $command editor "editing" com-undo } " and " { $command editor "editing" com-redo } "." ;
! Copyright (C) 2006, 2009 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays documents documents.elements kernel math
-math.ranges models models.arrow namespaces locals fry make opengl
-opengl.gl sequences strings math.vectors math.functions sorting colors
-colors.constants combinators assocs math.order calendar alarms
-continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
-ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
-ui.gadgets.menus ui.gadgets.wrappers ui.render ui.pens.solid
-ui.gadgets.line-support ui.text ui.gestures ui.baseline-alignment
-math.rectangles splitting unicode.categories grouping ;
+USING: accessors alarms arrays assocs calendar colors.constants
+combinators combinators.short-circuit documents
+documents.elements fry grouping kernel locals make math
+math.functions math.order math.ranges math.rectangles
+math.vectors models models.arrow namespaces opengl sequences
+sorting splitting ui.baseline-alignment ui.clipboards
+ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.line-support ui.gadgets.menus ui.gadgets.scrollers
+ui.gestures ui.pens.solid ui.render ui.text unicode.categories ;
EXCLUDE: fonts => selection ;
IN: ui.gadgets.editors
editor new-editor ;
: activate-editor-model ( editor model -- )
- 2dup add-connection
- dup activate-model
- swap model>> add-loc ;
+ [ add-connection ]
+ [ nip activate-model ]
+ [ swap model>> add-loc ] 2tri ;
: deactivate-editor-model ( editor model -- )
- 2dup remove-connection
- dup deactivate-model
- swap model>> remove-loc ;
+ [ remove-connection ]
+ [ nip deactivate-model ]
+ [ swap model>> remove-loc ] 2tri ;
: blink-caret ( editor -- )
[ not ] change-blink relayout-1 ;
] [ drop ] if ;
M: editor graft*
- dup
- dup caret>> activate-editor-model
- dup mark>> activate-editor-model ;
+ [ dup caret>> activate-editor-model ]
+ [ dup mark>> activate-editor-model ] bi ;
M: editor ungraft*
- dup
- dup stop-blinking
- dup caret>> deactivate-editor-model
- dup mark>> deactivate-editor-model ;
+ [ stop-blinking ]
+ [ dup caret>> deactivate-editor-model ]
+ [ dup mark>> deactivate-editor-model ] tri ;
: editor-caret ( editor -- loc ) caret>> value>> ;
: editor-mark ( editor -- loc ) mark>> value>> ;
: set-caret ( loc editor -- )
- [ model>> validate-loc ] keep
- caret>> set-model ;
+ [ model>> validate-loc ] [ caret>> ] bi set-model ;
: change-caret ( editor quot -- )
[ [ [ editor-caret ] [ model>> ] bi ] dip call ] [ drop ] 2bi
[ editor-caret ] keep loc>point ;
: caret-dim ( editor -- dim )
- line-height 0 swap 2array ;
+ [ 0 ] dip line-height 2array ;
: scroll>caret ( editor -- )
dup graft-state>> second [
] [ drop ] if ;
: draw-caret? ( editor -- ? )
- [ focused?>> ] [ blink>> ] bi and ;
+ { [ focused?>> ] [ blink>> ] } 1&& ;
: draw-caret ( editor -- )
dup draw-caret? [
: compute-selection ( editor -- assoc )
dup gadget-selection? [
- [ selection-start/end [ [ first ] bi@ [a,b] ] 2keep ] keep model>>
- '[ [ _ _ ] keep _ start/end-on-line 2array ] H{ } map>assoc
+ [ selection-start/end [ [ first ] bi@ [a,b] ] [ ] 2bi ]
+ [ model>> ] bi
+ '[ [ _ _ ] [ _ start/end-on-line ] bi 2array ] H{ } map>assoc
] [ drop f ] if ;
:: draw-selection ( line pair editor -- )
] [
[ draw-selection ]
[
- [ [ first2 ] [ selection-color>> ] bi* <selection> ] keep
- draw-unselected-line
+ [ [ first2 ] [ selection-color>> ] bi* <selection> ]
+ [ draw-unselected-line ] bi
] 3bi
] if ;
M: editor cap-height font>> font-metrics cap-height>> ;
: contents-changed ( model editor -- )
- swap
- over caret>> [ over validate-loc ] (change-model)
- over mark>> [ over validate-loc ] (change-model)
- drop relayout ;
+ [ [ nip caret>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ]
+ [ [ nip mark>> ] [ drop ] 2bi '[ _ validate-loc ] (change-model) ]
+ [ nip relayout ] 2tri ;
-: caret/mark-changed ( model editor -- )
- nip [ restart-blinking ] [ scroll>caret ] bi ;
+: caret/mark-changed ( editor -- )
+ [ restart-blinking ] keep scroll>caret ;
M: editor model-changed
{
{ [ 2dup model>> eq? ] [ contents-changed ] }
- { [ 2dup caret>> eq? ] [ caret/mark-changed ] }
- { [ 2dup mark>> eq? ] [ caret/mark-changed ] }
+ { [ 2dup caret>> eq? ] [ nip caret/mark-changed ] }
+ { [ 2dup mark>> eq? ] [ nip caret/mark-changed ] }
} cond ;
M: editor gadget-selection?
selection-start/end = not ;
M: editor gadget-selection
- [ selection-start/end ] keep model>> doc-range ;
+ [ selection-start/end ] [ model>> ] bi doc-range ;
: remove-selection ( editor -- )
- [ selection-start/end ] keep model>> remove-doc-range ;
+ [ selection-start/end ] [ model>> ] bi remove-doc-range ;
M: editor user-input*
- [ selection-start/end ] keep model>> set-doc-range t ;
+ [ selection-start/end ] [ model>> ] bi set-doc-range t ;
: editor-string ( editor -- string )
model>> doc-string ;
M: editor gadget-text* editor-string % ;
: extend-selection ( editor -- )
- dup request-focus
- dup restart-blinking
- dup caret>> click-loc ;
+ [ request-focus ]
+ [ restart-blinking ]
+ [ dup caret>> click-loc ] tri ;
: mouse-elt ( -- element )
hand-click# get {
: drag-selection-caret ( loc editor element -- loc )
[
- [ drag-direction? ] 2keep model>>
+ [ drag-direction? ] [ model>> ] 2bi
] dip prev/next-elt ? ;
: drag-selection-mark ( loc editor element -- loc )
[
- [ drag-direction? not ] keep
- [ editor-mark ] [ model>> ] bi
+ [ drag-direction? not ]
+ [ editor-mark ]
+ [ model>> ] tri
] dip prev/next-elt ? ;
: drag-caret&mark ( editor -- caret mark )
- dup clicked-loc swap mouse-elt
- [ drag-selection-caret ] 3keep
- drag-selection-mark ;
+ [ clicked-loc ] [ mouse-elt ] bi
+ [ drag-selection-caret ]
+ [ drag-selection-mark ] 3bi ;
: drag-selection ( editor -- )
- dup drag-caret&mark
- pick mark>> set-model
- swap caret>> set-model ;
+ [ drag-caret&mark ]
+ [ mark>> set-model ]
+ [ caret>> set-model ] tri ;
: editor-cut ( editor clipboard -- )
[ gadget-copy ] [ drop remove-selection ] 2bi ;
: delete-to-end-of-line ( editor -- )
one-line-elt editor-backspace ;
-: com-undo ( editor -- )
- model>> undo ;
+: com-undo ( editor -- ) model>> undo ;
-: com-redo ( editor -- )
- model>> redo ;
+: com-redo ( editor -- ) model>> redo ;
editor "editing" f {
{ undo-action com-undo }
"\n" swap user-input* drop ;
: change-selection ( editor quot -- )
- '[ gadget-selection @ ] keep user-input* drop ; inline
+ '[ gadget-selection @ ] [ user-input* drop ] bi ; inline
: join-lines ( string -- string' )
"\n" split
: this-line-and-next ( document line -- start end )
[ nip 0 swap 2array ]
- [ [ nip 1 + ] [ 1 + swap doc-line length ] 2bi 2array ]
+ [ 1 + [ nip ] [ swap doc-line length ] 2bi 2array ]
2bi ;
: last-line? ( document line -- ? )
M: field font>> editor>> font>> ;
M: field pref-dim*
- dup
- [ editor>> pref-dim ] keep
- [ line-gadget-width ] [ drop second ] 2bi 2array
- border-pref-dim ;
+ [ ]
+ [ editor>> pref-dim ]
+ [ [ line-gadget-width ] [ drop second ] 2bi 2array ]
+ tri border-pref-dim ;
TUPLE: model-field < field field-model ;
: <model-field> ( model -- gadget )
- model-field new-field swap >>field-model ;
+ model-field new-field
+ swap >>field-model ;
M: model-field graft*
[ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
TUPLE: action-field < field quot ;
: <action-field> ( quot -- gadget )
- action-field new-field swap >>quot ;
+ action-field new-field
+ swap >>quot ;
: invoke-action-field ( field -- )
[ editor>> editor-string ]
"The filled cell's column/row pair is stored in the frame gadget's " { $slot "filled-cell" } " slot. If the actual dimensions of a frame exceed it preferred dimensions, then the fill slot is resized appropriately, together with its row and column."
$nl
"Because frames inherit from grids, grid layout words can be used to add and remove children."
-{ $subsection frame }
+{ $subsections frame }
"Creating empty frames:"
-{ $subsection <frame> } ;
+{ $subsections <frame> } ;
HELP: frame
{ $class-description "A frame is a gadget which lays out its children in a grid, and assigns all remaining space to a distinguished filled cell. The " { $slot "filled-cell" } " slot stores a pair with shape " { $snippet "{ col row }" } "."
length 1 + * [-] ; inline
: -center) ( pref-dim gap filled-cell dims -- )
- [ nip available-space ] 2keep [ remove-nth sum [-] ] 2keep set-nth ; inline
+ [ nip available-space ]
+ [ [ remove-nth sum [-] ] [ set-nth ] 2bi ] 2bi ; inline
: (fill-center) ( frame grid-layout quot1 quot2 -- ) (fill- -center) ; inline
[ [ second ] [ row-heights>> ] (fill-center) ] 2bi ;
: <frame-layout> ( frame -- grid-layout )
- dup <grid-layout> [ fill-center ] keep ;
+ dup <grid-layout> [ fill-center ] [ ] bi ;
PRIVATE>
"A " { $emphasis "control" } " is a gadget which is linked to an underlying " { $link model } " by having its " { $snippet "model" } " slot set to a " { $link model } " instance."
$nl
"Some utility words useful in control implementations:"
-{ $subsection control-value }
-{ $subsection set-control-value }
+{ $subsections
+ control-value
+ set-control-value
+}
{ $see-also "models" } ;
: pick-up ( point gadget -- child/f )
2dup [ dup point>rect ] dip children-on
[ contains-point? ] with find-last nip
- [ [ loc>> v- ] keep pick-up ] [ nip ] ?if ;
+ [ [ loc>> v- ] [ pick-up ] bi ] [ nip ] ?if ;
: max-dim ( dims -- dim ) { 0 0 } [ vmax ] reduce ;
: pref-dim ( gadget -- dim )
dup pref-dim>> [ ] [
- [ pref-dim* ] keep dup layout-state>>
+ [ pref-dim* ] [ ] [ layout-state>> ] tri
[ drop ] [ dupd (>>pref-dim) ] if
] ?if ;
: notify ( gadget -- )
dup graft-state>>
- [ first { f f } { t t } ? >>graft-state ] keep
+ [ first { f f } { t t } ? >>graft-state ] [ ] bi
{
{ { f t } [ dup activate-control graft* ] }
{ { t f } [ dup deactivate-control ungraft* ] }
"This feature is used for completion popups and " { $link "ui.gadgets.menus" } " in the " { $link "ui-tools" } "."
$nl
"Displaying a gadget in a glass layer:"
-{ $subsection show-glass }
+{ $subsections show-glass }
"Hiding a gadget in a glass layer:"
-{ $subsection hide-glass }
+{ $subsections hide-glass }
"Callback generic invoked on the gadget when its glass layer is hidden:"
-{ $subsection hide-glass-hook }
+{ $subsections hide-glass-hook }
"Popup gadgets add support for forwarding keyboard gestures from an owner gadget to the glass layer:"
-{ $subsection show-popup }
-{ $subsection pass-to-popup } ;
+{ $subsections
+ show-popup
+ pass-to-popup
+} ;
ABOUT: "ui.gadgets.glass"
\ No newline at end of file
{ $description "Creates a new " { $link grid-lines } "." } ;
ARTICLE: "ui.gadgets.grid-lines" "Grid lines"
-{ $subsection grid-lines }
-{ $subsection <grid-lines> } ;
+{ $subsections
+ grid-lines
+ <grid-lines>
+} ;
ABOUT: "ui.gadgets.grid-lines"
\ No newline at end of file
ARTICLE: "ui-grid-layout" "Grid layouts"
"Grid gadgets layout their children in a rectangular grid."
-{ $subsection grid }
+{ $subsections grid }
"Creating grids from a fixed set of gadgets:"
-{ $subsection <grid> }
+{ $subsections <grid> }
"Managing children:"
-{ $subsection grid-add }
-{ $subsection grid-remove }
-{ $subsection grid-child }
+{ $subsections
+ grid-add
+ grid-remove
+ grid-child
+}
"Grid lines:"
-{ $subsection "ui.gadgets.grid-lines" } ;
+{ $subsections "ui.gadgets.grid-lines" } ;
HELP: grid
{ $class-description "A grid gadget lays out its children so that all gadgets in a column have equal width and all gadgets in a row have equal height."
: grid-child ( grid pair -- gadget ) grid@ nth ;
: grid-add ( grid child pair -- grid )
- [ nip grid-child unparent ] [ drop add-gadget ] [ swapd grid@ set-nth ] 3tri ;
+ [ nip grid-child unparent ]
+ [ drop add-gadget ]
+ [ swapd grid@ set-nth ] 3tri ;
: grid-remove ( grid pair -- grid ) [ <gadget> ] dip grid-add ;
M: grid children-on ( rect gadget -- seq )
dup children>> empty? [ 2drop f ] [
[ { 0 1 } ] dip grid>>
- [ 0 <column> fast-children-on ] keep
- <slice> concat
+ [ 0 <column> fast-children-on ] [ <slice> concat ] bi
] if ;
M: grid gadget-text*
[ [ gadget-text ] map ] map format-table
[ CHAR: \n , ] [ % ] interleave ;
-PRIVATE>
\ No newline at end of file
+PRIVATE>
"Incremental layout is used by " { $link "ui.gadgets.panes" } " to ensure that new lines of output does not take longer to display when the pane already has previous output."
$nl
"Incremental layouts are not a general replacement for " { $link "ui-pack-layout" } " and there are some limitations to be aware of."
-{ $subsection incremental }
-{ $subsection <incremental> }
+{ $subsections
+ incremental
+ <incremental>
+}
"Children are added and removed with a special set of words which perform necessary relayout immediately:"
-{ $subsection add-incremental }
-{ $subsection clear-incremental }
+{ $subsections
+ add-incremental
+ clear-incremental
+}
"Calling " { $link unparent } " to remove a child of an incremental layout is permitted, however the relayout following the removal will not be performed in constant time, because all gadgets following the removed gadget need to be moved." ;
ABOUT: "ui-incremental-layout"
ARTICLE: "ui.gadgets.labeled" "Labeled gadgets"
"The " { $vocab-link "ui.gadgets.labeled" } " vocabulary implements labeled borders around child gadgets."
-{ $subsection labeled-gadget }
-{ $subsection <labeled-gadget> } ;
+{ $subsections
+ labeled-gadget
+ <labeled-gadget>
+} ;
ABOUT: "ui.gadgets.labeled"
ARTICLE: "ui.gadgets.labels" "Label gadgets"
"The " { $vocab-link "ui.gadgets.labels" } " vocabulary implements labels. A label displays a piece of text, which is either a single line string or an array of line strings."
-{ $subsection label }
-{ $subsection <label> }
-{ $subsection <label-control> }
+{ $subsections
+ label
+ <label>
+ <label-control>
+}
"Labels have a virtual slot named " { $slot "string" } " which contains the displayed text. The " { $slot "text" } " slot should not be set directly."
$nl
"Label specifiers are used by buttons, checkboxes and radio buttons:"
-{ $subsection >label } ;
+{ $subsections >label } ;
ABOUT: "ui.gadgets.labels"
namespaces make opengl sequences strings splitting ui.gadgets
ui.gadgets.tracks ui.gadgets.packs fonts ui.render ui.pens.solid
ui.baseline-alignment ui.text colors colors.constants models
-combinators ;
+combinators opengl.gl ;
IN: ui.gadgets.labels
! A label gadget draws a string.
"The " { $vocab-link "ui.gadgets.line-support" } " vocabulary provides common code shared by gadgets which display a sequence of lines of text. Currently, the two gadgets that use it are " { $link "ui.gadgets.editors" } " and " { $link "ui.gadgets.tables" } "."
$nl
"The class of line gadgets:"
-{ $subsection line-gadget }
-{ $subsection line-gadget? }
+{ $subsections
+ line-gadget
+ line-gadget?
+}
"Line gadgets are backed by a model which must be a sequence. The number of lines in the gadget is the length of the sequence."
$nl
"Line gadgets cannot be created and used directly, instead a subclass must be defined:"
-{ $subsection new-line-gadget }
+{ $subsections new-line-gadget }
"Subclasses must implement a generic word:"
-{ $subsection draw-line }
+{ $subsections draw-line }
"Two optional generic words may be implemented; if they are not implemented in the subclass, a default implementation based on font metrics will be used:"
-{ $subsection line-height }
-{ $subsection line-leading }
+{ $subsections
+ line-height
+ line-leading
+}
"Validating line numbers:"
-{ $subsection validate-line }
+{ $subsections validate-line }
"Working with visible lines:"
-{ $subsection visible-lines }
-{ $subsection first-visible-line }
-{ $subsection last-visible-line }
+{ $subsections
+ visible-lines
+ first-visible-line
+ last-visible-line
+}
"Converting y co-ordinates to line numbers, and vice versa:"
-{ $subsection line>y }
-{ $subsection y>line } ;
+{ $subsections
+ line>y
+ y>line
+} ;
ABOUT: "ui.gadgets.line-support"
\ No newline at end of file
[ second ] [ [ line-height ] [ min-rows>> ] [ max-rows>> ] tri ] bi* clamp ;
M: line-gadget pref-viewport-dim
- [ pref-dim ] keep
+ [ pref-dim ] [ ] bi
[ line-gadget-width ]
[ line-gadget-height ]
2bi 2array ;
ARTICLE: "ui.gadgets.menus" "Popup menus"
"The " { $vocab-link "ui.gadgets.menus" } " vocabulary displays popup menus in " { $link "ui.gadgets.glass" } "."
-{ $subsection <commands-menu> }
-{ $subsection show-menu }
-{ $subsection show-commands-menu } ;
+{ $subsections
+ <commands-menu>
+ show-menu
+ show-commands-menu
+} ;
ABOUT: "ui.gadgets.menus"
ARTICLE: "ui-pack-layout" "Pack layouts"
"Pack gadgets layout their children along a single axis."
-{ $subsection pack }
+{ $subsections pack }
"Creating empty packs:"
-{ $subsection <pack> }
-{ $subsection <pile> }
-{ $subsection <shelf> }
+{ $subsections
+ <pack>
+ <pile>
+ <shelf>
+}
"For more control, custom layouts can reuse portions of pack layout logic:"
-{ $subsection pack-pref-dim }
-{ $subsection pack-layout } ;
+{ $subsections
+ pack-pref-dim
+ pack-layout
+} ;
HELP: pack
{ $class-description "A gadget which lays out its children along a single axis stored in the " { $snippet "orientation" } " slot. Can be constructed with one of the following words:"
ARTICLE: "ui.gadgets.panes" "Pane gadgets"
"The " { $vocab-link "ui.gadgets.panes" } " vocabulary implements panes, which display formatted text."
-{ $subsection pane }
-{ $subsection <pane> }
-{ $subsection <pane-control> }
+{ $subsections
+ pane
+ <pane>
+ <pane-control>
+}
"Panes are written to by creating a special output stream:"
-{ $subsection pane-stream }
-{ $subsection <pane-stream> }
+{ $subsections
+ pane-stream
+ <pane-stream>
+}
"In addition to the stream output words (" { $link "stream-protocol" } ", pane streams can have gadgets written to them:"
-{ $subsection write-gadget }
-{ $subsection print-gadget }
-{ $subsection gadget. }
+{ $subsections
+ write-gadget
+ print-gadget
+ gadget.
+}
"The " { $link gadget. } " word is useful for interactive debugging of gadgets in the listener."
$nl
"There are a few combinators for working with panes:"
-{ $subsection with-pane }
-{ $subsection make-pane } ;
+{ $subsections
+ with-pane
+ make-pane
+} ;
ABOUT: "ui.gadgets.panes"
: apply-page-color-style ( style gadget -- style gadget )
page-color [ <solid> >>interior ] apply-style ;
-: apply-border-width-style ( style gadget -- style gadget )
- border-width [ dup 2array <border> ] apply-style ;
+: apply-inset-style ( style gadget -- style gadget )
+ inset [ <border> ] apply-style ;
: style-pane ( style pane -- pane )
- apply-border-width-style
+ apply-inset-style
apply-border-color-style
apply-page-color-style
apply-presentation-style
"The " { $vocab-link "ui.gadgets.presentations" } " vocabulary implements presentations, which are graphical representations of an object, associated with the object itself (see " { $link "ui-operations" } ")."
$nl
"Clicking a presentation with the left mouse button invokes the object's primary operation, and clicking with the right mouse button displays a menu of all applicable operations. Presentations are usually not constructed directly, and instead are written to " { $link "ui.gadgets.panes" } " with formatted stream output words (see " { $link "presentations" } ")."
-{ $subsection presentation }
-{ $subsection <presentation> } ;
+{ $subsections
+ presentation
+ <presentation>
+} ;
ABOUT: "ui.gadgets.presentations"
ARTICLE: "ui.gadgets.scrollers" "Scroller gadgets"
"The " { $vocab-link "ui.gadgets.scrollers" } " vocabulary implements scroller gadgets. A scroller displays a gadget which is larger than the visible area."
-{ $subsection scroller }
-{ $subsection <scroller> }
+{ $subsections
+ scroller
+ <scroller>
+}
"Getting and setting the scroll position:"
-{ $subsection scroll-position }
-{ $subsection set-scroll-position }
+{ $subsections
+ scroll-position
+ set-scroll-position
+}
"Writing scrolling-aware gadgets:"
-{ $subsection scroll>bottom }
-{ $subsection scroll>top }
-{ $subsection scroll>rect }
-{ $subsection find-scroller } ;
+{ $subsections
+ scroll>bottom
+ scroll>top
+ scroll>rect
+ find-scroller
+} ;
ABOUT: "ui.gadgets.scrollers"
ARTICLE: "ui.gadgets.sliders" "Slider gadgets"
"The " { $vocab-link "ui.gadgets.sliders" } " vocabulary implements slider gadgets. A slider allows the user to graphically manipulate a value by moving a thumb back and forth."
-{ $subsection slider }
-{ $subsection <slider> }
+{ $subsections
+ slider
+ <slider>
+}
"Changing slider values:"
-{ $subsection slide-by }
-{ $subsection slide-by-line }
-{ $subsection slide-by-page }
+{ $subsections
+ slide-by
+ slide-by-line
+ slide-by-page
+}
"Since sliders are controls the value can be get and set by via the " { $snippet "model" } " slot. " ;
ABOUT: "ui.gadgets.sliders"
ARTICLE: "ui.gadgets.status-bar" "Status bars and mouse-over help"
"The " { $vocab-link "ui.gadgets.status-bar" } " vocabulary implements a word to display windows with a status bar."
-{ $subsection open-status-window }
+{ $subsections open-status-window }
"Gadgets can use a pair of words to show and hide status bar messages. These words will work in any gadget, but will have no effect unless the gadget is displayed inside a window with a status bar."
-{ $subsection show-status }
-{ $subsection hide-status }
+{ $subsections
+ show-status
+ hide-status
+}
{ $link "ui.gadgets.presentations" } " use the status bar to display object summary." ;
ABOUT: "ui.gadgets.status-bar"
! Copyright (C) 2007, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors models models.delay models.arrow
-sequences ui.gadgets.labels ui.gadgets.tracks
-ui.gadgets.worlds ui.gadgets ui ui.private kernel calendar summary ;
+USING: accessors calendar colors colors.constants fonts kernel
+models models.arrow models.delay sequences summary ui
+ui.gadgets ui.gadgets.labels ui.gadgets.tracks
+ui.gadgets.worlds ui.pens.solid ui.private ;
IN: ui.gadgets.status-bar
+: status-bar-font ( -- font )
+ sans-serif-font clone
+ COLOR: FactorDarkSlateBlue >>background
+ COLOR: white >>foreground ;
+
+: status-bar-theme ( label -- label )
+ status-bar-font >>font
+ COLOR: FactorDarkSlateBlue <solid> >>interior ;
+
: <status-bar> ( model -- gadget )
1/10 seconds <delay> [ "" like ] <arrow> <label-control>
- reverse-video-theme
+ status-bar-theme
t >>root? ;
: open-status-window ( gadget title/attributes -- )
"Table gadgets use a row renderer to display rows and do a few other things."
$nl
"Renderers are usually instances of singleton classes, since they don't need any state of their own. Renderers are required to implement a single generic word:"
-{ $subsection row-columns }
+{ $subsections row-columns }
"Renderers can also implement the following optional generic words for additional row information:"
-{ $subsection row-value }
-{ $subsection row-color }
+{ $subsections
+ row-value
+ row-color
+}
"The following optional generic words allow the renderer to provide some information about the display of all rows:"
-{ $subsection prototype-row }
-{ $subsection column-alignment }
-{ $subsection filled-column }
-{ $subsection column-titles } ;
+{ $subsections
+ prototype-row
+ column-alignment
+ filled-column
+ column-titles
+} ;
ARTICLE: "ui.gadgets.tables.selection" "Table row selection"
"A few slots in the table gadget concern row selection:"
{ { $slot "multiple-selection?" } { " - if set to a true value, users are allowed to select more than one value." } }
}
"Some words for row selection:"
-{ $subsection selected-rows }
-{ $subsection (selected-rows) }
-{ $subsection selected } ;
+{ $subsections
+ selected-rows
+ (selected-rows)
+ selected
+} ;
ARTICLE: "ui.gadgets.tables.actions" "Table row actions"
"When the user double-clicks on a row, or presses " { $command table "row" row-action } " while a row is selected, optional action and hook quotations are invoked. The action receives the row value and the hook receives the table gadget itself. These quotations are stored in the " { $slot "action" } " and " { $snippet "hook" } " slots of a table, respectively."
"If the " { $slot "single-click?" } " slot is set to a true value, then single-clicking on a row will invoke the row action. The default value is " { $link f } "."
$nl
"The row action can also be invoked programmatically:"
-{ $subsection row-action } ;
+{ $subsections row-action } ;
ARTICLE: "ui.gadgets.tables.config" "Table gadget configuration"
"Various slots in the table gadget can be set to change the appearance and behavior of the table gadget."
"Tables display a model as a series of rows. The model must be a sequence, and a " { $emphasis "renderer" } " creates a sequence of columns for each row. Tables are built from and inherit all features of " { $link "ui.gadgets.line-support" } "."
{ $command-map table "row" }
"The class of tables:"
-{ $subsection table }
-{ $subsection table? }
+{ $subsections
+ table
+ table?
+}
"Creating new tables:"
-{ $subsection <table> }
-{ $subsection "ui.gadgets.tables.renderers" }
-{ $subsection "ui.gadgets.tables.selection" }
-{ $subsection "ui.gadgets.tables.actions" }
-{ $subsection "ui.gadgets.tables.example" } ;
+{ $subsections
+ <table>
+ "ui.gadgets.tables.renderers"
+ "ui.gadgets.tables.selection"
+ "ui.gadgets.tables.actions"
+ "ui.gadgets.tables.example"
+} ;
ABOUT: "ui.gadgets.tables"
\ No newline at end of file
'[ _ row-value eq? ] with find drop ;
: (update-selected-indices) ( table -- set )
- [ selection>> value>> dup [ array? not ] [ ] bi and [ 1array ] when ] keep
+ [ selection>> value>> dup { [ array? not ] [ ] } 1&& [ 1array ] when ] keep
'[ _ find-row-index ] map sift unique f assoc-like ;
: initial-selected-indices ( table -- set )
ARTICLE: "ui-track-layout" "Track layouts"
"Track gadgets are like " { $link "ui-pack-layout" } " except each child is resized to a fixed multiple of the track's dimension."
-{ $subsection track }
+{ $subsections track }
"Creating empty tracks:"
-{ $subsection <track> }
+{ $subsections <track> }
"Adding children:"
-{ $subsection track-add } ;
+{ $subsections track-add } ;
HELP: track
{ $class-description "A track is like a " { $link pack } " except each child is resized to a fixed multiple of the track's dimension in the direction of " { $snippet "orientation" } ". Tracks are created by calling " { $link <track> } "." } ;
pick sizes>> push add-gadget ;
M: track remove-gadget
- [ [ children>> index ] keep sizes>> delete-nth ] [ call-next-method ] 2bi ;
+ [ [ children>> index ] [ sizes>> ] bi delete-nth ]
+ [ call-next-method ] 2bi ;
: clear-track ( track -- ) [ sizes>> delete-all ] [ clear-gadget ] bi ;
HELP: set-title
{ $values { "string" string } { "world" world } }
-{ $description "Sets the title bar of the native window containing the world." }
-{ $notes "This word should not be called directly by user code. Instead, change the " { $snippet "title" } " slot model; see " { $link "models" } "." } ;
+{ $description "Sets the title bar of the native window containing the world." } ;
HELP: set-gl-context
{ $values { "world" world } }
ARTICLE: "ui.gadgets.worlds-subclassing" "Subclassing worlds"
"The " { $link world } " gadget can be subclassed, giving Factor code full control of the window's OpenGL context. The following generic words can be overridden to replace standard UI behavior:"
-{ $subsection begin-world }
-{ $subsection end-world }
-{ $subsection resize-world }
-{ $subsection draw-world* }
+{ $subsections
+ begin-world
+ end-world
+ resize-world
+ draw-world*
+}
"See the " { $vocab-link "spheres" } " and " { $vocab-link "bunny" } " demos for examples." ;
ARTICLE: "ui-paint-custom" "Implementing custom drawing logic"
"The UI uses OpenGL to render gadgets. Custom rendering logic can be plugged in with the " { $link "ui-pen-protocol" } ", or by implementing a generic word:"
-{ $subsection draw-gadget* }
+{ $subsections draw-gadget* }
"Custom drawing code has access to the full OpenGL API in the " { $vocab-link "opengl" } " vocabulary."
$nl
"Gadgets which need to allocate and deallocate OpenGL resources such as textures, display lists, and so on, should perform the allocation in the " { $link graft* } " method, and the deallocation in the " { $link ungraft* } " method. Since those words are not necessarily called with the gadget's OpenGL context active, a utility word can be used to find and make the correct OpenGL context current:"
-{ $subsection find-gl-context }
+{ $subsections find-gl-context }
"OpenGL state must not be altered as a result of drawing a gadget, so any flags which were enabled should be disabled, and vice versa. To take full control of the OpenGL context, see " { $link "ui.gadgets.worlds-subclassing" } "."
-{ $subsection "ui-paint-coord" }
-{ $subsection "ui.gadgets.worlds-subclassing" }
-{ $subsection "gl-utilities" }
-{ $subsection "text-rendering" } ;
+{ $subsections
+ "ui-paint-coord"
+ "ui.gadgets.worlds-subclassing"
+ "gl-utilities"
+ "text-rendering"
+} ;
! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs continuations kernel math models
-namespaces opengl opengl.textures sequences io combinators
+namespaces opengl opengl.textures sequences io colors combinators
combinators.short-circuit fry math.vectors math.rectangles cache
ui.gadgets ui.gestures ui.render ui.backend ui.gadgets.tracks
ui.pixel-formats destructors literals strings ;
maximize-button
resize-handles
small-title-bar
- normal-title-bar ;
+ normal-title-bar
+ textured-background ;
CONSTANT: default-world-pixel-format-attributes
- { windowed double-buffered T{ depth-bits { value 16 } } }
+ {
+ windowed
+ double-buffered
+ T{ depth-bits { value 16 } }
+ }
CONSTANT: default-world-window-controls
{
text-handle handle images
window-loc
pixel-format-attributes
+ background-color
window-controls
window-resources ;
f >>grab-input?
V{ } clone >>window-resources ;
+: initial-background-color ( attributes -- color )
+ window-controls>> textured-background swap memq?
+ [ T{ rgba f 0.0 0.0 0.0 0.0 } ]
+ [ T{ rgba f 1.0 1.0 1.0 1.0 } ] if ;
+
: apply-world-attributes ( world attributes -- world )
{
[ title>> >>title ]
[ status>> >>status ]
[ pixel-format-attributes>> >>pixel-format-attributes ]
[ window-controls>> >>window-controls ]
+ [ initial-background-color >>background-color ]
[ grab-input?>> >>grab-input? ]
[ gadgets>> [ 1 track-add ] each ]
} cleave ;
"User actions such as keyboard input and mouse button clicks deliver " { $emphasis "gestures" } " to gadgets. If the direct receiver of the gesture does not handle it, the gesture is passed on to the receiver's parent, and this way it travels up the gadget hierarchy. Gestures which are not handled at some point are ignored."
$nl
"There are two ways to define gesture handling logic. The simplest way is to associate a fixed set of gestures with a class:"
-{ $subsection set-gestures }
+{ $subsections set-gestures }
"Another way is to define a generic word on a class which handles all gestures sent to gadgets of that class:"
-{ $subsection handle-gesture }
+{ $subsections handle-gesture }
"Sometimes a gesture needs to be presented to the user:"
-{ $subsection gesture>string }
+{ $subsections gesture>string }
"Keyboard input:"
-{ $subsection "ui-focus" }
-{ $subsection "keyboard-gestures" }
-{ $subsection "action-gestures" }
-{ $subsection "ui-user-input" }
+{ $subsections
+ "ui-focus"
+ "keyboard-gestures"
+ "action-gestures"
+ "ui-user-input"
+}
"Mouse input:"
-{ $subsection "mouse-gestures" }
-{ $subsection "multitouch-gestures" }
+{ $subsections
+ "mouse-gestures"
+ "multitouch-gestures"
+}
"Guidelines for cross-platform applications:"
-{ $subsection "gesture-differences" }
+{ $subsections "gesture-differences" }
"Abstractions built on top of gestures:"
-{ $subsection "ui-commands" }
-{ $subsection "ui-operations" } ;
+{ $subsections
+ "ui-commands"
+ "ui-operations"
+} ;
ARTICLE: "ui-focus" "Keyboard focus"
"The gadget with keyboard focus is the current receiver of keyboard gestures and user input. Gadgets that wish to receive keyboard input should request focus when clicked:"
-{ $subsection request-focus }
+{ $subsections request-focus }
"The following example demonstrates defining a handler for a mouse click gesture which requests focus:"
{ $code
"my-gadget H{"
"} set-gestures"
}
"To nominate a single child as the default focusable child, implement a method on a generic word:"
-{ $subsection focusable-child* }
+{ $subsections focusable-child* }
"Gestures are sent to a gadget when it gains or loses focus; this can be used to change the gadget's appearance, for example by displaying a border:"
-{ $subsection gain-focus }
-{ $subsection lose-focus } ;
+{ $subsections
+ gain-focus
+ lose-focus
+} ;
ARTICLE: "keyboard-gestures" "Keyboard gestures"
"There are two types of keyboard gestures:"
-{ $subsection key-down }
-{ $subsection key-up }
+{ $subsections
+ key-down
+ key-up
+}
"Each keyboard gesture has a set of modifiers and a key symbol. The set modifiers is denoted by an array which must either be " { $link f } ", or an order-preserving subsequence of the following:"
{ $code "{ S+ C+ A+ M+ }" }
-{ $subsection S+ }
-{ $subsection C+ }
-{ $subsection A+ }
-{ $subsection M+ }
+{ $subsections
+ S+
+ C+
+ A+
+ M+
+}
"A key symbol is either a single-character string denoting literal input, or one of the following strings:"
{ $list
{ $snippet "CLEAR" }
ARTICLE: "ui-user-input" "Free-form keyboard input"
"Whereas keyboard gestures are intended to be used for keyboard shortcuts, certain gadgets such as text fields need to accept free-form keyboard input. This can be done by implementing a generic word:"
-{ $subsection user-input* } ;
+{ $subsections user-input* } ;
ARTICLE: "mouse-gestures" "Mouse gestures"
"There are two types of mouse gestures indicating button clicks:"
-{ $subsection button-down }
-{ $subsection button-up }
+{ $subsections
+ button-down
+ button-up
+}
"When a mouse button is pressed or released, two gestures are sent. The first gesture indicates the specific button number, and if this gesture is not handled, the second has a button number set to " { $link f } ":"
{ $code "T{ button-down f 1 }" "T{ button-down f f }" }
"Because tuple literals fill unspecified slots with " { $link f } ", the last gesture can be written as " { $snippet "T{ button-down }" } "."
$nl
"Gestures to indicate mouse motion, depending on whenever a button is held down or not:"
-{ $subsection motion }
-{ $subsection drag }
+{ $subsections
+ motion
+ drag
+}
"Gestures to indicate that the mouse has crossed gadget boundaries:"
-{ $subsection mouse-enter }
-{ $subsection mouse-leave }
+{ $subsections
+ mouse-enter
+ mouse-leave
+}
"A number of global variables are set after a mouse gesture is sent. These variables can be read to obtain additional information about the gesture."
-{ $subsection hand-gadget }
-{ $subsection hand-world }
-{ $subsection hand-loc }
-{ $subsection hand-buttons }
-{ $subsection hand-clicked }
-{ $subsection hand-click-loc }
-{ $subsection hand-click# }
+{ $subsections
+ hand-gadget
+ hand-world
+ hand-loc
+ hand-buttons
+ hand-clicked
+ hand-click-loc
+ hand-click#
+}
"There are some utility words for working with click locations:"
-{ $subsection hand-rel }
-{ $subsection hand-click-rel }
-{ $subsection drag-loc }
+{ $subsections
+ hand-rel
+ hand-click-rel
+ drag-loc
+}
"Mouse scroll wheel gesture:"
-{ $subsection mouse-scroll }
+{ $subsections mouse-scroll }
"Global variable set when a mouse scroll wheel gesture is sent:"
-{ $subsection scroll-direction } ;
+{ $subsections scroll-direction } ;
ARTICLE: "multitouch-gestures" "Multi-touch gestures"
"Multi-touch gestures are only supported on Mac OS X with newer MacBook and MacBook Pro models."
$nl
"Three-finger swipe:"
-{ $subsection left-action }
-{ $subsection right-action }
-{ $subsection up-action }
-{ $subsection down-action }
+{ $subsections
+ left-action
+ right-action
+ up-action
+ down-action
+}
"Two-finger pinch:"
-{ $subsection zoom-in-action }
-{ $subsection zoom-out-action } ;
+{ $subsections
+ zoom-in-action
+ zoom-out-action
+} ;
ARTICLE: "action-gestures" "Action gestures"
"Action gestures exist to keep keyboard shortcuts for common application operations consistent."
-{ $subsection undo-action }
-{ $subsection redo-action }
-{ $subsection cut-action }
-{ $subsection copy-action }
-{ $subsection paste-action }
-{ $subsection delete-action }
-{ $subsection select-all-action }
-{ $subsection new-action }
-{ $subsection open-action }
-{ $subsection save-action }
-{ $subsection save-as-action }
-{ $subsection revert-action }
-{ $subsection close-action }
+{ $subsections
+ undo-action
+ redo-action
+ cut-action
+ copy-action
+ paste-action
+ delete-action
+ select-all-action
+ new-action
+ open-action
+ save-action
+ save-as-action
+ revert-action
+ close-action
+}
"The following keyboard gestures, if not handled directly, send action gestures:"
{ $table
{ { $strong "Keyboard gesture" } { $strong "Action gesture" } }
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces cache images images.loader accessors assocs
kernel opengl opengl.gl opengl.textures ui.gadgets.worlds
-memoize images.tiff ;
+memoize images.png images.tiff ;
IN: ui.images
TUPLE: image-name path ;
ARTICLE: "ui-operations" "Operations"
"Operations are commands performed on presentations."
-{ $subsection operation }
-{ $subsection define-operation }
-{ $subsection primary-operation }
-{ $subsection secondary-operation }
-{ $subsection define-operation-map }
+{ $subsections
+ operation
+ define-operation
+ primary-operation
+ secondary-operation
+ define-operation-map
+}
"When documenting gadgets, operation documentation can be automatically generated:"
-{ $subsection $operations }
-{ $subsection $operation } ;
+{ $subsections
+ $operations
+ $operation
+} ;
ABOUT: "ui-operations"
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays definitions kernel ui.commands
-ui.gestures sequences strings math words generic namespaces
-hashtables quotations assocs fry linked-assocs ;
+USING: accessors arrays assocs combinators.short-circuit fry
+kernel linked-assocs namespaces sequences ui.commands words ;
IN: ui.operations
SYMBOL: +keyboard+
swap >>predicate ;
PREDICATE: listener-operation < operation
- [ command>> listener-command? ] [ listener?>> ] bi or ;
+ { [ command>> listener-command? ] [ listener?>> ] } 1|| ;
M: operation command-name
command>> command-name ;
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors math math.vectors locals sequences
-specialized-arrays.float colors arrays combinators
+specialized-arrays colors arrays combinators
opengl opengl.gl ui.pens ui.pens.caching ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: ui.pens.gradient
! Gradient pen
ARTICLE: "ui-pen-protocol" "UI pen protocol"
"The " { $snippet "interior" } " and " { $snippet "boundary" } " slots of a gadget facilitate easy factoring and sharing of drawing logic. Objects stored in these slots must implement the pen protocol:"
-{ $subsection draw-interior }
-{ $subsection draw-boundary }
+{ $subsections
+ draw-interior
+ draw-boundary
+}
"The default value of these slots is the " { $link f } " singleton, which implements the above protocol by doing nothing."
$nl
"Some other pre-defined implementations:"
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors help.markup help.syntax kernel opengl
-opengl.gl sequences specialized-arrays.float math.vectors
-ui.gadgets ui.pens ;
+USING: accessors alien.c-types colors help.markup help.syntax
+kernel opengl opengl.gl sequences math.vectors ui.gadgets
+ui.pens specialized-arrays ;
+SPECIALIZED-ARRAY: float
IN: ui.pens.polygon
! Polygon pen
: <polygon-gadget> ( color points -- gadget )
[ <polygon> ] [ { 0 0 } [ vmax ] reduce ] bi
- [ <gadget> ] 2dip [ >>interior ] [ >>dim ] bi* ;
\ No newline at end of file
+ [ <gadget> ] 2dip [ >>interior ] [ >>dim ] bi* ;
-USING: destructors help.markup help.syntax kernel math multiline sequences
+USING: destructors help.markup help.syntax kernel math sequences
vocabs vocabs.parser words namespaces ;
IN: ui.pixel-formats
ARTICLE: "ui.pixel-formats-attributes" "Pixel format attributes"
"The following pixel format attributes can be requested and queried of " { $link pixel-format } "s. Binary attributes are represented by the presence of a symbol in an attribute sequence:"
-{ $subsection double-buffered }
-{ $subsection stereo }
-{ $subsection offscreen }
-{ $subsection fullscreen }
-{ $subsection windowed }
-{ $subsection accelerated }
-{ $subsection software-rendered }
-{ $subsection backing-store }
-{ $subsection multisampled }
-{ $subsection supersampled }
-{ $subsection sample-alpha }
-{ $subsection color-float }
+{ $subsections
+ double-buffered
+ stereo
+ offscreen
+ fullscreen
+ windowed
+ accelerated
+ software-rendered
+ backing-store
+ multisampled
+ supersampled
+ sample-alpha
+ color-float
+}
"Integer attributes are represented by a " { $link tuple } " with a single " { $snippet "value" } "slot:"
-{ $subsection color-bits }
-{ $subsection red-bits }
-{ $subsection green-bits }
-{ $subsection blue-bits }
-{ $subsection alpha-bits }
-{ $subsection accum-bits }
-{ $subsection accum-red-bits }
-{ $subsection accum-green-bits }
-{ $subsection accum-blue-bits }
-{ $subsection accum-alpha-bits }
-{ $subsection depth-bits }
-{ $subsection stencil-bits }
-{ $subsection aux-buffers }
-{ $subsection sample-buffers }
-{ $subsection samples }
+{ $subsections
+ color-bits
+ red-bits
+ green-bits
+ blue-bits
+ alpha-bits
+ accum-bits
+ accum-red-bits
+ accum-green-bits
+ accum-blue-bits
+ accum-alpha-bits
+ depth-bits
+ stencil-bits
+ aux-buffers
+ sample-buffers
+ samples
+}
{ $examples
"The following " { $link world } " subclass will request a double-buffered window with minimum 24-bit color and depth buffers, and will throw an error if the requirements aren't met:"
-{ $code <"
+{ $code """
USING: kernel ui.worlds ui.pixel-formats ;
IN: ui.pixel-formats.examples
[ color-bits pixel-format-attribute 24 < [ "Not enough color bits!" throw ] when ]
[ depth-bits pixel-format-attribute 24 < [ "Not enough depth bits!" throw ] when ]
tri ;
-"> } }
+""" } }
;
HELP: double-buffered
ARTICLE: "ui.pixel-formats" "Pixel formats"
"The UI allows you to control the window system's OpenGL interface with a cross-platform set of pixel format specifiers:"
-{ $subsection "ui.pixel-formats-attributes" }
+{ $subsections "ui.pixel-formats-attributes" }
"Pixel formats can be requested using these attributes:"
-{ $subsection pixel-format }
-{ $subsection <pixel-format> }
-{ $subsection pixel-format-attribute }
+{ $subsections
+ pixel-format
+ <pixel-format>
+ pixel-format-attribute
+}
"If a request for a set of pixel format attributes cannot be satisfied, an error is thrown:"
-{ $subsection invalid-pixel-format-attributes }
+{ $subsections invalid-pixel-format-attributes }
"Pixel formats are requested as part of opening a window for a " { $link world } ". These generics can be overridden on " { $snippet "world" } " subclasses to control pixel format selection:"
-{ $subsection world-pixel-format-attributes }
-{ $subsection check-world-pixel-format }
+{ $subsections
+ world-pixel-format-attributes
+ check-world-pixel-format
+}
;
ABOUT: "ui.pixel-formats"
-USING: accessors assocs classes destructors functors kernel
-lexer math parser sequences specialized-arrays.int ui.backend
-words ;
+USING: alien.c-types accessors assocs classes destructors
+functors kernel lexer math parser sequences specialized-arrays
+ui.backend words ;
+SPECIALIZED-ARRAY: int
IN: ui.pixel-formats
SYMBOLS:
{ "The " { $link draw-boundary } " generic word is called on the value of the " { $snippet "boundary" } " slot." }
}
"Now, each one of these steps will be covered in detail."
-{ $subsection "ui-pen-protocol" }
-{ $subsection "ui-paint-custom" } ;
+{ $subsections
+ "ui-pen-protocol"
+ "ui-paint-custom"
+} ;
ARTICLE: "ui-paint-coord" "The UI co-ordinate system"
"The UI uses a co-ordinate system where the y axis is oriented down. The OpenGL " { $link GL_MODELVIEW } " matrix is saved or restored when rendering a gadget, and the origin is translated to the gadget's origin within the window. The current origin is stored in a variable:"
-{ $subsection origin }
+{ $subsections origin }
"Gadgets must not draw outside of their bounding box, however clipping is not enforced by default, for performance reasons. This can be changed by setting the " { $slot "clipped?" } " slot to " { $link t } " in the gadget's constructor." ;
ABOUT: "ui-paint"
[ clip set ] bi
do-clip ;
-: init-gl ( clip-rect -- )
+SLOT: background-color
+
+: init-gl ( world -- )
GL_SMOOTH glShadeModel
GL_SCISSOR_TEST glEnable
GL_BLEND glEnable
GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA glBlendFunc
GL_VERTEX_ARRAY glEnableClientState
init-matrices
- init-clip
- ! white gl-clear is broken w.r.t window resizing
- ! Linux/PPC Radeon 9200
- COLOR: white gl-color
- { 0 0 } clip get dim>> gl-fill-rect ;
+ [ init-clip ]
+ [
+ background-color>> >rgba-components glClearColor
+ GL_COLOR_BUFFER_BIT glClear
+ ] bi ;
GENERIC: draw-gadget* ( gadget -- )
ARTICLE: "text-rendering" "Rendering text"
"The " { $vocab-link "ui.text" } " vocabulary provides a cross-platform interface to the operating system's native font rendering engine. Currently, it uses Core Text on Mac OS X and FreeType on Windows and X11."
-{ $subsection "fonts" }
+{ $subsections "fonts" }
"Measuring text:"
-{ $subsection text-dim }
-{ $subsection text-width }
-{ $subsection text-height }
-{ $subsection line-metrics }
+{ $subsections
+ text-dim
+ text-width
+ text-height
+ line-metrics
+}
"Converting screen locations to string offsets, and vice versa:"
-{ $subsection x>offset }
-{ $subsection offset>x }
+{ $subsections
+ x>offset
+ offset>x
+}
"Rendering text:"
-{ $subsection draw-text }
+{ $subsections draw-text }
"Low-level text protocol for UI backends:"
-{ $subsection string-width }
-{ $subsection string-height }
-{ $subsection string-dim }
-{ $subsection draw-string } ;
+{ $subsections
+ string-width
+ string-height
+ string-dim
+ draw-string
+} ;
ABOUT: "text-rendering"
\ No newline at end of file
ARTICLE: "ui-browser" "UI browser"
"The browser is used to display Factor code, documentation, and vocabularies. The browser is opened when a word or article link presentation is clicked. It can also be opened using words:"
-{ $subsection com-browse }
-{ $subsection browser-window }
+{ $subsections
+ com-browse
+ browser-window
+}
{ $command-map browser-gadget "toolbar" }
{ $command-map browser-gadget "scrolling" }
{ $command-map browser-gadget "navigation" }
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: debugger classes help help.topics help.crossref help.home
-kernel models compiler.units assocs words vocabs accessors fry arrays
-combinators.short-circuit namespaces sequences help.apropos
-combinators ui ui.commands ui.gadgets ui.gadgets.panes
-ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
-ui.gadgets.packs ui.gadgets.editors ui.gadgets.labels
-ui.gadgets.status-bar ui.gadgets.glass ui.gadgets.borders
-ui.gadgets.viewports ui.tools.common ui.tools.browser.popups
-ui.tools.browser.history ;
+USING: accessors arrays assocs classes combinators
+combinators.short-circuit compiler.units debugger fry help
+help.apropos help.crossref help.home help.topics kernel models
+sequences ui ui.commands ui.gadgets ui.gadgets.borders
+ui.gadgets.buttons ui.gadgets.editors ui.gadgets.glass
+ui.gadgets.labels ui.gadgets.panes ui.gadgets.scrollers
+ui.gadgets.status-bar ui.gadgets.tracks ui.gadgets.viewports
+ui.gestures ui.tools.browser.history ui.tools.browser.popups
+ui.tools.common vocabs ;
IN: ui.tools.browser
-TUPLE: browser-gadget < tool history pane scroller search-field popup ;
+TUPLE: browser-gadget < tool history scroller search-field popup ;
{ 650 400 } browser-gadget set-tool-dim
dup <history> >>history
dup <search-field> >>search-field
dup <browser-toolbar> { 3 3 } <border> { 1 0 } >>fill f track-add
- dup <help-pane> >>pane
- dup pane>> <scroller> >>scroller
- dup scroller>> 1 track-add ;
+ dup dup <help-pane> { 10 0 } <border> { 1 1 } >>fill
+ <scroller> >>scroller scroller>> 1 track-add ;
M: browser-gadget graft*
[ add-definition-observer ] [ call-next-method ] bi ;
} 2|| ;
M: browser-gadget definitions-changed ( assoc browser -- )
- model>> [ value>> swap showing-definition? ] keep
- '[ _ notify-connections ] when ;
+ [ model>> value>> swap showing-definition? ] keep
+ '[ _ [ history-value ] keep set-history-value ] when ;
M: browser-gadget focusable-child* search-field>> ;
"help.home" (browser-window) ;
: error-help-window ( error -- )
- [ error-help ]
- [ dup tuple? [ class ] [ drop "errors" ] if ] bi or (browser-window) ;
+ {
+ [ error-help ]
+ [ dup tuple? [ class ] [ drop "errors" ] if ]
+ } 1|| (browser-window) ;
\ browser-window H{ { +nullary+ t } } define-command
{ T{ key-down f f "PAGE_DOWN" } com-page-down }
} define-command-map
-MAIN: browser-window
\ No newline at end of file
+MAIN: browser-window
"The application deployment UI tool provides a graphical front-end to deployment configuration. Using the tool, you can set deployment options graphically."
$nl
"To start the tool, pass a vocabulary name to a word:"
-{ $subsection deploy-tool }
+{ $subsections deploy-tool }
"Alternatively, right-click on a vocabulary presentation in the UI and choose " { $strong "Deploy tool" } " from the resulting popup menu."
{ $see-also "tools.deploy" } ;
M: error-renderer column-alignment drop { 0 1 0 0 } ;
: sort-errors ( seq -- seq' )
- [ [ [ line#>> ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc
+ [ [ [ line#>> 0 or ] [ asset>> unparse-short ] bi 2array ] keep ] { } map>assoc
sort-keys values ;
: file-matches? ( error pathname/f -- ? )
"The graphical inspector provides functionality similar to the terminal inspector (see " { $link "inspector" } "), adding in-place editing of slot values."
$nl
"To display an object in the UI inspector, right-click a presentation and choose " { $strong "Inspector" } " from the menu that appears. The inspector can also be opened from the listener using a word:"
-{ $subsection inspector }
+{ $subsections inspector }
"The inspector embeds a table gadget, which supports keyboard navigation; see " { $link "ui.gadgets.tables" } ". It also provides a few other commands:"
{ $command-map inspector-gadget "toolbar" }
{ $command-map inspector-gadget "multi-touch" }
"The UI inspector is an instance of " { $link inspector-gadget } "."
-{ $subsection "ui-inspector-edit" } ;
+{ $subsections "ui-inspector-edit" } ;
HELP: inspector
{ $values { "obj" object } }
: slot-editor-window ( close-hook update-hook assoc key key-string -- )
[ <value-ref> <slot-editor> ] [ "Slot editor: " prepend ] bi*
- open-window ;
+ open-status-window ;
: com-edit-slot ( inspector -- )
[ close-window ] swap
USING: tools.test ui.tools.listener.completion ;
IN: ui.tools.listener.completion.tests
-[ t ] [ { "USING:" "A" "B" "C" } complete-USING:? ] unit-test
+[ f ] [ { "USE:" "A" "B" "C" } complete-vocab? ] unit-test
-[ f ] [ { "USING:" "A" "B" "C" ";" } complete-USING:? ] unit-test
+[ t ] [ { "USE:" "A" } complete-vocab? ] unit-test
-[ t ] [ { "X" ";" "USING:" "A" "B" "C" } complete-USING:? ] unit-test
\ No newline at end of file
+[ t ] [ { "UNUSE:" "A" } complete-vocab? ] unit-test
+
+[ t ] [ { "QUALIFIED:" "A" } complete-vocab? ] unit-test
+
+[ t ] [ { "QUALIFIED-WITH:" "A" } complete-vocab? ] unit-test
+
+[ t ] [ { "USING:" "A" "B" "C" } complete-vocab-list? ] unit-test
+
+[ f ] [ { "USING:" "A" "B" "C" ";" } complete-vocab-list? ] unit-test
+
+[ t ] [ { "X" ";" "USING:" "A" "B" "C" } complete-vocab-list? ] unit-test
\ No newline at end of file
M: vocab-completion row-color
drop vocab? COLOR: black COLOR: dark-gray ? ;
-: complete-IN:/USE:? ( tokens -- ? )
- 1 short head* 2 short tail* { "IN:" "USE:" } intersects? ;
+: complete-vocab? ( tokens -- ? )
+ 1 short head* 2 short tail*
+ { "IN:" "USE:" "UNUSE:" "QUALIFIED:" "QUALIFIED-WITH:" } intersects? ;
: chop-; ( seq -- seq' )
{ ";" } split1-last [ ] [ ] ?if ;
-: complete-USING:? ( tokens -- ? )
+: complete-vocab-list? ( tokens -- ? )
chop-; 1 short head* { "USING:" } intersects? ;
: complete-CHAR:? ( tokens -- ? )
: completion-mode ( interactor -- symbol )
[ manifest>> ] [ editor-caret ] [ model>> ] tri up-to-caret " \r\n" split
{
- { [ dup { [ complete-IN:/USE:? ] [ complete-USING:? ] } 1|| ] [ 2drop vocab-completion ] }
+ { [ dup { [ complete-vocab? ] [ complete-vocab-list? ] } 1|| ] [ 2drop vocab-completion ] }
{ [ dup complete-CHAR:? ] [ 2drop char-completion ] }
[ drop <word-completion> ]
} cond ;
] if ;
M: interactor stream-read
- swap dup zero? [
- 2drop ""
+ swap [
+ drop ""
] [
[ interactor-read dup [ "\n" join ] when ] dip short head
- ] if ;
+ ] if-zero ;
M: interactor stream-read-partial
stream-read ;
error-summary? off
tip-of-the-day. nl
listener
+ nl
+ "The listener has exited. To start it again, click “Restart Listener”." print
] with-streams* ;
: start-listener-thread ( listener -- )
[ wait-for-listener ]
} cleave ;
-: listener-help ( -- ) "help.home" com-browse ;
+: com-help ( -- ) "help.home" com-browse ;
-\ listener-help H{ { +nullary+ t } } define-command
+\ com-help H{ { +nullary+ t } } define-command
: com-auto-use ( -- )
auto-use? [ not ] change ;
\ com-auto-use H{ { +nullary+ t } { +listener+ t } } define-command
-listener-gadget "misc" "Miscellaneous commands" {
- { T{ key-down f f "F1" } listener-help }
-} define-command-map
-
listener-gadget "toolbar" f {
{ f restart-listener }
{ T{ key-down f { A+ } "u" } com-auto-use }
{ T{ key-down f { A+ } "k" } clear-output }
{ T{ key-down f { A+ } "K" } clear-stack }
{ T{ key-down f { C+ } "d" } com-end }
+ { T{ key-down f f "F1" } com-help }
} define-command-map
listener-gadget "scrolling"
! Copyright (C) 2007, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel quotations accessors fry assocs present math.order
-math.vectors arrays locals models.search models.sort models sequences
-vocabs tools.profiler words prettyprint combinators.smart
-definitions.icons see ui ui.commands ui.gadgets ui.gadgets.panes
-ui.gadgets.scrollers ui.gadgets.tracks ui.gestures ui.gadgets.buttons
-ui.gadgets.tables ui.gadgets.search-tables ui.gadgets.labeled
-ui.gadgets.packs ui.gadgets.labels ui.gadgets.tabbed
-ui.gadgets.status-bar ui.gadgets.borders ui.tools.browser
-ui.tools.common ui.baseline-alignment ui.operations ui.images ;
+USING: accessors arrays assocs combinators.short-circuit
+combinators.smart definitions.icons fry kernel locals
+math.order models models.search models.sort present see
+sequences tools.profiler ui.baseline-alignment ui.commands
+ui.gadgets ui.gadgets.borders ui.gadgets.buttons
+ui.gadgets.labeled ui.gadgets.labels ui.gadgets.packs
+ui.gadgets.search-tables ui.gadgets.status-bar
+ui.gadgets.tabbed ui.gadgets.tables ui.gadgets.tracks
+ui.gestures ui.images ui.operations ui.tools.browser
+ui.tools.common vocabs words ;
FROM: models.arrow => <arrow> ;
FROM: models.arrow.smart => <smart-arrow> ;
FROM: models.product => <product> ;
: method-matches? ( method generic class -- ? )
[ first ] 2dip
- [ drop dup [ subwords memq? ] [ 2drop t ] if ]
- [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ]
- 3bi and ;
+ {
+ [ drop dup [ subwords memq? ] [ 2drop t ] if ]
+ [ nip dup [ swap "method-class" word-prop = ] [ 2drop t ] if ]
+ } 3&& ;
: <methods-model> ( profiler -- model )
[
{ $code "USE: threads" "[ \"ui.tools\" run ] in-thread" } ;
ARTICLE: "ui-shortcuts" "UI tool keyboard shortcuts"
-"Every UI tool has its own set of keyboard shortcuts; press " { $snippet "F1" } " inside a tool to see help. Some common shortcuts are also supported by all tools:"
+"Every UI tool has its own set of keyboard shortcuts. Mouse-over a toolbar button to see its shortcut, if any, in the status bar, or press " { $snippet "F1" } " to see a list of all shortcuts supported by the tool."
+$nl
+"Some common shortcuts are supported by all tools:"
{ $command-map tool "tool-switching" }
{ $command-map tool "common" } ;
ARTICLE: "ui-tools" "UI developer tools"
"The " { $vocab-link "ui.tools" } " vocabulary hierarchy implements a collection of simple developer tools."
-{ $subsection "starting-ui-tools" }
+{ $subsections "starting-ui-tools" }
"To take full advantage of the UI tools, you should be using a supported text editor. See " { $link "editor" } "."
$nl
"Common functionality:"
-{ $subsection "ui-shortcuts" }
-{ $subsection "ui-presentations" }
-{ $subsection "definitions.icons" }
+{ $subsections
+ "ui-shortcuts"
+ "ui-presentations"
+ "definitions.icons"
+}
"Tools:"
-{ $subsection "ui-listener" }
-{ $subsection "ui-browser" }
-{ $subsection "ui-inspector" }
-{ $subsection "ui.tools.error-list" }
-{ $subsection "ui.tools.profiler" }
-{ $subsection "ui-walker" }
-{ $subsection "ui.tools.deploy" }
+{ $subsections
+ "ui-listener"
+ "ui-browser"
+ "ui-inspector"
+ "ui.tools.error-list"
+ "ui.tools.profiler"
+ "ui-walker"
+ "ui.tools.deploy"
+}
"Platform-specific features:"
-{ $subsection "ui-cocoa" } ;
+{ $subsections "ui-cocoa" } ;
TIP: "All UI developer tools support a common set of " { $link "ui-shortcuts" } ". Each individual tool has its own shortcuts as well; the F1 key is context-sensitive." ;
$nl\r
"The " { $link com-back } " command travels backwards through time, and restore stacks. This does not undo side effects (modifying array entries, writing to files, formatting the hard drive, etc) and therefore can only be used reliably on referentially transparent code." ;\r
\r
-ARTICLE: "breakpoints" "Setting breakpoints"\r
-"In addition to invoking the walker explicitly through the UI, it is possible to set breakpoints on words. See " { $link "tools.annotations" } "."\r
-$nl\r
-"Breakpoints can be inserted directly into code:"\r
-{ $subsection break }\r
-{ $subsection POSTPONE: B }\r
-"Note that because the walker calls various core library and UI words while rendering its own user interface, setting a breakpoint on a word such as " { $link append } " or " { $link draw-gadget } " will hang the UI." ;\r
-\r
ARTICLE: "ui-walker" "UI walker"\r
"The walker single-steps through quotations. To use the walker, enter a piece of code in the listener's input area and press " { $operation walk } "."\r
$nl\r
"Walkers are instances of " { $link walker-gadget } "."\r
-{ $subsection "ui-walker-step" }\r
-{ $subsection "breakpoints" }\r
+{ $subsections\r
+ "ui-walker-step"\r
+ "breakpoints"\r
+}\r
{ $command-map walker-gadget "toolbar" }\r
{ $command-map walker-gadget "multitouch" } ;\r
\r
ARTICLE: "building-ui" "Building user interfaces"
"A gadget is a graphical element which responds to user input. Gadgets are implemented as tuples which (directly or indirectly) inherit from " { $link gadget } ", which in turn inherits from " { $link rect } "."
-{ $subsection gadget }
+{ $subsections gadget }
"Gadgets are arranged in a hierarchy, and all visible gadgets except for instances of " { $link world } " are contained in a parent gadget, stored in the " { $snippet "parent" } " slot."
-{ $subsection "ui-geometry" }
-{ $subsection "ui-layouts" }
-{ $subsection "gadgets" }
-{ $subsection "ui-windows" }
-{ $subsection "ui.gadgets.status-bar" }
+{ $subsections
+ "ui-geometry"
+ "ui-layouts"
+ "gadgets"
+ "ui-windows"
+ "ui.gadgets.status-bar"
+}
{ $see-also "models" } ;
ARTICLE: "gadgets" "Pre-made UI gadgets"
-{ $subsection "ui.gadgets.labels" }
-{ $subsection "ui.gadgets.borders" }
-{ $subsection "ui.gadgets.labeled" }
-{ $subsection "ui.gadgets.buttons" }
-{ $subsection "ui.gadgets.sliders" }
-{ $subsection "ui.gadgets.scrollers" }
-{ $subsection "ui.gadgets.editors" }
-{ $subsection "ui.gadgets.menus" }
-{ $subsection "ui.gadgets.panes" }
-{ $subsection "ui.gadgets.presentations" }
-{ $subsection "ui.gadgets.tables" } ;
+{ $subsections
+ "ui.gadgets.labels"
+ "ui.gadgets.borders"
+ "ui.gadgets.labeled"
+ "ui.gadgets.buttons"
+ "ui.gadgets.sliders"
+ "ui.gadgets.scrollers"
+ "ui.gadgets.editors"
+ "ui.gadgets.menus"
+ "ui.gadgets.panes"
+ "ui.gadgets.presentations"
+ "ui.gadgets.tables"
+} ;
ARTICLE: "ui-geometry" "Gadget geometry"
"The " { $link gadget } " class inherits from the " { $link rect } " class, and thus all gadgets have a bounding box:"
-{ $subsection "math.rectangles" }
+{ $subsections "math.rectangles" }
"Word for converting from a child gadget's co-ordinate system to a parent's:"
-{ $subsection relative-loc }
-{ $subsection screen-loc }
+{ $subsections
+ relative-loc
+ screen-loc
+}
"Hit testing:"
-{ $subsection pick-up }
-{ $subsection children-on } ;
+{ $subsections
+ pick-up
+ children-on
+} ;
ARTICLE: "ui-windows" "Top-level windows"
"Opening a top-level window:"
-{ $subsection open-window }
+{ $subsections open-window }
"Finding top-level windows:"
-{ $subsection find-window }
+{ $subsections find-window }
"Top-level windows are stored in a global variable:"
-{ $subsection windows }
+{ $subsections windows }
"When a gadget is displayed in a top-level window, or added to a parent which is already showing in a top-level window, a generic word is called allowing the gadget to perform initialization tasks:"
-{ $subsection graft* }
+{ $subsections graft* }
"When the gadget is removed from a parent shown in a top-level window, or when the top-level window is closed, a corresponding generic word is called to clean up:"
-{ $subsection ungraft* }
+{ $subsections ungraft* }
"The root of the gadget hierarchy in a window is a special gadget which is rarely operated on directly, but it is helpful to know it exists:"
-{ $subsection world } ;
+{ $subsections world } ;
ARTICLE: "ui-backend" "Developing UI backends"
"None of the words documented in this section should be called directly by user code. They are only of interest when developing new UI backends."
-{ $subsection "ui-backend-init" }
-{ $subsection "ui-backend-windows" }
+{ $subsections
+ "ui-backend-init"
+ "ui-backend-windows"
+}
"UI backends may implement the " { $link "clipboard-protocol" } "." ;
ARTICLE: "ui-backend-init" "UI initialization and the event loop"
" ... start event loop here ... ;"
}
"The above word must call the following:"
-{ $subsection start-ui }
+{ $subsections start-ui }
"The " { $link (with-ui) } " word must not return until the event loop has stopped and the UI has been shut down." ;
ARTICLE: "ui-backend-windows" "UI backend window management"
"The high-level " { $link open-window } " word eventually calls a low-level word which you must implement:"
-{ $subsection open-world-window }
+{ $subsections open-world-window }
"This word should create a native window, store some kind of handle in the " { $snippet "handle" } " slot, then call two words:"
-{ $subsection register-window }
+{ $subsections register-window }
"The following words must also be implemented:"
-{ $subsection set-title }
-{ $subsection raise-window }
+{ $subsections
+ set-title
+ raise-window
+}
"When a world needs to be redrawn, the UI will call a word automatically:"
-{ $subsection draw-world }
+{ $subsections draw-world }
"This word can also be called directly if the UI backend is notified by the window system that window contents have been invalidated. Before and after drawing, two words are called, which the UI backend must implement:"
-{ $subsection select-gl-context }
-{ $subsection flush-gl-context }
+{ $subsections
+ select-gl-context
+ flush-gl-context
+}
"If the user clicks the window's close box, you must call the following word:"
-{ $subsection close-window } ;
+{ $subsections close-window } ;
ARTICLE: "ui-layouts" "Gadget hierarchy and layouts"
"A layout gadget is a gadget whose sole purpose is to contain other gadgets. Layout gadgets position and resize children according to a certain policy, taking the preferred size of the children into account. Gadget hierarchies are constructed by building up nested layouts."
-{ $subsection "ui-layout-basics" }
+{ $subsections "ui-layout-basics" }
"Common layout gadgets:"
-{ $subsection "ui-pack-layout" }
-{ $subsection "ui-track-layout" }
-{ $subsection "ui-grid-layout" }
-{ $subsection "ui-frame-layout" }
-{ $subsection "ui-book-layout" }
+{ $subsections
+ "ui-pack-layout"
+ "ui-track-layout"
+ "ui-grid-layout"
+ "ui-frame-layout"
+ "ui-book-layout"
+}
"Advanced topics:"
-{ $subsection "ui.gadgets.glass" }
-{ $subsection "ui-null-layout" }
-{ $subsection "ui-incremental-layout" }
-{ $subsection "ui-layout-impl" }
+{ $subsections
+ "ui.gadgets.glass"
+ "ui-null-layout"
+ "ui-incremental-layout"
+ "ui-layout-impl"
+}
{ $see-also "ui.gadgets.borders" } ;
ARTICLE: "ui-layout-basics" "Layout basics"
"Gadgets are arranged in a hierarchy, and all visible gadgets except for instances of " { $link world } " are contained in a parent gadget."
$nl
"Managing the gadget hierarchy:"
-{ $subsection add-gadget }
-{ $subsection unparent }
-{ $subsection add-gadgets }
-{ $subsection clear-gadget }
+{ $subsections
+ add-gadget
+ unparent
+ add-gadgets
+ clear-gadget
+}
"The children of a gadget are available via the "
{ $snippet "children" } " slot. "
$nl
"Working with gadget children:"
-{ $subsection gadget-child }
-{ $subsection nth-gadget }
-{ $subsection each-child }
-{ $subsection child? }
+{ $subsections
+ gadget-child
+ nth-gadget
+ each-child
+ child?
+}
"Working with gadget parents:"
-{ $subsection parents }
-{ $subsection each-parent }
-{ $subsection find-parent }
+{ $subsections
+ parents
+ each-parent
+ find-parent
+}
"Adding children, removing children and performing certain other operations initiates relayout requests automatically. In other cases, relayout may have to be triggered explicitly. There is no harm from doing this several times in a row as consecutive relayout requests are coalesced."
-{ $subsection relayout }
-{ $subsection relayout-1 }
+{ $subsections
+ relayout
+ relayout-1
+}
"Gadgets implement a generic word to inform their parents of their preferred size:"
-{ $subsection pref-dim* }
+{ $subsections pref-dim* }
"To get a gadget's preferred size, do not call the above word, instead use " { $link pref-dim } ", which caches the result." ;
ARTICLE: "ui-null-layout" "Manual layouts"
ARTICLE: "ui-layout-impl" "Implementing layout gadgets"
"The relayout process proceeds top-down, with parents laying out their children, which in turn lay out their children. Custom layout policy is implemented by defining a method on a generic word:"
-{ $subsection layout* }
+{ $subsections layout* }
"When a " { $link layout* } " method is called, the size and location of the gadget has already been determined by its parent, and the method's job is to lay out the gadget's children. Children can be positioned and resized by setting a pair of slots, " { $snippet "loc" } " and " { $snippet "dim" } "." $nl
"Some assorted utility words which are useful for implementing layout logic:"
-{ $subsection pref-dim }
-{ $subsection pref-dims }
-{ $subsection prefer }
-{ $subsection max-dim }
-{ $subsection dim-sum }
+{ $subsections
+ pref-dim
+ pref-dims
+ prefer
+ max-dim
+ dim-sum
+}
{ $warning
"When implementing the " { $link layout* } " generic word for a gadget which inherits from another layout, the " { $link children-on } " word might have to be re-implemented as well."
$nl
"One of the goals of the Factor UI is to minimize the need to implement new types of gadgets by offering a highly reusable, orthogonal set of building blocks. However, in some cases implementing a new type of gadget is necessary, for example when writing a graphical visualization."
$nl
"Bare gadgets can be constructed directly, which is useful if all you need is a custom appearance with no further behavior (see " { $link "ui-pen-protocol" } "):"
-{ $subsection <gadget> }
+{ $subsections <gadget> }
"New gadgets are defined as subclasses of an existing gadget type, perhaps even " { $link gadget } " itself. Direct subclasses of " { $link gadget } " can be constructed using " { $link new } ", however some subclasses may define their own parametrized constructors (see " { $link "parametrized-constructors" } ")."
$nl
"Further topics:"
-{ $subsection "ui-gestures" }
-{ $subsection "ui-paint" }
-{ $subsection "ui-control-impl" }
-{ $subsection "clipboard-protocol" }
-{ $subsection "ui.gadgets.line-support" }
+{ $subsections
+ "ui-gestures"
+ "ui-paint"
+ "ui-control-impl"
+ "clipboard-protocol"
+ "ui.gadgets.line-support"
+}
{ $see-also "ui-layout-impl" } ;
ARTICLE: "starting-ui" "Starting the UI"
"The main word of a vocabulary implementing a UI application should use a combinator to ensure that the application works when run from the command line as well as in the UI listener:"
-{ $subsection with-ui } ;
+{ $subsections with-ui } ;
ARTICLE: "ui" "UI framework"
"The " { $vocab-link "ui" } " vocabulary hierarchy implements the Factor UI framework. The implementation relies on a small amount of platform-specific code to open windows and receive keyboard and mouse events; UI gadgets are rendered using OpenGL."
-{ $subsection "starting-ui" }
-{ $subsection "ui-glossary" }
-{ $subsection "building-ui" }
-{ $subsection "new-gadgets" }
-{ $subsection "ui-backend" } ;
+{ $subsections
+ "starting-ui"
+ "ui-glossary"
+ "building-ui"
+ "new-gadgets"
+ "ui-backend"
+} ;
ABOUT: "ui"
HELP: normal-title-bar
{ $description "Asks for a window to have a title bar. Without a title bar, the " { $link close-button } ", " { $link minimize-button } ", and " { $link maximize-button } " controls will not be available." } ;
+HELP: textured-background
+{ $description "Asks for a window to have a background that blends seamlessly with the window frame. Factor will leave the window background transparent and pass mouse button gestures not handled directly by a gadget through to the window system so that the window can be dragged from anywhere on its background." } ;
+
ARTICLE: "ui.gadgets.worlds-window-controls" "Window controls"
"The following window controls can be placed in a " { $link world } " window:"
-{ $subsection close-button }
-{ $subsection minimize-button }
-{ $subsection maximize-button }
-{ $subsection resize-handles }
-{ $subsection small-title-bar }
-{ $subsection normal-title-bar }
+{ $subsections
+ close-button
+ minimize-button
+ maximize-button
+ resize-handles
+ small-title-bar
+ normal-title-bar
+ textured-background
+}
"Provide a sequence of these values in the " { $snippet "window-controls" } " slot of the " { $link world-attributes } " tuple you pass to " { $link open-window } "." ;
ARTICLE: "unicode.breaks" "Word and grapheme breaks"
"The " { $vocab-link "unicode.breaks" "unicode.breaks" } " vocabulary partially implements Unicode Standard Annex #29. This provides for segmentation of a string along grapheme and word boundaries. In Unicode, a grapheme, or a basic unit of display in text, may be more than one code point. For example, in the string \"e\\u000301\" (where U+0301 is a combining acute accent), there is only one grapheme, as the acute accent goes above the e, forming a single grapheme. Word breaks, in general, are more complicated than simply splitting by whitespace, and the Unicode algorithm provides for that."
$nl "Operations for graphemes:"
-{ $subsection first-grapheme }
-{ $subsection first-grapheme-from }
-{ $subsection last-grapheme }
-{ $subsection last-grapheme-from }
-{ $subsection >graphemes }
-{ $subsection string-reverse }
+{ $subsections
+ first-grapheme
+ first-grapheme-from
+ last-grapheme
+ last-grapheme-from
+ >graphemes
+ string-reverse
+}
"Operations on words:"
-{ $subsection first-word }
-{ $subsection first-word-from }
-{ $subsection last-word }
-{ $subsection last-word-from }
-{ $subsection >words } ;
+{ $subsections
+ first-word
+ first-word-from
+ last-word
+ last-word-from
+ >words
+} ;
HELP: first-grapheme
{ $values { "str" string } { "i" "an index" } }
ARTICLE: "unicode.case" "Case mapping"
"When considering Unicode in general and not just ASCII or a smaller character set, putting a string in upper case, title case or lower case is slightly more complicated. In most contexts it's best to use the general Unicode routines for case conversion. There is an additional type of casing, case-fold, which is defined as bringing a string into upper case and then lower. This exists because in some cases it is different from simple lower case."
-{ $subsection >upper }
-{ $subsection >lower }
-{ $subsection >title }
-{ $subsection >case-fold }
+{ $subsections
+ >upper
+ >lower
+ >title
+ >case-fold
+}
"To test if a string is in a given case:"
-{ $subsection upper? }
-{ $subsection lower? }
-{ $subsection title? }
-{ $subsection case-fold? }
+{ $subsections
+ upper?
+ lower?
+ title?
+ case-fold?
+}
"For certain languages (Turkish, Azeri, Lithuanian), case mapping is dependent on locale; To change this, set the following variable to the ISO-639-1 code for your language:"
-{ $subsection locale }
+{ $subsections locale }
"This is unnecessary for most locales." ;
HELP: >upper
ARTICLE: "unicode.categories" "Character classes"
"The " { $vocab-link "unicode.categories" } " vocabulary implements predicates for determining if a code point has a particular property, for example being a lower cased letter. These should be used in preference to the " { $vocab-link "ascii" } " equivalents in most cases. Each character class has an associated predicate word."
-{ $subsection blank }
-{ $subsection blank? }
-{ $subsection letter }
-{ $subsection letter? }
-{ $subsection LETTER }
-{ $subsection LETTER? }
-{ $subsection Letter }
-{ $subsection Letter? }
-{ $subsection digit }
-{ $subsection digit? }
-{ $subsection printable }
-{ $subsection printable? }
-{ $subsection alpha }
-{ $subsection alpha? }
-{ $subsection control }
-{ $subsection control? }
-{ $subsection uncased }
-{ $subsection uncased? }
-{ $subsection character }
-{ $subsection character? }
-{ $subsection math }
-{ $subsection math? } ;
+{ $subsections
+ blank
+ blank?
+ letter
+ letter?
+ LETTER
+ LETTER?
+ Letter
+ Letter?
+ digit
+ digit?
+ printable
+ printable?
+ alpha
+ alpha?
+ control
+ control?
+ uncased
+ uncased?
+ character
+ character?
+ math
+ math?
+} ;
ABOUT: "unicode.categories"
ARTICLE: "unicode.categories.syntax" "Unicode category syntax"
"There is special syntax sugar for making predicate classes which are unions of Unicode general categories, plus some other code."
-{ $subsection POSTPONE: CATEGORY: }
-{ $subsection POSTPONE: CATEGORY-NOT: } ;
+{ $subsections
+ POSTPONE: CATEGORY:
+ POSTPONE: CATEGORY-NOT:
+} ;
HELP: CATEGORY:
{ $syntax "CATEGORY: foo Nl Pd Lu | \"Diacritic\" property? ;" }
ARTICLE: "unicode.collation" "Collation and weak comparison"
"The " { $vocab-link "unicode.collation" "unicode.collation" } " vocabulary implements the Unicode Collation Algorithm. The Unicode Collation Algorithm (UTS #10) forms a reasonable way to sort strings when accouting for all of the characters in Unicode. It is far preferred over code point order when sorting for human consumption, in user interfaces. At the moment, only the default Unicode collation element table (DUCET) is used, but a more accurate collation would take locale into account. The following words are useful for collation directly:"
-{ $subsection sort-strings }
-{ $subsection collation-key }
-{ $subsection string<=> }
+{ $subsections
+ sort-strings
+ collation-key
+ string<=>
+}
"Predicates for weak equality testing:"
-{ $subsection primary= }
-{ $subsection secondary= }
-{ $subsection tertiary= }
-{ $subsection quaternary= } ;
+{ $subsections
+ primary=
+ secondary=
+ tertiary=
+ quaternary=
+} ;
ABOUT: "unicode.collation"
ARTICLE: "unicode.data" "Unicode data tables"
"The " { $vocab-link "unicode.data" "unicode.data" } " vocabulary contains core Unicode data tables and code for parsing this from files. The following words access these data tables."
-{ $subsection canonical-entry }
-{ $subsection combine-chars }
-{ $subsection combining-class }
-{ $subsection non-starter? }
-{ $subsection name>char }
-{ $subsection char>name }
-{ $subsection property? }
-{ $subsection category }
-{ $subsection ch>upper }
-{ $subsection ch>lower }
-{ $subsection ch>title }
-{ $subsection special-case } ;
+{ $subsections
+ canonical-entry
+ combine-chars
+ combining-class
+ non-starter?
+ name>char
+ char>name
+ property?
+ category
+ ch>upper
+ ch>lower
+ ch>title
+ special-case
+} ;
HELP: canonical-entry
{ $values { "char" "a code point" } { "seq" string } }
"There are four normalization forms: NFD, NFC, NFKD, and NFKC. Basically, in NFD and NFKD, everything is expanded, whereas in NFC and NFKC, everything is contracted. In NFKD and NFKC, more things are expanded and contracted. This is a process which loses some information, so it should be done only with care."
$nl
"Most of the world uses NFC to communicate, but for many purposes, NFD/NFKD is easier to process. For more information, see Unicode Standard Annex #15 and section 3 of the Unicode standard."
-{ $subsection nfc }
-{ $subsection nfd }
-{ $subsection nfkc }
-{ $subsection nfkd } ;
+{ $subsections
+ nfc
+ nfd
+ nfkc
+ nfkd
+} ;
HELP: nfc
{ $values { "string" string } { "nfc" "a string in NFC" } }
\r
ARTICLE: "unicode.script" "Unicode script properties"\r
"The unicode standard gives every character a script. Note that this is different from a language, and that it is non-trivial to detect language from a string. To get the script of a character, use"\r
-{ $subsection script-of } ;\r
+{ $subsections script-of } ;\r
\r
HELP: script-of\r
{ $values { "char" "a code point" } { "script" string } }\r
! Copyright (C) 2005, 2006 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax combinators system vocabs.loader ;
+USING: alien.c-types alien.syntax classes.struct combinators
+system unix.types vocabs.loader ;
IN: unix
CONSTANT: MAXPATHLEN 1024
CONSTANT: F_SETFL 4
CONSTANT: FD_CLOEXEC 1
-C-STRUCT: sockaddr-in
- { "uchar" "len" }
- { "uchar" "family" }
- { "ushort" "port" }
- { "in_addr_t" "addr" }
- { "longlong" "unused" } ;
-
-C-STRUCT: sockaddr-in6
- { "uchar" "len" }
- { "uchar" "family" }
- { "ushort" "port" }
- { "uint" "flowinfo" }
- { { "uchar" 16 } "addr" }
- { "uint" "scopeid" } ;
-
-C-STRUCT: sockaddr-un
- { "uchar" "len" }
- { "uchar" "family" }
- { { "char" 104 } "path" } ;
-
-C-STRUCT: passwd
- { "char*" "pw_name" }
- { "char*" "pw_passwd" }
- { "uid_t" "pw_uid" }
- { "gid_t" "pw_gid" }
- { "time_t" "pw_change" }
- { "char*" "pw_class" }
- { "char*" "pw_gecos" }
- { "char*" "pw_dir" }
- { "char*" "pw_shell" }
- { "time_t" "pw_expire" }
- { "int" "pw_fields" } ;
+STRUCT: sockaddr-in
+ { len uchar }
+ { family uchar }
+ { port ushort }
+ { addr in_addr_t }
+ { unused longlong } ;
+
+STRUCT: sockaddr-in6
+ { len uchar }
+ { family uchar }
+ { port ushort }
+ { flowinfo uint }
+ { addr uchar[16] }
+ { scopeid uint } ;
+
+STRUCT: sockaddr-un
+ { len uchar }
+ { family uchar }
+ { path char[104] } ;
+
+STRUCT: passwd
+ { pw_name char* }
+ { pw_passwd char* }
+ { pw_uid uid_t }
+ { pw_gid gid_t }
+ { pw_change time_t }
+ { pw_class char* }
+ { pw_gecos char* }
+ { pw_dir char* }
+ { pw_shell char* }
+ { pw_expire time_t }
+ { pw_fields int } ;
CONSTANT: max-un-path 104
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix
CONSTANT: FD_SETSIZE 1024
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "socklen_t" "addrlen" }
- { "char*" "canonname" }
- { "void*" "addr" }
- { "addrinfo*" "next" } ;
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
+ { addrlen socklen_t }
+ { canonname char* }
+ { addr void* }
+ { next addrinfo* } ;
-C-STRUCT: dirent
- { "u_int32_t" "d_fileno" }
- { "u_int16_t" "d_reclen" }
- { "u_int8_t" "d_type" }
- { "u_int8_t" "d_namlen" }
- { { "char" 256 } "d_name" } ;
+STRUCT: dirent
+ { d_fileno u_int32_t }
+ { d_reclen u_int16_t }
+ { d_type u_int8_t }
+ { d_namlen u_int8_t }
+ { d_name char[256] } ;
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
-USING: alien.syntax unix.time ;
+USING: alien.c-types alien.syntax unix.time unix.types
+unix.types.macosx classes.struct ;
IN: unix
CONSTANT: FD_SETSIZE 1024
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "socklen_t" "addrlen" }
- { "char*" "canonname" }
- { "void*" "addr" }
- { "addrinfo*" "next" } ;
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
+ { addrlen socklen_t }
+ { canonname char* }
+ { addr void* }
+ { next addrinfo* } ;
CONSTANT: _UTX_USERSIZE 256
CONSTANT: _UTX_LINESIZE 32
CONSTANT: _UTX_IDSIZE 4
CONSTANT: _UTX_HOSTSIZE 256
-C-STRUCT: utmpx
- { { "char" _UTX_USERSIZE } "ut_user" }
- { { "char" _UTX_IDSIZE } "ut_id" }
- { { "char" _UTX_LINESIZE } "ut_line" }
- { "pid_t" "ut_pid" }
- { "short" "ut_type" }
- { "timeval" "ut_tv" }
- { { "char" _UTX_HOSTSIZE } "ut_host" }
- { { "uint" 16 } "ut_pad" } ;
+STRUCT: utmpx
+ { ut_user { char _UTX_USERSIZE } }
+ { ut_id { char _UTX_IDSIZE } }
+ { ut_line { char _UTX_LINESIZE } }
+ { ut_pid pid_t }
+ { ut_type short }
+ { ut_tv timeval }
+ { ut_host { char _UTX_HOSTSIZE } }
+ { ut_pad { uint 16 } } ;
CONSTANT: __DARWIN_MAXPATHLEN 1024
CONSTANT: __DARWIN_MAXNAMELEN 255
CONSTANT: __DARWIN_MAXNAMELEN+1 255
-C-STRUCT: dirent
- { "ino_t" "d_ino" }
- { "__uint16_t" "d_reclen" }
- { "__uint8_t" "d_type" }
- { "__uint8_t" "d_namlen" }
- { { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
+STRUCT: dirent
+ { d_ino ino_t }
+ { d_reclen __uint16_t }
+ { d_type __uint8_t }
+ { d_namlen __uint8_t }
+ { d_name { char __DARWIN_MAXNAMELEN+1 } } ;
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
-USING: alien.syntax alien.c-types math vocabs.loader ;
+USING: alien.syntax alien.c-types math vocabs.loader
+classes.struct unix.types ;
IN: unix
CONSTANT: FD_SETSIZE 256
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "socklen_t" "addrlen" }
- { "char*" "canonname" }
- { "void*" "addr" }
- { "addrinfo*" "next" } ;
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
+ { addrlen socklen_t }
+ { canonname char* }
+ { addr void* }
+ { next addrinfo* } ;
-C-STRUCT: dirent
- { "__uint32_t" "d_fileno" }
- { "__uint16_t" "d_reclen" }
- { "__uint8_t" "d_type" }
- { "__uint8_t" "d_namlen" }
- { { "char" 256 } "d_name" } ;
+STRUCT: dirent
+ { d_fileno __uint32_t }
+ { d_reclen __uint16_t }
+ { d_type __uint8_t }
+ { d_namlen __uint8_t }
+ { d_name char[256] } ;
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
CONSTANT: _UTX_IDSIZE 4
CONSTANT: _UTX_HOSTSIZE 256
-: _SS_MAXSIZE ( -- n )
- 128 ; inline
+CONSTANT: _SS_MAXSIZE 128
: _SS_ALIGNSIZE ( -- n )
"__int64_t" heap-size ; inline
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.time ;
+USING: alien.c-types alien.syntax unix.time unix.types
+unix.types.netbsd classes.struct ;
IN: unix
-C-STRUCT: sockaddr_storage
- { "__uint8_t" "ss_len" }
- { "sa_family_t" "ss_family" }
- { { "char" _SS_PAD1SIZE } "__ss_pad1" }
- { "__int64_t" "__ss_align" }
- { { "char" _SS_PAD2SIZE } "__ss_pad2" } ;
+STRUCT: sockaddr_storage
+ { ss_len __uint8_t }
+ { ss_family sa_family_t }
+ { __ss_pad1 { char _SS_PAD1SIZE } }
+ { __ss_align __int64_t }
+ { __ss_pad2 { char _SS_PAD2SIZE } } ;
-C-STRUCT: exit_struct
- { "uint16_t" "e_termination" }
- { "uint16_t" "e_exit" } ;
+STRUCT: exit_struct
+ { e_termination uint16_t }
+ { e_exit uint16_t } ;
-C-STRUCT: utmpx
- { { "char" _UTX_USERSIZE } "ut_user" }
- { { "char" _UTX_IDSIZE } "ut_id" }
- { { "char" _UTX_LINESIZE } "ut_line" }
- { { "char" _UTX_HOSTSIZE } "ut_host" }
- { "uint16_t" "ut_session" }
- { "uint16_t" "ut_type" }
- { "pid_t" "ut_pid" }
- { "exit_struct" "ut_exit" }
- { "sockaddr_storage" "ut_ss" }
- { "timeval" "ut_tv" }
- { { "uint32_t" 10 } "ut_pad" } ;
+STRUCT: utmpx
+ { ut_user { char _UTX_USERSIZE } }
+ { ut_id { char _UTX_IDSIZE } }
+ { ut_line { char _UTX_LINESIZE } }
+ { ut_host { char _UTX_HOSTSIZE } }
+ { ut_session uint16_t }
+ { ut_type uint16_t }
+ { ut_pid pid_t }
+ { ut_exit exit_struct }
+ { ut_ss sockaddr_storage }
+ { ut_tv timeval }
+ { ut_pad { uint32_t 10 } } ;
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix
CONSTANT: FD_SETSIZE 1024
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "socklen_t" "addrlen" }
- { "void*" "addr" }
- { "char*" "canonname" }
- { "addrinfo*" "next" } ;
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
+ { addrlen socklen_t }
+ { addr void* }
+ { canonname char* }
+ { next addrinfo* } ;
-C-STRUCT: dirent
- { "__uint32_t" "d_fileno" }
- { "__uint16_t" "d_reclen" }
- { "__uint8_t" "d_type" }
- { "__uint8_t" "d_namlen" }
- { { "char" 256 } "d_name" } ;
+STRUCT: dirent
+ { d_fileno __uint32_t }
+ { d_reclen __uint16_t }
+ { d_type __uint8_t }
+ { d_namlen __uint8_t }
+ { d_name char[256] } ;
CONSTANT: EPERM 1
CONSTANT: ENOENT 2
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax unix.statfs.freebsd ;
IN: unix.getfsstat.freebsd
CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax unix.statfs.macosx ;
IN: unix.getfsstat.macosx
CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete
CONSTANT: MNT_NOWAIT 2 ! start all I/O, but do not wait for it
-FUNCTION: int getfsstat64 ( statfs* buf, int bufsize, int flags ) ;
+FUNCTION: int getfsstat64 ( statfs64* buf, int bufsize, int flags ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax unix.statvfs.netbsd ;
IN: unix.getfsstat.netbsd
CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete
CONSTANT: MNT_NOWAIT 2 ! start all I/O, but do not wait for it
CONSTANT: MNT_LAZY 3 ! push data not written by filesystem syncer
-FUNCTION: int getvfsstat ( statfs* buf, int bufsize, int flags ) ;
+FUNCTION: int getvfsstat ( statvfs* buf, int bufsize, int flags ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax unix.statfs.openbsd ;
IN: unix.getfsstat.openbsd
CONSTANT: MNT_WAIT 1 ! synchronously wait for I/O to complete
"The " { $vocab-link "unix.groups" } " vocabulary contains words that return information about Unix groups."
$nl
"Listing all groups:"
-{ $subsection all-groups }
+{ $subsections all-groups }
"Real groups:"
-{ $subsection real-group-name }
-{ $subsection real-group-id }
-{ $subsection set-real-group }
+{ $subsections
+ real-group-name
+ real-group-id
+ set-real-group
+}
"Effective groups:"
-{ $subsection effective-group-name }
-{ $subsection effective-group-id }
-{ $subsection set-effective-group }
+{ $subsections
+ effective-group-name
+ effective-group-id
+ set-effective-group
+}
"Combinators to change groups:"
-{ $subsection with-real-group }
-{ $subsection with-effective-group } ;
+{ $subsections
+ with-real-group
+ with-effective-group
+} ;
ABOUT: "unix.groups"
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings io.encodings.utf8
-io.backend.unix kernel math sequences splitting unix strings
+io.backend.unix kernel math sequences splitting strings
combinators.short-circuit byte-arrays combinators
accessors math.parser fry assocs namespaces continuations
-unix.users unix.utilities ;
+unix.users unix.utilities classes.struct ;
IN: unix.groups
+QUALIFIED: unix
+
QUALIFIED: grouping
TUPLE: group id name passwd members ;
<PRIVATE
: group-members ( group-struct -- seq )
- group-gr_mem utf8 alien>strings ;
+ gr_mem>> utf8 alien>strings ;
: (group-struct) ( id -- group-struct id group-struct byte-array length void* )
- "group" <c-object> tuck 4096
+ \ unix:group <struct> tuck 4096
[ <byte-array> ] keep f <void*> ;
: check-group-struct ( group-struct ptr -- group-struct/f )
*void* [ drop f ] unless ;
M: integer group-struct ( id -- group/f )
- (group-struct) [ getgrgid_r io-error ] keep check-group-struct ;
+ (group-struct) [ unix:getgrgid_r unix:io-error ] keep check-group-struct ;
M: string group-struct ( string -- group/f )
- (group-struct) [ getgrnam_r io-error ] keep check-group-struct ;
+ (group-struct) [ unix:getgrnam_r unix:io-error ] keep check-group-struct ;
: group-struct>group ( group-struct -- group )
[ \ group new ] dip
{
- [ group-gr_name >>name ]
- [ group-gr_passwd >>passwd ]
- [ group-gr_gid >>id ]
+ [ gr_name>> >>name ]
+ [ gr_passwd>> >>passwd ]
+ [ gr_gid>> >>id ]
[ group-members >>members ]
} cleave ;
dup group-cache get [
?at [ name>> ] [ number>string ] if
] [
- group-struct [ group-gr_name ] [ f ] if*
+ group-struct [ gr_name>> ] [ f ] if*
] if*
[ nip ] [ number>string ] if* ;
: group-id ( string -- id/f )
- group-struct [ group-gr_gid ] [ f ] if* ;
+ group-struct [ gr_gid>> ] [ f ] if* ;
<PRIVATE
: (user-groups) ( string -- seq )
#! first group is -1337, legacy unix code
- -1337 NGROUPS_MAX [ 4 * <byte-array> ] keep
- <int> [ getgrouplist io-error ] 2keep
+ -1337 unix:NGROUPS_MAX [ 4 * <byte-array> ] keep
+ <int> [ unix:getgrouplist unix:io-error ] 2keep
[ 4 tail-slice ] [ *int 1 - ] bi* >groups ;
PRIVATE>
user-name (user-groups) ;
: all-groups ( -- seq )
- [ getgrent dup ] [ group-struct>group ] produce nip ;
+ [ unix:getgrent dup ] [ \ unix:group memory>struct group-struct>group ] produce nip ;
: <group-cache> ( -- assoc )
all-groups [ [ id>> ] keep ] H{ } map>assoc ;
: with-group-cache ( quot -- )
[ <group-cache> group-cache ] dip with-variable ; inline
-: real-group-id ( -- id )
- getgid ; inline
+: real-group-id ( -- id ) unix:getgid ; inline
-: real-group-name ( -- string )
- real-group-id group-name ; inline
+: real-group-name ( -- string ) real-group-id group-name ; inline
-: effective-group-id ( -- string )
- getegid ; inline
+: effective-group-id ( -- string ) unix:getegid ; inline
: effective-group-name ( -- string )
effective-group-id group-name ; inline
<PRIVATE
: (set-real-group) ( id -- )
- setgid io-error ; inline
+ unix:setgid unix:io-error ; inline
: (set-effective-group) ( id -- )
- setegid io-error ; inline
+ unix:setegid unix:io-error ; inline
PRIVATE>
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.time ;
IN: unix.kqueue
-C-STRUCT: kevent
- { "ulong" "ident" } ! identifier for this event
- { "short" "filter" } ! filter for event
- { "ushort" "flags" } ! action flags for kqueue
- { "uint" "fflags" } ! filter flag value
- { "long" "data" } ! filter data value
- { "void*" "udata" } ! opaque user data identifier
-;
+STRUCT: kevent
+ { ident ulong }
+ { filter short }
+ { flags ushort }
+ { fflags uint }
+ { data long }
+ { udata void* } ;
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax system sequences vocabs.loader words
+USING: alien.c-types alien.syntax system sequences vocabs.loader words
accessors ;
IN: unix.kqueue
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.time ;
IN: unix.kqueue
-C-STRUCT: kevent
- { "ulong" "ident" } ! identifier for this event
- { "short" "filter" } ! filter for event
- { "ushort" "flags" } ! action flags for kqueue
- { "uint" "fflags" } ! filter flag value
- { "long" "data" } ! filter data value
- { "void*" "udata" } ! opaque user data identifier
-;
+STRUCT: kevent
+ { ident ulong }
+ { filter short }
+ { flags ushort }
+ { fflags uint }
+ { data long }
+ { udata void* } ;
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.time ;
IN: unix.kqueue
-C-STRUCT: kevent
- { "ulong" "ident" } ! identifier for this event
- { "uint" "filter" } ! filter for event
- { "uint" "flags" } ! action flags for kqueue
- { "uint" "fflags" } ! filter flag value
- { "longlong" "data" } ! filter data value
- { "void*" "udata" } ! opaque user data identifier
-;
+STRUCT: kevent
+ { ident ulong }
+ { filter uint }
+ { flags uint }
+ { fflags uint }
+ { data longlong }
+ { udata void* } ;
FUNCTION: int kevent ( int kq, kevent* changelist, size_t nchanges, kevent* eventlist, size_t nevents, timespec* timeout ) ;
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.time ;
IN: unix.kqueue
-C-STRUCT: kevent
- { "uint" "ident" } ! identifier for this event
- { "short" "filter" } ! filter for event
- { "ushort" "flags" } ! action flags for kqueue
- { "uint" "fflags" } ! filter flag value
- { "int" "data" } ! filter data value
- { "void*" "udata" } ! opaque user data identifier
-;
+STRUCT: kevent
+ { ident uint }
+ { filter short }
+ { flags ushort }
+ { fflags uint }
+ { data int }
+ { udata void* } ;
FUNCTION: int kevent ( int kq, kevent* changelist, int nchanges, kevent* eventlist, int nevents, timespec* timeout ) ;
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
IN: unix.linux.epoll
-USING: alien.syntax math ;
+USING: alien.c-types alien.syntax classes.struct math ;
FUNCTION: int epoll_create ( int size ) ;
-FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll_event* event ) ;
+STRUCT: epoll-event
+{ events uint }
+{ fd uint }
+{ padding uint } ;
-C-STRUCT: epoll-event
- { "uint" "events" }
- { "uint" "fd" }
- { "uint" "padding" } ;
+FUNCTION: int epoll_ctl ( int epfd, int op, int fd, epoll-event* event ) ;
-FUNCTION: int epoll_wait ( int epfd, epoll_event* events, int maxevents, int timeout ) ;
+FUNCTION: int epoll_wait ( int epfd, epoll-event* events, int maxevents, int timeout ) ;
CONSTANT: EPOLL_CTL_ADD 1 ! Add a file decriptor to the interface.
CONSTANT: EPOLL_CTL_DEL 2 ! Remove a file decriptor from the interface.
! Copyright (C) 2008 Slava Pestov.\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: alien.syntax math math.bitwise ;\r
+USING: alien.c-types alien.syntax math math.bitwise classes.struct ;\r
IN: unix.linux.inotify\r
\r
-C-STRUCT: inotify-event\r
- { "int" "wd" } ! watch descriptor\r
- { "uint" "mask" } ! watch mask\r
- { "uint" "cookie" } ! cookie to synchronize two events\r
- { "uint" "len" } ! length (including nulls) of name\r
- { "char[0]" "name" } ! stub for possible name\r
- ;\r
+STRUCT: inotify-event\r
+ { wd int }\r
+ { mask uint }\r
+ { cookie uint }\r
+ { len uint }\r
+ { name char[0] } ;\r
\r
CONSTANT: IN_ACCESS HEX: 1 ! File was accessed\r
CONSTANT: IN_MODIFY HEX: 2 ! File was modified\r
CONSTANT: IN_Q_OVERFLOW HEX: 4000 ! Event queued overflowed\r
CONSTANT: IN_IGNORED HEX: 8000 ! File was ignored\r
\r
-: IN_CLOSE ( -- n ) IN_CLOSE_WRITE IN_CLOSE_NOWRITE bitor ; inline ! close\r
-: IN_MOVE ( -- n ) IN_MOVED_FROM IN_MOVED_TO bitor ; inline ! moves\r
+: IN_CLOSE ( -- n ) { IN_CLOSE_WRITE IN_CLOSE_NOWRITE } flags ; foldable ! close\r
+: IN_MOVE ( -- n ) { IN_MOVED_FROM IN_MOVED_TO } flags ; foldable ! moves\r
\r
CONSTANT: IN_ONLYDIR HEX: 1000000 ! only watch the path if it is a directory\r
CONSTANT: IN_DONT_FOLLOW HEX: 2000000 ! don't follow a sym link\r
! Copyright (C) 2005, 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien system ;
+USING: alien.c-types alien.syntax alien system classes.struct
+unix.types ;
IN: unix
! Linux.
CONSTANT: F_SETFL 4
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "socklen_t" "addrlen" }
- { "void*" "addr" }
- { "char*" "canonname" }
- { "addrinfo*" "next" } ;
-
-C-STRUCT: sockaddr-in
- { "ushort" "family" }
- { "ushort" "port" }
- { "in_addr_t" "addr" }
- { "longlong" "unused" } ;
-
-C-STRUCT: sockaddr-in6
- { "ushort" "family" }
- { "ushort" "port" }
- { "uint" "flowinfo" }
- { { "uchar" 16 } "addr" }
- { "uint" "scopeid" } ;
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
+ { addrlen socklen_t }
+ { addr void* }
+ { canonname char* }
+ { next addrinfo* } ;
+
+STRUCT: sockaddr-in
+ { family ushort }
+ { port ushort }
+ { addr in_addr_t }
+ { unused longlong } ;
+
+STRUCT: sockaddr-in6
+ { family ushort }
+ { port ushort }
+ { flowinfo uint }
+ { addr uchar[16] }
+ { scopeid uint } ;
CONSTANT: max-un-path 108
-C-STRUCT: sockaddr-un
- { "ushort" "family" }
- { { "char" max-un-path } "path" } ;
+STRUCT: sockaddr-un
+ { family ushort }
+ { path { char max-un-path } } ;
CONSTANT: SOCK_STREAM 1
CONSTANT: SOCK_DGRAM 2
CONSTANT: SEEK_CUR 1
CONSTANT: SEEK_END 2
-C-STRUCT: passwd
- { "char*" "pw_name" }
- { "char*" "pw_passwd" }
- { "uid_t" "pw_uid" }
- { "gid_t" "pw_gid" }
- { "char*" "pw_gecos" }
- { "char*" "pw_dir" }
- { "char*" "pw_shell" } ;
+STRUCT: passwd
+ { pw_name char* }
+ { pw_passwd char* }
+ { pw_uid uid_t }
+ { pw_gid gid_t }
+ { pw_gecos char* }
+ { pw_dir char* }
+ { pw_shell char* } ;
! dirent64
-C-STRUCT: dirent
- { "ulonglong" "d_ino" }
- { "longlong" "d_off" }
- { "ushort" "d_reclen" }
- { "uchar" "d_type" }
- { { "char" 256 } "d_name" } ;
+STRUCT: dirent
+ { d_ino ulonglong }
+ { d_off longlong }
+ { d_reclen ushort }
+ { d_type uchar }
+ { d_name char[256] } ;
FUNCTION: int open64 ( char* path, int flags, int prot ) ;
-FUNCTION: dirent64* readdir64 ( DIR* dirp ) ;
+FUNCTION: dirent* readdir64 ( DIR* dirp ) ;
FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ;
M: linux open-file [ open64 ] unix-system-call ;
-USING: kernel alien.c-types alien.strings sequences math alien.syntax
-unix namespaces continuations threads assocs io.backend.unix
-io.encodings.utf8 unix.utilities fry ;
+USING: kernel alien.c-types alien.data alien.strings sequences
+math alien.syntax unix namespaces continuations threads assocs
+io.backend.unix io.encodings.utf8 unix.types unix.utilities fry ;
IN: unix.process
! Low-level Unix process launching utilities. These are used
! Copyright (C) 2006 Patrick Mauritz.
! See http://factorcode.org/license.txt for BSD license.
+USING: alien.c-types alien.syntax system kernel layouts ;
IN: unix
-USING: alien.syntax system kernel layouts ;
! Solaris.
CONSTANT: F_SETFL 4 ! set file status flags
CONSTANT: O_NONBLOCK HEX: 80 ! no delay
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
! #ifdef __sparcv9
! int _ai_pad;
! #endif
- { "int" "addrlen" }
- { "char*" "canonname" }
- { "void*" "addr" }
- { "void*" "next" } ;
-
-C-STRUCT: sockaddr-in
- { "ushort" "family" }
- { "ushort" "port" }
- { "in_addr_t" "addr" }
- { "longlong" "unused" } ;
-
-C-STRUCT: sockaddr-in6
- { "ushort" "family" }
- { "ushort" "port" }
- { "uint" "flowinfo" }
- { { "uchar" 16 } "addr" }
- { "uint" "scopeid" } ;
+ { addrlen int }
+ { canonname char* }
+ { addr void* }
+ { next void* } ;
+
+STRUCT: sockaddr-in
+ { family ushort }
+ { port ushort }
+ { addr in_addr_t }
+ { unused longlong } ;
+
+STRUCT: sockaddr-in6
+ { family ushort }
+ { port ushort }
+ { flowinfo uint }
+ { addr uchar[16] }
+ { scopeid uint } ;
: max-un-path 108 ;
-C-STRUCT: sockaddr-un
- { "ushort" "family" }
- { { "char" max-un-path } "path" } ;
+STRUCT: sockaddr-un
+ { family ushort }
+ { path { "char" max-un-path } } ;
CONSTANT: EINTR 4
CONSTANT: EAGAIN 11
+++ /dev/null
-USING: kernel alien.syntax math ;
-
-IN: unix.stat
-
-! FreeBSD 8.0-CURRENT
-
-C-STRUCT: stat
- { "__dev_t" "st_dev" }
- { "ino_t" "st_ino" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "__dev_t" "st_rdev" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "off_t" "st_size" }
- { "blkcnt_t" "st_blocks" }
- { "blksize_t" "st_blksize" }
- { "fflags_t" "st_flags" }
- { "__uint32_t" "st_gen" }
- { "__int32_t" "st_lspare" }
- { "timespec" "st_birthtimespec" }
-! not sure about the padding here.
- { "__uint32_t" "pad0" }
- { "__uint32_t" "pad1" } ;
-
-FUNCTION: int stat ( char* pathname, stat* buf ) ;
-FUNCTION: int lstat ( char* pathname, stat* buf ) ;
+++ /dev/null
-unportable
+++ /dev/null
-USING: kernel alien.syntax math ;
-IN: unix.stat
-
-! FreeBSD 8.0-CURRENT
-! untested
-
-C-STRUCT: stat
- { "__dev_t" "st_dev" }
- { "ino_t" "st_ino" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "__dev_t" "st_rdev" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "off_t" "st_size" }
- { "blkcnt_t" "st_blocks" }
- { "blksize_t" "st_blksize" }
- { "fflags_t" "st_flags" }
- { "__uint32_t" "st_gen" }
- { "__int32_t" "st_lspare" }
- { "timespec" "st_birthtimespec" }
-! not sure about the padding here.
- { "__uint32_t" "pad0" }
- { "__uint32_t" "pad1" } ;
-
-FUNCTION: int stat ( char* pathname, stat* buf ) ;
-FUNCTION: int lstat ( char* pathname, stat* buf ) ;
+++ /dev/null
-unportable
-USING: layouts combinators vocabs.loader ;
+USING: kernel alien.c-types alien.syntax math classes.struct
+unix.time unix.types ;
IN: unix.stat
-cell-bits {
- { 32 [ "unix.stat.freebsd.32" require ] }
- { 64 [ "unix.stat.freebsd.64" require ] }
-} case
+! FreeBSD 8.0-CURRENT
+
+STRUCT: stat
+ { st_dev __dev_t }
+ { st_ino ino_t }
+ { st_mode mode_t }
+ { st_nlink nlink_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { st_rdev __dev_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { st_size off_t }
+ { st_blocks blkcnt_t }
+ { st_blksize blksize_t }
+ { st_flags fflags_t }
+ { st_gen __uint32_t }
+ { st_lspare __int32_t }
+ { st_birthtimespec timespec }
+ { pad0 __int32_t[2] } ;
+
+FUNCTION: int stat ( char* pathname, stat* buf ) ;
+FUNCTION: int lstat ( char* pathname, stat* buf ) ;
-USING: kernel alien.syntax math sequences unix
-alien.c-types arrays accessors combinators ;
+USING: kernel alien.c-types alien.syntax math classes.struct
+unix.time unix.types ;
IN: unix.stat
! stat64
-C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "ushort" "__pad1" }
- { "__ino_t" "__st_ino" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "dev_t" "st_rdev" }
- { { "ushort" 2 } "__pad2" }
- { "off64_t" "st_size" }
- { "blksize_t" "st_blksize" }
- { "blkcnt64_t" "st_blocks" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "ulonglong" "st_ino" } ;
+STRUCT: stat
+ { st_dev dev_t }
+ { __pad1 ushort }
+ { __st_ino __ino_t }
+ { st_mode mode_t }
+ { st_nlink nlink_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { st_rdev dev_t }
+ { __pad2 ushort[2] }
+ { st_size off64_t }
+ { st_blksize blksize_t }
+ { st_blocks blkcnt64_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { st_ino ulonglong } ;
FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
-USING: kernel alien.syntax math sequences unix
-alien.c-types arrays accessors combinators ;
+USING: kernel alien.c-types alien.syntax math classes.struct
+unix.time unix.types ;
IN: unix.stat
! Ubuntu 7.10 64-bit
-C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "ino_t" "st_ino" }
- { "nlink_t" "st_nlink" }
- { "mode_t" "st_mode" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "int" "pad0" }
- { "dev_t" "st_rdev" }
- { "off64_t" "st_size" }
- { "blksize_t" "st_blksize" }
- { "blkcnt64_t" "st_blocks" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "long" "__unused0" }
- { "long" "__unused1" }
- { "long" "__unused2" } ;
+STRUCT: stat
+ { st_dev dev_t }
+ { st_ino ino_t }
+ { st_nlink nlink_t }
+ { st_mode mode_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { pad0 int }
+ { st_rdev dev_t }
+ { st_size off64_t }
+ { st_blksize blksize_t }
+ { st_blocks blkcnt64_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { __unused0 long[3] } ;
FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
-USING: kernel alien.syntax math unix math.bitwise
-alien.c-types alien sequences grouping accessors combinators ;
+USING: alien.c-types arrays accessors combinators classes.struct
+alien.syntax unix.time unix.types ;
IN: unix.stat
-! Mac OS X ppc
+! Mac OS X
! stat64 structure
-C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "ino64_t" "st_ino" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "dev_t" "st_rdev" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "timespec" "st_birthtimespec" }
- { "off_t" "st_size" }
- { "blkcnt_t" "st_blocks" }
- { "blksize_t" "st_blksize" }
- { "__uint32_t" "st_flags" }
- { "__uint32_t" "st_gen" }
- { "__int32_t" "st_lspare" }
- { "__int64_t" "st_qspare0" }
- { "__int64_t" "st_qspare1" } ;
+STRUCT: stat
+ { st_dev dev_t }
+ { st_mode mode_t }
+ { st_nlink nlink_t }
+ { st_ino ino64_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { st_rdev dev_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { st_birthtimespec timespec }
+ { st_size off_t }
+ { st_blocks blkcnt_t }
+ { st_blksize blksize_t }
+ { st_flags __uint32_t }
+ { st_gen __uint32_t }
+ { st_lspare __int32_t }
+ { st_qspare0 __int64_t }
+ { st_qspare1 __int64_t } ;
FUNCTION: int stat64 ( char* pathname, stat* buf ) ;
FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;
-USING: kernel alien.syntax math ;
+USING: kernel alien.c-types alien.syntax math classes.struct
+unix.time unix.types ;
IN: unix.stat
! NetBSD 4.0
-C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "mode_t" "st_mode" }
- { "ino_t" "st_ino" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "dev_t" "st_rdev" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "timespec" "st_birthtimespec" }
- { "off_t" "st_size" }
- { "blkcnt_t" "st_blocks" }
- { "blksize_t" "st_blksize" }
- { "uint32_t" "st_flags" }
- { "uint32_t" "st_gen" }
- { { "uint32_t" 2 } "st_qspare" } ;
+STRUCT: stat
+ { st_dev dev_t }
+ { st_mode mode_t }
+ { st_ino ino_t }
+ { st_nlink nlink_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { st_rdev dev_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { st_birthtimespec timespec }
+ { st_size off_t }
+ { st_blocks blkcnt_t }
+ { st_blksize blksize_t }
+ { st_flags uint32_t }
+ { st_gen uint32_t }
+ { st_qspare uint32_t[2] } ;
FUNCTION: int __stat30 ( char* pathname, stat* buf ) ;
FUNCTION: int __lstat30 ( char* pathname, stat* buf ) ;
-USING: kernel alien.syntax math ;
+USING: kernel alien.c-types alien.syntax math classes.struct
+unix.time unix.types ;
IN: unix.stat
! NetBSD 4.0
-C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "ino_t" "st_ino" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "dev_t" "st_rdev" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "off_t" "st_size" }
- { "blkcnt_t" "st_blocks" }
- { "blksize_t" "st_blksize" }
- { "uint32_t" "st_flags" }
- { "uint32_t" "st_gen" }
- { "uint32_t" "st_spare0" }
- { "timespec" "st_birthtimespec" } ;
+STRUCT: stat
+ { st_dev dev_t }
+ { st_ino ino_t }
+ { st_mode mode_t }
+ { st_nlink nlink_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { st_rdev dev_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { st_size off_t }
+ { st_blocks blkcnt_t }
+ { st_blksize blksize_t }
+ { st_flags uint32_t }
+ { st_gen uint32_t }
+ { st_spare0 uint32_t }
+ { st_birthtimespec timespec } ;
FUNCTION: int __stat13 ( char* pathname, stat* buf ) ;
FUNCTION: int __lstat13 ( char* pathname, stat* buf ) ;
-USING: kernel alien.syntax math ;
+USING: kernel alien.c-types alien.syntax math classes.struct
+unix.time unix.types ;
IN: unix.stat
! OpenBSD 4.2
-C-STRUCT: stat
- { "dev_t" "st_dev" }
- { "ino_t" "st_ino" }
- { "mode_t" "st_mode" }
- { "nlink_t" "st_nlink" }
- { "uid_t" "st_uid" }
- { "gid_t" "st_gid" }
- { "dev_t" "st_rdev" }
- { "int32_t" "st_lspare0" }
- { "timespec" "st_atimespec" }
- { "timespec" "st_mtimespec" }
- { "timespec" "st_ctimespec" }
- { "off_t" "st_size" }
- { "int64_t" "st_blocks" }
- { "u_int32_t" "st_blksize" }
- { "u_int32_t" "st_flags" }
- { "u_int32_t" "st_gen" }
- { "int32_t" "st_lspare1" }
- { "timespec" "st_birthtimespec" }
- { { "int64_t" 2 } "st_qspare" } ;
+STRUCT: stat
+ { st_dev dev_t }
+ { st_ino ino_t }
+ { st_mode mode_t }
+ { st_nlink nlink_t }
+ { st_uid uid_t }
+ { st_gid gid_t }
+ { st_rdev dev_t }
+ { st_lspare0 int32_t }
+ { st_atimespec timespec }
+ { st_mtimespec timespec }
+ { st_ctimespec timespec }
+ { st_size off_t }
+ { st_blocks int64_t }
+ { st_blksize u_int32_t }
+ { st_flags u_int32_t }
+ { st_gen u_int32_t }
+ { st_lspare1 int32_t }
+ { st_birthtimespec timespec }
+ { st_qspare int64_t[2] } ;
FUNCTION: int stat ( char* pathname, stat* buf ) ;
FUNCTION: int lstat ( char* pathname, stat* buf ) ;
USING: kernel system combinators alien.syntax alien.c-types
-math io.backend.unix vocabs.loader unix ;
+math io.backend.unix vocabs.loader unix classes.struct ;
IN: unix.stat
! File Types
CONSTANT: S_IFSOCK OCT: 140000 ! Socket.
CONSTANT: S_IFWHT OCT: 160000 ! Whiteout.
-C-STRUCT: fsid
- { { "int" 2 } "__val" } ;
+STRUCT: fsid
+ { __val int[2] } ;
TYPEDEF: fsid __fsid_t
TYPEDEF: fsid fsid_t
} case >>
: file-status ( pathname -- stat )
- "stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;
+ \ stat <struct> [ [ stat ] unix-system-call drop ] keep ;
: link-status ( pathname -- stat )
- "stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;
+ \ stat <struct> [ [ lstat ] unix-system-call drop ] keep ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.types unix.stat ;
+USING: alien.syntax alien.c-types unix.types unix.stat classes.struct ;
IN: unix.statfs.freebsd
CONSTANT: MFSNAMELEN 16 ! length of type name including null */
CONSTANT: MNAMELEN 88 ! size of on/from name bufs
CONSTANT: STATFS_VERSION HEX: 20030518 ! current version number
-C-STRUCT: statfs
- { "uint32_t" "f_version" }
- { "uint32_t" "f_type" }
- { "uint64_t" "f_flags" }
- { "uint64_t" "f_bsize" }
- { "uint64_t" "f_iosize" }
- { "uint64_t" "f_blocks" }
- { "uint64_t" "f_bfree" }
- { "int64_t" "f_bavail" }
- { "uint64_t" "f_files" }
- { "int64_t" "f_ffree" }
- { "uint64_t" "f_syncwrites" }
- { "uint64_t" "f_asyncwrites" }
- { "uint64_t" "f_syncreads" }
- { "uint64_t" "f_asyncreads" }
- { { "uint64_t" 10 } "f_spare" }
- { "uint32_t" "f_namemax" }
- { "uid_t" "f_owner" }
- { "fsid_t" "f_fsid" }
- { { "char" 80 } "f_charspare" }
- { { "char" MFSNAMELEN } "f_fstypename" }
- { { "char" MNAMELEN } "f_mntfromname" }
- { { "char" MNAMELEN } "f_mntonname" } ;
+STRUCT: statfs
+ { f_version uint32_t }
+ { f_type uint32_t }
+ { f_flags uint64_t }
+ { f_bsize uint64_t }
+ { f_iosize uint64_t }
+ { f_blocks uint64_t }
+ { f_bfree uint64_t }
+ { f_bavail int64_t }
+ { f_files uint64_t }
+ { f_ffree int64_t }
+ { f_syncwrites uint64_t }
+ { f_asyncwrites uint64_t }
+ { f_syncreads uint64_t }
+ { f_asyncreads uint64_t }
+ { f_spare uint64_t[10] }
+ { f_namemax uint32_t }
+ { f_owner uid_t }
+ { f_fsid fsid_t }
+ { f_charspare char[80] }
+ { f_fstypename { char MFSNAMELEN } }
+ { f_mntfromname { char MNAMELEN } }
+ { f_mntonname { char MNAMELEN } } ;
-FUNCTION: int statfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statfs ( char* path, statfs* buf ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.types unix.stat ;
+USING: alien.c-types alien.syntax unix.types unix.stat classes.struct ;
IN: unix.statfs.linux
-C-STRUCT: statfs64
- { "__SWORD_TYPE" "f_type" }
- { "__SWORD_TYPE" "f_bsize" }
- { "__fsblkcnt64_t" "f_blocks" }
- { "__fsblkcnt64_t" "f_bfree" }
- { "__fsblkcnt64_t" "f_bavail" }
- { "__fsfilcnt64_t" "f_files" }
- { "__fsfilcnt64_t" "f_ffree" }
- { "__fsid_t" "f_fsid" }
- { "__SWORD_TYPE" "f_namelen" }
- { "__SWORD_TYPE" "f_frsize" }
- { { "__SWORD_TYPE" 5 } "f_spare" } ;
+STRUCT: statfs64
+ { f_type __SWORD_TYPE }
+ { f_bsize __SWORD_TYPE }
+ { f_blocks __fsblkcnt64_t }
+ { f_bfree __fsblkcnt64_t }
+ { f_bavail __fsblkcnt64_t }
+ { f_files __fsblkcnt64_t }
+ { f_ffree __fsblkcnt64_t }
+ { f_fsid __fsid_t }
+ { f_namelen __SWORD_TYPE }
+ { f_frsize __SWORD_TYPE }
+ { f_spare __SWORD_TYPE[5] } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
USING: alien.c-types io.encodings.utf8 io.encodings.string
kernel sequences unix.stat accessors unix combinators math
grouping system alien.strings math.bitwise alien.syntax
-unix.types ;
+unix.types classes.struct ;
IN: unix.statfs.macosx
CONSTANT: MNT_RDONLY HEX: 00000001
CONSTANT: VFS_CTL_TIMEO HEX: 00010005
CONSTANT: VFS_CTL_NOLOCKS HEX: 00010006
-C-STRUCT: vfsquery
- { "uint32_t" "vq_flags" }
- { { "uint32_t" 31 } "vq_spare" } ;
+STRUCT: vfsquery
+ { vq_flags uint32_t }
+ { vq_spare uint32_t[31] } ;
CONSTANT: VQ_NOTRESP HEX: 0001
CONSTANT: VQ_NEEDAUTH HEX: 0002
CONSTANT: MNAMELEN 90
CONSTANT: MFSTYPENAMELEN 16
-C-STRUCT: fsid_t
- { { "int32_t" 2 } "val" } ;
+STRUCT: fsid_t
+ { val int32_t[2] } ;
-C-STRUCT: statfs64
- { "uint32_t" "f_bsize" }
- { "int32_t" "f_iosize" }
- { "uint64_t" "f_blocks" }
- { "uint64_t" "f_bfree" }
- { "uint64_t" "f_bavail" }
- { "uint64_t" "f_files" }
- { "uint64_t" "f_ffree" }
- { "fsid_t" "f_fsid" }
- { "uid_t" "f_owner" }
- { "uint32_t" "f_type" }
- { "uint32_t" "f_flags" }
- { "uint32_t" "f_fssubtype" }
- { { "char" MFSTYPENAMELEN } "f_fstypename" }
- { { "char" MAXPATHLEN } "f_mntonname" }
- { { "char" MAXPATHLEN } "f_mntfromname" }
- { { "uint32_t" 8 } "f_reserved" } ;
+STRUCT: statfs64
+ { f_bsize uint32_t }
+ { f_iosize int32_t }
+ { f_blocks uint64_t }
+ { f_bfree uint64_t }
+ { f_bavail uint64_t }
+ { f_files uint64_t }
+ { f_ffree uint64_t }
+ { f_fsid fsid_t }
+ { f_owner uid_t }
+ { f_type uint32_t }
+ { f_flags uint32_t }
+ { f_fssubtype uint32_t }
+ { f_fstypename { char MFSTYPENAMELEN } }
+ { f_mntonname { char MAXPATHLEN } }
+ { f_mntfromname { char MAXPATHLEN } }
+ { f_reserved uint32_t[8] } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax unix.types unix.stat ;
+USING: alien.c-types alien.syntax unix.types classes.struct
+unix.stat ;
IN: unix.statfs.openbsd
CONSTANT: MFSNAMELEN 16
CONSTANT: MNAMELEN 90
-C-STRUCT: statfs
- { "u_int32_t" "f_flags" }
- { "u_int32_t" "f_bsize" }
- { "u_int32_t" "f_iosize" }
- { "u_int64_t" "f_blocks" }
- { "u_int64_t" "f_bfree" }
- { "int64_t" "f_bavail" }
- { "u_int64_t" "f_files" }
- { "u_int64_t" "f_ffree" }
- { "int64_t" "f_favail" }
- { "u_int64_t" "f_syncwrites" }
- { "u_int64_t" "f_syncreads" }
- { "u_int64_t" "f_asyncwrites" }
- { "u_int64_t" "f_asyncreads" }
- { "fsid_t" "f_fsid" }
- { "u_int32_t" "f_namemax" }
- { "uid_t" "f_owner" }
- { "u_int32_t" "f_ctime" }
- { { "u_int32_t" 3 } "f_spare" }
- { { "char" MFSNAMELEN } "f_fstypename" }
- { { "char" MNAMELEN } "f_mntonname" }
- { { "char" MNAMELEN } "f_mntfromname" }
- { { "char" 160 } "mount_info" } ;
+STRUCT: statfs
+ { f_flags u_int32_t }
+ { f_bsize u_int32_t }
+ { f_iosize u_int32_t }
+ { f_blocks u_int64_t }
+ { f_bfree u_int64_t }
+ { f_bavail int64_t }
+ { f_files u_int64_t }
+ { f_ffree u_int64_t }
+ { f_favail int64_t }
+ { f_syncwrites u_int64_t }
+ { f_syncreads u_int64_t }
+ { f_asyncwrites u_int64_t }
+ { f_asyncreads u_int64_t }
+ { f_fsid fsid_t }
+ { f_namemax u_int32_t }
+ { f_owner uid_t }
+ { f_ctime u_int32_t }
+ { f_spare u_int32_t[3] }
+ { f_fstypename { char MFSNAMELEN } }
+ { f_mntonname { char MNAMELEN } }
+ { f_mntfromname { char MNAMELEN } }
+ { mount_info char[160] } ;
-FUNCTION: int statfs ( char* path, statvfs* buf ) ;
+FUNCTION: int statfs ( char* path, statfs* buf ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix.statvfs.freebsd
-C-STRUCT: statvfs
- { "fsblkcnt_t" "f_bavail" }
- { "fsblkcnt_t" "f_bfree" }
- { "fsblkcnt_t" "f_blocks" }
- { "fsfilcnt_t" "f_favail" }
- { "fsfilcnt_t" "f_ffree" }
- { "fsfilcnt_t" "f_files" }
- { "ulong" "f_bsize" }
- { "ulong" "f_flag" }
- { "ulong" "f_frsize" }
- { "ulong" "f_fsid" }
- { "ulong" "f_namemax" } ;
+STRUCT: statvfs
+ { f_bavail fsblkcnt_t }
+ { f_bfree fsblkcnt_t }
+ { f_blocks fsblkcnt_t }
+ { f_favail fsfilcnt_t }
+ { f_ffree fsfilcnt_t }
+ { f_files fsfilcnt_t }
+ { f_bsize ulong }
+ { f_flag ulong }
+ { f_frsize ulong }
+ { f_fsid ulong }
+ { f_namemax ulong } ;
! Flags
CONSTANT: ST_RDONLY HEX: 1 ! Read-only file system
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix.statvfs.linux
-C-STRUCT: statvfs64
- { "ulong" "f_bsize" }
- { "ulong" "f_frsize" }
- { "__fsblkcnt64_t" "f_blocks" }
- { "__fsblkcnt64_t" "f_bfree" }
- { "__fsblkcnt64_t" "f_bavail" }
- { "__fsfilcnt64_t" "f_files" }
- { "__fsfilcnt64_t" "f_ffree" }
- { "__fsfilcnt64_t" "f_favail" }
- { "ulong" "f_fsid" }
- { "ulong" "f_flag" }
- { "ulong" "f_namemax" }
- { { "int" 6 } "__f_spare" } ;
+STRUCT: statvfs64
+ { f_bsize ulong }
+ { f_frsize ulong }
+ { f_blocks __fsblkcnt64_t }
+ { f_bfree __fsblkcnt64_t }
+ { f_bavail __fsblkcnt64_t }
+ { f_files __fsfilcnt64_t }
+ { f_ffree __fsfilcnt64_t }
+ { f_favail __fsfilcnt64_t }
+ { f_fsid ulong }
+ { f_flag ulong }
+ { f_namemax ulong }
+ { __f_spare int[6] } ;
FUNCTION: int statvfs64 ( char* path, statvfs64* buf ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix.statvfs.macosx
-C-STRUCT: statvfs
- { "ulong" "f_bsize" }
- { "ulong" "f_frsize" }
- { "fsblkcnt_t" "f_blocks" }
- { "fsblkcnt_t" "f_bfree" }
- { "fsblkcnt_t" "f_bavail" }
- { "fsfilcnt_t" "f_files" }
- { "fsfilcnt_t" "f_ffree" }
- { "fsfilcnt_t" "f_favail" }
- { "ulong" "f_fsid" }
- { "ulong" "f_flag" }
- { "ulong" "f_namemax" } ;
+STRUCT: statvfs
+ { f_bsize ulong }
+ { f_frsize ulong }
+ { f_blocks fsblkcnt_t }
+ { f_bfree fsblkcnt_t }
+ { f_bavail fsblkcnt_t }
+ { f_files fsfilcnt_t }
+ { f_ffree fsfilcnt_t }
+ { f_favail fsfilcnt_t }
+ { f_fsid ulong }
+ { f_flag ulong }
+ { f_namemax ulong } ;
! Flags
CONSTANT: ST_RDONLY HEX: 1 ! Read-only file system
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types
+unix.stat ;
IN: unix.statvfs.netbsd
CONSTANT: _VFS_NAMELEN 32
CONSTANT: _VFS_MNAMELEN 1024
-C-STRUCT: statvfs
- { "ulong" "f_flag" }
- { "ulong" "f_bsize" }
- { "ulong" "f_frsize" }
- { "ulong" "f_iosize" }
- { "fsblkcnt_t" "f_blocks" }
- { "fsblkcnt_t" "f_bfree" }
- { "fsblkcnt_t" "f_bavail" }
- { "fsblkcnt_t" "f_bresvd" }
- { "fsfilcnt_t" "f_files" }
- { "fsfilcnt_t" "f_ffree" }
- { "fsfilcnt_t" "f_favail" }
- { "fsfilcnt_t" "f_fresvd" }
- { "uint64_t" "f_syncreads" }
- { "uint64_t" "f_syncwrites" }
- { "uint64_t" "f_asyncreads" }
- { "uint64_t" "f_asyncwrites" }
- { "fsid_t" "f_fsidx" }
- { "ulong" "f_fsid" }
- { "ulong" "f_namemax" }
- { "uid_t" "f_owner" }
- { { "uint32_t" 4 } "f_spare" }
- { { "char" _VFS_NAMELEN } "f_fstypename" }
- { { "char" _VFS_MNAMELEN } "f_mntonname" }
- { { "char" _VFS_MNAMELEN } "f_mntfromname" } ;
+STRUCT: statvfs
+ { f_flag ulong }
+ { f_bsize ulong }
+ { f_frsize ulong }
+ { f_iosize ulong }
+ { f_blocks fsblkcnt_t }
+ { f_bfree fsblkcnt_t }
+ { f_bavail fsblkcnt_t }
+ { f_bresvd fsblkcnt_t }
+ { f_files fsfilcnt_t }
+ { f_ffree fsfilcnt_t }
+ { f_favail fsfilcnt_t }
+ { f_fresvd fsfilcnt_t }
+ { f_syncreads uint64_t }
+ { f_syncwrites uint64_t }
+ { f_asyncreads uint64_t }
+ { f_asyncwrites uint64_t }
+ { f_fsidx fsid_t }
+ { f_fsid ulong }
+ { f_namemax ulong }
+ { f_owner uid_t }
+ { f_spare uint32_t[4] }
+ { f_fstypename { char _VFS_NAMELEN } }
+ { f_mntonname { char _VFS_MNAMELEN } }
+ { f_mntfromname { char _VFS_MNAMELEN } } ;
FUNCTION: int statvfs ( char* path, statvfs* buf ) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax ;
+USING: alien.c-types alien.syntax classes.struct unix.types ;
IN: unix.statvfs.openbsd
-C-STRUCT: statvfs
- { "ulong" "f_bsize" }
- { "ulong" "f_frsize" }
- { "fsblkcnt_t" "f_blocks" }
- { "fsblkcnt_t" "f_bfree" }
- { "fsblkcnt_t" "f_bavail" }
- { "fsfilcnt_t" "f_files" }
- { "fsfilcnt_t" "f_ffree" }
- { "fsfilcnt_t" "f_favail" }
- { "ulong" "f_fsid" }
- { "ulong" "f_flag" }
- { "ulong" "f_namemax" } ;
+STRUCT: statvfs
+ { f_bsize ulong }
+ { f_frsize ulong }
+ { f_blocks fsblkcnt_t }
+ { f_bfree fsblkcnt_t }
+ { f_bavail fsblkcnt_t }
+ { f_files fsfilcnt_t }
+ { f_ffree fsfilcnt_t }
+ { f_favail fsfilcnt_t }
+ { f_fsid ulong }
+ { f_flag ulong }
+ { f_namemax ulong } ;
CONSTANT: ST_RDONLY 1
CONSTANT: ST_NOSUID 2
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel alien.syntax alien.c-types math unix.types ;
+USING: kernel alien.syntax alien.c-types math unix.types
+classes.struct accessors ;
IN: unix.time
-C-STRUCT: timeval
- { "long" "sec" }
- { "long" "usec" } ;
+STRUCT: timeval
+ { sec long }
+ { usec long } ;
-C-STRUCT: timespec
- { "time_t" "sec" }
- { "long" "nsec" } ;
+STRUCT: timespec
+ { sec time_t }
+ { nsec long } ;
: make-timeval ( us -- timeval )
1000000 /mod
- "timeval" <c-object>
- [ set-timeval-usec ] keep
- [ set-timeval-sec ] keep ;
+ timeval <struct>
+ swap >>usec
+ swap >>sec ;
: make-timespec ( us -- timespec )
1000000 /mod 1000 *
- "timespec" <c-object>
- [ set-timespec-nsec ] keep
- [ set-timespec-sec ] keep ;
+ timespec <struct>
+ swap >>nsec
+ swap >>sec ;
-C-STRUCT: tm
- { "int" "sec" } ! Seconds: 0-59 (K&R says 0-61?)
- { "int" "min" } ! Minutes: 0-59
- { "int" "hour" } ! Hours since midnight: 0-23
- { "int" "mday" } ! Day of the month: 1-31
- { "int" "mon" } ! Months *since* january: 0-11
- { "int" "year" } ! Years since 1900
- { "int" "wday" } ! Days since Sunday (0-6)
- { "int" "yday" } ! Days since Jan. 1: 0-365
- { "int" "isdst" } ! +1 Daylight Savings Time, 0 No DST,
- { "long" "gmtoff" } ! Seconds: 0-59 (K&R says 0-61?)
- { "char*" "zone" } ;
+STRUCT: tm
+ { sec int }
+ { min int }
+ { hour int }
+ { mday int }
+ { mon int }
+ { year int }
+ { wday int }
+ { yday int }
+ { isdst int }
+ { gmtoff long }
+ { zone char* } ;
FUNCTION: time_t time ( time_t* t ) ;
FUNCTION: tm* localtime ( time_t* clock ) ;
-USING: kernel system alien.syntax combinators vocabs.loader ;
+USING: kernel system alien.c-types alien.syntax combinators vocabs.loader ;
IN: unix.types
TYPEDEF: char int8_t
TYPEDEF: __uint64_t rlim_t
TYPEDEF: uint32_t id_t
+C-TYPE: DIR
+C-TYPE: FILE
+C-TYPE: rlimit
+C-TYPE: rusage
+C-TYPE: sockaddr
+
os {
{ linux [ "unix.types.linux" require ] }
{ macosx [ "unix.types.macosx" require ] }
{ netbsd [ "unix.types.netbsd" require ] }
{ winnt [ ] }
} case
+
sequences continuations byte-arrays strings math namespaces
system combinators vocabs.loader accessors
stack-checker macros locals generalizations unix.types
-io vocabs ;
+io vocabs classes.struct unix.time ;
IN: unix
CONSTANT: PROT_NONE 0
CONSTANT: DT_SOCK 12
CONSTANT: DT_WHT 14
-C-STRUCT: group
- { "char*" "gr_name" }
- { "char*" "gr_passwd" }
- { "int" "gr_gid" }
- { "char**" "gr_mem" } ;
-
LIBRARY: libc
FUNCTION: char* strerror ( int errno ) ;
]
] ;
+HOOK: open-file os ( path flags mode -- fd )
+
+<<
+
+{
+ { [ os linux? ] [ "unix.linux" require ] }
+ { [ os bsd? ] [ "unix.bsd" require ] }
+ { [ os solaris? ] [ "unix.solaris" require ] }
+} cond
+
+"debugger" vocab [
+ "unix.debugger" require
+] when
+
+>>
+
+STRUCT: group
+ { gr_name char* }
+ { gr_passwd char* }
+ { gr_gid int }
+ { gr_mem char** } ;
+
FUNCTION: int accept ( int s, void* sockaddr, socklen_t* socklen ) ;
FUNCTION: int bind ( int s, void* name, socklen_t namelen ) ;
FUNCTION: int chdir ( char* path ) ;
! FUNCTION: int dup ( int oldd ) ;
: _exit ( status -- * )
#! We throw to give this a terminating stack effect.
- "int" f "_exit" { "int" } alien-invoke "Exit failed" throw ;
+ int f "_exit" { int } alien-invoke "Exit failed" throw ;
FUNCTION: void endpwent ( ) ;
FUNCTION: int fchdir ( int fd ) ;
FUNCTION: int fchown ( int fd, uid_t owner, gid_t group ) ;
FUNCTION: int open ( char* path, int flags, int prot ) ;
-HOOK: open-file os ( path flags mode -- fd )
-
M: unix open-file [ open ] unix-system-call ;
FUNCTION: DIR* opendir ( char* path ) ;
-C-STRUCT: utimbuf
- { "time_t" "actime" }
- { "time_t" "modtime" } ;
+STRUCT: utimbuf
+ { actime time_t }
+ { modtime time_t } ;
-FUNCTION: int utime ( char* path, utimebuf* buf ) ;
+FUNCTION: int utime ( char* path, utimbuf* buf ) ;
: touch ( filename -- ) f [ utime ] unix-system-call drop ;
: change-file-times ( filename access modification -- )
- "utimebuf" <c-object>
- [ set-utimbuf-modtime ] keep
- [ set-utimbuf-actime ] keep
- [ utime ] unix-system-call drop ;
+ utimbuf <struct>
+ swap >>modtime
+ swap >>actime
+ [ utime ] unix-system-call drop ;
FUNCTION: int pclose ( void* file ) ;
FUNCTION: int pipe ( int* filedes ) ;
FUNCTION: ssize_t write ( int fd, void* buf, size_t nbytes ) ;
-{
- { [ os linux? ] [ "unix.linux" require ] }
- { [ os bsd? ] [ "unix.bsd" require ] }
- { [ os solaris? ] [ "unix.solaris" require ] }
-} cond
-
-"debugger" vocab [
- "unix.debugger" require
-] when
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: combinators accessors kernel unix unix.users
+USING: combinators accessors kernel unix.users
system ;
IN: unix.users.bsd
+QUALIFIED: unix
TUPLE: bsd-passwd < passwd change class expire fields ;
M: bsd passwd>new-passwd ( passwd -- bsd-passwd )
[ call-next-method ] keep
{
- [ passwd-pw_change >>change ]
- [ passwd-pw_class >>class ]
- [ passwd-pw_shell >>shell ]
- [ passwd-pw_expire >>expire ]
- [ passwd-pw_fields >>fields ]
+ [ pw_change>> >>change ]
+ [ pw_class>> >>class ]
+ [ pw_shell>> >>shell ]
+ [ pw_expire>> >>expire ]
+ [ pw_fields>> >>fields ]
} cleave ;
"The " { $vocab-link "unix.users" } " vocabulary contains words that return information about Unix users."
$nl
"Listing all users:"
-{ $subsection all-users }
+{ $subsections all-users }
"Real user:"
-{ $subsection real-user-name }
-{ $subsection real-user-id }
-{ $subsection set-real-user }
+{ $subsections
+ real-user-name
+ real-user-id
+ set-real-user
+}
"Effective user:"
-{ $subsection effective-user-name }
-{ $subsection effective-user-id }
-{ $subsection set-effective-user }
+{ $subsections
+ effective-user-name
+ effective-user-id
+ set-effective-user
+}
"Combinators to change users:"
-{ $subsection with-real-user }
-{ $subsection with-effective-user } ;
+{ $subsections
+ with-real-user
+ with-effective-user
+} ;
ABOUT: "unix.users"
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings io.encodings.utf8
-io.backend.unix kernel math sequences splitting unix strings
+io.backend.unix kernel math sequences splitting strings
combinators.short-circuit grouping byte-arrays combinators
accessors math.parser fry assocs namespaces continuations
-vocabs.loader system ;
+vocabs.loader system classes.struct ;
IN: unix.users
+QUALIFIED: unix
TUPLE: passwd user-name password uid gid gecos dir shell ;
M: unix passwd>new-passwd ( passwd -- seq )
[ new-passwd ] dip
{
- [ passwd-pw_name >>user-name ]
- [ passwd-pw_passwd >>password ]
- [ passwd-pw_uid >>uid ]
- [ passwd-pw_gid >>gid ]
- [ passwd-pw_gecos >>gecos ]
- [ passwd-pw_dir >>dir ]
- [ passwd-pw_shell >>shell ]
+ [ pw_name>> >>user-name ]
+ [ pw_passwd>> >>password ]
+ [ pw_uid>> >>uid ]
+ [ pw_gid>> >>gid ]
+ [ pw_gecos>> >>gecos ]
+ [ pw_dir>> >>dir ]
+ [ pw_shell>> >>shell ]
} cleave ;
: with-pwent ( quot -- )
- [ endpwent ] [ ] cleanup ; inline
+ [ unix:endpwent ] [ ] cleanup ; inline
PRIVATE>
: all-users ( -- seq )
[
- [ getpwent dup ] [ passwd>new-passwd ] produce nip
+ [ unix:getpwent dup ] [ unix:passwd memory>struct passwd>new-passwd ] produce nip
] with-pwent ;
SYMBOL: user-cache
M: integer user-passwd ( id -- passwd/f )
user-cache get
- [ at ] [ getpwuid [ passwd>new-passwd ] [ f ] if* ] if* ;
+ [ at ] [ unix:getpwuid [ unix:passwd memory>struct passwd>new-passwd ] [ f ] if* ] if* ;
M: string user-passwd ( string -- passwd/f )
- getpwnam dup [ passwd>new-passwd ] when ;
+ unix:getpwnam dup [ unix:passwd memory>struct passwd>new-passwd ] when ;
: user-name ( id -- string )
dup user-passwd
user-passwd uid>> ;
: real-user-id ( -- id )
- getuid ; inline
+ unix:getuid ; inline
: real-user-name ( -- string )
real-user-id user-name ; inline
: effective-user-id ( -- id )
- geteuid ; inline
+ unix:geteuid ; inline
: effective-user-name ( -- string )
effective-user-id user-name ; inline
<PRIVATE
: (set-real-user) ( id -- )
- setuid io-error ; inline
+ unix:setuid unix:io-error ; inline
: (set-effective-user) ( id -- )
- seteuid io-error ; inline
+ unix:seteuid unix:io-error ; inline
PRIVATE>
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings
-combinators.short-circuit fry kernel layouts sequences
-specialized-arrays.alien accessors ;
+USING: alien alien.c-types alien.data alien.strings
+combinators.short-circuit fry kernel layouts sequences accessors
+specialized-arrays ;
IN: unix.utilities
+SPECIALIZED-ARRAY: void*
+
: more? ( alien -- ? )
{ [ ] [ *void* ] } 1&& ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types alien.syntax combinators continuations
-io.encodings.string io.encodings.utf8 kernel sequences strings
-unix calendar system accessors unix.time calendar.unix
-vocabs.loader ;
+USING: alien.c-types alien.data alien.syntax combinators
+continuations io.encodings.string io.encodings.utf8 kernel
+sequences strings unix calendar system accessors unix.time
+calendar.unix vocabs.loader classes.struct ;
IN: unix.utmpx
CONSTANT: EMPTY 0
utmpx-record new ;
M: unix utmpx>utmpx-record ( utmpx -- utmpx-record )
- [ new-utmpx-record ] dip
+ [ new-utmpx-record ] dip \ utmpx memory>struct
{
- [ utmpx-ut_user _UTX_USERSIZE memory>string >>user ]
- [ utmpx-ut_id _UTX_IDSIZE memory>string >>id ]
- [ utmpx-ut_line _UTX_LINESIZE memory>string >>line ]
- [ utmpx-ut_pid >>pid ]
- [ utmpx-ut_type >>type ]
- [ utmpx-ut_tv timeval>unix-time >>timestamp ]
- [ utmpx-ut_host _UTX_HOSTSIZE memory>string >>host ]
+ [ ut_user>> _UTX_USERSIZE memory>string >>user ]
+ [ ut_id>> _UTX_IDSIZE memory>string >>id ]
+ [ ut_line>> _UTX_LINESIZE memory>string >>line ]
+ [ ut_pid>> >>pid ]
+ [ ut_type>> >>type ]
+ [ ut_tv>> timeval>unix-time >>timestamp ]
+ [ ut_host>> _UTX_HOSTSIZE memory>string >>host ]
} cleave ;
: with-utmpx ( quot -- )
ARTICLE: "unrolled-lists" "Unrolled lists"
"The " { $vocab-link "unrolled-lists" } " vocabulary provides an implementation of the " { $link deque } " protocol with constant time insertion and removal at both ends, and lower memory overhead than a " { $link dlist } " due to packing 32 elements per every node. The one tradeoff is that unlike dlists, " { $link delete-node } " is not supported for unrolled lists."
-{ $subsection unrolled-list }
-{ $subsection <unrolled-list> }
-{ $subsection <hashed-unrolled-list> } ;
+{ $subsections
+ unrolled-list
+ <unrolled-list>
+ <hashed-unrolled-list>
+} ;
ABOUT: "unrolled-lists"
+USING: strings help.markup help.syntax assocs ;
IN: urls.encoding
-USING: strings help.markup help.syntax assocs multiline ;
HELP: url-decode
{ $values { "str" string } { "decoded" string } }
"USING: prettyprint urls.encoding ;"
"\"gender=female&agefrom=22&ageto=28&location=Omaha+NE\""
"query>assoc ."
- <" H{
+ """H{
{ "gender" "female" }
{ "agefrom" "22" }
{ "ageto" "28" }
{ "location" "Omaha NE" }
-}">
+}"""
}
} ;
ARTICLE: "url-encoding" "URL encoding and decoding"
"URL encoding and decoding strings:"
-{ $subsection url-encode }
-{ $subsection url-decode }
-{ $subsection url-quotable? }
+{ $subsections
+ url-encode
+ url-decode
+ url-quotable?
+}
"Encoding and decoding queries:"
-{ $subsection assoc>query }
-{ $subsection query>assoc }
+{ $subsections
+ assoc>query
+ query>assoc
+}
"See " { $url "http://en.wikipedia.org/wiki/Percent-encoding" } " for a description of URL encoding." ;
ABOUT: "url-encoding"
USING: assocs hashtables help.markup help.syntax
io.streams.string io.files io.pathnames kernel strings present
-math multiline ;
+math ;
IN: urls
HELP: url
}
{ $examples
{ $code
- <" USING: kernel http.client urls ;
+ """USING: kernel http.client urls ;
URL" http://search.yahooapis.com/WebSearchService/V1/webSearch" clone
"concatenative programming (NSFW)" "query" set-query-param
"1" "adult_ok" set-query-param
-http-get">
+http-get"""
}
"(For a complete Yahoo! search web service implementation, see the " { $vocab-link "yahoo" } " vocabulary.)"
}
{ $description "Like " { $link append-path } ", but intended for use with URL paths and not filesystem paths." } ;
ARTICLE: "url-utilities" "URL implementation utilities"
-{ $subsection parse-host }
-{ $subsection secure-protocol? }
-{ $subsection url-append-path } ;
+{ $subsections
+ parse-host
+ secure-protocol?
+ url-append-path
+} ;
ARTICLE: "urls" "URL objects"
"The " { $vocab-link "urls" } " vocabulary implements a URL data type. The benefit of using a data type to prepresent URLs rather than a string is that the parsing, printing and escaping logic is encapsulated and reused, rather than re-implemented in a potentially buggy manner every time."
"URL objects are used heavily by the " { $vocab-link "http" } " and " { $vocab-link "furnace" } " vocabularies, and are also useful on their own."
$nl
"The class of URLs, and a constructor:"
-{ $subsection url }
-{ $subsection <url> }
+{ $subsections
+ url
+ <url>
+}
"Converting strings to URLs:"
-{ $subsection >url }
+{ $subsections >url }
"URLs can be converted back to strings using the " { $link present } " word."
$nl
"URL literal syntax:"
-{ $subsection POSTPONE: URL" }
+{ $subsections POSTPONE: URL" }
"Manipulating URLs:"
-{ $subsection derive-url }
-{ $subsection relative-url }
-{ $subsection ensure-port }
-{ $subsection query-param }
-{ $subsection set-query-param }
+{ $subsections
+ derive-url
+ relative-url
+ ensure-port
+ query-param
+ set-query-param
+}
"Creating " { $link "network-addressing" } " from URLs:"
-{ $subsection url-addr }
+{ $subsections url-addr }
"The URL implemention encodes and decodes components of " { $link url } " instances automatically, but sometimes this functionality is needed for non-URL strings."
-{ $subsection "url-encoding" }
+{ $subsections "url-encoding" }
"Utility words used by the URL implementation:"
-{ $subsection "url-utilities" } ;
+{ $subsections "url-utilities" } ;
ABOUT: "urls"
"The below words can be used to generate version 1, 3, 4, and 5 UUIDs as specified in RFC 4122."
$nl
"If all you want is a unique ID, you should probably call " { $link uuid1 } " or " { $link uuid4 } "."
-{ $subsection uuid1 }
-{ $subsection uuid3 }
-{ $subsection uuid4 }
-{ $subsection uuid5 }
+{ $subsections
+ uuid1
+ uuid3
+ uuid4
+ uuid5
+}
;
ABOUT: "uuid"
"Note that validators which take numbers must be preceded by " { $link v-integer } " or " { $link v-number } " if the original input is a string."
$nl
"Higher-order validators which require additional parameters:"
-{ $subsection v-default }
-{ $subsection v-optional }
-{ $subsection v-min-length }
-{ $subsection v-max-length }
-{ $subsection v-min-value }
-{ $subsection v-max-value }
-{ $subsection v-regexp }
+{ $subsections
+ v-default
+ v-optional
+ v-min-length
+ v-max-length
+ v-min-value
+ v-max-value
+ v-regexp
+}
"Simple validators:"
-{ $subsection v-required }
-{ $subsection v-number }
-{ $subsection v-integer }
-{ $subsection v-one-line }
-{ $subsection v-one-word }
-{ $subsection v-captcha }
-{ $subsection v-checkbox }
+{ $subsections
+ v-required
+ v-number
+ v-integer
+ v-one-line
+ v-one-word
+ v-captcha
+ v-checkbox
+}
"More complex validators:"
-{ $subsection v-email }
-{ $subsection v-url }
-{ $subsection v-username }
-{ $subsection v-password }
-{ $subsection v-credit-card }
-{ $subsection v-mode } ;
+{ $subsections
+ v-email
+ v-url
+ v-username
+ v-password
+ v-credit-card
+ v-mode
+} ;
ABOUT: "validators"
\r
ARTICLE: "values" "Global values"\r
"Usually, dynamically-scoped variables subsume global variables and are sufficient for holding global data. But occasionally, for global information that's calculated just once and must be accessed more rapidly than a dynamic variable lookup can provide, it's useful to use the word mechanism instead, and set a word to the appropriate value just once. The " { $vocab-link "values" } " vocabulary implements " { $emphasis "values" } ", which abstract over this concept. To create a new word as a value, use the following syntax:"\r
-{ $subsection POSTPONE: VALUE: }\r
+{ $subsections POSTPONE: VALUE: }\r
"To get the value, just call the word. The following words manipulate values:"\r
-{ $subsection get-value }\r
-{ $subsection set-value }\r
-{ $subsection POSTPONE: to: }\r
-{ $subsection change-value } ;\r
+{ $subsections\r
+ get-value\r
+ set-value\r
+ POSTPONE: to:\r
+ change-value\r
+} ;\r
\r
ABOUT: "values"\r
\r
--- /dev/null
+Phil Dawes
\ No newline at end of file
--- /dev/null
+Layout of the C vm structure
--- /dev/null
+! Copyright (C) 2009 Phil Dawes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.struct alien.c-types alien.syntax ;
+IN: vm
+
+TYPEDEF: void* cell
+C-TYPE: context
+
+STRUCT: zone
+ { start cell }
+ { here cell }
+ { size cell }
+ { end cell } ;
+
+STRUCT: vm
+ { stack_chain context* }
+ { nursery zone }
+ { cards_offset cell }
+ { decks_offset cell }
+ { userenv cell[70] } ;
+
+: vm-field-offset ( field -- offset ) vm offset-of ; inline
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: compiler.units continuations fry kernel vocabs vocabs.parser ;
+IN: vocabs.generated
+
+: generate-vocab ( vocab-name quot -- vocab )
+ [ dup vocab [ ] ] dip '[
+ [
+ [
+ [ _ with-current-vocab ] [ ] [ forget-vocab ] cleanup
+ ] with-compilation-unit
+ ] keep
+ ] ?if ; inline
"These tools operate on all vocabularies found in the current set of " { $link vocab-roots } ", loaded or not."\r
$nl\r
"Loading vocabulary hierarchies:"\r
-{ $subsection load }\r
-{ $subsection load-all }\r
+{ $subsections\r
+ load\r
+ load-all\r
+}\r
"Getting all vocabularies from disk:"\r
-{ $subsection all-vocabs }\r
-{ $subsection all-vocabs-recursive }\r
+{ $subsections\r
+ all-vocabs\r
+ all-vocabs-recursive\r
+}\r
"Getting all vocabularies from disk whose names which match a string prefix:"\r
-{ $subsection child-vocabs }\r
-{ $subsection child-vocabs-recursive }\r
+{ $subsections\r
+ child-vocabs\r
+ child-vocabs-recursive\r
+}\r
"Words for modifying output:"\r
-{ $subsection no-roots }\r
-{ $subsection no-prefixes }\r
+{ $subsections\r
+ no-roots\r
+ no-prefixes\r
+}\r
"Getting " { $link "vocabs.metadata" } " for all vocabularies from disk:"\r
-{ $subsection all-tags }\r
-{ $subsection all-authors } ;\r
+{ $subsections\r
+ all-tags\r
+ all-authors\r
+} ;\r
\r
ABOUT: "vocabs.hierarchy"\r
\r
ARTICLE: "vocabs.metadata" "Vocabulary metadata"
"Vocabulary summaries:"
-{ $subsection vocab-summary }
-{ $subsection set-vocab-summary }
+{ $subsections
+ vocab-summary
+ set-vocab-summary
+}
"Vocabulary authors:"
-{ $subsection vocab-authors }
-{ $subsection set-vocab-authors }
+{ $subsections
+ vocab-authors
+ set-vocab-authors
+}
"Vocabulary tags:"
-{ $subsection vocab-tags }
-{ $subsection set-vocab-tags }
-{ $subsection add-vocab-tags }
+{ $subsections
+ vocab-tags
+ set-vocab-tags
+ add-vocab-tags
+}
"Getting and setting arbitrary vocabulary metadata:"
-{ $subsection vocab-file-contents }
-{ $subsection set-vocab-file-contents } ;
+{ $subsections
+ vocab-file-contents
+ set-vocab-file-contents
+} ;
ABOUT: "vocabs.metadata"
+USING: vocabs.prettyprint tools.test io.streams.string eval ;
IN: vocabs.prettyprint.tests
-USING: vocabs.prettyprint tools.test io.streams.string multiline eval ;
: manifest-test-1 ( -- string )
- <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
+ """USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
- << manifest get pprint-manifest >> "> ;
+ << manifest get pprint-manifest >>""" ;
[
-<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;">
+"""USING: kernel namespaces vocabs.parser vocabs.prettyprint ;"""
]
[ [ manifest-test-1 eval( -- ) ] with-string-writer ] unit-test
: manifest-test-2 ( -- string )
- <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
+ """USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
IN: vocabs.prettyprint.tests
- << manifest get pprint-manifest >> "> ;
+ << manifest get pprint-manifest >>""" ;
[
-<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
-IN: vocabs.prettyprint.tests">
+"""USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
+IN: vocabs.prettyprint.tests"""
]
[ [ manifest-test-2 eval( -- ) ] with-string-writer ] unit-test
: manifest-test-3 ( -- string )
- <" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
+ """USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
FROM: math => + - ;
QUALIFIED: system
QUALIFIED-WITH: assocs a
EXCLUDE: parser => run-file ;
IN: vocabs.prettyprint.tests
- << manifest get pprint-manifest >> "> ;
+ << manifest get pprint-manifest >>""" ;
[
-<" USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
+"""USING: kernel namespaces vocabs.parser vocabs.prettyprint ;
FROM: math => + - ;
QUALIFIED: system
QUALIFIED-WITH: assocs a
EXCLUDE: parser => run-file ;
-IN: vocabs.prettyprint.tests">
+IN: vocabs.prettyprint.tests"""
]
-[ [ manifest-test-3 eval( -- ) ] with-string-writer ] unit-test
\ No newline at end of file
+[ [ manifest-test-3 eval( -- ) ] with-string-writer ] unit-test
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel sorting sequences vocabs io io.styles arrays assocs
-namespaces sets parser colors prettyprint.backend prettyprint.sections
-vocabs.parser make fry math.order ;
+USING: accessors arrays assocs colors colors.constants fry io
+io.styles kernel make math.order namespaces parser
+prettyprint.backend prettyprint.sections prettyprint.stylesheet
+sequences sets sorting vocabs vocabs.parser ;
+FROM: io.styles => inset ;
IN: vocabs.prettyprint
: pprint-vocab ( vocab -- )
- [ vocab-name ] [ vocab ] bi present-text ;
+ [ vocab-name ] [ vocab vocab-style ] bi styled-text ;
: pprint-in ( vocab -- )
[ \ IN: pprint-word pprint-vocab ] with-pprint ;
"To avoid doing this in the future, add the following forms" print
"at the top of the source file:" print nl
] with-style
- { { page-color T{ rgba f 0.8 0.8 0.8 1.0 } } }
- [ manifest get pprint-manifest ] with-nesting
+ {
+ { page-color COLOR: FactorLightTan }
+ { border-color COLOR: FactorDarkTan }
+ { inset { 5 5 } }
+ } [ manifest get pprint-manifest ] with-nesting
nl nl
] print-use-hook set-global
\ No newline at end of file
ARTICLE: "vocabs.refresh" "Runtime code reloading"
"Reloading source files changed on disk:"
-{ $subsection refresh }
-{ $subsection refresh-all } ;
+{ $subsections
+ refresh
+ refresh-all
+} ;
ABOUT: "vocabs.refresh"
-USING: alien.syntax kernel math windows.types windows.kernel32
-math.bitwise ;
+USING: alien.c-types alien.syntax kernel math windows.types
+windows.kernel32 math.bitwise classes.struct ;
IN: windows.advapi32
LIBRARY: advapi32
CONSTANT: CRYPT_MACHINE_KEYSET HEX: 20
CONSTANT: CRYPT_SILENT HEX: 40
-C-STRUCT: ACL
- { "BYTE" "AclRevision" }
- { "BYTE" "Sbz1" }
- { "WORD" "AclSize" }
- { "WORD" "AceCount" }
- { "WORD" "Sbz2" } ;
+STRUCT: ACL
+ { AclRevision BYTE }
+ { Sbz1 BYTE }
+ { AclSize WORD }
+ { AceCount WORD }
+ { Sbz2 WORD } ;
TYPEDEF: ACL* PACL
CONSTANT: INHERIT_ONLY_ACE HEX: 8
CONSTANT: VALID_INHERIT_FLAGS HEX: f
-C-STRUCT: ACE_HEADER
- { "BYTE" "AceType" }
- { "BYTE" "AceFlags" }
- { "WORD" "AceSize" } ;
+STRUCT: ACE_HEADER
+ { AceType BYTE }
+ { AceFlags BYTE }
+ { AceSize WORD } ;
TYPEDEF: ACE_HEADER* PACE_HEADER
-C-STRUCT: ACCESS_ALLOWED_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: ACCESS_ALLOWED_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: ACCESS_ALLOWED_ACE* PACCESS_ALLOWED_ACE
-C-STRUCT: ACCESS_DENIED_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: ACCESS_DENIED_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: ACCESS_DENIED_ACE* PACCESS_DENIED_ACE
-C-STRUCT: SYSTEM_AUDIT_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: SYSTEM_AUDIT_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: SYSTEM_AUDIT_ACE* PSYSTEM_AUDIT_ACE
-C-STRUCT: SYSTEM_ALARM_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: SYSTEM_ALARM_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: SYSTEM_ALARM_ACE* PSYSTEM_ALARM_ACE
-C-STRUCT: ACCESS_ALLOWED_CALLBACK_ACE
- { "ACE_HEADER" "Header" }
- { "DWORD" "Mask" }
- { "DWORD" "SidStart" } ;
+STRUCT: ACCESS_ALLOWED_CALLBACK_ACE
+ { Header ACE_HEADER }
+ { Mask DWORD }
+ { SidStart DWORD } ;
TYPEDEF: ACCESS_ALLOWED_CALLBACK_ACE* PACCESS_ALLOWED_CALLBACK_ACE
-C-STRUCT: SECURITY_DESCRIPTOR
- { "UCHAR" "Revision" }
- { "UCHAR" "Sbz1" }
- { "WORD" "Control" }
- { "PVOID" "Owner" }
- { "PVOID" "Group" }
- { "PACL" "Sacl" }
- { "PACL" "Dacl" } ;
+STRUCT: SECURITY_DESCRIPTOR
+ { Revision UCHAR }
+ { Sbz1 UCHAR }
+ { Control WORD }
+ { Owner PVOID }
+ { Group PVOID }
+ { Sacl PACL }
+ { Dacl PACL } ;
TYPEDEF: SECURITY_DESCRIPTOR* PSECURITY_DESCRIPTOR
SE_WMIGUID_OBJECT
SE_REGISTRY_WOW64_32KEY ;
+STRUCT: TRUSTEE
+ { pMultipleTrustee TRUSTEE* }
+ { MultipleTrusteeOperation MULTIPLE_TRUSTEE_OPERATION }
+ { TrusteeForm TRUSTEE_FORM }
+ { TrusteeType TRUSTEE_TYPE }
+ { ptstrName LPTSTR } ;
+
TYPEDEF: TRUSTEE* PTRUSTEE
-C-STRUCT: TRUSTEE
- { "PTRUSTEE" "pMultipleTrustee" }
- { "MULTIPLE_TRUSTEE_OPERATION" "MultipleTrusteeOperation" }
- { "TRUSTEE_FORM" "TrusteeForm" }
- { "TRUSTEE_TYPE" "TrusteeType" }
- { "LPTSTR" "ptstrName" } ;
-
-C-STRUCT: EXPLICIT_ACCESS
- { "DWORD" "grfAccessPermissions" }
- { "ACCESS_MODE" "grfAccessMode" }
- { "DWORD" "grfInheritance" }
- { "TRUSTEE" "Trustee" } ;
-
-C-STRUCT: SID_IDENTIFIER_AUTHORITY
- { { "BYTE" 6 } "Value" } ;
+STRUCT: EXPLICIT_ACCESS
+ { grfAccessPermissions DWORD }
+ { grfAccessMode ACCESS_MODE }
+ { grfInheritance DWORD }
+ { Trustee TRUSTEE } ;
+
+STRUCT: SID_IDENTIFIER_AUTHORITY
+ { Value { BYTE 6 } } ;
TYPEDEF: SID_IDENTIFIER_AUTHORITY* PSID_IDENTIFIER_AUTHORITY
C: <test-implementation> test-implementation
{
- { "IInherited" {
+ { IInherited {
[ drop S_OK ] ! ISimple::returnOK
[ drop E_FAIL ] ! ISimple::returnError
[ x>> ] ! IInherited::getX
[ >>x drop ] ! IInherited::setX
} }
- { "IUnrelated" {
+ { IUnrelated {
[ swap x>> + ] ! IUnrelated::xPlus
[ spin x>> * + ] ! IUnrelated::xMulAdd
} }
+guinea-pig-implementation+ get ISimple-iid com-query-interface
dup com-release
] unit-test
- "void*" heap-size +guinea-pig-implementation+ get <displaced-alien>
+ void* heap-size +guinea-pig-implementation+ get <displaced-alien>
+guinea-pig-implementation+ get
2array [
+guinea-pig-implementation+ get IUnrelated-iid com-query-interface
-USING: alien alien.c-types alien.destructors windows.com.syntax\r
-windows.ole32 windows.types continuations kernel alien.syntax\r
-libc destructors accessors ;\r
-IN: windows.com\r
-\r
-LIBRARY: ole32\r
-\r
-COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}\r
- HRESULT QueryInterface ( REFGUID iid, void** ppvObject )\r
- ULONG AddRef ( )\r
- ULONG Release ( ) ;\r
-\r
-COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}\r
- HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
- HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )\r
- HRESULT QueryGetData ( FORMATETC* pFormatetc )\r
- HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )\r
- HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )\r
- HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )\r
- HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )\r
- HRESULT DUnadvise ( DWORD pdwConnection )\r
- HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;\r
-\r
-COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}\r
- HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
- HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )\r
- HRESULT DragLeave ( )\r
- HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;\r
-\r
-: com-query-interface ( interface iid -- interface' )\r
- [\r
- "void*" malloc-object &free\r
- [ IUnknown::QueryInterface ole32-error ] keep *void*\r
- ] with-destructors ;\r
-\r
-: com-add-ref ( interface -- interface )\r
- [ IUnknown::AddRef drop ] keep ; inline\r
-\r
-: com-release ( interface -- )\r
- IUnknown::Release drop ; inline\r
-\r
-: with-com-interface ( interface quot -- )\r
- over [ com-release ] curry [ ] cleanup ; inline\r
-\r
-DESTRUCTOR: com-release\r
+USING: alien alien.c-types alien.destructors windows.com.syntax
+windows.ole32 windows.types continuations kernel alien.syntax
+libc destructors accessors alien.data ;
+IN: windows.com
+
+LIBRARY: ole32
+
+COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
+ HRESULT QueryInterface ( REFGUID iid, void** ppvObject )
+ ULONG AddRef ( )
+ ULONG Release ( ) ;
+
+C-TYPE: IAdviseSink
+
+COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046}
+ HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
+ HRESULT GetDataHere ( FORMATETC* pFormatetc, STGMEDIUM* pmedium )
+ HRESULT QueryGetData ( FORMATETC* pFormatetc )
+ HRESULT GetCanonicalFormatEtc ( FORMATETC* pFormatetcIn, FORMATETC* pFormatetcOut )
+ HRESULT SetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium, BOOL fRelease )
+ HRESULT EnumFormatEtc ( DWORD dwDirection, IEnumFORMATETC** ppenumFormatetc )
+ HRESULT DAdvise ( FORMATETC* pFormatetc, DWORD advf, IAdviseSink* pAdvSink, DWORD* pdwConnection )
+ HRESULT DUnadvise ( DWORD pdwConnection )
+ HRESULT EnumDAdvise ( IEnumSTATDATA** ppenumAdvise ) ;
+
+COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046}
+ HRESULT DragEnter ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )
+ HRESULT DragOver ( DWORD grfKeyState, POINTL pt, DWORD* pdwEffect )
+ HRESULT DragLeave ( )
+ HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ;
+
+FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
+FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
+FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
+
+: com-query-interface ( interface iid -- interface' )
+ [
+ "void*" malloc-object &free
+ [ IUnknown::QueryInterface ole32-error ] keep *void*
+ ] with-destructors ;
+
+: com-add-ref ( interface -- interface )
+ [ IUnknown::AddRef drop ] keep ; inline
+
+: com-release ( interface -- )
+ IUnknown::Release drop ; inline
+
+: with-com-interface ( interface quot -- )
+ over [ com-release ] curry [ ] cleanup ; inline
+
+DESTRUCTOR: com-release
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: windows.com windows.kernel32 windows.ole32
+prettyprint.custom prettyprint.sections sequences ;
+IN: windows.com.prettyprint
+
+M: GUID pprint* guid>string "GUID: " prepend text ;
--- /dev/null
+unportable
-USING: help.markup help.syntax io kernel math quotations
-multiline ;
+USING: help.markup help.syntax io kernel math quotations ;
IN: windows.com.syntax
HELP: GUID:
{ $description "\nCreate a COM globally-unique identifier (GUID) literal at parse time, and push it onto the data stack." } ;
HELP: COM-INTERFACE:
-{ $syntax <"
-COM-INTERFACE: <interface> <parent> <iid>
+{ $syntax """COM-INTERFACE: <interface> <parent> <iid>
<function-1> ( <params1> )
<function-2> ( <params2> )
... ;
-"> }
+""" }
{ $description "\nFor the interface " { $snippet "<interface>" } ", a word " { $snippet "<interface>-iid ( -- iid )" } " is defined to push the interface GUID (IID) onto the stack. Words of the form " { $snippet "<interface>::<function>" } " are also defined to invoke each method, as well as the methods inherited from " { $snippet "<parent>" } ". A " { $snippet "<parent>" } " of " { $snippet "f" } " indicates that the interface is a root interface. (Note that COM conventions demand that all interfaces at least inherit from " { $snippet "IUnknown" } ".)\n\nExample:" }
-{ $code <"
+{ $code """
COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046}
HRESULT QueryInterface ( REFGUID iid, void** ppvObject )
ULONG AddRef ( )
COM-INTERFACE: IInherited ISimple {9620ecec-8438-423b-bb14-86f835aa40dd}
int getX ( )
void setX ( int newX ) ;
-"> } ;
+""" } ;
-USING: alien alien.c-types alien.accessors effects kernel
-windows.ole32 parser lexer splitting grouping sequences
-namespaces assocs quotations generalizations accessors words
-macros alien.syntax fry arrays layouts math ;
+USING: alien alien.c-types alien.accessors alien.parser
+effects kernel windows.ole32 parser lexer splitting grouping
+sequences namespaces assocs quotations generalizations
+accessors words macros alien.syntax fry arrays layouts math
+classes.struct windows.kernel32 ;
IN: windows.com.syntax
<PRIVATE
-C-STRUCT: com-interface
- { "void*" "vtbl" } ;
-
MACRO: com-invoke ( n return parameters -- )
[ 2nip length ] 3keep
'[
- _ npick com-interface-vtbl _ cell * alien-cell _ _
+ _ npick *void* _ cell * alien-cell _ _
"stdcall" alien-indirect
] ;
-TUPLE: com-interface-definition name parent iid functions ;
+TUPLE: com-interface-definition word parent iid functions ;
C: <com-interface-definition> com-interface-definition
TUPLE: com-function-definition name return parameters ;
[ H{ } +com-interface-definitions+ set-global ]
unless
+ERROR: no-com-interface interface ;
+
: find-com-interface-definition ( name -- definition )
- dup "f" = [ drop f ] [
+ [
dup +com-interface-definitions+ get-global at*
- [ nip ]
- [ swap " COM interface hasn't been defined" append throw ]
- if
- ] if ;
+ [ nip ] [ drop no-com-interface ] if
+ ] [ f ] if* ;
: save-com-interface-definition ( definition -- )
- dup name>> +com-interface-definitions+ get-global set-at ;
+ dup word>> +com-interface-definitions+ get-global set-at ;
: (parse-com-function) ( tokens -- definition )
[ second ]
[ first ]
- [ 3 tail [ CHAR: , swap remove ] map 2 group { "void*" "this" } prefix ]
- tri
+ [
+ 3 tail [ CHAR: , swap remove ] map
+ 2 group [ first2 normalize-c-arg 2array ] map
+ { void* "this" } prefix
+ ] tri
<com-function-definition> ;
: parse-com-functions ( -- functions )
[ (parse-com-function) ] map ;
: (iid-word) ( definition -- word )
- name>> "-iid" append create-in ;
+ word>> name>> "-iid" append create-in ;
: (function-word) ( function interface -- word )
- name>> "::" rot name>> 3append create-in ;
+ swap [ word>> name>> "::" ] [ name>> ] bi*
+ 3append create-in ;
: family-tree ( definition -- definitions )
dup parent>> [ family-tree ] [ { } ] if*
: (stack-effect-from-return-and-parameters) ( return parameters -- stack-effect )
swap
[ [ second ] map ]
- [ dup "void" = [ drop { } ] [ 1array ] if ] bi*
+ [ dup void? [ drop { } ] [ 1array ] if ] bi*
<effect> ;
: (define-word-for-function) ( function interface n -- )
: define-words-for-com-interface ( definition -- )
[ [ (iid-word) ] [ iid>> 1quotation ] bi (( -- iid )) define-declared ]
- [ name>> "com-interface" swap typedef ]
+ [ word>> void* swap typedef ]
[
dup family-tree-functions
[ (define-word-for-function) ] with each-index
PRIVATE>
SYNTAX: COM-INTERFACE:
- scan
- scan find-com-interface-definition
+ CREATE-C-TYPE
+ scan-object find-com-interface-definition
scan string>guid
parse-com-functions
<com-interface-definition>
define-words-for-com-interface ;
SYNTAX: GUID: scan string>guid parsed ;
+
+USING: vocabs vocabs.loader ;
+
+"prettyprint" vocab [
+ "windows.com.prettyprint" require
+] when
USING: help.markup help.syntax io kernel math quotations\r
-multiline alien windows.com windows.com.syntax continuations\r
+alien windows.com windows.com.syntax continuations\r
destructors ;\r
IN: windows.com.wrapper\r
\r
HELP: <com-wrapper>\r
{ $values { "implementations" "an assoc relating COM interface names to arrays of quotations implementing that interface" } { "wrapper" "a " { $link com-wrapper } " tuple" } }\r
{ $description "Constructs a " { $link com-wrapper } " tuple. Each key in the " { $snippet "implementations" } " assoc must be the name of an interface defined with " { $link POSTPONE: COM-INTERFACE: } ". The corresponding value must be an array of quotations implementing the methods of that interface in order, including those of its parent interfaces. The " { $snippet "IUnknown" } " methods (" { $link IUnknown::QueryInterface } ", " { $link IUnknown::AddRef } ", and " { $link IUnknown::Release } ") will be defined automatically and must not be specified in the array. These quotations should have stack effects mirroring those of the interface methods being implemented; for example, a method " { $snippet "void foobar ( int foo, int bar )" } " should be implemented with a quotation of effect " { $snippet "( this foo bar -- )" } ". The " { $snippet "this" } " parameter (that is, the leftmost parameter of any COM method) will be automatically converted from an alien pointer to the underlying Factor object before the quotation is invoked.\n\nThe resulting wrapper can be applied to a Factor object using the " { $link com-wrap } " word. The COM interface pointer returned by " { $snippet "com-wrap" } " can then be passed to C functions requiring a COM object as a parameter. The vtables constructed by " { $snippet "<com-wrapper>" } " are stored on the non-GC heap in order to be accessible to C functions; when the wrapper object and its vtables are no longer needed, the object's resources must be freed using " { $link dispose } ".\n\nExample:" }\r
-{ $code <"\r
+{ $code """\r
COM-INTERFACE: ISimple IUnknown {216fb341-0eb2-44b1-8edb-60b76e353abc}\r
HRESULT returnOK ( )\r
HRESULT returnError ( ) ;\r
[ swap x>> + ] ! IUnrelated::xPlus\r
[ spin x>> * + ] ! IUnrealted::xMulAdd\r
} }\r
-} <com-wrapper>\r
-"> } ;\r
+} <com-wrapper>""" } ;\r
\r
HELP: com-wrap\r
{ $values { "object" "The factor object to wrap" } { "wrapper" "A " { $link com-wrapper } " object" } { "wrapped-object" "A COM object referencing " { $snippet "object" } } }\r
-USING: alien alien.c-types alien.accessors windows.com.syntax
-init windows.com.syntax.private windows.com continuations kernel
-namespaces windows.ole32 libc vocabs assocs accessors arrays
-sequences quotations combinators math words compiler.units
-destructors fry math.parser generalizations sets
-specialized-arrays.alien specialized-arrays.direct.alien ;
+USING: alien alien.c-types alien.data alien.accessors
+windows.com.syntax init windows.com.syntax.private windows.com
+continuations kernel namespaces windows.ole32 libc vocabs
+assocs accessors arrays sequences quotations combinators math
+words compiler.units destructors fry math.parser generalizations
+sets specialized-arrays windows.kernel32 classes.struct ;
+SPECIALIZED-ARRAY: void*
IN: windows.com.wrapper
TUPLE: com-wrapper < disposable callbacks vtbls ;
: (make-query-interface) ( interfaces -- quot )
(query-interface-cases)
'[
- swap 16 memory>byte-array
+ swap GUID memory>struct
_ case
[
- "void*" heap-size * rot <displaced-alien> com-add-ref
+ void* heap-size * rot <displaced-alien> com-add-ref
swap 0 set-alien-cell S_OK
] [ nip f swap 0 set-alien-cell E_NOINTERFACE ] if*
] ;
: (make-add-ref) ( interfaces -- quot )
- length "void*" heap-size * '[
+ length void* heap-size * '[
_
[ alien-unsigned-4 1 + dup ]
[ set-alien-unsigned-4 ]
] ;
: (make-release) ( interfaces -- quot )
- length "void*" heap-size * '[
+ length void* heap-size * '[
_
[ drop ]
[ alien-unsigned-4 1 - dup ]
: (thunk) ( n -- quot )
dup 0 =
[ drop [ ] ]
- [ "void*" heap-size neg * '[ _ swap <displaced-alien> ] ]
+ [ void* heap-size neg * '[ _ swap <displaced-alien> ] ]
if ;
: (thunked-quots) ( quots iunknown-methods thunk -- {thunk,quot}s )
[ [ (( -- alien )) define-declared ] pick [ call ] dip ]
with-compilation-unit ;
-: (callback-word) ( function-name interface-name counter -- word )
- [ "::" rot 3append "-callback-" ] dip number>string 3append
+: (callback-word) ( function-name interface counter -- word )
+ [ name>> "::" rot 3append "-callback-" ] dip number>string 3append
"windows.com.wrapper.callbacks" create ;
: (finish-thunk) ( param-count thunk quot -- thunked-quot )
[ [ drop [ ] ] [ swap 1 - '[ _ _ ndip ] ] if-empty ]
dip compose ;
-: (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words )
+: (make-interface-callbacks) ( interface quots iunknown-methods n -- words )
(thunk) (thunked-quots)
swap [ find-com-interface-definition family-tree-functions ]
keep (next-vtbl-counter) '[
curry map-index ;
: (malloc-wrapped-object) ( wrapper -- wrapped-object )
- vtbls>> length "void*" heap-size *
- [ "ulong" heap-size + malloc ] keep
+ vtbls>> length void* heap-size *
+ [ ulong heap-size + malloc ] keep
[ [ 1 ] 2dip set-alien-unsigned-4 ] [ drop ] 2bi ;
: (callbacks>vtbl) ( callbacks -- vtbl )
USING: windows.dinput windows.kernel32 windows.ole32 windows.com
-windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
-combinators sequences fry math accessors macros words quotations
-libc continuations generalizations splitting locals assocs init
-struct-arrays memoize ;
+windows.com.syntax alien alien.c-types alien.data alien.syntax
+kernel system namespaces combinators sequences fry math accessors
+macros words quotations libc continuations generalizations
+splitting locals assocs init specialized-arrays memoize
+classes.struct strings arrays ;
+SPECIALIZED-ARRAY: DIOBJECTDATAFORMAT
IN: windows.dinput.constants
! Some global variables aren't provided by the DirectInput DLL (they're in the
MEMO: c-type* ( name -- c-type ) c-type ;
MEMO: heap-size* ( c-type -- n ) heap-size ;
+GENERIC: array-base-type ( c-type -- c-type' )
+M: object array-base-type ;
+M: string array-base-type "[" split1 drop ;
+M: array array-base-type first ;
+
: (field-spec-of) ( field struct -- field-spec )
c-type* fields>> [ name>> = ] with find nip ;
: (offsetof) ( field struct -- offset )
[ (field-spec-of) offset>> ] [ drop 0 ] if* ;
: (sizeof) ( field struct -- size )
- [ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ;
+ [ (field-spec-of) type>> array-base-type heap-size* ] [ drop 1 ] if* ;
: (flag) ( thing -- integer )
{
: (flags) ( array -- n )
0 [ (flag) bitor ] reduce ;
-: (DIOBJECTDATAFORMAT) ( pguid dwOfs dwType dwFlags alien -- alien )
- [ {
- [ set-DIOBJECTDATAFORMAT-dwFlags ]
- [ set-DIOBJECTDATAFORMAT-dwType ]
- [ set-DIOBJECTDATAFORMAT-dwOfs ]
- [ set-DIOBJECTDATAFORMAT-pguid ]
- } cleave ] keep ;
-
: <DIOBJECTDATAFORMAT> ( struct {pguid-var,field,index,dwType-flags,dwFlags} -- alien )
{
[ first dup word? [ get ] when ]
[ fourth (flags) ]
[ 4 swap nth (flag) ]
} cleave
- "DIOBJECTDATAFORMAT" <c-object> (DIOBJECTDATAFORMAT) ;
+ DIOBJECTDATAFORMAT <struct-boa> ;
-:: malloc-DIOBJECTDATAFORMAT-array ( struct array -- alien )
- [let | alien [ array length "DIOBJECTDATAFORMAT" malloc-struct-array ] |
+:: make-DIOBJECTDATAFORMAT-array ( struct array -- alien )
+ [let | alien [ array length malloc-DIOBJECTDATAFORMAT-array ] |
array [| args i |
struct args <DIOBJECTDATAFORMAT>
i alien set-nth
alien
] ;
-: (DIDATAFORMAT) ( dwSize dwObjSize dwFlags dwDataSize dwNumObjs rgodf alien -- alien )
- [
- {
- [ set-DIDATAFORMAT-rgodf ]
- [ set-DIDATAFORMAT-dwNumObjs ]
- [ set-DIDATAFORMAT-dwDataSize ]
- [ set-DIDATAFORMAT-dwFlags ]
- [ set-DIDATAFORMAT-dwObjSize ]
- [ set-DIDATAFORMAT-dwSize ]
- } cleave
- ] keep ;
-
: <DIDATAFORMAT> ( dwFlags dwDataSize struct rgodf-array -- alien )
- [ "DIDATAFORMAT" heap-size "DIOBJECTDATAFORMAT" heap-size ] 4 ndip
- [ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
- "DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
+ [ DIDATAFORMAT heap-size DIOBJECTDATAFORMAT heap-size ] 4 ndip
+ [ nip length ] [ make-DIOBJECTDATAFORMAT-array ] 2bi
+ DIDATAFORMAT <struct-boa> ;
: initialize ( symbol quot -- )
call swap set-global ; inline
{
c_dfDIKeyboard c_dfDIKeyboard_HID c_dfDIMouse2 c_dfDIJoystick2
- } [ [ DIDATAFORMAT-rgodf free ] uninitialize ] each ;
+ } [ [ rgodf>> free ] uninitialize ] each ;
PRIVATE>
USING: windows.kernel32 windows.ole32 windows.com windows.com.syntax
-alien alien.c-types alien.syntax kernel system namespaces math ;
+alien alien.c-types alien.syntax kernel system namespaces math
+classes.struct windows.types ;
IN: windows.dinput
LIBRARY: dinput
-TYPEDEF: void* LPDIENUMDEVICESCALLBACKW
-: LPDIENUMDEVICESCALLBACKW ( quot -- alien )
- [ "BOOL" { "LPCDIDEVICEINSTANCEW" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMDEVICESBYSEMANTICSCBW
-: LPDIENUMDEVICESBYSEMANTICSCBW ( quot -- alien )
- [ "BOOL" { "LPCDIDEVICEINSTANCEW" "IDirectInputDevice8W*" "DWORD" "DWORD" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDICONFIGUREDEVICESCALLBACK
-: LPDICONFIGUREDEVICESCALLBACK ( quot -- alien )
- [ "BOOL" { "IUnknown*" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMEFFECTSCALLBACKW
-: LPDIENUMEFFECTSCALLBACKW ( quot -- alien )
- [ "BOOL" { "LPCDIEFFECTINFOW" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMCREATEDEFFECTOBJECTSCALLBACK
-: LPDIENUMCREATEDEFFECTOBJECTSCALLBACK ( quot -- callback )
- [ "BOOL" { "LPDIRECTINPUTEFFECT" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMEFFECTSINFILECALLBACK
-: LPDIENUMEFFECTSINFILECALLBACK ( quot -- callback )
- [ "BOOL" { "LPCDIFILEEFFECT" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-TYPEDEF: void* LPDIENUMDEVICEOBJECTSCALLBACKW
-: LPDIENUMDEVICEOBJECTSCALLBACKW ( quot -- callback )
- [ "BOOL" { "LPCDIDEVICEOBJECTINSTANCEW" "LPVOID" } "stdcall" ]
- dip alien-callback ; inline
-
TYPEDEF: DWORD D3DCOLOR
-C-STRUCT: DIDEVICEINSTANCEW
- { "DWORD" "dwSize" }
- { "GUID" "guidInstance" }
- { "GUID" "guidProduct" }
- { "DWORD" "dwDevType" }
- { "WCHAR[260]" "tszInstanceName" }
- { "WCHAR[260]" "tszProductName" }
- { "GUID" "guidFFDriver" }
- { "WORD" "wUsagePage" }
- { "WORD" "wUsage" } ;
+STRUCT: DIDEVICEINSTANCEW
+ { dwSize DWORD }
+ { guidInstance GUID }
+ { guidProduct GUID }
+ { dwDevType DWORD }
+ { tszInstanceName WCHAR[260] }
+ { tszProductName WCHAR[260] }
+ { guidFFDriver GUID }
+ { wUsagePage WORD }
+ { wUsage WORD } ;
TYPEDEF: DIDEVICEINSTANCEW* LPDIDEVICEINSTANCEW
TYPEDEF: DIDEVICEINSTANCEW* LPCDIDEVICEINSTANCEW
-C-UNION: DIACTION-union "LPCWSTR" "UINT" ;
-C-STRUCT: DIACTIONW
- { "UINT_PTR" "uAppData" }
- { "DWORD" "dwSemantic" }
- { "DWORD" "dwFlags" }
- { "DIACTION-union" "lptszActionName-or-uResIdString" }
- { "GUID" "guidInstance" }
- { "DWORD" "dwObjID" }
- { "DWORD" "dwHow" } ;
+UNION-STRUCT: DIACTION-union
+ { lptszActionName LPCWSTR }
+ { uResIdString UINT } ;
+STRUCT: DIACTIONW
+ { uAppData UINT_PTR }
+ { dwSemantic DWORD }
+ { dwFlags DWORD }
+ { union DIACTION-union }
+ { guidInstance GUID }
+ { dwObjID DWORD }
+ { dwHow DWORD } ;
TYPEDEF: DIACTIONW* LPDIACTIONW
TYPEDEF: DIACTIONW* LPCDIACTIONW
-C-STRUCT: DIACTIONFORMATW
- { "DWORD" "dwSize" }
- { "DWORD" "dwActionSize" }
- { "DWORD" "dwDataSize" }
- { "DWORD" "dwNumActions" }
- { "LPDIACTIONW" "rgoAction" }
- { "GUID" "guidActionMap" }
- { "DWORD" "dwGenre" }
- { "DWORD" "dwBufferSize" }
- { "LONG" "lAxisMin" }
- { "LONG" "lAxisMax" }
- { "HINSTANCE" "hInstString" }
- { "FILETIME" "ftTimeStamp" }
- { "DWORD" "dwCRC" }
- { "WCHAR[260]" "tszActionMap" } ;
+STRUCT: DIACTIONFORMATW
+ { dwSize DWORD }
+ { dwActionSize DWORD }
+ { dwDataSize DWORD }
+ { dwNumActions DWORD }
+ { rgoAction LPDIACTIONW }
+ { guidActionMap GUID }
+ { dwGenre DWORD }
+ { dwBufferSize DWORD }
+ { lAxisMin LONG }
+ { lAxisMax LONG }
+ { hInstString HINSTANCE }
+ { ftTimeStamp FILETIME }
+ { dwCRC DWORD }
+ { tszActionMap WCHAR[260] } ;
TYPEDEF: DIACTIONFORMATW* LPDIACTIONFORMATW
TYPEDEF: DIACTIONFORMATW* LPCDIACTIONFORMATW
-C-STRUCT: DICOLORSET
- { "DWORD" "dwSize" }
- { "D3DCOLOR" "cTextFore" }
- { "D3DCOLOR" "cTextHighlight" }
- { "D3DCOLOR" "cCalloutLine" }
- { "D3DCOLOR" "cCalloutHighlight" }
- { "D3DCOLOR" "cBorder" }
- { "D3DCOLOR" "cControlFill" }
- { "D3DCOLOR" "cHighlightFill" }
- { "D3DCOLOR" "cAreaFill" } ;
+STRUCT: DICOLORSET
+ { dwSize DWORD }
+ { cTextFore D3DCOLOR }
+ { cTextHighlight D3DCOLOR }
+ { cCalloutLine D3DCOLOR }
+ { cCalloutHighlight D3DCOLOR }
+ { cBorder D3DCOLOR }
+ { cControlFill D3DCOLOR }
+ { cHighlightFill D3DCOLOR }
+ { cAreaFill D3DCOLOR } ;
TYPEDEF: DICOLORSET* LPDICOLORSET
TYPEDEF: DICOLORSET* LPCDICOLORSET
-C-STRUCT: DICONFIGUREDEVICESPARAMSW
- { "DWORD" "dwSize" }
- { "DWORD" "dwcUsers" }
- { "LPWSTR" "lptszUserNames" }
- { "DWORD" "dwcFormats" }
- { "LPDIACTIONFORMATW" "lprgFormats" }
- { "HWND" "hwnd" }
- { "DICOLORSET" "dics" }
- { "IUnknown*" "lpUnkDDSTarget" } ;
+STRUCT: DICONFIGUREDEVICESPARAMSW
+ { dwSize DWORD }
+ { dwcUsers DWORD }
+ { lptszUserNames LPWSTR }
+ { dwcFormats DWORD }
+ { lprgFormats LPDIACTIONFORMATW }
+ { hwnd HWND }
+ { dics DICOLORSET }
+ { lpUnkDDSTarget IUnknown* } ;
TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
TYPEDEF: DICONFIGUREDEVICESPARAMSW* LPDICONFIGUREDEVICESPARAMSW
-C-STRUCT: DIDEVCAPS
- { "DWORD" "dwSize" }
- { "DWORD" "dwFlags" }
- { "DWORD" "dwDevType" }
- { "DWORD" "dwAxes" }
- { "DWORD" "dwButtons" }
- { "DWORD" "dwPOVs" }
- { "DWORD" "dwFFSamplePeriod" }
- { "DWORD" "dwFFMinTimeResolution" }
- { "DWORD" "dwFirmwareRevision" }
- { "DWORD" "dwHardwareRevision" }
- { "DWORD" "dwFFDriverVersion" } ;
+STRUCT: DIDEVCAPS
+ { dwSize DWORD }
+ { dwFlags DWORD }
+ { dwDevType DWORD }
+ { dwAxes DWORD }
+ { dwButtons DWORD }
+ { dwPOVs DWORD }
+ { dwFFSamplePeriod DWORD }
+ { dwFFMinTimeResolution DWORD }
+ { dwFirmwareRevision DWORD }
+ { dwHardwareRevision DWORD }
+ { dwFFDriverVersion DWORD } ;
TYPEDEF: DIDEVCAPS* LPDIDEVCAPS
TYPEDEF: DIDEVCAPS* LPCDIDEVCAPS
-C-STRUCT: DIDEVICEOBJECTINSTANCEW
- { "DWORD" "dwSize" }
- { "GUID" "guidType" }
- { "DWORD" "dwOfs" }
- { "DWORD" "dwType" }
- { "DWORD" "dwFlags" }
- { "WCHAR[260]" "tszName" }
- { "DWORD" "dwFFMaxForce" }
- { "DWORD" "dwFFForceResolution" }
- { "WORD" "wCollectionNumber" }
- { "WORD" "wDesignatorIndex" }
- { "WORD" "wUsagePage" }
- { "WORD" "wUsage" }
- { "DWORD" "dwDimension" }
- { "WORD" "wExponent" }
- { "WORD" "wReportId" } ;
+STRUCT: DIDEVICEOBJECTINSTANCEW
+ { dwSize DWORD }
+ { guidType GUID }
+ { dwOfs DWORD }
+ { dwType DWORD }
+ { dwFlags DWORD }
+ { tszName WCHAR[260] }
+ { dwFFMaxForce DWORD }
+ { dwFFForceResolution DWORD }
+ { wCollectionNumber WORD }
+ { wDesignatorIndex WORD }
+ { wUsagePage WORD }
+ { wUsage WORD }
+ { dwDimension DWORD }
+ { wExponent WORD }
+ { wReportId WORD } ;
TYPEDEF: DIDEVICEOBJECTINSTANCEW* LPDIDEVICEOBJECTINSTANCEW
TYPEDEF: DIDEVICEOBJECTINSTANCEW* LPCDIDEVICEOBJECTINSTANCEW
-C-STRUCT: DIDEVICEOBJECTDATA
- { "DWORD" "dwOfs" }
- { "DWORD" "dwData" }
- { "DWORD" "dwTimeStamp" }
- { "DWORD" "dwSequence" }
- { "UINT_PTR" "uAppData" } ;
+STRUCT: DIDEVICEOBJECTDATA
+ { dwOfs DWORD }
+ { dwData DWORD }
+ { dwTimeStamp DWORD }
+ { dwSequence DWORD }
+ { uAppData UINT_PTR } ;
TYPEDEF: DIDEVICEOBJECTDATA* LPDIDEVICEOBJECTDATA
TYPEDEF: DIDEVICEOBJECTDATA* LPCDIDEVICEOBJECTDATA
-C-STRUCT: DIOBJECTDATAFORMAT
- { "GUID*" "pguid" }
- { "DWORD" "dwOfs" }
- { "DWORD" "dwType" }
- { "DWORD" "dwFlags" } ;
+STRUCT: DIOBJECTDATAFORMAT
+ { pguid GUID* }
+ { dwOfs DWORD }
+ { dwType DWORD }
+ { dwFlags DWORD } ;
TYPEDEF: DIOBJECTDATAFORMAT* LPDIOBJECTDATAFORMAT
TYPEDEF: DIOBJECTDATAFORMAT* LPCDIOBJECTDATAFORMAT
-C-STRUCT: DIDATAFORMAT
- { "DWORD" "dwSize" }
- { "DWORD" "dwObjSize" }
- { "DWORD" "dwFlags" }
- { "DWORD" "dwDataSize" }
- { "DWORD" "dwNumObjs" }
- { "LPDIOBJECTDATAFORMAT" "rgodf" } ;
+STRUCT: DIDATAFORMAT
+ { dwSize DWORD }
+ { dwObjSize DWORD }
+ { dwFlags DWORD }
+ { dwDataSize DWORD }
+ { dwNumObjs DWORD }
+ { rgodf LPDIOBJECTDATAFORMAT } ;
TYPEDEF: DIDATAFORMAT* LPDIDATAFORMAT
TYPEDEF: DIDATAFORMAT* LPCDIDATAFORMAT
-C-STRUCT: DIPROPHEADER
- { "DWORD" "dwSize" }
- { "DWORD" "dwHeaderSize" }
- { "DWORD" "dwObj" }
- { "DWORD" "dwHow" } ;
+STRUCT: DIPROPHEADER
+ { dwSize DWORD }
+ { dwHeaderSize DWORD }
+ { dwObj DWORD }
+ { dwHow DWORD } ;
TYPEDEF: DIPROPHEADER* LPDIPROPHEADER
TYPEDEF: DIPROPHEADER* LPCDIPROPHEADER
-C-STRUCT: DIPROPDWORD
- { "DIPROPHEADER" "diph" }
- { "DWORD" "dwData" } ;
+STRUCT: DIPROPDWORD
+ { diph DIPROPHEADER }
+ { dwData DWORD } ;
TYPEDEF: DIPROPDWORD* LPDIPROPDWORD
TYPEDEF: DIPROPDWORD* LPCDIPROPDWORD
-C-STRUCT: DIPROPPOINTER
- { "DIPROPHEADER" "diph" }
- { "UINT_PTR" "uData" } ;
+STRUCT: DIPROPPOINTER
+ { diph DIPROPHEADER }
+ { uData UINT_PTR } ;
TYPEDEF: DIPROPPOINTER* LPDIPROPPOINTER
TYPEDEF: DIPROPPOINTER* LPCDIPROPPOINTER
-C-STRUCT: DIPROPRANGE
- { "DIPROPHEADER" "diph" }
- { "LONG" "lMin" }
- { "LONG" "lMax" } ;
+STRUCT: DIPROPRANGE
+ { diph DIPROPHEADER }
+ { lMin LONG }
+ { lMax LONG } ;
TYPEDEF: DIPROPRANGE* LPDIPROPRANGE
TYPEDEF: DIPROPRANGE* LPCDIPROPRANGE
-C-STRUCT: DIPROPCAL
- { "DIPROPHEADER" "diph" }
- { "LONG" "lMin" }
- { "LONG" "lCenter" }
- { "LONG" "lMax" } ;
+STRUCT: DIPROPCAL
+ { diph DIPROPHEADER }
+ { lMin LONG }
+ { lCenter LONG }
+ { lMax LONG } ;
TYPEDEF: DIPROPCAL* LPDIPROPCAL
TYPEDEF: DIPROPCAL* LPCDIPROPCAL
-C-STRUCT: DIPROPGUIDANDPATH
- { "DIPROPHEADER" "diph" }
- { "GUID" "guidClass" }
- { "WCHAR[260]" "wszPath" } ;
+STRUCT: DIPROPGUIDANDPATH
+ { diph DIPROPHEADER }
+ { guidClass GUID }
+ { wszPath WCHAR[260] } ;
TYPEDEF: DIPROPGUIDANDPATH* LPDIPROPGUIDANDPATH
TYPEDEF: DIPROPGUIDANDPATH* LPCDIPROPGUIDANDPATH
-C-STRUCT: DIPROPSTRING
- { "DIPROPHEADER" "diph" }
- { "WCHAR[260]" "wsz" } ;
+STRUCT: DIPROPSTRING
+ { diph DIPROPHEADER }
+ { wsz WCHAR[260] } ;
TYPEDEF: DIPROPSTRING* LPDIPROPSTRING
TYPEDEF: DIPROPSTRING* LPCDIPROPSTRING
-C-STRUCT: CPOINT
- { "LONG" "lP" }
- { "DWORD" "dwLog" } ;
-C-STRUCT: DIPROPCPOINTS
- { "DIPROPHEADER" "diph" }
- { "DWORD" "dwCPointsNum" }
- { "CPOINT[8]" "cp" } ;
+STRUCT: CPOINT
+ { lP LONG }
+ { dwLog DWORD } ;
+STRUCT: DIPROPCPOINTS
+ { diph DIPROPHEADER }
+ { dwCPointsNum DWORD }
+ { cp CPOINT[8] } ;
TYPEDEF: DIPROPCPOINTS* LPDIPROPCPOINTS
TYPEDEF: DIPROPCPOINTS* LPCDIPROPCPOINTS
-C-STRUCT: DIENVELOPE
- { "DWORD" "dwSize" }
- { "DWORD" "dwAttackLevel" }
- { "DWORD" "dwAttackTime" }
- { "DWORD" "dwFadeLevel" }
- { "DWORD" "dwFadeTime" } ;
+STRUCT: DIENVELOPE
+ { dwSize DWORD }
+ { dwAttackLevel DWORD }
+ { dwAttackTime DWORD }
+ { dwFadeLevel DWORD }
+ { dwFadeTime DWORD } ;
TYPEDEF: DIENVELOPE* LPDIENVELOPE
TYPEDEF: DIENVELOPE* LPCDIENVELOPE
-C-STRUCT: DIEFFECT
- { "DWORD" "dwSize" }
- { "DWORD" "dwFlags" }
- { "DWORD" "dwDuration" }
- { "DWORD" "dwSamplePeriod" }
- { "DWORD" "dwGain" }
- { "DWORD" "dwTriggerButton" }
- { "DWORD" "dwTriggerRepeatInterval" }
- { "DWORD" "cAxes" }
- { "LPDWORD" "rgdwAxes" }
- { "LPLONG" "rglDirection" }
- { "LPDIENVELOPE" "lpEnvelope" }
- { "DWORD" "cbTypeSpecificParams" }
- { "LPVOID" "lpvTypeSpecificParams" }
- { "DWORD" "dwStartDelay" } ;
+STRUCT: DIEFFECT
+ { dwSize DWORD }
+ { dwFlags DWORD }
+ { dwDuration DWORD }
+ { dwSamplePeriod DWORD }
+ { dwGain DWORD }
+ { dwTriggerButton DWORD }
+ { dwTriggerRepeatInterval DWORD }
+ { cAxes DWORD }
+ { rgdwAxes LPDWORD }
+ { rglDirection LPLONG }
+ { lpEnvelope LPDIENVELOPE }
+ { cbTypeSpecificParams DWORD }
+ { lpvTypeSpecificParams LPVOID }
+ { dwStartDelay DWORD } ;
TYPEDEF: DIEFFECT* LPDIEFFECT
TYPEDEF: DIEFFECT* LPCDIEFFECT
-C-STRUCT: DIEFFECTINFOW
- { "DWORD" "dwSize" }
- { "GUID" "guid" }
- { "DWORD" "dwEffType" }
- { "DWORD" "dwStaticParams" }
- { "DWORD" "dwDynamicParams" }
- { "WCHAR[260]" "tszName" } ;
+STRUCT: DIEFFECTINFOW
+ { dwSize DWORD }
+ { guid GUID }
+ { dwEffType DWORD }
+ { dwStaticParams DWORD }
+ { dwDynamicParams DWORD }
+ { tszName WCHAR[260] } ;
TYPEDEF: DIEFFECTINFOW* LPDIEFFECTINFOW
TYPEDEF: DIEFFECTINFOW* LPCDIEFFECTINFOW
-C-STRUCT: DIEFFESCAPE
- { "DWORD" "dwSize" }
- { "DWORD" "dwCommand" }
- { "LPVOID" "lpvInBuffer" }
- { "DWORD" "cbInBuffer" }
- { "LPVOID" "lpvOutBuffer" }
- { "DWORD" "cbOutBuffer" } ;
+STRUCT: DIEFFESCAPE
+ { dwSize DWORD }
+ { dwCommand DWORD }
+ { lpvInBuffer LPVOID }
+ { cbInBuffer DWORD }
+ { lpvOutBuffer LPVOID }
+ { cbOutBuffer DWORD } ;
TYPEDEF: DIEFFESCAPE* LPDIEFFESCAPE
TYPEDEF: DIEFFESCAPE* LPCDIEFFESCAPE
-C-STRUCT: DIFILEEFFECT
- { "DWORD" "dwSize" }
- { "GUID" "GuidEffect" }
- { "LPCDIEFFECT" "lpDiEffect" }
- { "CHAR[260]" "szFriendlyName" } ;
+STRUCT: DIFILEEFFECT
+ { dwSize DWORD }
+ { GuidEffect GUID }
+ { lpDiEffect LPCDIEFFECT }
+ { szFriendlyName CHAR[260] } ;
TYPEDEF: DIFILEEFFECT* LPDIFILEEFFECT
TYPEDEF: DIFILEEFFECT* LPCDIFILEEFFECT
-C-STRUCT: DIDEVICEIMAGEINFOW
- { "WCHAR[260]" "tszImagePath" }
- { "DWORD" "dwFlags" }
- { "DWORD" "dwViewID" }
- { "RECT" "rcOverlay" }
- { "DWORD" "dwObjID" }
- { "DWORD" "dwcValidPts" }
- { "POINT[5]" "rgptCalloutLine" }
- { "RECT" "rcCalloutRect" }
- { "DWORD" "dwTextAlign" } ;
+STRUCT: DIDEVICEIMAGEINFOW
+ { tszImagePath WCHAR[260] }
+ { dwFlags DWORD }
+ { dwViewID DWORD }
+ { rcOverlay RECT }
+ { dwObjID DWORD }
+ { dwcValidPts DWORD }
+ { rgptCalloutLine POINT[5] }
+ { rcCalloutRect RECT }
+ { dwTextAlign DWORD } ;
TYPEDEF: DIDEVICEIMAGEINFOW* LPDIDEVICEIMAGEINFOW
TYPEDEF: DIDEVICEIMAGEINFOW* LPCDIDEVICEIMAGEINFOW
-C-STRUCT: DIDEVICEIMAGEINFOHEADERW
- { "DWORD" "dwSize" }
- { "DWORD" "dwSizeImageInfo" }
- { "DWORD" "dwcViews" }
- { "DWORD" "dwcButtons" }
- { "DWORD" "dwcAxes" }
- { "DWORD" "dwcPOVs" }
- { "DWORD" "dwBufferSize" }
- { "DWORD" "dwBufferUsed" }
- { "DIDEVICEIMAGEINFOW*" "lprgImageInfoArray" } ;
+STRUCT: DIDEVICEIMAGEINFOHEADERW
+ { dwSize DWORD }
+ { dwSizeImageInfo DWORD }
+ { dwcViews DWORD }
+ { dwcButtons DWORD }
+ { dwcAxes DWORD }
+ { dwcPOVs DWORD }
+ { dwBufferSize DWORD }
+ { dwBufferUsed DWORD }
+ { lprgImageInfoArray DIDEVICEIMAGEINFOW* } ;
TYPEDEF: DIDEVICEIMAGEINFOHEADERW* LPDIDEVICEIMAGEINFOHEADERW
TYPEDEF: DIDEVICEIMAGEINFOHEADERW* LPCDIDEVICEIMAGEINFOHEADERW
-C-STRUCT: DIMOUSESTATE2
- { "LONG" "lX" }
- { "LONG" "lY" }
- { "LONG" "lZ" }
- { "BYTE[8]" "rgbButtons" } ;
+STRUCT: DIMOUSESTATE2
+ { lX LONG }
+ { lY LONG }
+ { lZ LONG }
+ { rgbButtons BYTE[8] } ;
TYPEDEF: DIMOUSESTATE2* LPDIMOUSESTATE2
TYPEDEF: DIMOUSESTATE2* LPCDIMOUSESTATE2
-C-STRUCT: DIJOYSTATE2
- { "LONG" "lX" }
- { "LONG" "lY" }
- { "LONG" "lZ" }
- { "LONG" "lRx" }
- { "LONG" "lRy" }
- { "LONG" "lRz" }
- { "LONG[2]" "rglSlider" }
- { "DWORD[4]" "rgdwPOV" }
- { "BYTE[128]" "rgbButtons" }
- { "LONG" "lVX" }
- { "LONG" "lVY" }
- { "LONG" "lVZ" }
- { "LONG" "lVRx" }
- { "LONG" "lVRy" }
- { "LONG" "lVRz" }
- { "LONG[2]" "rglVSlider" }
- { "LONG" "lAX" }
- { "LONG" "lAY" }
- { "LONG" "lAZ" }
- { "LONG" "lARx" }
- { "LONG" "lARy" }
- { "LONG" "lARz" }
- { "LONG[2]" "rglASlider" }
- { "LONG" "lFX" }
- { "LONG" "lFY" }
- { "LONG" "lFZ" }
- { "LONG" "lFRx" }
- { "LONG" "lFRy" }
- { "LONG" "lFRz" }
- { "LONG[2]" "rglFSlider" } ;
+STRUCT: DIJOYSTATE2
+ { lX LONG }
+ { lY LONG }
+ { lZ LONG }
+ { lRx LONG }
+ { lRy LONG }
+ { lRz LONG }
+ { rglSlider LONG[2] }
+ { rgdwPOV DWORD[4] }
+ { rgbButtons BYTE[128] }
+ { lVX LONG }
+ { lVY LONG }
+ { lVZ LONG }
+ { lVRx LONG }
+ { lVRy LONG }
+ { lVRz LONG }
+ { rglVSlider LONG[2] }
+ { lAX LONG }
+ { lAY LONG }
+ { lAZ LONG }
+ { lARx LONG }
+ { lARy LONG }
+ { lARz LONG }
+ { rglASlider LONG[2] }
+ { lFX LONG }
+ { lFY LONG }
+ { lFZ LONG }
+ { lFRx LONG }
+ { lFRy LONG }
+ { lFRz LONG }
+ { rglFSlider LONG[2] } ;
TYPEDEF: DIJOYSTATE2* LPDIJOYSTATE2
TYPEDEF: DIJOYSTATE2* LPCDIJOYSTATE2
+CALLBACK: BOOL LPDIENUMDEVICESCALLBACKW (
+ LPCDIDEVICEINSTANCEW lpddi,
+ LPVOID pvRef
+) ;
+CALLBACK: BOOL LPDICONFIGUREDEVICESCALLBACK (
+ IUnknown* lpDDSTarget,
+ LPVOID pvRef
+) ;
+CALLBACK: BOOL LPDIENUMEFFECTSCALLBACKW (
+ LPCDIEFFECTINFOW pdei,
+ LPVOID pvRef
+) ;
+CALLBACK: BOOL LPDIENUMEFFECTSINFILECALLBACK (
+ LPCDIFILEEFFECT lpDiFileEf,
+ LPVOID pvRef
+) ;
+CALLBACK: BOOL LPDIENUMDEVICEOBJECTSCALLBACKW (
+ LPCDIDEVICEOBJECTINSTANCEW lpddoi,
+ LPVOID pvRef
+) ;
+
COM-INTERFACE: IDirectInputEffect IUnknown {E7E1F7C0-88D2-11D0-9AD0-00A0C9A06E35}
HRESULT Initialize ( HINSTANCE hinst, DWORD dwVersion, REFGUID rguid )
HRESULT GetEffectGuid ( LPGUID pguid )
HRESULT Unload ( )
HRESULT Escape ( LPDIEFFESCAPE pesc ) ;
+CALLBACK: BOOL LPDIENUMCREATEDEFFECTOBJECTSCALLBACK (
+ IDirectInputEffect* peff,
+ LPVOID pvRef
+) ;
+
COM-INTERFACE: IDirectInputDevice8W IUnknown {54D41081-DC15-4833-A41B-748F73A38179}
HRESULT GetCapabilities ( LPDIDEVCAPS lpDIDeviceCaps )
HRESULT EnumObjects ( LPDIENUMDEVICEOBJECTSCALLBACKW lpCallback, LPVOID pvRef, DWORD dwFlags )
HRESULT SetActionMap ( LPDIACTIONFORMATW lpdiActionFormat, LPCWSTR lpwszUserName, DWORD dwFlags )
HRESULT GetImageInfo ( LPDIDEVICEIMAGEINFOHEADERW lpdiDeviceImageInfoHeader ) ;
+CALLBACK: BOOL LPDIENUMDEVICESBYSEMANTICSCBW (
+ LPCDIDEVICEINSTANCEW lpddi,
+ IDirectInputDevice8W* lpdid,
+ DWORD dwFlags,
+ DWORD dwRemaining,
+ LPVOID pvRef
+) ;
+
COM-INTERFACE: IDirectInput8W IUnknown {BF798031-483A-4DA2-AA99-5D64ED369700}
HRESULT CreateDevice ( REFGUID rguid, IDirectInputDevice8W** lplpDevice, LPUNKNOWN pUnkOuter )
HRESULT EnumDevices ( DWORD dwDevType, LPDIENUMDEVICESCALLBACKW lpCallback, LPVOID pvRef, DWORD dwFlags )
-USING: windows.com windows.com.wrapper combinators\r
-windows.kernel32 windows.ole32 windows.shell32 kernel accessors\r
+USING: alien.strings io.encodings.utf16n windows.com\r
+windows.com.wrapper combinators windows.kernel32 windows.ole32\r
+windows.shell32 kernel accessors windows.types\r
prettyprint namespaces ui.tools.listener ui.tools.workspace\r
-alien.c-types alien sequences math ;\r
+alien.data alien sequences math classes.struct ;\r
+SPECIALIZED-ARRAY: WCHAR\r
IN: windows.dragdrop-listener\r
\r
: filenames-from-hdrop ( hdrop -- filenames )\r
dup HEX: FFFFFFFF f 0 DragQueryFile ! get count of files\r
[\r
2dup f 0 DragQueryFile 1 + ! get size of filename buffer\r
- dup "WCHAR" <c-array>\r
+ dup WCHAR <c-array>\r
[ swap DragQueryFile drop ] keep\r
- alien>u16-string\r
+ utf16n alien>string\r
] with map ;\r
\r
: filenames-from-data-object ( data-object -- filenames )\r
- "FORMATETC" <c-object>\r
- CF_HDROP over set-FORMATETC-cfFormat\r
- f over set-FORMATETC-ptd\r
- DVASPECT_CONTENT over set-FORMATETC-dwAspect\r
- -1 over set-FORMATETC-lindex\r
- TYMED_HGLOBAL over set-FORMATETC-tymed\r
- "STGMEDIUM" <c-object>\r
+ FORMATETC <struct>\r
+ CF_HDROP >>cfFormat\r
+ f >>ptd\r
+ DVASPECT_CONTENT >>dwAspect\r
+ -1 >>lindex\r
+ TYMED_HGLOBAL >>tymed\r
+ STGMEDIUM <struct>\r
[ IDataObject::GetData ] keep swap succeeded? [\r
- dup STGMEDIUM-data\r
+ dup data>>\r
[ filenames-from-hdrop ] with-global-lock\r
swap ReleaseStgMedium\r
] [ drop f ] if ;\r
--- /dev/null
+! (c)2009 Joe Groff bsd license
+USING: alien.c-types alien.data alien.libraries alien.syntax
+classes.struct kernel math system-info.windows windows.types ;
+IN: windows.dwmapi
+
+STRUCT: MARGINS
+ { cxLeftWidth int }
+ { cxRightWidth int }
+ { cyTopHeight int }
+ { cyBottomHeight int } ;
+
+STRUCT: DWM_BLURBEHIND
+ { dwFlags DWORD }
+ { fEnable BOOL }
+ { hRgnBlur HANDLE }
+ { fTransitionOnMaximized BOOL } ;
+
+: <MARGINS> ( l r t b -- MARGINS )
+ MARGINS <struct-boa> ; inline
+
+: full-window-margins ( -- MARGINS )
+ -1 -1 -1 -1 <MARGINS> ; inline
+
+<< "dwmapi" "dwmapi.dll" "stdcall" add-library >>
+
+LIBRARY: dwmapi
+
+FUNCTION: HRESULT DwmExtendFrameIntoClientArea ( HWND hWnd, MARGINS* pMarInset ) ;
+FUNCTION: HRESULT DwmEnableBlurBehindWindow ( HWND hWnd, DWM_BLURBEHIND* pBlurBehind ) ;
+FUNCTION: HRESULT DwmIsCompositionEnabled ( BOOL* pfEnabled ) ;
+
+CONSTANT: WM_DWMCOMPOSITIONCHANGED HEX: 31E
+
+: composition-enabled? ( -- ? )
+ windows-major 6 >=
+ [ 0 <int> [ DwmIsCompositionEnabled drop ] keep *int c-bool> ]
+ [ f ] if ;
--- /dev/null
+Windows Vista Desktop Window Manager API functions
--- /dev/null
+windows
+unportable
-USING: alien.c-types kernel locals math math.bitwise
+USING: alien.data kernel locals math math.bitwise
windows.kernel32 sequences byte-arrays unicode.categories
io.encodings.string io.encodings.utf16n alien.strings
-arrays literals ;
+arrays literals windows.types specialized-arrays ;
+SPECIALIZED-ARRAY: TCHAR
IN: windows.errors
CONSTANT: ERROR_SUCCESS 0
f
id
LANG_NEUTRAL SUBLANG_DEFAULT make-lang-id
- 32768 [ "TCHAR" <c-array> ] keep
+ 32768 [ TCHAR <c-array> ] [ ] bi
f pick [ FormatMessage 0 = [ id error-message-failed ] when ] dip
utf16n alien>string [ blank? ] trim ;
-USING: assocs memoize locals kernel accessors init fonts math\r
-combinators windows.errors windows.types windows.gdi32 ;\r
-IN: windows.fonts\r
-\r
-: windows-font-name ( string -- string' )\r
- H{\r
- { "sans-serif" "Tahoma" }\r
- { "serif" "Times New Roman" }\r
- { "monospace" "Courier New" }\r
- } ?at drop ;\r
- \r
-MEMO:: (cache-font) ( font -- HFONT )\r
- font size>> neg ! nHeight\r
- 0 0 0 ! nWidth, nEscapement, nOrientation\r
- font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight\r
- font italic?>> TRUE FALSE ? ! fdwItalic\r
- FALSE ! fdwUnderline\r
- FALSE ! fdWStrikeOut\r
- DEFAULT_CHARSET ! fdwCharSet\r
- OUT_OUTLINE_PRECIS ! fdwOutputPrecision\r
- CLIP_DEFAULT_PRECIS ! fdwClipPrecision\r
- DEFAULT_QUALITY ! fdwQuality\r
- DEFAULT_PITCH ! fdwPitchAndFamily\r
- font name>> windows-font-name\r
- CreateFont\r
- dup win32-error=0/f ;\r
-\r
-: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;\r
-\r
-[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook\r
-\r
-: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )\r
- [ metrics new 0 >>width ] dip {\r
- [ TEXTMETRICW-tmHeight >>height ]\r
- [ TEXTMETRICW-tmAscent >>ascent ]\r
- [ TEXTMETRICW-tmDescent >>descent ]\r
- } cleave ;\r
+USING: assocs memoize locals kernel accessors init fonts math
+combinators system-info.windows windows.errors windows.types
+windows.gdi32 ;
+IN: windows.fonts
+
+MEMO: windows-fonts ( -- fonts )
+ windows-major 6 >=
+ H{
+ { "sans-serif" "Segoe UI" }
+ { "serif" "Cambria" }
+ { "monospace" "Consolas" }
+ }
+ H{
+ { "sans-serif" "Tahoma" }
+ { "serif" "Times New Roman" }
+ { "monospace" "Courier New" }
+ } ? ;
+
+: windows-font-name ( string -- string' )
+ windows-fonts ?at drop ;
+
+MEMO:: (cache-font) ( font -- HFONT )
+ font size>> neg ! nHeight
+ 0 0 0 ! nWidth, nEscapement, nOrientation
+ font bold?>> FW_BOLD FW_NORMAL ? ! fnWeight
+ font italic?>> TRUE FALSE ? ! fdwItalic
+ FALSE ! fdwUnderline
+ FALSE ! fdWStrikeOut
+ DEFAULT_CHARSET ! fdwCharSet
+ OUT_OUTLINE_PRECIS ! fdwOutputPrecision
+ CLIP_DEFAULT_PRECIS ! fdwClipPrecision
+ DEFAULT_QUALITY ! fdwQuality
+ DEFAULT_PITCH ! fdwPitchAndFamily
+ font name>> windows-font-name
+ CreateFont
+ dup win32-error=0/f ;
+
+: cache-font ( font -- HFONT ) strip-font-colors (cache-font) ;
+
+[ \ (cache-font) reset-memoized ] "windows.fonts" add-init-hook
+
+: TEXTMETRIC>metrics ( TEXTMETRIC -- metrics )
+ [ metrics new 0 >>width ] dip {
+ [ tmHeight>> >>height ]
+ [ tmAscent>> >>ascent ]
+ [ tmDescent>> >>descent ]
+ } cleave ;
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax alien.destructors kernel windows.types
-math.bitwise ;
+USING: alien alien.c-types alien.syntax alien.destructors
+kernel windows.types math.bitwise ;
IN: windows.gdi32
CONSTANT: BI_RGB 0
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel windows.types multiline
-classes.struct ;
+USING: alien alien.c-types alien.syntax kernel windows.types
+multiline classes.struct ;
IN: windows.kernel32
CONSTANT: MAX_PATH 260
CONSTANT: FILE_ACTION_RENAMED_OLD_NAME 4
CONSTANT: FILE_ACTION_RENAMED_NEW_NAME 5
-C-STRUCT: FILE_NOTIFY_INFORMATION
- { "DWORD" "NextEntryOffset" }
- { "DWORD" "Action" }
- { "DWORD" "FileNameLength" }
- { "WCHAR[1]" "FileName" } ;
+STRUCT: FILE_NOTIFY_INFORMATION
+ { NextEntryOffset DWORD }
+ { Action DWORD }
+ { FileNameLength DWORD }
+ { FileName WCHAR[1] } ;
+
TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION
CONSTANT: STD_INPUT_HANDLE -10
TYPEDEF: uint COMPUTER_NAME_FORMAT
-C-STRUCT: OVERLAPPED
- { "UINT_PTR" "internal" }
- { "UINT_PTR" "internal-high" }
- { "DWORD" "offset" }
- { "DWORD" "offset-high" }
- { "HANDLE" "event" } ;
+STRUCT: OVERLAPPED
+ { internal UINT_PTR }
+ { internal-high UINT_PTR }
+ { offset DWORD }
+ { offset-high DWORD }
+ { event HANDLE } ;
STRUCT: SYSTEMTIME
{ wYear WORD }
{ wSecond WORD }
{ wMilliseconds WORD } ;
-C-STRUCT: TIME_ZONE_INFORMATION
- { "LONG" "Bias" }
- { { "WCHAR" 32 } "StandardName" }
- { "SYSTEMTIME" "StandardDate" }
- { "LONG" "StandardBias" }
- { { "WCHAR" 32 } "DaylightName" }
- { "SYSTEMTIME" "DaylightDate" }
- { "LONG" "DaylightBias" } ;
+STRUCT: TIME_ZONE_INFORMATION
+ { Bias LONG }
+ { StandardName WCHAR[32] }
+ { StandardDate SYSTEMTIME }
+ { StandardBias LONG }
+ { DaylightName WCHAR[32] }
+ { DaylightDate SYSTEMTIME }
+ { DaylightBias LONG } ;
STRUCT: FILETIME
{ dwLowDateTime DWORD }
TYPEDEF: void* LPMEMORYSTATUSEX
-C-STRUCT: OSVERSIONINFO
- { "DWORD" "dwOSVersionInfoSize" }
- { "DWORD" "dwMajorVersion" }
- { "DWORD" "dwMinorVersion" }
- { "DWORD" "dwBuildNumber" }
- { "DWORD" "dwPlatformId" }
- { { "WCHAR" 128 } "szCSDVersion" } ;
+STRUCT: OSVERSIONINFO
+ { dwOSVersionInfoSize DWORD }
+ { dwMajorVersion DWORD }
+ { dwMinorVersion DWORD }
+ { dwBuildNumber DWORD }
+ { dwPlatformId DWORD }
+ { szCSDVersion WCHAR[128] } ;
TYPEDEF: void* LPOSVERSIONINFO
-C-STRUCT: MEMORY_BASIC_INFORMATION
- { "void*" "BaseAddress" }
- { "void*" "AllocationBase" }
- { "DWORD" "AllocationProtect" }
- { "SIZE_T" "RegionSize" }
- { "DWORD" "state" }
- { "DWORD" "protect" }
- { "DWORD" "type" } ;
-
-C-STRUCT: GUID
- { "ULONG" "Data1" }
- { "WORD" "Data2" }
- { "WORD" "Data3" }
- { { "UCHAR" 8 } "Data4" } ;
+STRUCT: MEMORY_BASIC_INFORMATION
+ { BaseAddress void* }
+ { AllocationBase void* }
+ { AllocationProtect DWORD }
+ { RegionSize SIZE_T }
+ { state DWORD }
+ { protect DWORD }
+ { type DWORD } ;
+
+STRUCT: GUID
+ { Data1 ULONG }
+ { Data2 WORD }
+ { Data3 WORD }
+ { Data4 UCHAR[8] } ;
/*
fBinary :1;
CONSTANT: EV_EVENT1 HEX: 800
CONSTANT: EV_EVENT2 HEX: 1000
-C-STRUCT: DCB
- { "DWORD" "DCBlength" }
- { "DWORD" "BaudRate" }
- { "DWORD" "flags" }
- { "WORD" "wReserved" }
- { "WORD" "XonLim" }
- { "WORD" "XoffLim" }
- { "BYTE" "ByteSize" }
- { "BYTE" "Parity" }
- { "BYTE" "StopBits" }
- { "char" "XonChar" }
- { "char" "XoffChar" }
- { "char" "ErrorChar" }
- { "char" "EofChar" }
- { "char" "EvtChar" }
- { "WORD" "wReserved1" } ;
+STRUCT: DCB
+ { DCBlength DWORD }
+ { BaudRate DWORD }
+ { flags DWORD }
+ { wReserved WORD }
+ { XonLim WORD }
+ { XoffLim WORD }
+ { ByteSize BYTE }
+ { Parity BYTE }
+ { StopBits BYTE }
+ { XonChar char }
+ { XoffChar char }
+ { ErrorChar char }
+ { EofChar char }
+ { EvtChar char }
+ { wReserved1 WORD } ;
TYPEDEF: DCB* PDCB
TYPEDEF: DCB* LPDCB
-C-STRUCT: COMM_CONFIG
- { "DWORD" "dwSize" }
- { "WORD" "wVersion" }
- { "WORD" "wReserved" }
- { "DCB" "dcb" }
- { "DWORD" "dwProviderSubType" }
- { "DWORD" "dwProviderOffset" }
- { "DWORD" "dwProviderSize" }
- { { "WCHAR" 1 } "wcProviderData" } ;
+STRUCT: COMMCONFIG
+ { dwSize DWORD }
+ { wVersion WORD }
+ { wReserved WORD }
+ { dcb DCB }
+ { dwProviderSubType DWORD }
+ { dwProviderOffset DWORD }
+ { dwProviderSize DWORD }
+ { wcProviderData { WCHAR 1 } } ;
TYPEDEF: COMMCONFIG* LPCOMMCONFIG
-C-STRUCT: COMMPROP
- { "WORD" "wPacketLength" }
- { "WORD" "wPacketVersion" }
- { "DWORD" "dwServiceMask" }
- { "DWORD" "dwReserved1" }
- { "DWORD" "dwMaxTxQueue" }
- { "DWORD" "dwMaxRxQueue" }
- { "DWORD" "dwMaxBaud" }
- { "DWORD" "dwProvSubType" }
- { "DWORD" "dwProvCapabilities" }
- { "DWORD" "dwSettableParams" }
- { "DWORD" "dwSettableBaud" }
- { "WORD" "wSettableData" }
- { "WORD" "wSettableStopParity" }
- { "DWORD" "dwCurrentTxQueue" }
- { "DWORD" "dwCurrentRxQueue" }
- { "DWORD" "dwProvSpec1" }
- { "DWORD" "dwProvSpec2" }
- { { "WCHAR" 1 } "wcProvChar" } ;
+STRUCT: COMMPROP
+ { wPacketLength WORD }
+ { wPacketVersion WORD }
+ { dwServiceMask DWORD }
+ { dwReserved1 DWORD }
+ { dwMaxTxQueue DWORD }
+ { dwMaxRxQueue DWORD }
+ { dwMaxBaud DWORD }
+ { dwProvSubType DWORD }
+ { dwProvCapabilities DWORD }
+ { dwSettableParams DWORD }
+ { dwSettableBaud DWORD }
+ { wSettableData WORD }
+ { wSettableStopParity WORD }
+ { dwCurrentTxQueue DWORD }
+ { dwCurrentRxQueue DWORD }
+ { dwProvSpec1 DWORD }
+ { dwProvSpec2 DWORD }
+ { wcProvChar { WCHAR 1 } } ;
TYPEDEF: COMMPROP* LPCOMMPROP
CONSTANT: WAIT_IO_COMPLETION HEX: c0
CONSTANT: WAIT_FAILED HEX: ffffffff
-C-STRUCT: LUID
- { "DWORD" "LowPart" }
- { "LONG" "HighPart" } ;
+STRUCT: LUID
+ { LowPart DWORD }
+ { HighPart LONG } ;
TYPEDEF: LUID* PLUID
-C-STRUCT: LUID_AND_ATTRIBUTES
- { "LUID" "Luid" }
- { "DWORD" "Attributes" } ;
+STRUCT: LUID_AND_ATTRIBUTES
+ { Luid LUID }
+ { Attributes DWORD } ;
TYPEDEF: LUID_AND_ATTRIBUTES* PLUID_AND_ATTRIBUTES
-C-STRUCT: TOKEN_PRIVILEGES
- { "DWORD" "PrivilegeCount" }
- { "LUID_AND_ATTRIBUTES*" "Privileges" } ;
+STRUCT: TOKEN_PRIVILEGES
+ { PrivilegeCount DWORD }
+ { Privileges LUID_AND_ATTRIBUTES* } ;
TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES
-C-STRUCT: WIN32_FILE_ATTRIBUTE_DATA
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" } ;
+STRUCT: WIN32_FILE_ATTRIBUTE_DATA
+ { dwFileAttributes DWORD }
+ { ftCreationTime FILETIME }
+ { ftLastAccessTime FILETIME }
+ { ftLastWriteTime FILETIME }
+ { nFileSizeHigh DWORD }
+ { nFileSizeLow DWORD } ;
TYPEDEF: WIN32_FILE_ATTRIBUTE_DATA* LPWIN32_FILE_ATTRIBUTE_DATA
-C-STRUCT: BY_HANDLE_FILE_INFORMATION
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "dwVolumeSerialNumber" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" }
- { "DWORD" "nNumberOfLinks" }
- { "DWORD" "nFileIndexHigh" }
- { "DWORD" "nFileIndexLow" } ;
+STRUCT: BY_HANDLE_FILE_INFORMATION
+ { dwFileAttributes DWORD }
+ { ftCreationTime FILETIME }
+ { ftLastAccessTime FILETIME }
+ { ftLastWriteTime FILETIME }
+ { dwVolumeSerialNumber DWORD }
+ { nFileSizeHigh DWORD }
+ { nFileSizeLow DWORD }
+ { nNumberOfLinks DWORD }
+ { nFileIndexHigh DWORD }
+ { nFileIndexLow DWORD } ;
TYPEDEF: BY_HANDLE_FILE_INFORMATION* LPBY_HANDLE_FILE_INFORMATION
CONSTANT: OFS_MAXPATHNAME 128
-C-STRUCT: OFSTRUCT
- { "BYTE" "cBytes" }
- { "BYTE" "fFixedDisk" }
- { "WORD" "nErrCode" }
- { "WORD" "Reserved1" }
- { "WORD" "Reserved2" }
- ! { { "CHAR" OFS_MAXPATHNAME } "szPathName" } ;
- { { "CHAR" 128 } "szPathName" } ;
+STRUCT: OFSTRUCT
+ { cBytes BYTE }
+ { fFixedDisk BYTE }
+ { nErrCode WORD }
+ { Reserved1 WORD }
+ { Reserved2 WORD }
+ { szPathName { CHAR 128 } } ;
+ ! { szPathName { CHAR OFS_MAXPATHNAME } } ;
TYPEDEF: OFSTRUCT* LPOFSTRUCT
-! MAX_PATH = 260
-C-STRUCT: WIN32_FIND_DATA
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" }
- { "DWORD" "dwReserved0" }
- { "DWORD" "dwReserved1" }
- ! { { "TCHAR" MAX_PATH } "cFileName" }
- { { "TCHAR" 260 } "cFileName" }
- { { "TCHAR" 14 } "cAlternateFileName" } ;
-
-STRUCT: BY_HANDLE_FILE_INFORMATION
+STRUCT: WIN32_FIND_DATA
{ dwFileAttributes DWORD }
{ ftCreationTime FILETIME }
{ ftLastAccessTime FILETIME }
{ ftLastWriteTime FILETIME }
- { dwVolumeSerialNumber DWORD }
{ nFileSizeHigh DWORD }
{ nFileSizeLow DWORD }
- { nNumberOfLinks DWORD }
- { nFileIndexHigh DWORD }
- { nFileIndexLow DWORD } ;
+ { dwReserved0 DWORD }
+ { dwReserved1 DWORD }
+ { cFileName { TCHAR MAX_PATH } }
+ { cAlternateFileName TCHAR[14] } ;
TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA
TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA
! Copyright (C) 2009 Joe Groff, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types kernel combinators sequences
-math windows.gdi32 windows.types images destructors
-accessors fry locals ;
+USING: alien.c-types alien.data kernel combinators
+sequences math windows.gdi32 windows.types images
+destructors accessors fry locals classes.struct ;
IN: windows.offscreen
: (bitmap-info) ( dim -- BITMAPINFO )
- "BITMAPINFO" <c-object> [
- BITMAPINFO-bmiHeader {
- [ nip "BITMAPINFOHEADER" heap-size swap set-BITMAPINFOHEADER-biSize ]
- [ [ first ] dip set-BITMAPINFOHEADER-biWidth ]
- [ [ second ] dip set-BITMAPINFOHEADER-biHeight ]
- [ nip 1 swap set-BITMAPINFOHEADER-biPlanes ]
- [ nip 32 swap set-BITMAPINFOHEADER-biBitCount ]
- [ nip BI_RGB swap set-BITMAPINFOHEADER-biCompression ]
- [ [ first2 * 4 * ] dip set-BITMAPINFOHEADER-biSizeImage ]
- [ nip 72 swap set-BITMAPINFOHEADER-biXPelsPerMeter ]
- [ nip 72 swap set-BITMAPINFOHEADER-biYPelsPerMeter ]
- [ nip 0 swap set-BITMAPINFOHEADER-biClrUsed ]
- [ nip 0 swap set-BITMAPINFOHEADER-biClrImportant ]
- } 2cleave
- ] keep ;
+ [
+ BITMAPINFO <struct>
+ dup bmiHeader>>
+ BITMAPINFOHEADER heap-size >>biSize
+ ] dip
+ [ first >>biWidth ]
+ [ second >>biHeight ]
+ [ first2 * 4 * >>biSizeImage ] tri
+ 1 >>biPlanes
+ 32 >>biBitCount
+ BI_RGB >>biCompression
+ 72 >>biXPelsPerMeter
+ 72 >>biYPelsPerMeter
+ 0 >>biClrUsed
+ 0 >>biClrImportant
+ drop ;
: make-bitmap ( dim dc -- hBitmap bits )
[ nip ]
-USING: kernel tools.test windows.ole32 alien.c-types ;
+USING: kernel tools.test windows.ole32 alien.c-types
+classes.struct specialized-arrays windows.kernel32
+windows.com.syntax ;
+SPECIALIZED-ARRAY: uchar
IN: windows.ole32.tests
[ t ] [
guid=
] unit-test
-little-endian?
-[ B{
- HEX: 67 HEX: 45 HEX: 23 HEX: 01 HEX: ab HEX: 89 HEX: ef HEX: cd
- HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ]
-[ B{
- HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
- HEX: 01 HEX: 23 HEX: 45 HEX: 67 HEX: 89 HEX: ab HEX: cd HEX: ef
-} ] ?
-[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ]
-unit-test
+[
+ GUID: 01234567-89ab-cdef-0123-456789abcdef}
+] [ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid ] unit-test
[ "{01234567-89ab-cdef-0123-456789abcdef}" ]
[ "{01234567-89ab-cdef-0123-456789abcdef}" string>guid guid>string ]
-USING: alien alien.syntax alien.c-types alien.strings math
-kernel sequences windows.errors windows.types io
-accessors math.order namespaces make math.parser windows.kernel32
-combinators locals specialized-arrays.direct.uchar ;
+USING: alien alien.syntax alien.c-types alien.data alien.strings
+math kernel sequences windows.errors windows.types io accessors
+math.order namespaces make math.parser windows.kernel32
+combinators locals specialized-arrays literals splitting
+grouping classes.struct combinators.smart ;
+SPECIALIZED-ARRAY: uchar
IN: windows.ole32
LIBRARY: ole32
CONSTANT: TYMED_ENHMF 64
CONSTANT: TYMED_NULL 0
-C-STRUCT: DVTARGETDEVICE
- { "DWORD" "tdSize" }
- { "WORD" "tdDriverNameOffset" }
- { "WORD" "tdDeviceNameOffset" }
- { "WORD" "tdPortNameOffset" }
- { "WORD" "tdExtDevmodeOffset" }
- { "BYTE[1]" "tdData" } ;
+STRUCT: DVTARGETDEVICE
+ { tdSize DWORD }
+ { tdDriverNameOffset WORD }
+ { tdDeviceNameOffset WORD }
+ { tdPortNameOffset WORD }
+ { tdExtDevmodeOffset WORD }
+ { tdData BYTE[1] } ;
TYPEDEF: WORD CLIPFORMAT
TYPEDEF: POINT POINTL
-C-STRUCT: FORMATETC
- { "CLIPFORMAT" "cfFormat" }
- { "DVTARGETDEVICE*" "ptd" }
- { "DWORD" "dwAspect" }
- { "LONG" "lindex" }
- { "DWORD" "tymed" } ;
+STRUCT: FORMATETC
+ { cfFormat CLIPFORMAT }
+ { ptd DVTARGETDEVICE* }
+ { dwAspect DWORD }
+ { lindex LONG }
+ { tymed DWORD } ;
TYPEDEF: FORMATETC* LPFORMATETC
-C-STRUCT: STGMEDIUM
- { "DWORD" "tymed" }
- { "void*" "data" }
- { "LPUNKNOWN" "punkForRelease" } ;
+STRUCT: STGMEDIUM
+ { tymed DWORD }
+ { data void* }
+ { punkForRelease LPUNKNOWN } ;
TYPEDEF: STGMEDIUM* LPSTGMEDIUM
CONSTANT: COINIT_MULTITHREADED 0
FUNCTION: HRESULT OleInitialize ( void* reserved ) ;
FUNCTION: HRESULT CoInitializeEx ( void* reserved, DWORD dwCoInit ) ;
-FUNCTION: HRESULT RegisterDragDrop ( HWND hWnd, IDropTarget* pDropTarget ) ;
-FUNCTION: HRESULT RevokeDragDrop ( HWND hWnd ) ;
-FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ;
-
: succeeded? ( hresult -- ? )
0 HEX: 7FFFFFFF between? ;
: guid= ( a b -- ? )
[ 16 memory>byte-array ] bi@ = ;
-: GUID-STRING-LENGTH ( -- n )
- "{01234567-89ab-cdef-0123-456789abcdef}" length ; inline
-
-:: (guid-section>guid) ( string guid start end quot -- )
- start end string subseq hex> guid quot call ; inline
-
-:: (guid-byte>guid) ( string guid start end byte -- )
- start end string subseq hex> byte guid set-nth ; inline
+CONSTANT: GUID-STRING-LENGTH
+ $[ "{01234567-89ab-cdef-0123-456789abcdef}" length ]
: string>guid ( string -- guid )
- "GUID" <c-object> [
- {
- [ 1 9 [ set-GUID-Data1 ] (guid-section>guid) ]
- [ 10 14 [ set-GUID-Data2 ] (guid-section>guid) ]
- [ 15 19 [ set-GUID-Data3 ] (guid-section>guid) ]
- [ ]
- } 2cleave
-
- GUID-Data4 {
- [ 20 22 0 (guid-byte>guid) ]
- [ 22 24 1 (guid-byte>guid) ]
-
- [ 25 27 2 (guid-byte>guid) ]
- [ 27 29 3 (guid-byte>guid) ]
- [ 29 31 4 (guid-byte>guid) ]
- [ 31 33 5 (guid-byte>guid) ]
- [ 33 35 6 (guid-byte>guid) ]
- [ 35 37 7 (guid-byte>guid) ]
- } 2cleave
- ] keep ;
-
-: (guid-section%) ( guid quot len -- )
- [ call >hex ] dip CHAR: 0 pad-head % ; inline
-
-: (guid-byte%) ( guid byte -- )
- swap nth >hex 2 CHAR: 0 pad-head % ; inline
+ "{-}" split harvest
+ [ first3 [ hex> ] tri@ ]
+ [ 3 tail concat 2 group [ hex> ] B{ } map-as ] bi
+ GUID <struct-boa> ;
: guid>string ( guid -- string )
[
- "{" % {
- [ [ GUID-Data1 ] 8 (guid-section%) "-" % ]
- [ [ GUID-Data2 ] 4 (guid-section%) "-" % ]
- [ [ GUID-Data3 ] 4 (guid-section%) "-" % ]
- [ ]
+ [ "{" ] dip {
+ [ Data1>> >hex 8 CHAR: 0 pad-head "-" ]
+ [ Data2>> >hex 4 CHAR: 0 pad-head "-" ]
+ [ Data3>> >hex 4 CHAR: 0 pad-head "-" ]
+ [
+ Data4>> [
+ {
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head "-" ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ [ >hex 2 CHAR: 0 pad-head ]
+ } spread
+ ] input<sequence "}"
+ ]
} cleave
- GUID-Data4 {
- [ 0 (guid-byte%) ]
- [ 1 (guid-byte%) "-" % ]
- [ 2 (guid-byte%) ]
- [ 3 (guid-byte%) ]
- [ 4 (guid-byte%) ]
- [ 5 (guid-byte%) ]
- [ 6 (guid-byte%) ]
- [ 7 (guid-byte%) "}" % ]
- } cleave
- ] "" make ;
-
+ ] "" append-outputs-as ;
! Copyright (C) 2006, 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax
-combinators io.encodings.utf16n io.files io.pathnames kernel
-windows.errors windows.com windows.com.syntax windows.user32
-windows.ole32 windows ;
+classes.struct combinators io.encodings.utf16n io.files
+io.pathnames kernel windows.errors windows.com
+windows.com.syntax windows.types windows.user32
+windows.ole32 windows specialized-arrays ;
+SPECIALIZED-ARRAY: ushort
IN: windows.shell32
CONSTANT: CSIDL_DESKTOP HEX: 00
: shell32-directory ( n -- str )
f swap f SHGFP_TYPE_DEFAULT
- MAX_UNICODE_PATH "ushort" <c-array>
+ MAX_UNICODE_PATH <ushort-array>
[ SHGetFolderPath drop ] keep utf16n alien>string ;
: desktop ( -- str )
TYPEDEF: ULONG SFGAOF
-C-STRUCT: DROPFILES
- { "DWORD" "pFiles" }
- { "POINT" "pt" }
- { "BOOL" "fNC" }
- { "BOOL" "fWide" } ;
+STRUCT: DROPFILES
+ { pFiles DWORD }
+ { pt POINT }
+ { fNC BOOL }
+ { fWide BOOL } ;
TYPEDEF: DROPFILES* LPDROPFILES
TYPEDEF: DROPFILES* LPCDROPFILES
TYPEDEF: HANDLE HDROP
-C-STRUCT: SHITEMID
- { "USHORT" "cb" }
- { "BYTE[1]" "abID" } ;
+STRUCT: SHITEMID
+ { cb USHORT }
+ { abID BYTE[1] } ;
TYPEDEF: SHITEMID* LPSHITEMID
TYPEDEF: SHITEMID* LPCSHITEMID
-C-STRUCT: ITEMIDLIST
- { "SHITEMID" "mkid" } ;
+STRUCT: ITEMIDLIST
+ { mkid SHITEMID } ;
TYPEDEF: ITEMIDLIST* LPITEMIDLIST
TYPEDEF: ITEMIDLIST* LPCITEMIDLIST
TYPEDEF: ITEMIDLIST ITEMID_CHILD
CONSTANT: STRRET_OFFSET 1
CONSTANT: STRRET_CSTR 2
-C-UNION: STRRET-union "LPWSTR" "LPSTR" "UINT" "char[260]" ;
-C-STRUCT: STRRET
- { "int" "uType" }
- { "STRRET-union" "union" } ;
+UNION-STRUCT: STRRET-union
+ { pOleStr LPWSTR }
+ { uOffset UINT }
+ { cStr char[260] } ;
+STRUCT: STRRET
+ { uType int }
+ { value STRRET-union } ;
COM-INTERFACE: IEnumIDList IUnknown {000214F2-0000-0000-C000-000000000046}
HRESULT Next ( ULONG celt, LPITEMIDLIST* rgelt, ULONG* pceltFetched )
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes.struct tools.test windows.types ;
+IN: windows.types.tests
+
+[ S{ RECT { right 100 } { bottom 100 } } ]
+[ { 0 0 } { 100 100 } <RECT> ] unit-test
+
+[ S{ RECT { left 100 } { top 100 } { right 200 } { bottom 200 } } ]
+[ { 100 100 } { 100 100 } <RECT> ] unit-test
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.syntax namespaces kernel words
sequences math math.bitwise math.vectors colors
-io.encodings.utf16n classes.struct ;
+io.encodings.utf16n classes.struct accessors ;
+FROM: alien.c-types => float short ;
IN: windows.types
TYPEDEF: char CHAR
TYPEDEF: uchar BYTE
TYPEDEF: ushort wchar_t
+SYMBOL: wchar_t*
+<<
+{ char* utf16n } \ wchar_t* typedef
+\ wchar_t \ wchar_t* "pointer-c-type" set-word-prop
+>>
+
TYPEDEF: wchar_t WCHAR
TYPEDEF: short SHORT
TYPEDEF: int INT32
TYPEDEF: uint UINT32
TYPEDEF: uint DWORD32
+TYPEDEF: long LONG32
TYPEDEF: ulong ULONG32
TYPEDEF: ulonglong ULONG64
TYPEDEF: long* POINTER_32
TYPEDEF: ulonglong ULARGE_INTEGER
TYPEDEF: LARGE_INTEGER* PLARGE_INTEGER
TYPEDEF: ULARGE_INTEGER* PULARGE_INTEGER
-
-<< { "char*" utf16n } "wchar_t*" typedef >>
+TYPEDEF: size_t SIZE_T
+TYPEDEF: ptrdiff_t SSIZE_T
TYPEDEF: wchar_t* LPCSTR
TYPEDEF: wchar_t* LPWSTR
TYPEDEF: LONGLONG USN
TYPEDEF: UINT_PTR WPARAM
-TYPEDEF: RECT* LPRECT
-TYPEDEF: void* PWNDCLASS
-TYPEDEF: void* PWNDCLASSEX
-TYPEDEF: void* LPWNDCLASS
-TYPEDEF: void* LPWNDCLASSEX
-TYPEDEF: void* MSGBOXPARAMSA
-TYPEDEF: void* MSGBOXPARAMSW
-TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
-
TYPEDEF: size_t socklen_t
TYPEDEF: void* WNDPROC
! typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM);
-C-STRUCT: WNDCLASS
- { "UINT" "style" }
- { "WNDPROC" "lpfnWndProc" }
- { "int" "cbClsExtra" }
- { "int" "cbWndExtra" }
- { "HINSTANCE" "hInstance" }
- { "HICON" "hIcon" }
- { "HCURSOR" "hCursor" }
- { "HBRUSH" "hbrBackground" }
- { "LPCTSTR" "lpszMenuName" }
- { "LPCTSTR" "lpszClassName" } ;
-
-C-STRUCT: WNDCLASSEX
- { "UINT" "cbSize" }
- { "UINT" "style" }
- { "WNDPROC" "lpfnWndProc" }
- { "int" "cbClsExtra" }
- { "int" "cbWndExtra" }
- { "HINSTANCE" "hInstance" }
- { "HICON" "hIcon" }
- { "HCURSOR" "hCursor" }
- { "HBRUSH" "hbrBackground" }
- { "LPCTSTR" "lpszMenuName" }
- { "LPCTSTR" "lpszClassName" }
- { "HICON" "hIconSm" } ;
-
-C-STRUCT: RECT
- { "LONG" "left" }
- { "LONG" "top" }
- { "LONG" "right" }
- { "LONG" "bottom" } ;
-
-C-STRUCT: PAINTSTRUCT
- { "HDC" " hdc" }
- { "BOOL" "fErase" }
- { "RECT" "rcPaint" }
- { "BOOL" "fRestore" }
- { "BOOL" "fIncUpdate" }
- { "BYTE[32]" "rgbReserved" }
-;
-
-C-STRUCT: BITMAPINFOHEADER
- { "DWORD" "biSize" }
- { "LONG" "biWidth" }
- { "LONG" "biHeight" }
- { "WORD" "biPlanes" }
- { "WORD" "biBitCount" }
- { "DWORD" "biCompression" }
- { "DWORD" "biSizeImage" }
- { "LONG" "biXPelsPerMeter" }
- { "LONG" "biYPelsPerMeter" }
- { "DWORD" "biClrUsed" }
- { "DWORD" "biClrImportant" } ;
-
-C-STRUCT: RGBQUAD
- { "BYTE" "rgbBlue" }
- { "BYTE" "rgbGreen" }
- { "BYTE" "rgbRed" }
- { "BYTE" "rgbReserved" } ;
-
-C-STRUCT: BITMAPINFO
- { "BITMAPINFOHEADER" "bmiHeader" }
- { "RGBQUAD[1]" "bmiColors" } ;
+STRUCT: WNDCLASS
+ { style UINT }
+ { lpfnWndProc WNDPROC }
+ { cbClsExtra int }
+ { cbWndExtra int }
+ { hInstance HINSTANCE }
+ { hIcon HICON }
+ { hCursor HCURSOR }
+ { hbrBackground HBRUSH }
+ { lpszMenuName LPCTSTR }
+ { lpszClassName LPCTSTR } ;
+
+STRUCT: WNDCLASSEX
+ { cbSize UINT }
+ { style UINT }
+ { lpfnWndProc WNDPROC }
+ { cbClsExtra int }
+ { cbWndExtra int }
+ { hInstance HINSTANCE }
+ { hIcon HICON }
+ { hCursor HCURSOR }
+ { hbrBackground HBRUSH }
+ { lpszMenuName LPCTSTR }
+ { lpszClassName LPCTSTR }
+ { hIconSm HICON } ;
+
+STRUCT: RECT
+ { left LONG }
+ { top LONG }
+ { right LONG }
+ { bottom LONG } ;
+
+STRUCT: PAINTSTRUCT
+ { hdc HDC }
+ { fErase BOOL }
+ { rcPaint RECT }
+ { fRestore BOOL }
+ { fIncUpdate BOOL }
+ { rgbReserved BYTE[32] } ;
+
+STRUCT: BITMAPINFOHEADER
+ { biSize DWORD }
+ { biWidth LONG }
+ { biHeight LONG }
+ { biPlanes WORD }
+ { biBitCount WORD }
+ { biCompression DWORD }
+ { biSizeImage DWORD }
+ { biXPelsPerMeter LONG }
+ { biYPelsPerMeter LONG }
+ { biClrUsed DWORD }
+ { biClrImportant DWORD } ;
+
+STRUCT: RGBQUAD
+ { rgbBlue BYTE }
+ { rgbGreen BYTE }
+ { rgbRed BYTE }
+ { rgbReserved BYTE } ;
+
+STRUCT: BITMAPINFO
+ { bmiHeader BITMAPINFOHEADER }
+ { bimColors RGBQUAD[1] } ;
TYPEDEF: void* LPPAINTSTRUCT
TYPEDEF: void* PAINTSTRUCT
-C-STRUCT: POINT
- { "LONG" "x" }
- { "LONG" "y" } ;
+STRUCT: POINT
+ { x LONG }
+ { y LONG } ;
-C-STRUCT: SIZE
- { "LONG" "cx" }
- { "LONG" "cy" } ;
+STRUCT: SIZE
+ { cx LONG }
+ { cy LONG } ;
-C-STRUCT: MSG
- { "HWND" "hWnd" }
- { "UINT" "message" }
- { "WPARAM" "wParam" }
- { "LPARAM" "lParam" }
- { "DWORD" "time" }
- { "POINT" "pt" } ;
+STRUCT: MSG
+ { hWnd HWND }
+ { message UINT }
+ { wParam WPARAM }
+ { lParam LPARAM }
+ { time DWORD }
+ { pt POINT } ;
TYPEDEF: MSG* LPMSG
{ dwVisibleMask DWORD }
{ dwDamageMask DWORD } ;
-C-STRUCT: RECT
- { "LONG" "left" }
- { "LONG" "top" }
- { "LONG" "right" }
- { "LONG" "bottom" } ;
-
: <RECT> ( loc dim -- RECT )
- over v+
- "RECT" <c-object>
- over first over set-RECT-right
- swap second over set-RECT-bottom
- over first over set-RECT-left
- swap second over set-RECT-top ;
+ dupd v+ [ first2 ] bi@ RECT <struct-boa> ;
TYPEDEF: RECT* PRECT
TYPEDEF: RECT* LPRECT
TYPEDEF: HANDLE HGLRC
TYPEDEF: HANDLE HRGN
-C-STRUCT: LVITEM
- { "uint" "mask" }
- { "int" "iItem" }
- { "int" "iSubItem" }
- { "uint" "state" }
- { "uint" "stateMask" }
- { "void*" "pszText" }
- { "int" "cchTextMax" }
- { "int" "iImage" }
- { "long" "lParam" }
- { "int" "iIndent" }
- { "int" "iGroupId" }
- { "uint" "cColumns" }
- { "uint*" "puColumns" }
- { "int*" "piColFmt" }
- { "int" "iGroup" } ;
-
-C-STRUCT: LVFINDINFO
- { "uint" "flags" }
- { "char*" "psz" }
- { "long" "lParam" }
- { "POINT" "pt" }
- { "uint" "vkDirection" } ;
-
-C-STRUCT: ACCEL
- { "BYTE" "fVirt" }
- { "WORD" "key" }
- { "WORD" "cmd" } ;
+TYPEDEF: void* PWNDCLASS
+TYPEDEF: void* PWNDCLASSEX
+TYPEDEF: void* LPWNDCLASS
+TYPEDEF: void* LPWNDCLASSEX
+TYPEDEF: void* MSGBOXPARAMSA
+TYPEDEF: void* MSGBOXPARAMSW
+TYPEDEF: void* LPOVERLAPPED_COMPLETION_ROUTINE
+
+STRUCT: LVITEM
+ { mask uint }
+ { iItem int }
+ { iSubItem int }
+ { state uint }
+ { stateMask uint }
+ { pszText void* }
+ { cchTextMax int }
+ { iImage int }
+ { lParam long }
+ { iIndent int }
+ { iGroupId int }
+ { cColumns uint }
+ { puColumns uint* }
+ { piColFmt int* }
+ { iGroup int } ;
+
+STRUCT: LVFINDINFO
+ { flags uint }
+ { psz char* }
+ { lParam long }
+ { pt POINT }
+ { vkDirection uint } ;
+
+STRUCT: ACCEL
+ { fVirt BYTE }
+ { key WORD }
+ { cmd WORD } ;
TYPEDEF: ACCEL* LPACCEL
TYPEDEF: DWORD COLORREF
: RGB ( r g b -- COLORREF )
{ 16 8 0 } bitfield ; inline
+: >RGB< ( COLORREF -- r g b )
+ [ HEX: ff bitand ]
+ [ -8 shift HEX: ff bitand ]
+ [ -16 shift HEX: ff bitand ] tri ;
: color>RGB ( color -- COLORREF )
>rgba-components drop [ 255 * >integer ] tri@ RGB ;
-
-C-STRUCT: TEXTMETRICW
- { "LONG" "tmHeight" }
- { "LONG" "tmAscent" }
- { "LONG" "tmDescent" }
- { "LONG" "tmInternalLeading" }
- { "LONG" "tmExternalLeading" }
- { "LONG" "tmAveCharWidth" }
- { "LONG" "tmMaxCharWidth" }
- { "LONG" "tmWeight" }
- { "LONG" "tmOverhang" }
- { "LONG" "tmDigitizedAspectX" }
- { "LONG" "tmDigitizedAspectY" }
- { "WCHAR" "tmFirstChar" }
- { "WCHAR" "tmLastChar" }
- { "WCHAR" "tmDefaultChar" }
- { "WCHAR" "tmBreakChar" }
- { "BYTE" "tmItalic" }
- { "BYTE" "tmUnderlined" }
- { "BYTE" "tmStruckOut" }
- { "BYTE" "tmPitchAndFamily" }
- { "BYTE" "tmCharSet" } ;
+: RGB>color ( COLORREF -- color )
+ >RGB< [ 1/255. * >float ] tri@ 1.0 <rgba> ;
+
+STRUCT: TEXTMETRICW
+ { tmHeight LONG }
+ { tmAscent LONG }
+ { tmDescent LONG }
+ { tmInternalLeading LONG }
+ { tmExternalLeading LONG }
+ { tmAveCharWidth LONG }
+ { tmMaxCharWidth LONG }
+ { tmWeight LONG }
+ { tmOverhang LONG }
+ { tmDigitizedAspectX LONG }
+ { tmDigitizedAspectY LONG }
+ { tmFirstChar WCHAR }
+ { tmLastChar WCHAR }
+ { tmDefaultChar WCHAR }
+ { tmBreakChar WCHAR }
+ { tmItalic BYTE }
+ { tmUnderlined BYTE }
+ { tmStruckOut BYTE }
+ { tmPitchAndFamily BYTE }
+ { tmCharSet BYTE } ;
TYPEDEF: TEXTMETRICW* LPTEXTMETRIC
io.encodings.utf16n accessors arrays combinators destructors
cache namespaces init fonts alien.c-types windows.usp10
windows.offscreen windows.gdi32 windows.ole32 windows.types
-windows.fonts opengl.textures locals windows.errors ;
+windows.fonts opengl.textures locals windows.errors
+classes.struct ;
IN: windows.uniscribe
TUPLE: script-string < disposable font string metrics ssa size image ;
: script-string-size ( script-string -- dim )
ssa>> ScriptString_pSize
dup win32-error=0/f
- [ SIZE-cx ] [ SIZE-cy ] bi 2array ;
+ SIZE memory>struct
+ [ cx>> ] [ cy>> ] bi 2array ;
: dc-metrics ( dc -- metrics )
- "TEXTMETRICW" <c-object>
+ TEXTMETRICW <struct>
[ GetTextMetrics drop ] keep
TEXTMETRIC>metrics ;
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax parser namespaces kernel math
-windows.types generalizations math.bitwise classes.struct ;
+USING: alien alien.c-types alien.syntax parser namespaces
+kernel math windows.types generalizations math.bitwise
+classes.struct literals windows.kernel32 ;
IN: windows.user32
! HKL for ActivateKeyboardLayout
CONSTANT: WS_EX_CONTROLPARENT HEX: 00010000
CONSTANT: WS_EX_STATICEDGE HEX: 00020000
CONSTANT: WS_EX_APPWINDOW HEX: 00040000
+
: WS_EX_OVERLAPPEDWINDOW ( -- n )
WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable
+
: WS_EX_PALETTEWINDOW ( -- n )
{ WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST } flags ; foldable
CONSTANT: TME_QUERY HEX: 40000000
CONSTANT: TME_CANCEL HEX: 80000000
CONSTANT: HOVER_DEFAULT HEX: ffffffff
-C-STRUCT: TRACKMOUSEEVENT
- { "DWORD" "cbSize" }
- { "DWORD" "dwFlags" }
- { "HWND" "hwndTrack" }
- { "DWORD" "dwHoverTime" } ;
+STRUCT: TRACKMOUSEEVENT
+ { cbSize DWORD }
+ { dwFlags DWORD }
+ { hwndTrack HWND }
+ { dwHoverTime DWORD } ;
TYPEDEF: TRACKMOUSEEVENT* LPTRACKMOUSEEVENT
CONSTANT: DBT_DEVICEARRIVAL HEX: 8000
CONSTANT: DEVICE_NOTIFY_ALL_INTERFACE_CLASSES 4
-C-STRUCT: DEV_BROADCAST_HDR
- { "DWORD" "dbch_size" }
- { "DWORD" "dbch_devicetype" }
- { "DWORD" "dbch_reserved" } ;
+STRUCT: DEV_BROADCAST_HDR
+ { dbch_size DWORD }
+ { dbch_devicetype DWORD }
+ { dbch_reserved DWORD } ;
-C-STRUCT: DEV_BROADCAST_DEVICEW
- { "DWORD" "dbcc_size" }
- { "DWORD" "dbcc_devicetype" }
- { "DWORD" "dbcc_reserved" }
- { "GUID" "dbcc_classguid" }
- { { "WCHAR" 1 } "dbcc_name" } ;
+STRUCT: DEV_BROADCAST_DEVICEW
+ { dbcc_size DWORD }
+ { dbcc_devicetype DWORD }
+ { dbcc_reserved DWORD }
+ { dbcc_classguid GUID }
+ { dbcc_name WCHAR[1] } ;
CONSTANT: CCHDEVICENAME 32
-C-STRUCT: MONITORINFOEX
- { "DWORD" "cbSize" }
- { "RECT" "rcMonitor" }
- { "RECT" "rcWork" }
- { "DWORD" "dwFlags" }
- { { "TCHAR" CCHDEVICENAME } "szDevice" } ;
+STRUCT: MONITORINFOEX
+ { cbSize DWORD }
+ { rcMonitor RECT }
+ { rcWork RECT }
+ { dwFlags DWORD }
+ { szDevice { TCHAR CCHDEVICENAME } } ;
TYPEDEF: MONITORINFOEX* LPMONITORINFOEX
TYPEDEF: MONITORINFOEX* LPMONITORINFO
! FUNCTION: GetScrollRange
! FUNCTION: GetShellWindow
! FUNCTION: GetSubMenu
-! FUNCTION: GetSysColor
+FUNCTION: COLORREF GetSysColor ( int nIndex ) ;
FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ;
! FUNCTION: GetSystemMetrics
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax alien.destructors ;
+USING: alien.c-types alien.syntax alien.destructors classes.struct
+windows.types ;
IN: windows.usp10
LIBRARY: usp10
-C-STRUCT: SCRIPT_CONTROL
- { "DWORD" "flags" } ;
+STRUCT: SCRIPT_CONTROL
+ { flags DWORD } ;
-C-STRUCT: SCRIPT_STATE
- { "WORD" "flags" } ;
+STRUCT: SCRIPT_STATE
+ { flags WORD } ;
-C-STRUCT: SCRIPT_ANALYSIS
- { "WORD" "flags" }
- { "SCRIPT_STATE" "s" } ;
+STRUCT: SCRIPT_ANALYSIS
+ { flags WORD }
+ { s SCRIPT_STATE } ;
-C-STRUCT: SCRIPT_ITEM
- { "int" "iCharPos" }
- { "SCRIPT_ANALYSIS" "a" } ;
+STRUCT: SCRIPT_ITEM
+ { iCharPos int }
+ { a SCRIPT_ANALYSIS } ;
FUNCTION: HRESULT ScriptItemize (
WCHAR* pwcInChars,
SCRIPT_JUSTIFY_SEEN
SCRIPT_JUSTIFFY_RESERVED4 ;
-C-STRUCT: SCRIPT_VISATTR
- { "WORD" "flags" } ;
+STRUCT: SCRIPT_VISATTR
+ { flags WORD } ;
+
+TYPEDEF: void* SCRIPT_CACHE*
+C-TYPE: ABC
FUNCTION: HRESULT ScriptShape (
HDC hdc,
int* pcGlyphs
) ;
-C-STRUCT: GOFFSET
- { "LONG" "du" }
- { "LONG" "dv" } ;
+STRUCT: GOFFSET
+ { du LONG }
+ { dv LONG } ;
FUNCTION: HRESULT ScriptPlace (
HDC hdc,
int* piJustify
) ;
-C-STRUCT: SCRIPT_LOGATTR
- { "BYTE" "flags" } ;
+STRUCT: SCRIPT_LOGATTR
+ { flags BYTE } ;
FUNCTION: HRESULT ScriptBreak (
WCHAR* pwcChars,
ABC* pABC
) ;
-C-STRUCT: SCRIPT_PROPERTIES
- { "DWORD" "flags" } ;
+STRUCT: SCRIPT_PROPERTIES
+ { flags DWORD } ;
FUNCTION: HRESULT ScriptGetProperties (
SCRIPT_PROPERTIES*** ppSp,
int* piNumScripts
) ;
-C-STRUCT: SCRIPT_FONTPROPERTIES
- { "int" "cBytes" }
- { "WORD" "wgBlank" }
- { "WORD" "wgDefault" }
- { "WORD" "wgInvalid" }
- { "WORD" "wgKashida" }
- { "int" "iKashidaWidth" } ;
+STRUCT: SCRIPT_FONTPROPERTIES
+ { cBytes int }
+ { wgBlank WORD }
+ { wgDefault WORD }
+ { wgInvalid WORD }
+ { wgKashida WORD }
+ { iKashidaWidth int } ;
FUNCTION: HRESULT ScriptGetFontProperties (
HDC hdc,
CONSTANT: SSA_DONTGLYPH HEX: 40000000
CONSTANT: SSA_NOKASHIDA HEX: 80000000
-C-STRUCT: SCRIPT_TABDEF
- { "int" "cTabStops" }
- { "int" "iScale" }
- { "int*" "pTabStops" }
- { "int" "iTabOrigin" } ;
+STRUCT: SCRIPT_TABDEF
+ { cTabStops int }
+ { iScale int }
+ { pTabStops int* }
+ { iTabOrigin int } ;
TYPEDEF: void* SCRIPT_STRING_ANALYSIS
DWORD dwFlags
) ;
-C-STRUCT: SCRIPT_DIGITSUBSTITUTE
- { "DWORD" "flags" } ;
+STRUCT: SCRIPT_DIGITSUBSTITUTE
+ { flags DWORD } ;
FUNCTION: HRESULT ScriptRecordDigitSubstitution (
LCID Locale,
SCRIPT_DIGITSUBSTITUTE* psds,
SCRIPT_CONTROL* psc,
SCRIPT_STATE* pss
-) ;
\ No newline at end of file
+) ;
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings alien.syntax arrays
-byte-arrays kernel math sequences windows.types windows.kernel32
-windows.errors math.bitwise io.encodings.utf16n ;
+byte-arrays kernel literals math sequences windows.types
+windows.kernel32 windows.errors math.bitwise io.encodings.utf16n
+classes.struct windows.com.syntax init ;
+FROM: alien.c-types => short ;
IN: windows.winsock
-USE: libc
-: alien>byte-array ( alien str -- byte-array )
- heap-size dup <byte-array> [ -rot memcpy ] keep ;
-
TYPEDEF: void* SOCKET
: <wsadata> ( -- byte-array )
CONSTANT: AI_PASSIVE 1
CONSTANT: AI_CANONNAME 2
CONSTANT: AI_NUMERICHOST 4
-: AI_MASK ( -- n ) { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ;
+
+: AI_MASK ( -- n )
+ { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ; inline
CONSTANT: NI_NUMERICHOST 1
CONSTANT: NI_NUMERICSERV 2
CONSTANT: INADDR_ANY 0
-: INVALID_SOCKET ( -- alien ) -1 <alien> ; inline
+: INVALID_SOCKET ( -- n ) -1 <alien> ; inline
+
CONSTANT: SOCKET_ERROR -1
CONSTANT: SD_RECV 0
CONSTANT: SOL_SOCKET HEX: ffff
-! TYPEDEF: uint in_addr_t
-! C-STRUCT: in_addr
- ! { "in_addr_t" "s_addr" } ;
-
-C-STRUCT: sockaddr-in
- { "short" "family" }
- { "ushort" "port" }
- { "uint" "addr" }
- { { "char" 8 } "pad" } ;
-
-C-STRUCT: sockaddr-in6
- { "uchar" "family" }
- { "ushort" "port" }
- { "uint" "flowinfo" }
- { { "uchar" 16 } "addr" }
- { "uint" "scopeid" } ;
-
-C-STRUCT: hostent
- { "char*" "name" }
- { "void*" "aliases" }
- { "short" "addrtype" }
- { "short" "length" }
- { "void*" "addr-list" } ;
-
-C-STRUCT: addrinfo
- { "int" "flags" }
- { "int" "family" }
- { "int" "socktype" }
- { "int" "protocol" }
- { "size_t" "addrlen" }
- { "char*" "canonname" }
- { "sockaddr*" "addr" }
- { "addrinfo*" "next" } ;
-
-C-STRUCT: timeval
- { "long" "sec" }
- { "long" "usec" } ;
-
-: hostent-addr ( hostent -- addr ) hostent-addr-list *void* ; ! *uint ;
+C-TYPE: sockaddr
+
+STRUCT: sockaddr-in
+ { family short }
+ { port ushort }
+ { addr uint }
+ { pad char[8] } ;
+
+STRUCT: sockaddr-in6
+ { family uchar }
+ { port ushort }
+ { flowinfo uint }
+ { addr uchar[16] }
+ { scopeid uint } ;
+
+STRUCT: hostent
+ { name char* }
+ { aliases void* }
+ { addrtype short }
+ { length short }
+ { addr-list void* } ;
+
+STRUCT: addrinfo
+ { flags int }
+ { family int }
+ { socktype int }
+ { protocol int }
+ { addrlen size_t }
+ { canonname char* }
+ { addr sockaddr* }
+ { next addrinfo* } ;
+
+STRUCT: timeval
+ { sec long }
+ { usec long } ;
+
+TYPEDEF: void* fd_set*
LIBRARY: winsock
-
FUNCTION: int setsockopt ( SOCKET s, int level, int optname, char* optval, int optlen ) ;
FUNCTION: ushort htons ( ushort n ) ;
FUNCTION: ushort ntohs ( ushort n ) ;
-FUNCTION: int bind ( void* socket, sockaddr_in* sockaddr, int len ) ;
+FUNCTION: int bind ( void* socket, sockaddr-in* sockaddr, int len ) ;
FUNCTION: int listen ( void* socket, int backlog ) ;
FUNCTION: char* inet_ntoa ( int in-addr ) ;
FUNCTION: int getaddrinfo ( char* nodename,
FUNCTION: hostent* gethostbyname ( char* name ) ;
FUNCTION: int gethostname ( char* name, int len ) ;
-FUNCTION: int connect ( void* socket, sockaddr_in* sockaddr, int addrlen ) ;
+FUNCTION: int connect ( void* socket, sockaddr-in* sockaddr, int addrlen ) ;
FUNCTION: int select ( int nfds, fd_set* readfds, fd_set* writefds, fd_set* exceptfds, timeval* timeout ) ;
FUNCTION: int closesocket ( SOCKET s ) ;
FUNCTION: int shutdown ( SOCKET s, int how ) ;
FUNCTION: int send ( SOCKET s, char* buf, int len, int flags ) ;
FUNCTION: int recv ( SOCKET s, char* buf, int len, int flags ) ;
-FUNCTION: int getsockname ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
-FUNCTION: int getpeername ( SOCKET s, sockaddr_in* address, int* addrlen ) ;
+FUNCTION: int getsockname ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
+FUNCTION: int getpeername ( SOCKET s, sockaddr-in* address, int* addrlen ) ;
TYPEDEF: uint SERVICETYPE
TYPEDEF: OVERLAPPED WSAOVERLAPPED
TYPEDEF: LPHANDLE LPWSAEVENT
TYPEDEF: sockaddr* LPSOCKADDR
-C-STRUCT: FLOWSPEC
- { "uint" "TokenRate" }
- { "uint" "TokenBucketSize" }
- { "uint" "PeakBandwidth" }
- { "uint" "Latency" }
- { "uint" "DelayVariation" }
- { "SERVICETYPE" "ServiceType" }
- { "uint" "MaxSduSize" }
- { "uint" "MinimumPolicedSize" } ;
+STRUCT: FLOWSPEC
+ { TokenRate uint }
+ { TokenBucketSize uint }
+ { PeakBandwidth uint }
+ { Latency uint }
+ { DelayVariation uint }
+ { ServiceType SERVICETYPE }
+ { MaxSduSize uint }
+ { MinimumPolicedSize uint } ;
TYPEDEF: FLOWSPEC* PFLOWSPEC
TYPEDEF: FLOWSPEC* LPFLOWSPEC
-C-STRUCT: WSABUF
- { "ulong" "len" }
- { "void*" "buf" } ;
+STRUCT: WSABUF
+ { len ulong }
+ { buf void* } ;
TYPEDEF: WSABUF* LPWSABUF
-C-STRUCT: QOS
- { "FLOWSPEC" "SendingFlowspec" }
- { "FLOWSPEC" "ReceivingFlowspec" }
- { "WSABUF" "ProviderSpecific" } ;
+STRUCT: QOS
+ { SendingFlowspec FLOWSPEC }
+ { ReceivingFlowspec FLOWSPEC }
+ { ProviderSpecific WSABUF } ;
TYPEDEF: QOS* LPQOS
CONSTANT: MAX_PROTOCOL_CHAIN 7
-C-STRUCT: WSAPROTOCOLCHAIN
- { "int" "ChainLen" }
- ! { { "DWORD" MAX_PROTOCOL_CHAIN } "ChainEntries" } ;
- { { "DWORD" 7 } "ChainEntries" } ;
+STRUCT: WSAPROTOCOLCHAIN
+ { ChainLen int }
+ { ChainEntries { DWORD 7 } } ;
+ ! { ChainEntries { DWORD MAX_PROTOCOL_CHAIN } } ;
TYPEDEF: WSAPROTOCOLCHAIN* LPWSAPROTOCOLCHAIN
CONSTANT: WSAPROTOCOL_LEN 255
-C-STRUCT: WSAPROTOCOL_INFOW
- { "DWORD" "dwServiceFlags1" }
- { "DWORD" "dwServiceFlags2" }
- { "DWORD" "dwServiceFlags3" }
- { "DWORD" "dwServiceFlags4" }
- { "DWORD" "dwProviderFlags" }
- { "GUID" "ProviderId" }
- { "DWORD" "dwCatalogEntryId" }
- { "WSAPROTOCOLCHAIN" "ProtocolChain" }
- { "int" "iVersion" }
- { "int" "iAddressFamily" }
- { "int" "iMaxSockAddr" }
- { "int" "iMinSockAddr" }
- { "int" "iSocketType" }
- { "int" "iProtocol" }
- { "int" "iProtocolMaxOffset" }
- { "int" "iNetworkByteOrder" }
- { "int" "iSecurityScheme" }
- { "DWORD" "dwMessageSize" }
- { "DWORD" "dwProviderReserved" }
- { { "WCHAR" 256 } "szProtocol" } ;
- ! { { "WCHAR" 256 } "szProtocol"[WSAPROTOCOL_LEN+1] } ;
+STRUCT: WSAPROTOCOL_INFOW
+ { dwServiceFlags1 DWORD }
+ { dwServiceFlags2 DWORD }
+ { dwServiceFlags3 DWORD }
+ { dwServiceFlags4 DWORD }
+ { dwProviderFlags DWORD }
+ { ProviderId GUID }
+ { dwCatalogEntryId DWORD }
+ { ProtocolChain WSAPROTOCOLCHAIN }
+ { iVersion int }
+ { iAddressFamily int }
+ { iMaxSockAddr int }
+ { iMinSockAddr int }
+ { iSocketType int }
+ { iProtocol int }
+ { iProtocolMaxOffset int }
+ { iNetworkByteOrder int }
+ { iSecurityScheme int }
+ { dwMessageSize DWORD }
+ { dwProviderReserved DWORD }
+ { szProtocol { WCHAR 256 } } ;
+ ! { szProtocol[WSAPROTOCOL_LEN+1] { WCHAR 256 } } ;
TYPEDEF: WSAPROTOCOL_INFOW* PWSAPROTOCOL_INFOW
TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFOW
TYPEDEF: WSAPROTOCOL_INFOW WSAPROTOCOL_INFO
TYPEDEF: WSAPROTOCOL_INFOW* LPWSAPROTOCOL_INFO
-C-STRUCT: WSANAMESPACE_INFOW
- { "GUID" "NSProviderId" }
- { "DWORD" "dwNameSpace" }
- { "BOOL" "fActive" }
- { "DWORD" "dwVersion" }
- { "LPWSTR" "lpszIdentifier" } ;
+STRUCT: WSANAMESPACE_INFOW
+ { NSProviderId GUID }
+ { dwNameSpace DWORD }
+ { fActive BOOL }
+ { dwVersion DWORD }
+ { lpszIdentifier LPWSTR } ;
TYPEDEF: WSANAMESPACE_INFOW* PWSANAMESPACE_INFOW
TYPEDEF: WSANAMESPACE_INFOW* LPWSANAMESPACE_INFOW
TYPEDEF: WSANAMESPACE_INFOW WSANAMESPACE_INFO
CONSTANT: FD_MAX_EVENTS 10
-C-STRUCT: WSANETWORKEVENTS
- { "long" "lNetworkEvents" }
- { { "int" FD_MAX_EVENTS } "iErrorCode" } ;
+STRUCT: WSANETWORKEVENTS
+ { lNetworkEvents long }
+ { iErrorCode { int FD_MAX_EVENTS } } ;
TYPEDEF: WSANETWORKEVENTS* PWSANETWORKEVENTS
TYPEDEF: WSANETWORKEVENTS* LPWSANETWORKEVENTS
-! C-STRUCT: WSAOVERLAPPED
- ! { "DWORD" "Internal" }
- ! { "DWORD" "InternalHigh" }
- ! { "DWORD" "Offset" }
- ! { "DWORD" "OffsetHigh" }
- ! { "WSAEVENT" "hEvent" }
- ! { "DWORD" "bytesTransferred" } ;
+! STRUCT: WSAOVERLAPPED
+ ! { Internal DWORD }
+ ! { InternalHigh DWORD }
+ ! { Offset DWORD }
+ ! { OffsetHigh DWORD }
+ ! { hEvent WSAEVENT }
+ ! { bytesTransferred DWORD } ;
! TYPEDEF: WSAOVERLAPPED* LPWSAOVERLAPPED
FUNCTION: SOCKET WSAAccept ( SOCKET s,
BOOL fAlertable ) ;
-
-
LIBRARY: mswsock
! Not in Windows CE
FUNCTION: int AcceptEx ( void* listen, void* accept, void* out-buf, int recv-len, int addr-len, int remote-len, void* out-len, void* overlapped ) ;
-FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, void* f, void* g, void* h ) ;
+
+FUNCTION: void GetAcceptExSockaddrs (
+ PVOID lpOutputBuffer,
+ DWORD dwReceiveDataLength,
+ DWORD dwLocalAddressLength,
+ DWORD dwRemoteAddressLength,
+ LPSOCKADDR* LocalSockaddr,
+ LPINT LocalSockaddrLength,
+ LPSOCKADDR* RemoteSockaddr,
+ LPINT RemoteSockaddrLength
+) ;
CONSTANT: SIO_GET_EXTENSION_FUNCTION_POINTER -939524090
-: WSAID_CONNECTEX ( -- GUID )
- "GUID" <c-object>
- HEX: 25a207b9 over set-GUID-Data1
- HEX: ddf3 over set-GUID-Data2
- HEX: 4660 over set-GUID-Data3
- B{
- HEX: 8e HEX: e9 HEX: 76 HEX: e5
- HEX: 8c HEX: 74 HEX: 06 HEX: 3e
- } over set-GUID-Data4 ;
+CONSTANT: WSAID_CONNECTEX GUID: {25a207b9-ddf3-4660-8ee9-76e58c74063e}
: winsock-expected-error? ( n -- ? )
- ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING 3array member? ;
+ ${ ERROR_IO_PENDING ERROR_SUCCESS WSA_IO_PENDING } member? ;
: (winsock-error-string) ( n -- str )
! #! WSAStartup returns the error code 'n' directly
: init-winsock ( -- )
HEX: 0202 <wsadata> WSAStartup winsock-return-check ;
+
+[ init-winsock ] "windows.winsock" add-init-hook
ARTICLE: "wrap.strings" "String word wrapping"
"The " { $vocab-link "wrap.strings" } " vocabulary implements word wrapping for simple strings, assumed to be in monospace font."
-{ $subsection wrap-lines }
-{ $subsection wrap-string }
-{ $subsection wrap-indented-string } ;
+{ $subsections
+ wrap-lines
+ wrap-string
+ wrap-indented-string
+} ;
HELP: wrap-lines
{ $values { "lines" string } { "width" integer } { "newlines" "sequence of strings" } }
! Copyright (C) 2008, 2009 Daniel Ehrenberg, Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: wrap.strings tools.test multiline ;
+USING: wrap.strings tools.test ;
IN: wrap.strings.tests
[
- <" This is a
+ """This is a
long piece
of text
that we
wish to
-word wrap.">
+word wrap."""
] [
- <" This is a long piece of text that we wish to word wrap."> 10
+ """This is a long piece of text that we wish to word wrap.""" 10
wrap-string
] unit-test
[
- <" This is a
+ """ This is a
long piece
of text
that we
wish to
- word wrap.">
+ word wrap."""
] [
- <" This is a long piece of text that we wish to word wrap."> 12
+ """This is a long piece of text that we wish to word wrap.""" 12
" " wrap-indented-string
] unit-test
ARTICLE: "wrap.words" "Word object wrapping"
"The " { $vocab-link "wrap.words" } " vocabulary implements word wrapping on abstract word objects, which have certain properties making it a more suitable input representation than strings."
-{ $subsection wrap-words }
-{ $subsection word }
-{ $subsection <word> } ;
+{ $subsections
+ wrap-words
+ word
+ <word>
+} ;
HELP: wrap-words
{ $values { "words" { "a sequence of " { $instance word } "s" } } { "line-max" integer } { "line-ideal" integer } { "lines" "a sequence of sequences of words" } }
! Copyright (C) 2006, 2007 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax arrays
-kernel math namespaces sequences io.encodings.string
-io.encodings.utf8 io.encodings.ascii x11 x11.xlib x11.constants
-specialized-arrays.int accessors ;
+USING: accessors alien.c-types alien.strings classes.struct
+io.encodings.utf8 kernel namespaces sequences
+specialized-arrays x11 x11.constants x11.xlib ;
+SPECIALIZED-ARRAY: int
IN: x11.clipboard
! This code was based on by McCLIM's Backends/CLX/port.lisp
[ XGetWindowProperty drop ] keep snarf-property ;
: selection-from-event ( event window -- string )
- swap XSelectionEvent-property zero? [
- drop f
- ] [
- selection-property 1 window-property
- ] if ;
+ swap property>> 0 =
+ [ drop f ] [ selection-property 1 window-property ] if ;
: own-selection ( prop win -- )
[ dpy get ] 2dip CurrentTime XSetSelectionOwner drop
flush-dpy ;
: set-targets-prop ( evt -- )
- dpy get swap
- [ XSelectionRequestEvent-requestor ] keep
- XSelectionRequestEvent-property
+ [ dpy get ] dip [ requestor>> ] [ property>> ] bi
"TARGETS" x-atom 32 PropModeReplace
{
"UTF8_STRING" "STRING" "TARGETS" "TIMESTAMP"
4 XChangeProperty drop ;
: set-timestamp-prop ( evt -- )
- dpy get swap
- [ XSelectionRequestEvent-requestor ] keep
- [ XSelectionRequestEvent-property ] keep
- [ "TIMESTAMP" x-atom 32 PropModeReplace ] dip
- XSelectionRequestEvent-time <int>
+ [ dpy get ] dip
+ [ requestor>> ]
+ [ property>> "TIMESTAMP" x-atom 32 PropModeReplace ]
+ [ time>> <int> ] tri
1 XChangeProperty drop ;
: send-notify ( evt prop -- )
- "XSelectionEvent" <c-object>
- SelectionNotify over set-XSelectionEvent-type
- [ set-XSelectionEvent-property ] keep
- over XSelectionRequestEvent-display over set-XSelectionEvent-display
- over XSelectionRequestEvent-requestor over set-XSelectionEvent-requestor
- over XSelectionRequestEvent-selection over set-XSelectionEvent-selection
- over XSelectionRequestEvent-target over set-XSelectionEvent-target
- over XSelectionRequestEvent-time over set-XSelectionEvent-time
- [ dpy get swap XSelectionRequestEvent-requestor 0 0 ] dip
+ XSelectionEvent <struct>
+ SelectionNotify >>type
+ swap >>property
+ over display>> >>display
+ over requestor>> >>requestor
+ over selection>> >>selection
+ over target>> >>target
+ over time>> >>time
+ [ [ dpy get ] dip requestor>> 0 0 ] dip
XSendEvent drop
flush-dpy ;
: send-notify-success ( evt -- )
- dup XSelectionRequestEvent-property send-notify ;
+ dup property>> send-notify ;
: send-notify-failure ( evt -- )
0 send-notify ;
! Based on X.h
-USING: alien alien.syntax math x11.xlib ;
+USING: alien alien.c-types alien.syntax math x11.xlib ;
IN: x11.constants
TYPEDEF: ulong Mask
! * EXTENDED WINDOW MANAGER HINTS
! *****************************************************************
-C-ENUM: _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;
\ No newline at end of file
+C-ENUM: _NET_WM_STATE_REMOVE _NET_WM_STATE_ADD _NET_WM_STATE_TOGGLE ;
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays hashtables io kernel math
-math.order namespaces prettyprint sequences strings combinators
-x11 x11.xlib ;
+USING: accessors arrays classes.struct combinators kernel
+math.order namespaces x11 x11.xlib ;
IN: x11.events
GENERIC: expose-event ( event window -- )
GENERIC: client-event ( event window -- )
: next-event ( -- event )
- dpy get "XEvent" <c-object> [ XNextEvent drop ] keep ;
+ dpy get XEvent <struct> [ XNextEvent drop ] keep ;
: mask-event ( mask -- event )
- [ dpy get ] dip "XEvent" <c-object> [ XMaskEvent drop ] keep ;
+ [ dpy get ] dip XEvent <struct> [ XMaskEvent drop ] keep ;
: events-queued ( mode -- n ) [ dpy get ] dip XEventsQueued ;
-: wheel? ( event -- ? ) XButtonEvent-button 4 7 between? ;
+: wheel? ( event -- ? ) button>> 4 7 between? ;
: button-down-event$ ( event window -- )
over wheel? [ wheel-event ] [ button-down-event ] if ;
over wheel? [ 2drop ] [ button-up-event ] if ;
: handle-event ( event window -- )
- over XAnyEvent-type {
- { Expose [ expose-event ] }
- { ConfigureNotify [ configure-event ] }
- { ButtonPress [ button-down-event$ ] }
- { ButtonRelease [ button-up-event$ ] }
- { EnterNotify [ enter-event ] }
- { LeaveNotify [ leave-event ] }
- { MotionNotify [ motion-event ] }
- { KeyPress [ key-down-event ] }
- { KeyRelease [ key-up-event ] }
- { FocusIn [ focus-in-event ] }
- { FocusOut [ focus-out-event ] }
- { SelectionNotify [ selection-notify-event ] }
- { SelectionRequest [ selection-request-event ] }
- { ClientMessage [ client-event ] }
+ swap dup XAnyEvent>> type>> {
+ { Expose [ XExposeEvent>> swap expose-event ] }
+ { ConfigureNotify [ XConfigureEvent>> swap configure-event ] }
+ { ButtonPress [ XButtonEvent>> swap button-down-event$ ] }
+ { ButtonRelease [ XButtonEvent>> swap button-up-event$ ] }
+ { EnterNotify [ XCrossingEvent>> swap enter-event ] }
+ { LeaveNotify [ XCrossingEvent>> swap leave-event ] }
+ { MotionNotify [ XMotionEvent>> swap motion-event ] }
+ { KeyPress [ XKeyEvent>> swap key-down-event ] }
+ { KeyRelease [ XKeyEvent>> swap key-up-event ] }
+ { FocusIn [ XFocusChangeEvent>> swap focus-in-event ] }
+ { FocusOut [ XFocusChangeEvent>> swap focus-out-event ] }
+ { SelectionNotify [ XSelectionEvent>> swap selection-notify-event ] }
+ { SelectionRequest [ XSelectionRequestEvent>> swap selection-request-event ] }
+ { ClientMessage [ XClientMessageEvent>> swap client-event ] }
[ 3drop ]
} case ;
-: configured-loc ( event -- dim )
- [ XConfigureEvent-x ] [ XConfigureEvent-y ] bi 2array ;
+: event-loc ( event -- loc )
+ [ x>> ] [ y>> ] bi 2array ;
-: configured-dim ( event -- dim )
- [ XConfigureEvent-width ] [ XConfigureEvent-height ] bi 2array ;
-
-: mouse-event-loc ( event -- loc )
- [ XButtonEvent-x ] [ XButtonEvent-y ] bi 2array ;
+: event-dim ( event -- dim )
+ [ width>> ] [ height>> ] bi 2array ;
: close-box? ( event -- ? )
- [ XClientMessageEvent-message_type "WM_PROTOCOLS" x-atom = ]
- [ XClientMessageEvent-data0 "WM_DELETE_WINDOW" x-atom = ]
+ [ message_type>> "WM_PROTOCOLS" x-atom = ]
+ [ data0>> "WM_DELETE_WINDOW" x-atom = ]
bi and ;
!
! based on glx.h from xfree86, and some of glxtokens.h
USING: alien alien.c-types alien.syntax x11 x11.xlib x11.syntax
-namespaces make kernel sequences parser words specialized-arrays.int
-accessors ;
+namespaces make kernel sequences parser words
+specialized-arrays accessors ;
+SPECIALIZED-ARRAY: int
IN: x11.glx
LIBRARY: glx
! Copyright (C) 2005, 2006 Eduardo Cavazos and Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types hashtables kernel math math.vectors
-math.bitwise namespaces sequences x11 x11.xlib x11.constants x11.glx
-arrays fry ;
+USING: accessors kernel math math.bitwise math.vectors
+namespaces sequences x11 x11.xlib x11.constants x11.glx arrays
+fry classes.struct ;
IN: x11.windows
: create-window-mask ( -- n )
{ CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
: create-colormap ( visinfo -- colormap )
- [ dpy get root get ] dip XVisualInfo-visual AllocNone
+ [ dpy get root get ] dip visual>> AllocNone
XCreateColormap ;
: event-mask ( -- n )
} flags ;
: window-attributes ( visinfo -- attributes )
- "XSetWindowAttributes" <c-object>
- 0 over set-XSetWindowAttributes-background_pixel
- 0 over set-XSetWindowAttributes-border_pixel
- [ [ create-colormap ] dip set-XSetWindowAttributes-colormap ] keep
- event-mask over set-XSetWindowAttributes-event_mask ;
+ XSetWindowAttributes <struct>
+ 0 >>background_pixel
+ 0 >>border_pixel
+ event-mask >>event_mask
+ swap create-colormap >>colormap ;
: set-size-hints ( window -- )
- "XSizeHints" <c-object>
- USPosition over set-XSizeHints-flags
+ XSizeHints <struct>
+ USPosition >>flags
[ dpy get ] 2dip XSetWMNormalHints ;
: auto-position ( window loc -- )
: create-window ( loc dim visinfo -- window )
pick [
[ [ [ dpy get root get ] dip >xy ] dip { 1 1 } vmax >xy 0 ] dip
- [ XVisualInfo-depth InputOutput ] keep
- [ XVisualInfo-visual create-window-mask ] keep
+ [ depth>> InputOutput ] keep
+ [ visual>> create-window-mask ] keep
window-attributes XCreateWindow
dup
] dip auto-position ;
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings arrays byte-arrays
hashtables io io.encodings.string kernel math namespaces
-sequences strings continuations x11 x11.xlib specialized-arrays.uint
-accessors io.encodings.utf16n ;
+sequences strings continuations x11 x11.xlib
+specialized-arrays accessors io.encodings.utf16n ;
+SPECIALIZED-ARRAY: uint
IN: x11.xim
SYMBOL: xim
! add to this library and are wondering what part of the file to
! modify, just find the function or data structure in the manual
! and note the section.
-
-USING: kernel arrays alien alien.c-types alien.strings
-alien.syntax math math.bitwise words sequences namespaces
-continuations io io.encodings.ascii x11.syntax ;
+USING: accessors kernel arrays alien alien.c-types alien.data
+alien.strings alien.syntax classes.struct math math.bitwise words
+sequences namespaces continuations io io.encodings.ascii x11.syntax ;
+FROM: alien.c-types => short ;
IN: x11.xlib
LIBRARY: xlib
TYPEDEF: ulong Atom
TYPEDEF: char* XPointer
-TYPEDEF: void* Screen*
+C-TYPE: Screen
TYPEDEF: void* GC
-TYPEDEF: void* Visual*
-TYPEDEF: void* XExtData*
-TYPEDEF: void* XFontProp*
-TYPEDEF: void* XComposeStatus*
+C-TYPE: Visual
+C-TYPE: XExtData
+C-TYPE: XFontProp
+C-TYPE: XComposeStatus
TYPEDEF: void* XIM
TYPEDEF: void* XIC
TYPEDEF: ulong VisualID
TYPEDEF: ulong Time
-TYPEDEF: void* Window**
-TYPEDEF: void* Atom**
-
ALIAS: <XID> <ulong>
ALIAS: <Window> <XID>
ALIAS: <Drawable> <XID>
!
! This struct is incomplete
-C-STRUCT: Display
-{ "void*" "ext_data" }
-{ "void*" "free_funcs" }
-{ "int" "fd" } ;
+STRUCT: Display
+{ ext_data void* }
+{ free_funcs void* }
+{ fd int } ;
X-FUNCTION: Display* XOpenDisplay ( void* display_name ) ;
: CWColormap ( -- n ) 13 2^ ; inline
: CWCursor ( -- n ) 14 2^ ; inline
-C-STRUCT: XSetWindowAttributes
- { "Pixmap" "background_pixmap" }
- { "ulong" "background_pixel" }
- { "Pixmap" "border_pixmap" }
- { "ulong" "border_pixel" }
- { "int" "bit_gravity" }
- { "int" "win_gravity" }
- { "int" "backing_store" }
- { "ulong" "backing_planes" }
- { "ulong" "backing_pixel" }
- { "Bool" "save_under" }
- { "long" "event_mask" }
- { "long" "do_not_propagate_mask" }
- { "Bool" "override_redirect" }
- { "Colormap" "colormap" }
- { "Cursor" "cursor" } ;
+STRUCT: XSetWindowAttributes
+{ background_pixmap Pixmap }
+{ background_pixel ulong }
+{ border_pixmap Pixmap }
+{ border_pixel ulong }
+{ bit_gravity int }
+{ win_gravity int }
+{ backing_store int }
+{ backing_planes ulong }
+{ backing_pixel ulong }
+{ save_under Bool }
+{ event_mask long }
+{ do_not_propagate_mask long }
+{ override_redirect Bool }
+{ colormap Colormap }
+{ cursor Cursor } ;
CONSTANT: UnmapGravity 0
: CWSibling ( -- n ) 5 2^ ; inline
: CWStackMode ( -- n ) 6 2^ ; inline
-C-STRUCT: XWindowChanges
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "border_width" }
- { "Window" "sibling" }
- { "int" "stack_mode" } ;
+STRUCT: XWindowChanges
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ border_width int }
+{ sibling Window }
+{ stack_mode int } ;
X-FUNCTION: Status XConfigureWindow ( Display* display, Window w, uint value_mask, XWindowChanges* values ) ;
X-FUNCTION: Status XMoveWindow ( Display* display, Window w, int x, int y ) ;
Window* parent_return,
Window** children_return, uint* nchildren_return ) ;
-C-STRUCT: XWindowAttributes
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" " height" }
- { "int" "border_width" }
- { "int" "depth" }
- { "Visual*" "visual" }
- { "Window" "root" }
- { "int" "class" }
- { "int" "bit_gravity" }
- { "int" "win_gravity" }
- { "int" "backing_store" }
- { "ulong" "backing_planes" }
- { "ulong" "backing_pixel" }
- { "Bool" "save_under" }
- { "Colormap" "colormap" }
- { "Bool" "map_installed" }
- { "int" "map_state" }
- { "long" "all_event_masks" }
- { "long" "your_event_mask" }
- { "long" "do_not_propagate_mask" }
- { "Bool" "override_redirect" }
- { "Screen*" "screen" } ;
+STRUCT: XWindowAttributes
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ border_width int }
+{ depth int }
+{ visual Visual* }
+{ root Window }
+{ class int }
+{ bit_gravity int }
+{ win_gravity int }
+{ backing_store int }
+{ backing_planes ulong }
+{ backing_pixel ulong }
+{ save_under Bool }
+{ colormap Colormap }
+{ map_installed Bool }
+{ map_state int }
+{ all_event_masks long }
+{ your_event_mask long }
+{ do_not_propagate_mask long }
+{ override_redirect Bool }
+{ screen Screen* } ;
X-FUNCTION: Status XGetWindowAttributes ( Display* display, Window w, XWindowAttributes* attr ) ;
! 6 - Color Management Functions
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XColor
- { "ulong" "pixel" }
- { "ushort" "red" }
- { "ushort" "green" }
- { "ushort" "blue" }
- { "char" "flags" }
- { "char" "pad" } ;
+STRUCT: XColor
+{ pixel ulong }
+{ red ushort }
+{ green ushort }
+{ blue ushort }
+{ flags char }
+{ pad char } ;
X-FUNCTION: Status XLookupColor ( Display* display, Colormap colormap, char* color_name, XColor* exact_def_return, XColor* screen_def_return ) ;
X-FUNCTION: Status XAllocColor ( Display* display, Colormap colormap, XColor* screen_in_out ) ;
CONSTANT: GXnand HEX: e
CONSTANT: GXset HEX: f
-C-STRUCT: XGCValues
- { "int" "function" }
- { "ulong" "plane_mask" }
- { "ulong" "foreground" }
- { "ulong" "background" }
- { "int" "line_width" }
- { "int" "line_style" }
- { "int" "cap_style" }
- { "int" "join_style" }
- { "int" "fill_style" }
- { "int" "fill_rule" }
- { "int" "arc_mode" }
- { "Pixmap" "tile" }
- { "Pixmap" "stipple" }
- { "int" "ts_x_origin" }
- { "int" "ts_y_origin" }
- { "Font" "font" }
- { "int" "subwindow_mode" }
- { "Bool" "graphics_exposures" }
- { "int" "clip_x_origin" }
- { "int" "clip_y_origin" }
- { "Pixmap" "clip_mask" }
- { "int" "dash_offset" }
- { "char" "dashes" } ;
+STRUCT: XGCValues
+{ function int }
+{ plane_mask ulong }
+{ foreground ulong }
+{ background ulong }
+{ line_width int }
+{ line_style int }
+{ cap_style int }
+{ join_style int }
+{ fill_style int }
+{ fill_rule int }
+{ arc_mode int }
+{ tile Pixmap }
+{ stipple Pixmap }
+{ ts_x_origin int }
+{ ts_y_origin int }
+{ font Font }
+{ subwindow_mode int }
+{ graphics_exposures Bool }
+{ clip_x_origin int }
+{ clip_y_origin int }
+{ clip_mask Pixmap }
+{ dash_offset int }
+{ dashes char } ;
X-FUNCTION: GC XCreateGC ( Display* display, Window d, ulong valuemask, XGCValues* values ) ;
X-FUNCTION: int XChangeGC ( Display* display, GC gc, ulong valuemask, XGCValues* values ) ;
! 8.5 - Font Metrics
-C-STRUCT: XCharStruct
- { "short" "lbearing" }
- { "short" "rbearing" }
- { "short" "width" }
- { "short" "ascent" }
- { "short" "descent" }
- { "ushort" "attributes" } ;
+STRUCT: XCharStruct
+{ lbearing short }
+{ rbearing short }
+{ width short }
+{ ascent short }
+{ descent short }
+{ attributes ushort } ;
+
+STRUCT: XFontStruct
+{ ext_data XExtData* }
+{ fid Font }
+{ direction uint }
+{ min_char_or_byte2 uint }
+{ max_char_or_byte2 uint }
+{ min_byte1 uint }
+{ max_byte1 uint }
+{ all_chars_exist Bool }
+{ default_char uint }
+{ n_properties int }
+{ properties XFontProp* }
+{ min_bounds XCharStruct }
+{ max_bounds XCharStruct }
+{ per_char XCharStruct* }
+{ ascent int }
+{ descent int } ;
X-FUNCTION: Font XLoadFont ( Display* display, char* name ) ;
X-FUNCTION: XFontStruct* XQueryFont ( Display* display, XID font_ID ) ;
X-FUNCTION: XFontStruct* XLoadQueryFont ( Display* display, char* name ) ;
-C-STRUCT: XFontStruct
- { "XExtData*" "ext_data" }
- { "Font" "fid" }
- { "uint" "direction" }
- { "uint" "min_char_or_byte2" }
- { "uint" "max_char_or_byte2" }
- { "uint" "min_byte1" }
- { "uint" "max_byte1" }
- { "Bool" "all_chars_exist" }
- { "uint" "default_char" }
- { "int" "n_properties" }
- { "XFontProp*" "properties" }
- { "XCharStruct" "min_bounds" }
- { "XCharStruct" "max_bounds" }
- { "XCharStruct*" "per_char" }
- { "int" "ascent" }
- { "int" "descent" } ;
-
X-FUNCTION: int XTextWidth ( XFontStruct* font_struct, char* string, int count ) ;
! 8.6 - Drawing Text
CONSTANT: AllPlanes -1
-C-STRUCT: XImage-funcs
- { "void*" "create_image" }
- { "void*" "destroy_image" }
- { "void*" "get_pixel" }
- { "void*" "put_pixel" }
- { "void*" "sub_image" }
- { "void*" "add_pixel" } ;
-
-C-STRUCT: XImage
- { "int" "width" }
- { "int" "height" }
- { "int" "xoffset" }
- { "int" "format" }
- { "char*" "data" }
- { "int" "byte_order" }
- { "int" "bitmap_unit" }
- { "int" "bitmap_bit_order" }
- { "int" "bitmap_pad" }
- { "int" "depth" }
- { "int" "bytes_per_line" }
- { "int" "bits_per_pixel" }
- { "ulong" "red_mask" }
- { "ulong" "green_mask" }
- { "ulong" "blue_mask" }
- { "XPointer" "obdata" }
- { "XImage-funcs" "f" } ;
+STRUCT: XImage-funcs
+{ create_image void* }
+{ destroy_image void* }
+{ get_pixel void* }
+{ put_pixel void* }
+{ sub_image void* }
+{ add_pixel void* } ;
+
+STRUCT: XImage
+{ width int }
+{ height int }
+{ xoffset int }
+{ format int }
+{ data char* }
+{ byte_order int }
+{ bitmap_unit int }
+{ bitmap_bit_order int }
+{ bitmap_pad int }
+{ depth int }
+{ bytes_per_line int }
+{ bits_per_pixel int }
+{ red_mask ulong }
+{ green_mask ulong }
+{ blue_mask ulong }
+{ obdata XPointer }
+{ f XImage-funcs } ;
X-FUNCTION: XImage* XGetImage ( Display* display, Drawable d, int x, int y, uint width, uint height, ulong plane_mask, int format ) ;
X-FUNCTION: int XDestroyImage ( XImage* ximage ) ;
: XImage-size ( ximage -- size )
- [ XImage-height ] [ XImage-bytes_per_line ] bi * ;
+ [ height>> ] [ bytes_per_line>> ] bi * ;
: XImage-pixels ( ximage -- byte-array )
- [ XImage-data ] [ XImage-size ] bi memory>byte-array ;
+ [ data>> ] [ XImage-size ] bi memory>byte-array ;
!
! 9 - Window and Session Manager Functions
CONSTANT: MotionNotify 6
CONSTANT: EnterNotify 7
CONSTANT: LeaveNotify 8
-CONSTANT: FocusIn 9
+CONSTANT: FocusIn 9
CONSTANT: FocusOut 10
CONSTANT: KeymapNotify 11
-CONSTANT: Expose 12
-CONSTANT: GraphicsExpose 13
+CONSTANT: Expose 12
+CONSTANT: GraphicsExpose 13
CONSTANT: NoExpose 14
CONSTANT: VisibilityNotify 15
CONSTANT: CreateNotify 16
CONSTANT: UnmapNotify 18
CONSTANT: MapNotify 19
CONSTANT: MapRequest 20
-CONSTANT: ReparentNotify 21
-CONSTANT: ConfigureNotify 22
+CONSTANT: ReparentNotify 21
+CONSTANT: ConfigureNotify 22
CONSTANT: ConfigureRequest 23
CONSTANT: GravityNotify 24
CONSTANT: ResizeRequest 25
-CONSTANT: CirculateNotify 26
+CONSTANT: CirculateNotify 26
CONSTANT: CirculateRequest 27
-CONSTANT: PropertyNotify 28
-CONSTANT: SelectionClear 29
+CONSTANT: PropertyNotify 28
+CONSTANT: SelectionClear 29
CONSTANT: SelectionRequest 30
-CONSTANT: SelectionNotify 31
-CONSTANT: ColormapNotify 32
+CONSTANT: SelectionNotify 31
+CONSTANT: ColormapNotify 32
CONSTANT: ClientMessage 33
CONSTANT: MappingNotify 34
CONSTANT: LASTEvent 35
-C-STRUCT: XAnyEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" } ;
+STRUCT: XAnyEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
: Mod4Mask ( -- n ) 1 6 shift ; inline
: Mod5Mask ( -- n ) 1 7 shift ; inline
-C-STRUCT: XButtonEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Window" "root" }
- { "Window" "subwindow" }
- { "Time" "time" }
- { "int" "x" }
- { "int" "y" }
- { "int" "x_root" }
- { "int" "y_root" }
- { "uint" "state" }
- { "uint" "button" }
- { "Bool" "same_screen" } ;
+STRUCT: XButtonEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ root Window }
+{ subwindow Window }
+{ time Time }
+{ x int }
+{ y int }
+{ x_root int }
+{ y_root int }
+{ state uint }
+{ button uint }
+{ same_screen Bool } ;
TYPEDEF: XButtonEvent XButtonPressedEvent
TYPEDEF: XButtonEvent XButtonReleasedEvent
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XKeyEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Window" "root" }
- { "Window" "subwindow" }
- { "Time" "time" }
- { "int" "x" }
- { "int" "y" }
- { "int" "x_root" }
- { "int" "y_root" }
- { "uint" "state" }
- { "uint" "keycode" }
- { "Bool" "same_screen" } ;
+STRUCT: XKeyEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ root Window }
+{ subwindow Window }
+{ time Time }
+{ x int }
+{ y int }
+{ x_root int }
+{ y_root int }
+{ state uint }
+{ keycode uint }
+{ same_screen Bool } ;
TYPEDEF: XKeyEvent XKeyPressedEvent
TYPEDEF: XKeyEvent XKeyReleasedEvent
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XMotionEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Window" "root" }
- { "Window" "subwindow" }
- { "Time" "time" }
- { "int" "x" }
- { "int" "y" }
- { "int" "x_root" }
- { "int" "y_root" }
- { "uint" "state" }
- { "char" "is_hint" }
- { "Bool" "same_screen" } ;
+STRUCT: XMotionEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ root Window }
+{ subwindow Window }
+{ time Time }
+{ x int }
+{ y int }
+{ x_root int }
+{ y_root int }
+{ state uint }
+{ is_hint char }
+{ same_screen Bool } ;
TYPEDEF: XMotionEvent XPointerMovedEvent
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XCrossingEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Window" "root" }
- { "Window" "subwindow" }
- { "Time" "time" }
- { "int" "x" }
- { "int" "y" }
- { "int" "x_root" }
- { "int" "y_root" }
- { "int" "mode" }
- { "int" "detail" }
- { "Bool" "same_screen" }
- { "Bool" "focus" }
- { "uint" "state" } ;
+STRUCT: XCrossingEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ root Window }
+{ subwindow Window }
+{ time Time }
+{ x int }
+{ y int }
+{ x_root int }
+{ y_root int }
+{ mode int }
+{ detail int }
+{ same_screen Bool }
+{ focus Bool }
+{ state uint } ;
TYPEDEF: XCrossingEvent XEnterWindowEvent
TYPEDEF: XCrossingEvent XLeaveWindowEvent
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XFocusChangeEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "int" "mode" }
- { "int" "detail" } ;
+STRUCT: XFocusChangeEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ mode int }
+{ detail int } ;
TYPEDEF: XFocusChangeEvent XFocusInEvent
TYPEDEF: XFocusChangeEvent XFocusOutEvent
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XExposeEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "count" } ;
+STRUCT: XExposeEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ count int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XGraphicsExposeEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Drawable" "drawable" }
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "count" }
- { "int" "major_code" }
- { "int" "minor_code" } ;
-
-C-STRUCT: XNoExposeEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Drawable" "drawable" }
- { "int" "major_code" }
- { "int" "minor_code" } ;
+STRUCT: XGraphicsExposeEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ drawable Drawable }
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ count int }
+{ major_code int }
+{ minor_code int } ;
+
+STRUCT: XNoExposeEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ drawable Drawable }
+{ major_code int }
+{ minor_code int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XVisibilityEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "int" "state" } ;
+STRUCT: XVisibilityEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ state int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XCreateWindowEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "parent" }
- { "Window" "window" }
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "border_width" }
- { "Bool" "override_redirect" } ;
+STRUCT: XCreateWindowEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ parent Window }
+{ window Window }
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ border_width int }
+{ override_redirect Bool } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XDestroyWindowEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" } ;
+STRUCT: XDestroyWindowEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XUnmapEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" }
- { "Bool" "from_configure" } ;
+STRUCT: XUnmapEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window }
+{ from_configure Bool } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XMapEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" }
- { "Bool" "override_redirect" } ;
+STRUCT: XMapEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window }
+{ override_redirect Bool } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XMapRequestEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "parent" }
- { "Window" "window" } ;
+STRUCT: XMapRequestEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ parent Window }
+{ window Window } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XReparentEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" }
- { "Window" "parent" }
- { "int" "x" }
- { "int" "y" }
- { "Bool" "override_redirect" } ;
+STRUCT: XReparentEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window }
+{ parent Window }
+{ x int }
+{ y int }
+{ override_redirect Bool } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XConfigureEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" }
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "border_width" }
- { "Window" "above" }
- { "Bool" "override_redirect" } ;
+STRUCT: XConfigureEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window }
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ border_width int }
+{ above Window }
+{ override_redirect Bool } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XGravityEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" }
- { "int" "x" }
- { "int" "y" } ;
+STRUCT: XGravityEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window }
+{ x int }
+{ y int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XResizeRequestEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "int" "width" }
- { "int" "height" } ;
+STRUCT: XResizeRequestEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ width int }
+{ height int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XConfigureRequestEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "parent" }
- { "Window" "window" }
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "border_width" }
- { "Window" "above" }
- { "int" "detail" }
- { "ulong" "value_mask" } ;
+STRUCT: XConfigureRequestEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ parent Window }
+{ window Window }
+{ x int }
+{ y int }
+{ width int }
+{ height int }
+{ border_width int }
+{ above Window }
+{ detail int }
+{ value_mask ulong } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XCirculateEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "event" }
- { "Window" "window" }
- { "int" "place" } ;
+STRUCT: XCirculateEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ event Window }
+{ window Window }
+{ place int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XCirculateRequestEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "parent" }
- { "Window" "window" }
- { "int" "place" } ;
+STRUCT: XCirculateRequestEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ parent Window }
+{ window Window }
+{ place int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XPropertyEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Atom" "atom" }
- { "Time" "time" }
- { "int" "state" } ;
+STRUCT: XPropertyEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ atom Atom }
+{ time Time }
+{ state int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XSelectionClearEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Atom" "selection" }
- { "Time" "time" } ;
+STRUCT: XSelectionClearEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ selection Atom }
+{ time Time } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XSelectionRequestEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "owner" }
- { "Window" "requestor" }
- { "Atom" "selection" }
- { "Atom" "target" }
- { "Atom" "property" }
- { "Time" "time" } ;
+STRUCT: XSelectionRequestEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ owner Window }
+{ requestor Window }
+{ selection Atom }
+{ target Atom }
+{ property Atom }
+{ time Time } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XSelectionEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "requestor" }
- { "Atom" "selection" }
- { "Atom" "target" }
- { "Atom" "property" }
- { "Time" "time" } ;
+STRUCT: XSelectionEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ requestor Window }
+{ selection Atom }
+{ target Atom }
+{ property Atom }
+{ time Time } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XColormapEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Colormap" "colormap" }
- { "Bool" "new" }
- { "int" "state" } ;
+STRUCT: XColormapEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ colormap Colormap }
+{ new Bool }
+{ state int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XClientMessageEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "Atom" "message_type" }
- { "int" "format" }
- { "long" "data0" }
- { "long" "data1" }
- { "long" "data2" }
- { "long" "data3" }
- { "long" "data4" }
-! union {
-! char b[20];
-! short s[10];
-! long l[5];
-! } data;
-;
+STRUCT: XClientMessageEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ message_type Atom }
+{ format int }
+{ data0 long }
+{ data1 long }
+{ data2 long }
+{ data3 long }
+{ data4 long } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XMappingEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- { "int" "request" }
- { "int" "first_keycode" }
- { "int" "count" } ;
+STRUCT: XMappingEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ request int }
+{ first_keycode int }
+{ count int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XErrorEvent
- { "int" "type" }
- { "Display*" "display" }
- { "XID" "resourceid" }
- { "ulong" "serial" }
- { "uchar" "error_code" }
- { "uchar" "request_code" }
- { "uchar" "minor_code" } ;
+STRUCT: XErrorEvent
+{ type int }
+{ display Display* }
+{ resourceid XID }
+{ serial ulong }
+{ error_code uchar }
+{ request_code uchar }
+{ minor_code uchar } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-C-STRUCT: XKeymapEvent
- { "int" "type" }
- { "ulong" "serial" }
- { "Bool" "send_event" }
- { "Display*" "display" }
- { "Window" "window" }
- ! char key_vector[32];
- { "int" "pad" }
- { "int" "pad" }
- { "int" "pad" }
- { "int" "pad" }
- { "int" "pad" }
- { "int" "pad" }
- { "int" "pad" }
- { "int" "pad" } ;
-
-C-UNION: XEvent
- "int"
- "XAnyEvent"
- "XKeyEvent"
- "XButtonEvent"
- "XMotionEvent"
- "XCrossingEvent"
- "XFocusChangeEvent"
- "XExposeEvent"
- "XGraphicsExposeEvent"
- "XNoExposeEvent"
- "XVisibilityEvent"
- "XCreateWindowEvent"
- "XDestroyWindowEvent"
- "XUnmapEvent"
- "XMapEvent"
- "XMapRequestEvent"
- "XReparentEvent"
- "XConfigureEvent"
- "XGravityEvent"
- "XResizeRequestEvent"
- "XConfigureRequestEvent"
- "XCirculateEvent"
- "XCirculateRequestEvent"
- "XPropertyEvent"
- "XSelectionClearEvent"
- "XSelectionRequestEvent"
- "XSelectionEvent"
- "XColormapEvent"
- "XClientMessageEvent"
- "XMappingEvent"
- "XErrorEvent"
- "XKeymapEvent"
- { "long" 24 } ;
+STRUCT: XKeymapEvent
+{ type int }
+{ serial ulong }
+{ send_event Bool }
+{ display Display* }
+{ window Window }
+{ pad int }
+{ pad int }
+{ pad int }
+{ pad int }
+{ pad int }
+{ pad int }
+{ pad int }
+{ pad int } ;
+
+UNION-STRUCT: XEvent
+{ int int }
+{ XAnyEvent XAnyEvent }
+{ XKeyEvent XKeyEvent }
+{ XButtonEvent XButtonEvent }
+{ XMotionEvent XMotionEvent }
+{ XCrossingEvent XCrossingEvent }
+{ XFocusChangeEvent XFocusChangeEvent }
+{ XExposeEvent XExposeEvent }
+{ XGraphicsExposeEvent XGraphicsExposeEvent }
+{ XNoExposeEvent XNoExposeEvent }
+{ XVisibilityEvent XVisibilityEvent }
+{ XCreateWindowEvent XCreateWindowEvent }
+{ XDestroyWindowEvent XDestroyWindowEvent }
+{ XUnmapEvent XUnmapEvent }
+{ XMapEvent XMapEvent }
+{ XMapRequestEvent XMapRequestEvent }
+{ XReparentEvent XReparentEvent }
+{ XConfigureEvent XConfigureEvent }
+{ XGravityEvent XGravityEvent }
+{ XResizeRequestEvent XResizeRequestEvent }
+{ XConfigureRequestEvent XConfigureRequestEvent }
+{ XCirculateEvent XCirculateEvent }
+{ XCirculateRequestEvent XCirculateRequestEvent }
+{ XPropertyEvent XPropertyEvent }
+{ XSelectionClearEvent XSelectionClearEvent }
+{ XSelectionRequestEvent XSelectionRequestEvent }
+{ XSelectionEvent XSelectionEvent }
+{ XColormapEvent XColormapEvent }
+{ XClientMessageEvent XClientMessageEvent }
+{ XMappingEvent XMappingEvent }
+{ XErrorEvent XErrorEvent }
+{ XKeymapEvent XKeymapEvent }
+{ padding long[24] } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! 11 - Event Handling Functions
: PAllHints ( -- n )
{ PPosition PSize PMinSize PMaxSize PResizeInc PAspect } flags ; foldable
-C-STRUCT: XSizeHints
- { "long" "flags" }
- { "int" "x" }
- { "int" "y" }
- { "int" "width" }
- { "int" "height" }
- { "int" "min_width" }
- { "int" "min_height" }
- { "int" "max_width" }
- { "int" "max_height" }
- { "int" "width_inc" }
- { "int" "height_inc" }
- { "int" "min_aspect_x" }
- { "int" "min_aspect_y" }
- { "int" "max_aspect_x" }
- { "int" "max_aspect_y" }
- { "int" "base_width" }
- { "int" "base_height" }
- { "int" "win_gravity" } ;
+STRUCT: XSizeHints
+ { flags long }
+ { x int }
+ { y int }
+ { width int }
+ { height int }
+ { min_width int }
+ { min_height int }
+ { max_width int }
+ { max_height int }
+ { width_inc int }
+ { height_inc int }
+ { min_aspect_x int }
+ { min_aspect_y int }
+ { max_aspect_x int }
+ { max_aspect_y int }
+ { base_width int }
+ { base_height int }
+ { win_gravity int } ;
! 14.1.10. Setting and Reading the WM_PROTOCOLS Property
CONSTANT: VisualBitsPerRGBMask HEX: 100
CONSTANT: VisualAllMask HEX: 1FF
-C-STRUCT: XVisualInfo
- { "Visual*" "visual" }
- { "VisualID" "visualid" }
- { "int" "screen" }
- { "uint" "depth" }
- { "int" "class" }
- { "ulong" "red_mask" }
- { "ulong" "green_mask" }
- { "ulong" "blue_mask" }
- { "int" "colormap_size" }
- { "int" "bits_per_rgb" } ;
+STRUCT: XVisualInfo
+ { visual Visual* }
+ { visualid VisualID }
+ { screen int }
+ { depth uint }
+ { class int }
+ { red_mask ulong }
+ { green_mask ulong }
+ { blue_mask ulong }
+ { colormap_size int }
+ { bits_per_rgb int } ;
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Appendix D - Compatibility Functions
{ $description "posts an XML-RPC document to the specified URL, receives the response and parses it as XML-RPC, returning the tuple" } ;
ARTICLE: { "xml-rpc" "intro" } "XML-RPC"
- "This is the XML-RPC library. XML-RPC is used instead of SOAP because it is far simpler and easier to use for most tasks. The library was implemented by Daniel Ehrenberg."
- $nl
- "The most important words that this library implements are:"
- { $subsection send-rpc }
- { $subsection receive-rpc }
- "data types in XML-RPC"
- { $subsection base64 }
- { $subsection rpc-method }
- { $subsection rpc-response }
- { $subsection rpc-fault }
- "the constructors for these are"
- { $subsection <base64> }
- { $subsection <rpc-method> }
- { $subsection <rpc-response> }
- { $subsection <rpc-fault> }
- "other words include"
- { $subsection post-rpc } ;
+"This is the XML-RPC library. XML-RPC is used instead of SOAP because it is far simpler and easier to use for most tasks. The library was implemented by Daniel Ehrenberg."
+$nl
+"The most important words that this library implements are:"
+{ $subsections
+ send-rpc
+ receive-rpc
+}
+"data types in XML-RPC"
+{ $subsections
+ base64
+ rpc-method
+ rpc-response
+ rpc-fault
+}
+"the constructors for these are"
+{ $subsections
+ <base64>
+ <rpc-method>
+ <rpc-response>
+ <rpc-fault>
+}
+"other words include"
+{ $subsections post-rpc } ;
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel xml arrays math generic http.client
-combinators hashtables namespaces io base64 sequences strings
-calendar xml.data xml.writer xml.traversal assocs math.parser
-debugger calendar.format math.order xml.syntax ;
+USING: accessors arrays assocs base64 calendar calendar.format
+combinators debugger generic hashtables http http.client
+http.client.private io io.encodings.string io.encodings.utf8
+kernel math math.order math.parser namespaces sequences strings
+xml xml.data xml.syntax xml.traversal xml.writer ;
IN: xml-rpc
! * Sending RPC requests
] [ "Bad main tag name" server-error ] if
] if ;
+<PRIVATE
+
+: xml-post-data ( xml -- post-data )
+ xml>string utf8 encode "text/xml" <post-data> swap >>data ;
+
+: rpc-post-request ( xml url -- request )
+ [ send-rpc xml-post-data ] [ "POST" <client-request> ] bi*
+ swap >>post-data ;
+
+PRIVATE>
+
: post-rpc ( rpc url -- rpc )
! This needs to do something in the event of an error
- [ send-rpc ] dip http-post nip string>xml receive-rpc ;
+ rpc-post-request http-request nip string>xml receive-rpc ;
: invoke-method ( params method url -- response )
[ swap <rpc-method> ] dip post-rpc ;
ARTICLE: "xml.data" "XML data types"
"The " { $vocab-link "xml.data" } " vocabulary defines a simple document object model for XML. Everything is simply a tuple and can be manipulated as such."
-{ $subsection { "xml.data" "classes" } }
-{ $subsection { "xml.data" "constructors" } }
+{ $subsections
+ { "xml.data" "classes" }
+ { "xml.data" "constructors" }
+}
"Simple words for manipulating names:"
- { $subsection names-match? }
- { $subsection assure-name }
+{ $subsections
+ names-match?
+ assure-name
+}
"For high-level tools for manipulating XML, see " { $vocab-link "xml.traversal" } ;
ARTICLE: { "xml.data" "classes" } "XML data classes"
- "XML documents and chunks are made of the following classes:"
- { $subsection xml }
- { $subsection xml-chunk }
- { $subsection tag }
- { $subsection name }
- { $subsection contained-tag }
- { $subsection open-tag }
- { $subsection prolog }
- { $subsection comment }
- { $subsection instruction }
- { $subsection unescaped }
- { $subsection element-decl }
- { $subsection attlist-decl }
- { $subsection entity-decl }
- { $subsection system-id }
- { $subsection public-id }
- { $subsection doctype-decl }
- { $subsection notation-decl } ;
+"XML documents and chunks are made of the following classes:"
+{ $subsections
+ xml
+ xml-chunk
+ tag
+ name
+ contained-tag
+ open-tag
+ prolog
+ comment
+ instruction
+ unescaped
+ element-decl
+ attlist-decl
+ entity-decl
+ system-id
+ public-id
+ doctype-decl
+ notation-decl
+} ;
ARTICLE: { "xml.data" "constructors" } "XML data constructors"
- "These data types are constructed with:"
- { $subsection <xml> }
- { $subsection <xml-chunk> }
- { $subsection <tag> }
- { $subsection <name> }
- { $subsection <contained-tag> }
- { $subsection <prolog> }
- { $subsection <comment> }
- { $subsection <instruction> }
- { $subsection <unescaped> }
- { $subsection <simple-name> }
- { $subsection <element-decl> }
- { $subsection <attlist-decl> }
- { $subsection <entity-decl> }
- { $subsection <system-id> }
- { $subsection <public-id> }
- { $subsection <doctype-decl> }
- { $subsection <notation-decl> } ;
+"These data types are constructed with:"
+{ $subsections
+ <xml>
+ <xml-chunk>
+ <tag>
+ <name>
+ <contained-tag>
+ <prolog>
+ <comment>
+ <instruction>
+ <unescaped>
+ <simple-name>
+ <element-decl>
+ <attlist-decl>
+ <entity-decl>
+ <system-id>
+ <public-id>
+ <doctype-decl>
+ <notation-decl>
+} ;
HELP: tag
{ $class-description "Tuple representing an XML tag, delegating to a " { $link
ARTICLE: "xml.entities" "XML entities"
"When XML is parsed, entities like &foo; are replaced with the characters they represent. A few entities like & and < are defined by default, but more are available, and the set of entities can be customized. Below are some words involved in XML entities, defined in the vocabulary 'entities':"
- { $subsection entities }
- { $subsection with-entities }
+{ $subsections
+ entities
+ with-entities
+}
"For entities used in HTML/XHTML, see " { $vocab-link "xml.entities.html" } ;
HELP: entities
ARTICLE: "xml.entities.html" "HTML entities"
{ $vocab-link "xml.entities.html" } " defines words for using entities defined in HTML/XHTML."
-{ $subsection html-entities }
-{ $subsection with-html-entities } ;
+{ $subsections
+ html-entities
+ with-html-entities
+} ;
HELP: html-entities
{ $description "A hash table from HTML entity names to their character values." }
ARTICLE: "xml.errors" "XML parsing errors"
"The " { $vocab-link "xml.errors" } " vocabulary provides a rich and highly inspectable set of parsing errors. All XML errors are described by the union class " { $link xml-error } "."
- { $subsection multitags }
- { $subsection notags }
- { $subsection extra-attrs }
- { $subsection nonexist-ns }
- { $subsection not-yes/no }
- { $subsection unclosed }
- { $subsection mismatched }
- { $subsection expected }
- { $subsection no-entity }
- { $subsection pre/post-content }
- { $subsection unclosed-quote }
- { $subsection bad-name }
- { $subsection quoteless-attr }
- { $subsection disallowed-char }
- { $subsection missing-close }
- { $subsection unexpected-end }
- { $subsection duplicate-attr }
- { $subsection bad-cdata }
- { $subsection text-w/]]> }
- { $subsection attr-w/< }
- { $subsection misplaced-directive }
- "Additionally, most of these errors are a kind of " { $link xml-error-at } " which provides more information about where the error occurred."
- $nl
- "Note that, in parsing an XML document, only the first error is reported." ;
+{ $subsections
+ multitags
+ notags
+ extra-attrs
+ nonexist-ns
+ not-yes/no
+ unclosed
+ mismatched
+ expected
+ no-entity
+ pre/post-content
+ unclosed-quote
+ bad-name
+ quoteless-attr
+ disallowed-char
+ missing-close
+ unexpected-end
+ duplicate-attr
+ bad-cdata
+ text-w/]]>
+ attr-w/<
+ misplaced-directive
+}
+"Additionally, most of these errors are a kind of " { $link xml-error-at } " which provides more information about where the error occurred."
+$nl
+"Note that, in parsing an XML document, only the first error is reported." ;
ABOUT: "xml.errors"
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax xml.data present multiline ;
+USING: help.markup help.syntax xml.data present ;
IN: xml.syntax
ABOUT: "xml.syntax"
ARTICLE: "xml.syntax" "Syntax extensions for XML"
"The " { $link "xml.syntax" } " vocabulary defines a number of new parsing words forXML processing."
-{ $subsection { "xml.syntax" "tags" } }
-{ $subsection { "xml.syntax" "literals" } }
-{ $subsection POSTPONE: XML-NS: } ;
+{ $subsections
+ { "xml.syntax" "tags" }
+ { "xml.syntax" "literals" }
+ POSTPONE: XML-NS:
+} ;
ARTICLE: { "xml.syntax" "tags" } "Dispatch on XML tag names"
"There is a system, analogous to generic words, for processing XML. A word can dispatch off the name of the tag that is passed to it. To define such a word, use"
-{ $subsection POSTPONE: TAGS: }
+{ $subsections POSTPONE: TAGS: }
"and to define a new 'method' for this word, use"
-{ $subsection POSTPONE: TAG: } ;
+{ $subsections POSTPONE: TAG: } ;
HELP: TAGS:
{ $syntax "TAGS: word" }
ARTICLE: { "xml.syntax" "literals" } "XML literals"
"The following words provide syntax for XML literals:"
-{ $subsection POSTPONE: <XML }
-{ $subsection POSTPONE: [XML }
+{ $subsections
+ POSTPONE: <XML
+ POSTPONE: [XML
+}
"These can be used for creating an XML literal, which can be used with variables or a fry-like syntax to interpolate data into XML."
-{ $subsection { "xml.syntax" "interpolation" } } ;
+{ $subsections { "xml.syntax" "interpolation" } } ;
HELP: <XML
{ $syntax "<XML <?xml version=\"1.0\"?><document>...</document> XML>" }
$nl
"These forms can be used where a tag might go, as in " { $snippet "[XML <foo><-></foo> XML]" } " or where an attribute might go, as in " { $snippet "[XML <foo bar=<->/> XML]" } ". When an attribute is spliced in, it is not included if the value is " { $snippet "f" } " and if the value is not a string, the value is put through " { $link present } ". Here is an example of the fry style of XML interpolation:"
{ $example
-{" USING: splitting xml.writer xml.syntax ;
+"""USING: splitting xml.writer xml.syntax ;
"one two three" " " split
[ [XML <item><-></item> XML] ] map
-<XML <doc><-></doc> XML> pprint-xml"}
-{" <?xml version="1.0" encoding="UTF-8"?>
+<XML <doc><-></doc> XML> pprint-xml"""
+
+"""<?xml version="1.0" encoding="UTF-8"?>
<doc>
<item>
one
<item>
three
</item>
-</doc>"} }
+</doc>""" }
"Here is an example of the locals version:"
{ $example
-{" USING: locals urls xml.syntax xml.writer ;
+"""USING: locals urls xml.syntax xml.writer ;
[let |
number [ 3 ]
false [ f ]
url [ URL" http://factorcode.org/" ]
string [ "hello" ]
- word [ \ drop ] |
+ word [ \\ drop ] |
<XML
<x
number=<-number->
url=<-url->
string=<-string->
word=<-word-> />
- XML> pprint-xml ] "}
-{" <?xml version="1.0" encoding="UTF-8"?>
-<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} }
+ XML> pprint-xml
+]"""
+
+"""<?xml version="1.0" encoding="UTF-8"?>
+<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>""" }
"XML interpolation can also be used, in conjunction with " { $vocab-link "inverse" } " in pattern matching. For example:"
-{ $example {" USING: xml.syntax inverse ;
+{ $example """USING: xml.syntax inverse ;
: dispatch ( xml -- string )
{
{ [ [XML <a><-></a> XML] ] [ "a" prepend ] }
{ [ [XML <b val='yes'/> XML] ] [ "yes" ] }
{ [ [XML <b val=<->/> XML] ] [ "no" prepend ] }
} switch ;
-[XML <a>pple</a> XML] dispatch write "} "apple" } ;
+[XML <a>pple</a> XML] dispatch write"""
+"apple" } ;
HELP: XML-NS:
{ $syntax "XML-NS: name http://url" }
[ extract-variables ] tri
] unit-test
-[ {" <?xml version="1.0" encoding="UTF-8"?>
+[ """<?xml version="1.0" encoding="UTF-8"?>
<x>
one
<b val="two"/>
y
<foo/>
-</x>"} ] [
+</x>""" ] [
[let* | a [ "one" ] c [ "two" ] x [ "y" ]
d [ [XML <-x-> <foo/> XML] ] |
<XML
]
] unit-test
-[ {" <?xml version="1.0" encoding="UTF-8"?>
+[ """<?xml version="1.0" encoding="UTF-8"?>
<doc>
<item>
one
<item>
three
</item>
-</doc>"} ] [
+</doc>""" ] [
"one two three" " " split
[ [XML <item><-></item> XML] ] map
<XML <doc><-></doc> XML> pprint-xml>string
] unit-test
-[ {" <?xml version="1.0" encoding="UTF-8"?>
-<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>"} ]
+[ """<?xml version="1.0" encoding="UTF-8"?>
+<x number="3" url="http://factorcode.org/" string="hello" word="drop"/>""" ]
[ 3 f "http://factorcode.org/" "hello" \ drop
<XML <x number=<-> false=<-> url=<-> string=<-> word=<->/> XML>
pprint-xml>string ] unit-test
! Copyright (C) 2005, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax xml.data sequences strings multiline ;
+USING: help.markup help.syntax xml.data sequences strings ;
IN: xml.traversal
ABOUT: "xml.traversal"
ARTICLE: "xml.traversal" "Utilities for traversing XML"
"The " { $vocab-link "xml.traversal" } " vocabulary provides utilities for traversing an XML DOM tree and viewing the contents of a single tag. The following words are defined:"
- $nl
- { $subsection { "xml.traversal" "intro" } }
- { $subsection tag-named }
- { $subsection tags-named }
- { $subsection deep-tag-named }
- { $subsection deep-tags-named }
- { $subsection get-id }
- "To get at the contents of a single tag, use"
- { $subsection children>string }
- { $subsection children-tags }
- { $subsection first-child-tag }
- { $subsection assert-tag } ;
+$nl
+{ $subsections
+ { "xml.traversal" "intro" }
+ tag-named
+ tags-named
+ deep-tag-named
+ deep-tags-named
+ get-id
+}
+"To get at the contents of a single tag, use"
+{ $subsections
+ children>string
+ children-tags
+ first-child-tag
+ assert-tag
+} ;
ARTICLE: { "xml.traversal" "intro" } "An example of XML processing"
"To illustrate how to use the XML library, we develop a simple Atom parser in Factor. Atom is an XML-based syndication format, like RSS. To see the full version of what we develop here, look at " { $snippet "basis/syndication" } " at the " { $snippet "atom1.0" } " word. First, we want to load a file and get a DOM tree for it."
-{ $code <" "file.xml" file>xml "> }
+{ $code """"file.xml" file>xml""" }
"No encoding descriptor is needed, because XML files contain sufficient information to auto-detect the encoding. Next, we want to extract information from the tree. To get the title, we can use the following:"
-{ $code <" "title" tag-named children>string "> }
+{ $code """"title" tag-named children>string""" }
"The " { $link tag-named } " word finds the first tag named " { $snippet "title" } " in the top level (just under the main tag). Then, with a tag on the stack, its children are asserted to be a string, and the string is returned." $nl
"For a slightly more complicated example, we can look at how entries are parsed. To get a sequence of tags with the name " { $snippet "entry" } ":"
-{ $code <" "entry" tags-named "> }
+{ $code """"entry" tags-named""" }
"Imagine that, for each of these, we want to get the URL of the entry. In Atom, the URLs are in a " { $snippet "link" } " tag which is contained in the " { $snippet "entry" } " tag. There are multiple " { $snippet "link" } " tags, but one of them contains the attribute " { $snippet "rel=alternate" } ", and the " { $snippet "href" } " attribute has the URL. So, given an element of the sequence produced in the above quotation, we run the code:"
-{ $code <" "link" tags-named [ "rel" attr "alternate" = ] find nip "> }
+{ $code """"link" tags-named [ "rel" attr "alternate" = ] find nip """ }
"to get the link tag on the stack, and"
-{ $code <" "href" attr >url "> }
+{ $code """"href" attr >url """ }
"to extract the URL from it." ;
HELP: deep-tag-named
ABOUT: "xml.writer"
ARTICLE: "xml.writer" "Writing XML"
- "These words are used to print XML preserving whitespace in text nodes"
- { $subsection write-xml }
- { $subsection xml>string }
- "These words are used to prettyprint XML"
- { $subsection pprint-xml>string }
- { $subsection pprint-xml }
- "Certain variables can be changed to mainpulate prettyprinting"
- { $subsection sensitive-tags }
- { $subsection indenter }
- "All of these words operate on arbitrary pieces of XML: they can take, as in put, XML documents, comments, tags, strings (text nodes), XML chunks, etc." ;
+"These words are used to print XML preserving whitespace in text nodes"
+{ $subsections
+ write-xml
+ xml>string
+}
+"These words are used to prettyprint XML"
+{ $subsections
+ pprint-xml>string
+ pprint-xml
+}
+"Certain variables can be changed to mainpulate prettyprinting"
+{ $subsections
+ sensitive-tags
+ indenter
+}
+"All of these words operate on arbitrary pieces of XML: they can take, as in put, XML documents, comments, tags, strings (text nodes), XML chunks, etc." ;
HELP: xml>string
{ $values { "xml" "an XML document" } { "string" "a string" } }
HELP: indenter
{ $var-description "Contains the string which is used for indenting in the XML prettyprinter. For example, to print an XML document using " { $snippet "%%%%" } " for indentation, you can use the following:" }
-{ $example {" USING: xml.syntax xml.writer namespaces ;
-[XML <foo>bar</foo> XML] "%%%%" indenter [ pprint-xml ] with-variable "} {"
+{ $example """USING: xml.syntax xml.writer namespaces ;
+[XML <foo>bar</foo> XML] "%%%%" indenter [ pprint-xml ] with-variable """ """
<foo>
%%%%bar
-</foo>"} } ;
+</foo>""" } ;
HELP: sensitive-tags
{ $var-description "Contains a sequence of " { $link name } "s where whitespace should be considered significant for prettyprinting purposes. The sequence can contain " { $link string } "s in place of names. For example, to preserve whitespace inside a " { $snippet "pre" } " tag:" }
-{ $example {" USING: xml.syntax xml.writer namespaces ;
+{ $example """USING: xml.syntax xml.writer namespaces ;
[XML <html> <head> <title> something</title></head><body><pre>bing
bang
- bong</pre></body></html> XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable "} {"
+ bong</pre></body></html> XML] { "pre" } sensitive-tags [ pprint-xml ] with-variable"""
+"""
<html>
<head>
<title>
bang
bong</pre>
</body>
-</html>"} } ;
+</html>""" } ;
"<?xml version=\"1.0\" encoding=\"UTF-8\"?><x/>" reprints-same
-{" <?xml version="1.0" encoding="UTF-8"?>
+"""<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE foo [<!ENTITY foo "bar">]>
-<x>bar</x> "}
-{" <?xml version="1.0" encoding="UTF-8"?>
+<x>bar</x>"""
+"""<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE foo [<!ENTITY foo 'bar'>]>
-<x>&foo;</x> "} reprints-as
+<x>&foo;</x>""" reprints-as
-{" <?xml version="1.0" encoding="UTF-8"?>
+"""<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE foo [
<!ENTITY foo "bar">
<!ELEMENT br EMPTY>
]>
<x>
bar
-</x>"}
-{" <?xml version="1.0" encoding="UTF-8"?>
+</x>"""
+"""<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE foo [ <!ENTITY foo 'bar'> <!ELEMENT br EMPTY>
<!ATTLIST list
type (bullets|ordered|glossary) "ordered">
<!NOTATION foo bar> <?baz bing bang bong?>
<!--wtf-->
]>
-<x>&foo;</x>"} pprint-reprints-as
+<x>&foo;</x>""" pprint-reprints-as
[ t ] [ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" \"http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd\" >" dup string>xml-chunk xml>string = ] unit-test
[ "<?xml version=\"1.0\" encoding=\"UTF-8\"?><a b=\"c\"/>" ]
[XML <tr><td><-></td><td><-></td></tr> XML]
] map [XML <h2>Timings</h2> <table><-></table> XML]
pprint-xml
-] unit-test
\ No newline at end of file
+] unit-test
{ read-dtd file>dtd string>dtd } related-words\r
\r
ARTICLE: { "xml" "reading" } "Reading XML"\r
- "The following words are used to read something into an XML document"\r
- { $subsection read-xml }\r
- { $subsection read-xml-chunk }\r
- { $subsection string>xml }\r
- { $subsection string>xml-chunk }\r
- { $subsection file>xml }\r
- { $subsection bytes>xml }\r
- "To read a DTD:"\r
- { $subsection read-dtd }\r
- { $subsection file>dtd }\r
- { $subsection string>dtd } ;\r
+"The following words are used to read something into an XML document"\r
+{ $subsections\r
+ read-xml\r
+ read-xml-chunk\r
+ string>xml\r
+ string>xml-chunk\r
+ file>xml\r
+ bytes>xml\r
+}\r
+"To read a DTD:"\r
+{ $subsections\r
+ read-dtd\r
+ file>dtd\r
+ string>dtd\r
+} ;\r
\r
ARTICLE: { "xml" "events" } "Event-based XML parsing"\r
"In addition to DOM-style parsing based around " { $link read-xml } ", the XML module also provides SAX-style event-based parsing. This uses much of the same data structures as normal XML, with the exception of the classes " { $link xml } " and " { $link tag } " and as such, the article " { $vocab-link "xml.data" } " may be useful in learning how to process documents in this way. Other useful words are:"\r
- { $subsection each-element }\r
- { $subsection opener }\r
- { $subsection closer }\r
- { $subsection contained }\r
- "There is also pull-based parsing to augment the push-parsing of SAX. This is probably easier to use and more logical. It uses the same parsing objects as the above style of parsing, except string elements are always in arrays, for example { \"\" }. Relevant pull-parsing words are:"\r
- { $subsection <pull-xml> }\r
- { $subsection pull-xml }\r
- { $subsection pull-event }\r
- { $subsection pull-elem } ;\r
+{ $subsections\r
+ each-element\r
+ opener\r
+ closer\r
+ contained\r
+}\r
+"There is also pull-based parsing to augment the push-parsing of SAX. This is probably easier to use and more logical. It uses the same parsing objects as the above style of parsing, except string elements are always in arrays, for example { \"\" }. Relevant pull-parsing words are:"\r
+{ $subsections\r
+ <pull-xml>\r
+ pull-xml\r
+ pull-event\r
+ pull-elem\r
+} ;\r
\r
ARTICLE: { "xml" "namespaces" } "Working with XML namespaces"\r
"The Factor XML parser implements XML namespaces, and provides convenient utilities for working with them. Anywhere in the public API that a name is accepted as an argument, either a string or an XML name is accepted. If a string is used, it is coerced into a name by giving it a null namespace. Names are stored as " { $link name } " tuples, which have slots for the namespace prefix and namespace URL as well as the main part of the tag name." $nl\r
\r
ARTICLE: "xml" "XML parser"\r
"The " { $vocab-link "xml" } " vocabulary implements the XML 1.0 and 1.1 standards, converting strings of text into XML and vice versa. The parser checks for well-formedness but is not validating. There is only partial support for processing DTDs."\r
- { $subsection { "xml" "reading" } }\r
- { $subsection { "xml" "events" } }\r
- { $subsection { "xml" "namespaces" } }\r
- { $vocab-subsection "Writing XML" "xml.writer" }\r
- { $vocab-subsection "XML parsing errors" "xml.errors" }\r
- { $vocab-subsection "XML entities" "xml.entities" }\r
- { $vocab-subsection "XML data types" "xml.data" }\r
- { $vocab-subsection "Utilities for traversing XML" "xml.traversal" }\r
- { $vocab-subsection "Syntax extensions for XML" "xml.syntax" } ;\r
+{ $subsections\r
+ { "xml" "reading" }\r
+ { "xml" "events" }\r
+ { "xml" "namespaces" }\r
+}\r
+{ $vocab-subsection "Writing XML" "xml.writer" }\r
+{ $vocab-subsection "XML parsing errors" "xml.errors" }\r
+{ $vocab-subsection "XML entities" "xml.entities" }\r
+{ $vocab-subsection "XML data types" "xml.data" }\r
+{ $vocab-subsection "Utilities for traversing XML" "xml.traversal" }\r
+{ $vocab-subsection "Syntax extensions for XML" "xml.syntax" } ;\r
\r
ABOUT: "xml"\r
[ ] [ \ (load-mode) reset-memoized ] unit-test
[ ] [
- <" <style type="text/css" media="screen" >
- * {margin:0; padding:0; border:0;} ">
+ """<style type="text/css" media="screen" >
+ * {margin:0; padding:0; border:0;}"""
string-lines "html" htmlize-lines drop
] unit-test
[ ] [
"test.c"
- <" int x = "hi";
-/* a comment */ "> <string-reader> htmlize-stream
+ """int x = "hi";
+/* a comment */""" <string-reader> htmlize-stream
write-xml
] unit-test
[ ":foo" ] [
{ ":foo" } "factor" htmlize-lines xml>string
-] unit-test
\ No newline at end of file
+] unit-test
"When an image is loaded, any alien objects which persisted from the previous session are marked as having expired. This is because the C pointers they contain are almost certainly no longer valid."
$nl
"For this reason, the " { $link POSTPONE: ALIEN: } " word should not be used in source files, since loading the source file then saving the image will result in the literal becoming expired. Use " { $link <alien> } " instead, and ensure the word calling " { $link <alien> } " is not declared " { $link POSTPONE: flushable } "."
-{ $subsection expired? } ;
+{ $subsections expired? } ;
ARTICLE: "aliens" "Alien addresses"
"Instances of the " { $link alien } " class represent pointers to C data outside the Factor heap:"
-{ $subsection <alien> }
-{ $subsection <displaced-alien> }
-{ $subsection alien-address }
+{ $subsections
+ <alien>
+ <displaced-alien>
+ alien-address
+}
"Anywhere that a " { $link alien } " instance is accepted, the " { $link f } " singleton may be passed in to denote a null pointer."
$nl
"Usually alien objects do not have to created and dereferenced directly; instead declaring C function parameters and return values as having a pointer type such as " { $snippet "void*" } " takes care of the details."
-{ $subsection "syntax-aliens" }
-{ $subsection "alien-expiry" }
+{ $subsections
+ "syntax-aliens"
+ "alien-expiry"
+}
"When higher-level abstractions won't do:"
-{ $subsection "reading-writing-memory" }
+{ $subsections "reading-writing-memory" }
{ $see-also "c-data" "c-types-specs" } ;
ARTICLE: "reading-writing-memory" "Reading and writing memory directly"
"Numerical values can be read from memory addresses and converted to Factor objects using the various typed memory accessor words:"
-{ $subsection alien-signed-1 }
-{ $subsection alien-unsigned-1 }
-{ $subsection alien-signed-2 }
-{ $subsection alien-unsigned-2 }
-{ $subsection alien-signed-4 }
-{ $subsection alien-unsigned-4 }
-{ $subsection alien-signed-cell }
-{ $subsection alien-unsigned-cell }
-{ $subsection alien-signed-8 }
-{ $subsection alien-unsigned-8 }
-{ $subsection alien-float }
-{ $subsection alien-double }
+{ $subsections
+ alien-signed-1
+ alien-unsigned-1
+ alien-signed-2
+ alien-unsigned-2
+ alien-signed-4
+ alien-unsigned-4
+ alien-signed-cell
+ alien-unsigned-cell
+ alien-signed-8
+ alien-unsigned-8
+ alien-float
+ alien-double
+}
"Factor numbers can also be converted to C values and stored to memory:"
-{ $subsection set-alien-signed-1 }
-{ $subsection set-alien-unsigned-1 }
-{ $subsection set-alien-signed-2 }
-{ $subsection set-alien-unsigned-2 }
-{ $subsection set-alien-signed-4 }
-{ $subsection set-alien-unsigned-4 }
-{ $subsection set-alien-signed-cell }
-{ $subsection set-alien-unsigned-cell }
-{ $subsection set-alien-signed-8 }
-{ $subsection set-alien-unsigned-8 }
-{ $subsection set-alien-float }
-{ $subsection set-alien-double } ;
+{ $subsections
+ set-alien-signed-1
+ set-alien-unsigned-1
+ set-alien-signed-2
+ set-alien-unsigned-2
+ set-alien-signed-4
+ set-alien-unsigned-4
+ set-alien-signed-cell
+ set-alien-unsigned-cell
+ set-alien-signed-8
+ set-alien-unsigned-8
+ set-alien-float
+ set-alien-double
+} ;
ARTICLE: "alien-invoke" "Calling C from Factor"
"The easiest way to call into a C library is to define bindings using a pair of parsing words:"
-{ $subsection POSTPONE: LIBRARY: }
-{ $subsection POSTPONE: FUNCTION: }
+{ $subsections
+ POSTPONE: LIBRARY:
+ POSTPONE: FUNCTION:
+}
"The above parsing words create word definitions which call a lower-level word; you can use it directly, too:"
-{ $subsection alien-invoke }
+{ $subsections alien-invoke }
"Sometimes it is necessary to invoke a C function pointer, rather than a named C function:"
-{ $subsection alien-indirect }
+{ $subsections alien-indirect }
"There are some details concerning the conversion of Factor objects to C values, and vice versa. See " { $link "c-data" } "." ;
HELP: alien-invoke-error
ARTICLE: "alien-callback" "Calling Factor from C"
"Callbacks can be defined and passed to C code as function pointers; the C code can then invoke the callback and run Factor code:"
-{ $subsection alien-callback }
+{ $subsections
+ alien-callback
+ POSTPONE: CALLBACK:
+}
"There are some caveats concerning the conversion of Factor objects to C values, and vice versa. See " { $link "c-data" } "."
-{ $subsection "alien-callback-gc" }
+{ $subsections "alien-callback-gc" }
{ $see-also "byte-arrays-gc" } ;
ARTICLE: "dll.private" "DLL handles"
"DLL handles are a built-in class of objects which represent loaded native libraries. DLL handles are instances of the " { $link dll } " class, and have a literal syntax used for debugging prinouts; see " { $link "syntax-aliens" } "."
$nl
"Usually one never has to deal with DLL handles directly; the C library interface creates them as required. However if direct access to these operating system facilities is required, the following primitives can be used:"
-{ $subsection dlopen }
-{ $subsection dlsym }
-{ $subsection dlclose }
-{ $subsection dll-valid? } ;
+{ $subsections
+ dlopen
+ dlsym
+ dlclose
+ dll-valid?
+} ;
ARTICLE: "embedding-api" "Factor embedding API"
"The Factor embedding API is defined in " { $snippet "vm/master.h" } "."
"One exception is that the global " { $link input-stream } " and " { $link output-stream } " streams are not bound by default, to avoid conflicting with any I/O the host process might perform. The " { $link init-stdio } " words must be called explicitly to initialize terminal streams."
$nl
"There is a word which can detect when Factor is embedded:"
-{ $subsection embedded? }
+{ $subsections embedded? }
"No special support is provided for calling out from Factor into the owner process. The C library inteface works fine for this task - see " { $link "alien" } "." ;
ARTICLE: "embedding" "Embedding Factor into C applications"
{ "Other Unix" { $snippet "libfactor.a" } "No" }
}
"An image file must be supplied; a minimal image can be built, however the compiler must be included for the embedding API to work (see " { $link "bootstrap-cli-args" } ")."
-{ $subsection "embedding-api" }
-{ $subsection "embedding-factor" }
-{ $subsection "embedding-restrictions" } ;
+{ $subsections
+ "embedding-api"
+ "embedding-factor"
+ "embedding-restrictions"
+} ;
ARTICLE: "alien" "C library interface"
"Factor can directly call C functions in native libraries. It is also possible to compile callbacks which run Factor code, and pass them to native libraries as function pointers."
$nl
"The C library interface is entirely self-contained; there is no C code which one must write in order to wrap a library."
$nl
-"C library interface words are found in the " { $vocab-link "alien" } " vocabulary."
+"C library interface words are found in the " { $vocab-link "alien" } " vocabulary and its subvocabularies."
{ $warning "C does not perform runtime type checking, automatic memory management or array bounds checks. Incorrect usage of C library functions can lead to crashes, data corruption, and security exploits." }
-{ $subsection "loading-libs" }
-{ $subsection "aliens" }
-{ $subsection "alien-invoke" }
-{ $subsection "alien-callback" }
-{ $subsection "c-data" }
-{ $subsection "dll.private" }
-{ $subsection "embedding" } ;
+{ $subsections
+ "loading-libs"
+ "alien-invoke"
+ "alien-callback"
+ "c-data"
+ "classes.struct"
+ "dll.private"
+ "embedding"
+} ;
ABOUT: "alien"
] unit-test
] when
-[ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test
+[ "ALIEN: 1234" ] [
HEX: 1234 <alien> unparse ] unit-test
[ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test
-USING: alien.strings alien.c-types tools.test kernel libc
+USING: alien.strings alien.c-types alien.data 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
[ stream>> >byte-array ]
tri ;
+M: tuple string>alien drop underlying>> ;
+
HOOK: alien>native-string os ( alien -- string )
M: windows alien>native-string utf16n alien>string ;
ARTICLE: "arrays-unsafe" "Unsafe array operations"
"These two words are used internally by the Factor implementation. User code should never need to call them; instead use " { $link nth } " and " { $link set-nth } "."
-{ $subsection array-nth }
-{ $subsection set-array-nth } ;
+{ $subsections
+ array-nth
+ set-array-nth
+} ;
ARTICLE: "arrays" "Arrays"
"The " { $vocab-link "arrays" } " vocabulary implements fixed-size mutable sequences which support the " { $link "sequence-protocol" } "."
"Array literal syntax is documented in " { $link "syntax-arrays" } ". Resizable arrays also exist and are known as " { $link "vectors" } "."
$nl
"Arrays form a class of objects:"
-{ $subsection array }
-{ $subsection array? }
+{ $subsections
+ array
+ array?
+}
"Creating new arrays:"
-{ $subsection >array }
-{ $subsection <array> }
+{ $subsections
+ >array
+ <array>
+}
"Creating an array from several elements on the stack:"
-{ $subsection 1array }
-{ $subsection 2array }
-{ $subsection 3array }
-{ $subsection 4array }
+{ $subsections
+ 1array
+ 2array
+ 3array
+ 4array
+}
"The class of two-element arrays:"
-{ $subsection pair }
+{ $subsections pair }
"Arrays can be accessed without bounds checks in a pointer unsafe way."
-{ $subsection "arrays-unsafe" } ;
+{ $subsections "arrays-unsafe" } ;
ABOUT: "arrays"
"There is no special syntax for literal alists since they are just sequences; in practice, literals look like so:"
{ $code "{" " { key1 value1 }" " { key2 value2 }" "}" }
"To make an assoc into an alist:"
-{ $subsection >alist } ;
+{ $subsections >alist } ;
ARTICLE: "enums" "Enumerations"
"An enumeration provides a view of a sequence as an assoc mapping integer indices to elements:"
-{ $subsection enum }
-{ $subsection <enum> }
+{ $subsections
+ enum
+ <enum>
+}
"Inverting a permutation using enumerations:"
{ $example "IN: scratchpad" ": invert ( perm -- perm' )" " <enum> >alist sort-values keys ;" "{ 2 0 4 1 3 } invert ." "{ 1 3 0 4 2 }" } ;
ARTICLE: "assocs-protocol" "Associative mapping protocol"
"All associative mappings must be instances of a mixin class:"
-{ $subsection assoc }
-{ $subsection assoc? }
+{ $subsections
+ assoc
+ assoc?
+}
"All associative mappings must implement methods on the following generic words:"
-{ $subsection at* }
-{ $subsection assoc-size }
-{ $subsection >alist }
+{ $subsections
+ at*
+ assoc-size
+ >alist
+}
"Mutable assocs should implement the following additional words:"
-{ $subsection set-at }
-{ $subsection delete-at }
-{ $subsection clear-assoc }
+{ $subsections
+ set-at
+ delete-at
+ clear-assoc
+}
"The following three words are optional:"
-{ $subsection value-at* }
-{ $subsection new-assoc }
-{ $subsection assoc-like }
+{ $subsections
+ value-at*
+ new-assoc
+ assoc-like
+}
"Assocs should also implement methods on the " { $link clone } ", " { $link equal? } " and " { $link hashcode* } " generic words. Two utility words will help with the implementation of the last two:"
-{ $subsection assoc= }
-{ $subsection assoc-hashcode }
+{ $subsections
+ assoc=
+ assoc-hashcode
+}
"Finally, assoc classes should define a word for converting other types of assocs; conventionally, such words are named " { $snippet ">" { $emphasis "class" } } " where " { $snippet { $emphasis "class" } } " is the class name. Such a word can be implemented using a utility:"
-{ $subsection assoc-clone-like } ;
+{ $subsections assoc-clone-like } ;
ARTICLE: "assocs-lookup" "Lookup and querying of assocs"
"Utility operations built up from the " { $link "assocs-protocol" } ":"
-{ $subsection key? }
-{ $subsection at }
-{ $subsection ?at }
-{ $subsection assoc-empty? }
-{ $subsection keys }
-{ $subsection values }
-{ $subsection assoc-stack }
+{ $subsections
+ key?
+ at
+ ?at
+ assoc-empty?
+ keys
+ values
+ assoc-stack
+}
{ $see-also at* assoc-size } ;
ARTICLE: "assocs-values" "Transposed assoc operations"
"default Most assoc words take a key and find the corresponding value. The following words take a value and find the corresponding key:"
-{ $subsection value-at }
-{ $subsection value-at* }
-{ $subsection value? }
+{ $subsections
+ value-at
+ value-at*
+ value?
+}
"With most assoc implementations, these words runs in linear time, proportional to the number of entries in the assoc. For fast value lookups, use " { $vocab-link "biassocs" } "." ;
ARTICLE: "assocs-sets" "Set-theoretic operations on assocs"
"It is often useful to use the keys of an associative mapping as a set, exploiting the constant or logarithmic lookup time of most implementations (" { $link "alists" } " being a notable exception)."
-{ $subsection assoc-subset? }
-{ $subsection assoc-intersect }
-{ $subsection update }
-{ $subsection assoc-union }
-{ $subsection assoc-diff }
-{ $subsection remove-all }
-{ $subsection substitute }
-{ $subsection substitute-here }
-{ $subsection extract-keys }
+{ $subsections
+ assoc-subset?
+ assoc-intersect
+ update
+ assoc-union
+ assoc-diff
+ remove-all
+ substitute
+ substitute-here
+ extract-keys
+}
{ $see-also key? assoc-any? assoc-all? "sets" } ;
ARTICLE: "assocs-mutation" "Storing keys and values in assocs"
"Utility operations built up from the " { $link "assocs-protocol" } ":"
-{ $subsection delete-at* }
-{ $subsection rename-at }
-{ $subsection change-at }
-{ $subsection at+ }
-{ $subsection inc-at }
+{ $subsections
+ delete-at*
+ rename-at
+ change-at
+ at+
+ inc-at
+}
{ $see-also set-at delete-at clear-assoc push-at } ;
ARTICLE: "assocs-conversions" "Associative mapping conversions"
"Converting to other assocs:"
-{ $subsection assoc-clone-like }
+{ $subsections assoc-clone-like }
"Combining a sequence of assocs into a single assoc:"
-{ $subsection assoc-combine }
+{ $subsections assoc-combine }
"Creating an assoc from key/value sequences:"
-{ $subsection zip }
+{ $subsections zip }
"Creating key/value sequences from an assoc:"
-{ $subsection unzip }
+{ $subsections unzip }
;
ARTICLE: "assocs-combinators" "Associative mapping combinators"
"The " { $link assoc-find } " combinator is part of the " { $link "assocs-protocol" } " and must be implemented once for each class of assoc. All other combinators are implemented in terms of this combinator."
$nl
"The standard functional programming idioms:"
-{ $subsection assoc-each }
-{ $subsection assoc-find }
-{ $subsection assoc-map }
-{ $subsection assoc-filter }
-{ $subsection assoc-filter-as }
-{ $subsection assoc-any? }
-{ $subsection assoc-all? }
+{ $subsections
+ assoc-each
+ assoc-find
+ assoc-map
+ assoc-filter
+ assoc-filter-as
+ assoc-any?
+ assoc-all?
+}
"Additional combinators:"
-{ $subsection assoc-partition }
-{ $subsection cache }
-{ $subsection 2cache }
-{ $subsection map>assoc }
-{ $subsection assoc>map }
-{ $subsection assoc-map-as } ;
+{ $subsections
+ assoc-partition
+ cache
+ 2cache
+ map>assoc
+ assoc>map
+ assoc-map-as
+} ;
ARTICLE: "assocs" "Associative mapping operations"
"An " { $emphasis "associative mapping" } ", abbreviated " { $emphasis "assoc" } ", is a collection of key/value pairs which provides efficient lookup and storage indexed by key."
"Words used for working with assocs are in the " { $vocab-link "assocs" } " vocabulary."
$nl
"Associative mappings implement a protocol:"
-{ $subsection "assocs-protocol" }
+{ $subsections "assocs-protocol" }
"A large set of utility words work on any object whose class implements the associative mapping protocol."
-{ $subsection "assocs-lookup" }
-{ $subsection "assocs-values" }
-{ $subsection "assocs-mutation" }
-{ $subsection "assocs-combinators" }
-{ $subsection "assocs-sets" }
-{ $subsection "assocs-conversions" } ;
+{ $subsections
+ "assocs-lookup"
+ "assocs-values"
+ "assocs-mutation"
+ "assocs-combinators"
+ "assocs-sets"
+ "assocs-conversions"
+} ;
ABOUT: "assocs"
USING: kernel math namespaces make tools.test vectors sequences
sequences.private hashtables io prettyprint assocs
-continuations specialized-arrays.double ;
+continuations specialized-arrays alien.c-types ;
+SPECIALIZED-ARRAY: double
IN: assocs.tests
[ t ] [ H{ } dup assoc-subset? ] unit-test
"threads.private"
"tools.profiler.private"
"words"
+ "words.private"
"vectors"
"vectors.private"
+ "vm"
} [ create-vocab drop ] each
! Builtin classes
{ "float<=" "math.private" (( x y -- ? )) }
{ "float>" "math.private" (( x y -- ? )) }
{ "float>=" "math.private" (( x y -- ? )) }
- { "<word>" "words" (( name vocab -- word )) }
+ { "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 )) }
{ "getenv" "kernel.private" (( n -- obj )) }
{ "setenv" "kernel.private" (( obj n -- )) }
{ "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 -- )) }
{ "<wrapper>" "kernel" (( obj -- wrapper )) }
{ "inline-cache-stats" "generic.single" (( -- stats )) }
{ "optimized?" "words" (( word -- ? )) }
{ "quot-compiled?" "quotations" (( quot -- ? )) }
+ { "vm-ptr" "vm" (( -- ptr )) }
} [ [ first3 ] dip swap make-primitive ] each-index
! Bump build number
"bootstrap.layouts" require
[
- "vocab:bootstrap/stage2.factor"
+ "resource:basis/bootstrap/stage2.factor"
dup exists? [
run-file
] [
"MAIN:"
"MATH:"
"MIXIN:"
+ "NAN:"
"OCT:"
"P\""
"POSTPONE:"
$nl
"Byte array words are in the " { $vocab-link "byte-arrays" } " vocabulary."
$nl
-"Byte arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-byte-arrays" } "."
+"Byte arrays play a special role in the C library interface; they can be used to pass binary data back and forth between Factor and C. See " { $link "c-pointers" } "."
$nl
"Byte arrays form a class of objects."
-{ $subsection byte-array }
-{ $subsection byte-array? }
+{ $subsections
+ byte-array
+ byte-array?
+}
"There are several ways to construct byte arrays."
-{ $subsection >byte-array }
-{ $subsection <byte-array> }
-{ $subsection 1byte-array }
-{ $subsection 2byte-array }
-{ $subsection 3byte-array }
-{ $subsection 4byte-array }
+{ $subsections
+ >byte-array
+ <byte-array>
+ 1byte-array
+ 2byte-array
+ 3byte-array
+ 4byte-array
+}
"Resizing byte-arrays:"
-{ $subsection resize-byte-array } ;
+{ $subsections resize-byte-array } ;
ABOUT: "byte-arrays"
"The " { $vocab-link "byte-vectors" } " vocabulary implements resizable mutable sequence of unsigned bytes. Byte vectors implement the " { $link "sequence-protocol" } " and thus all " { $link "sequences" } " can be used with them."\r
$nl\r
"Byte vectors form a class:"\r
-{ $subsection byte-vector }\r
-{ $subsection byte-vector? }\r
+{ $subsections\r
+ byte-vector\r
+ byte-vector?\r
+}\r
"Creating byte vectors:"\r
-{ $subsection >byte-vector }\r
-{ $subsection <byte-vector> }\r
+{ $subsections\r
+ >byte-vector\r
+ <byte-vector>\r
+}\r
"Literal syntax:"\r
-{ $subsection POSTPONE: BV{ }\r
+{ $subsections POSTPONE: BV{ }\r
"If you don't care about initial capacity, a more elegant way to create a new byte vector is to write:"\r
{ $code "BV{ } clone" } ;\r
\r
HELP: checksum-bytes
{ $values { "bytes" "a sequence of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
-{ $contract "Computes the checksum of all data in a sequence." } ;
+{ $contract "Computes the checksum of all data in a sequence." }
+{ $examples
+ { $example
+ "USING: checksums checksums.crc32 prettyprint ;"
+ "B{ 1 10 100 } crc32 checksum-bytes ."
+ "B{ 78 179 254 238 }"
+ }
+} ;
HELP: checksum-lines
{ $values { "lines" "a sequence of sequences of bytes" } { "checksum" "a checksum specifier" } { "value" byte-array } }
-{ $contract "Computes the checksum of all data in a sequence." } ;
+{ $contract "Computes the checksum of all data in a sequence." }
+{ $examples
+ { $example
+ "USING: checksums checksums.crc32 prettyprint ;"
+"""{
+ "Take me out to the ball game"
+ "Take me out with the crowd"
+} crc32 checksum-lines ."""
+ "B{ 111 205 9 27 }"
+ }
+} ;
HELP: checksum-file
{ $values { "path" "a pathname specifier" } { "checksum" "a checksum specifier" } { "value" byte-array } }
-{ $contract "Computes the checksum of all data in a file." } ;
+{ $contract "Computes the checksum of all data in a file." }
+{ $examples
+ { $example
+ "USING: checksums checksums.crc32 prettyprint ;"
+ """"resource:license.txt" crc32 checksum-file ."""
+ "B{ 100 139 199 92 }"
+ }
+} ;
ARTICLE: "checksums" "Checksums"
"A " { $emphasis "checksum" } " is a function mapping sequences of bytes to fixed-length strings. While checksums are not one-to-one, a good checksum should have a low probability of collision. Additionally, some checksum algorithms are designed to be hard to reverse, in the sense that finding an input string which hashes to a given checksum string requires a brute-force search."
$nl
"Checksums are instances of a class:"
-{ $subsection checksum }
+{ $subsections checksum }
"Operations on checksums:"
-{ $subsection checksum-bytes }
-{ $subsection checksum-stream }
-{ $subsection checksum-lines }
+{ $subsections
+ checksum-bytes
+ checksum-stream
+ checksum-lines
+}
"Checksums should implement at least one of " { $link checksum-bytes } " and " { $link checksum-stream } ". Implementing " { $link checksum-lines } " is optional."
$nl
"Utilities:"
-{ $subsection checksum-file }
-{ $subsection hex-string }
+{ $subsections
+ checksum-file
+ hex-string
+}
"Checksum implementations:"
-{ $subsection "checksums.crc32" }
+{ $subsections "checksums.crc32" }
{ $vocab-subsection "MD5 checksum" "checksums.md5" }
{ $vocab-subsection "SHA checksums" "checksums.sha" }
{ $vocab-subsection "Adler-32 checksum" "checksums.adler-32" }
over bytes>> [ push-all ] keep
[ dup length pick block-size>> >= ]
[
- 64 cut-slice [ >byte-array ] dip [
+ over block-size>> cut-slice [ >byte-array ] dip [
over [ checksum-block ]
- [ [ 64 + ] change-bytes-read drop ] bi
+ [ [ ] [ block-size>> ] bi [ + ] curry change-bytes-read drop ] bi
] dip
] while
>byte-vector
ARTICLE: "checksums.crc32" "CRC32 checksum"
"The CRC32 checksum algorithm provides a quick but unreliable way to detect changes in data."
-{ $subsection crc32 } ;
+{ $subsections crc32 } ;
ABOUT: "checksums.crc32"
\r
ARTICLE: "class-operations" "Class operations"\r
"Set-theoretic operations on classes:"\r
-{ $subsection class= }\r
-{ $subsection class< }\r
-{ $subsection class<= }\r
-{ $subsection class-and }\r
-{ $subsection class-or }\r
-{ $subsection classes-intersect? }\r
-{ $subsection min-class }\r
+{ $subsections\r
+ class=\r
+ class<\r
+ class<=\r
+ class-and\r
+ class-or\r
+ classes-intersect?\r
+}\r
"Low-level implementation detail:"\r
-{ $subsection flatten-class }\r
-{ $subsection flatten-builtin-class }\r
-{ $subsection class-types }\r
-{ $subsection class-tags } ;\r
+{ $subsections\r
+ flatten-class\r
+ flatten-builtin-class\r
+ class-types\r
+ class-tags\r
+} ;\r
\r
ARTICLE: "class-linearization" "Class linearization"\r
"Classes have an intrinsic partial order; given two classes A and B, we either have that A is a subset of B, B is a subset of A, A and B are equal as sets, or they are incomparable. The last two situations present difficulties for method dispatch:"\r
"The second problem is resolved with another tie-breaker. When performing the topological sort of classes, if there are multiple candidates at any given step of the sort, lexicographical order on the class name is used."\r
$nl\r
"Operations:"\r
-{ $subsection class< }\r
-{ $subsection sort-classes }\r
+{ $subsections\r
+ class<\r
+ sort-classes\r
+ smallest-class\r
+}\r
"Metaclass order:"\r
-{ $subsection rank-class } ;\r
+{ $subsections rank-class } ;\r
\r
HELP: flatten-builtin-class\r
{ $values { "class" class } { "assoc" "an assoc whose keys are classes" } }\r
{ $values { "first" class } { "second" class } { "?" "a boolean" } }\r
{ $description "Tests if two classes have a non-empty intersection. If the intersection is empty, no object can be an instance of both classes at once." } ;\r
\r
-HELP: min-class\r
-{ $values { "class" class } { "seq" "a sequence of class words" } { "class/f" "a class word or " { $link f } } }\r
-{ $description "If all classes in " { $snippet "seq" } " that intersect " { $snippet "class" } " are subtypes of " { $snippet "class" } ", outputs the last such element of " { $snippet "seq" } ". If any conditions fail to hold, outputs " { $link f } "." } ;\r
+HELP: smallest-class\r
+{ $values { "classes" "a sequence of class words" } { "class/f" { $maybe class } } }\r
+{ $description "Outputs a minimum class from the given sequence." } ;\r
classes.private classes.union classes.mixin classes.predicate\r
vectors source-files compiler.units growable random\r
stack-checker effects kernel.private sbufs math.order\r
-classes.tuple accessors ;\r
+classes.tuple accessors generic.private ;\r
IN: classes.algebra.tests\r
\r
: class-and* ( cls1 cls2 cls3 -- ? ) [ class-and ] dip class= ;\r
] unit-test\r
\r
! Test method inlining\r
+[ real ] [ { real sequence } smallest-class ] unit-test\r
+[ real ] [ { sequence real } smallest-class ] unit-test\r
+\r
+: min-class ( class classes -- class/f )\r
+ interesting-classes smallest-class ;\r
+\r
[ f ] [ fixnum { } min-class ] unit-test\r
\r
[ string ] [\r
[ dup largest-class [ over delete-nth ] dip ]\r
produce nip ;\r
\r
-: min-class ( class seq -- class/f )\r
- over [ classes-intersect? ] curry filter\r
- [ drop f ] [\r
- [ nip ] [ [ class<= ] with all? ] 2bi [ last ] [ drop f ] if\r
+: smallest-class ( classes -- class/f )\r
+ [ f ] [\r
+ natural-sort <reversed>\r
+ [ ] [ [ class<= ] most ] map-reduce\r
] if-empty ;\r
\r
GENERIC: (flatten-class) ( class -- )\r
"Every object is an instance of exactly one canonical " { $emphasis "built-in class" } " which defines its layout in memory and basic behavior."
$nl
"The set of built-in classes is a class:"
-{ $subsection builtin-class }
-{ $subsection builtin-class? }
+{ $subsections
+ builtin-class
+ builtin-class?
+}
"See " { $link "type-index" } " for a list of built-in classes." ;
HELP: builtin-class
{ { $link null } { $snippet "[ drop f ]" } { "No object is an instance of " { $link null } } }
}
"The set of class predicate words is a class:"
-{ $subsection predicate }
-{ $subsection predicate? }
+{ $subsections
+ predicate
+ predicate?
+}
"A predicate word holds a reference to the class it is predicating over in the " { $snippet "\"predicating\"" } " word property." ;
ARTICLE: "classes" "Classes"
"Words for working with classes are found in the " { $vocab-link "classes" } " vocabulary."
$nl
"Classes themselves form a class:"
-{ $subsection class? }
+{ $subsections class? }
"You can ask an object for its class:"
-{ $subsection class }
+{ $subsections class }
"Testing if an object is an instance of a class:"
-{ $subsection instance? }
+{ $subsections instance? }
"You can ask a class for its superclass:"
-{ $subsection superclass }
-{ $subsection superclasses }
-{ $subsection subclass-of? }
+{ $subsections
+ superclass
+ superclasses
+ subclass-of?
+}
"Class predicates can be used to test instances directly:"
-{ $subsection "class-predicates" }
+{ $subsections "class-predicates" }
"There is a universal class which all objects are an instance of, and an empty class with no instances:"
-{ $subsection object }
-{ $subsection null }
+{ $subsections
+ object
+ null
+}
"Obtaining a list of all defined classes:"
-{ $subsection classes }
+{ $subsections classes }
"There are several sorts of classes:"
-{ $subsection "builtin-classes" }
-{ $subsection "unions" }
-{ $subsection "intersections" }
-{ $subsection "mixins" }
-{ $subsection "predicates" }
-{ $subsection "singletons" }
+{ $subsections
+ "builtin-classes"
+ "unions"
+ "intersections"
+ "mixins"
+ "predicates"
+ "singletons"
+}
{ $link "tuples" } " are documented in their own section."
$nl
"Classes can be inspected and operated upon:"
-{ $subsection "class-operations" }
-{ $subsection "class-linearization" }
+{ $subsections
+ "class-operations"
+ "class-linearization"
+}
{ $see-also "class-index" } ;
ABOUT: "classes"
! So the user has some code...
[ ] [
- <" IN: classes.test.a
+ """IN: classes.test.a
GENERIC: g ( a -- b )
TUPLE: x ;
M: x g ;
- TUPLE: z < x ;"> <string-reader>
+ TUPLE: z < x ;""" <string-reader>
"class-intersect-no-method-a" parse-stream drop
] unit-test
! Note that q inlines M: x g ;
[ ] [
- <" IN: classes.test.b
+ """IN: classes.test.b
USE: classes.test.a
USE: kernel
- : q ( -- b ) z new g ;"> <string-reader>
+ : q ( -- b ) z new g ;""" <string-reader>
"class-intersect-no-method-b" parse-stream drop
] unit-test
! Now, the user removes the z class and adds a method,
[ ] [
- <" IN: classes.test.a
+ """IN: classes.test.a
GENERIC: g ( a -- b )
TUPLE: x ;
M: x g ;
TUPLE: j ;
- M: j g ;"> <string-reader>
+ M: j g ;""" <string-reader>
"class-intersect-no-method-a" parse-stream drop
] unit-test
! And changes the definition of q
[ ] [
- <" IN: classes.test.b
+ """IN: classes.test.b
USE: classes.test.a
USE: kernel
- : q ( -- b ) j new g ;"> <string-reader>
+ : q ( -- b ) j new g ;""" <string-reader>
"class-intersect-no-method-b" parse-stream drop
] unit-test
! Similar problem, but with anonymous classes
[ ] [
- <" IN: classes.test.c
+ """IN: classes.test.c
USE: kernel
GENERIC: g ( a -- b )
M: object g ;
- TUPLE: z ;"> <string-reader>
+ TUPLE: z ;""" <string-reader>
"class-intersect-no-method-c" parse-stream drop
] unit-test
[ ] [
- <" IN: classes.test.d
+ """IN: classes.test.d
USE: classes.test.c
USE: kernel
- : q ( a -- b ) dup z? [ g ] unless ;"> <string-reader>
+ : q ( a -- b ) dup z? [ g ] unless ;""" <string-reader>
"class-intersect-no-method-d" parse-stream drop
] unit-test
! Now, the user removes the z class and adds a method,
[ ] [
- <" IN: classes.test.c
+ """IN: classes.test.c
USE: kernel
GENERIC: g ( a -- b )
M: object g ;
TUPLE: j ;
- M: j g ;"> <string-reader>
+ M: j g ;""" <string-reader>
"class-intersect-no-method-c" parse-stream drop
] unit-test
ARTICLE: "intersections" "Intersection classes"
"An object is an instance of a intersection class if it is an instance of all of its participants."
-{ $subsection POSTPONE: INTERSECTION: }
-{ $subsection define-intersection-class }
+{ $subsections POSTPONE: INTERSECTION: }
+{ $subsections define-intersection-class }
"Intersection classes can be introspected:"
-{ $subsection participants }
+{ $subsections participants }
"The set of intersection classes is a class:"
-{ $subsection intersection-class }
-{ $subsection intersection-class? }
+{ $subsections
+ intersection-class
+ intersection-class?
+}
"Intersection classes are used to associate a method with objects which are simultaneously instances of multiple different classes, as well as to conveniently define predicates." ;
ABOUT: "intersections"
ARTICLE: "mixins" "Mixin classes"
"An object is an instance of a union class if it is an instance of one of its members. In this respect, mixin classes are identical to union classes. However, mixin classes have the additional property that they are " { $emphasis "open" } "; new classes can be added to the mixin after the original definition of the mixin."
-{ $subsection POSTPONE: MIXIN: }
-{ $subsection POSTPONE: INSTANCE: }
-{ $subsection define-mixin-class }
-{ $subsection add-mixin-instance }
+{ $subsections
+ POSTPONE: MIXIN:
+ POSTPONE: INSTANCE:
+ define-mixin-class
+ add-mixin-instance
+}
"The set of mixin classes is a class:"
-{ $subsection mixin-class }
-{ $subsection mixin-class? }
+{ $subsections
+ mixin-class
+ mixin-class?
+}
"Mixins are used to defines suites of behavior which are generally useful and can be applied to user-defined classes. For example, the " { $link immutable-sequence } " mixin can be used with user-defined sequences to make them immutable."
{ $see-also "unions" "tuple-subclassing" } ;
ARTICLE: "predicates" "Predicate classes"
"Predicate classes allow fine-grained control over method dispatch."
-{ $subsection POSTPONE: PREDICATE: }
-{ $subsection define-predicate-class }
+{ $subsections
+ POSTPONE: PREDICATE:
+ define-predicate-class
+}
"The set of predicate classes is a class:"
-{ $subsection predicate-class }
-{ $subsection predicate-class? } ;
+{ $subsections
+ predicate-class
+ predicate-class?
+} ;
ABOUT: "predicates"
ARTICLE: "singletons" "Singleton classes"
"A singleton is a class with only one instance and with no state."
-{ $subsection POSTPONE: SINGLETON: }
-{ $subsection POSTPONE: SINGLETONS: }
-{ $subsection define-singleton-class }
+{ $subsections
+ POSTPONE: SINGLETON:
+ POSTPONE: SINGLETONS:
+ define-singleton-class
+}
"The set of all singleton classes is itself a class:"
-{ $subsection singleton-class? }
-{ $subsection singleton-class } ;
+{ $subsections
+ singleton-class?
+ singleton-class
+} ;
HELP: define-singleton-class
{ $values { "word" "a new word" } }
" x 3 }"
} "\n" join eval( -- tuple )
] [ error>> unexpected-eof? ] must-fail-with
+
+TUPLE: bad-inheritance-tuple ;
+[
+ "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple < bad-inheritance-tuple ;" eval( -- )
+] [ error>> bad-inheritance? ] must-fail-with
+
+TUPLE: bad-inheritance-tuple2 ;
+TUPLE: bad-inheritance-tuple3 < bad-inheritance-tuple2 ;
+[
+ "IN: classes.tuple.parser.tests TUPLE: bad-inheritance-tuple2 < bad-inheritance-tuple3 ;" eval( -- )
+] [ error>> bad-inheritance? ] must-fail-with
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sets namespaces make sequences parser
lexer combinators words classes.parser classes.tuple arrays
-slots math assocs parser.notes ;
+slots math assocs parser.notes classes.algebra ;
IN: classes.tuple.parser
: slot-names ( slots -- seq )
: parse-tuple-slots ( -- )
";" parse-tuple-slots-delim ;
+ERROR: bad-inheritance class superclass ;
+
+: check-inheritance ( class1 class2 -- class1 class2 )
+ 2dup swap class<= [ bad-inheritance ] when ;
+
: parse-tuple-definition ( -- class superclass slots )
CREATE-CLASS
- scan {
+ scan 2dup = [ ] when {
{ ";" [ tuple f ] }
- { "<" [ scan-word [ parse-tuple-slots ] { } make ] }
+ { "<" [
+ scan-word check-inheritance [ parse-tuple-slots ] { } make
+ ] }
[ tuple swap [ parse-slot-name [ parse-tuple-slots ] when ] { } make ]
} case
dup check-duplicate-slots
M: tuple-class boa>object
swap prefix >tuple ;
+ERROR: bad-slot-name class slot ;
+
+: check-slot-exists ( class initials slot-spec/f index/f name -- class initials slot-spec index )
+ over [ drop ] [ nip nip nip bad-slot-name ] if ;
+
+: slot-named-checked ( class initials name slots -- class initials slot-spec )
+ over [ slot-named* ] dip check-slot-exists drop ;
+
: assoc>object ( class slots values -- tuple )
[ [ [ initial>> ] map ] keep ] dip
- swap [ [ slot-named* drop ] curry dip ] curry assoc-map
+ swap [ [ slot-named-checked ] curry dip ] curry assoc-map
[ dup <enum> ] dip update boa>object ;
: parse-tuple-literal-slots ( class slots -- tuple )
{ "The " { $link slots>tuple } " and " { $link >tuple } " words ensure that the values in the sequence satisfy the correct class predicates." }
{ { $link "tuple-redefinition" } " fills in new slots with initial values and ensures that changes to existing declarations result in incompatible values being replaced with the initial value of their respective slots." }
}
-{ $subsection "slot-class-coercion" } ;
+{ $subsections "slot-class-coercion" } ;
ARTICLE: "slot-class-coercion" "Coercive slot declarations"
"If the class of a slot is declared to be one of " { $link fixnum } " or " { $link float } ", then rather than testing values with the class predicate, writer words coerce values to the relevant type with " { $link >fixnum } " or " { $link >float } ". This may still result in error, but permits a wider range of values than a class predicate test. It also results in a possible loss of precision; for example, storing a large integer into a " { $link fixnum } " slot will silently overflow and discard high bits, and storing a ratio into a " { $link float } " slot may lose precision if the ratio is one which cannot be represented exactly with floating-point."
{ "whether a slot is read only or not (" { $link read-only } ")" }
{ "an initial value (" { $link initial: } ")" }
}
-{ $subsection "slot-read-only-declaration" }
-{ $subsection "slot-class-declaration" }
-{ $subsection "slot-initial-values" } ;
+{ $subsections
+ "slot-read-only-declaration"
+ "slot-class-declaration"
+ "slot-initial-values"
+} ;
ARTICLE: "parametrized-constructors" "Parameterized constructors"
"A " { $emphasis "parametrized constructor" } " is a word which directly or indirectly calls " { $link new } " or " { $link boa } ", but instead of passing a literal class symbol, it takes the class symbol as an input from the stack."
ARTICLE: "tuple-constructors" "Tuple constructors"
"Tuples are created by calling one of two constructor primitives:"
-{ $subsection new }
-{ $subsection boa }
+{ $subsections
+ new
+ boa
+}
"A shortcut for defining BOA constructors:"
-{ $subsection POSTPONE: C: }
+{ $subsections POSTPONE: C: }
"By convention, construction logic is encapsulated in a word named after the tuple class surrounded in angle brackets; for example, the constructor word for a " { $snippet "point" } " class might be named " { $snippet "<point>" } "."
$nl
"Constructors play a part in enforcing the invariant that slot values must always match slot declarations. The " { $link new } " word fills in the tuple with initial values, and " { $link boa } " ensures that the values on the stack match the corresponding slot declarations. See " { $link "tuple-declarations" } "."
"! Run-time error"
"\"not a number\" 2 3 4 color boa"
}
-{ $subsection "parametrized-constructors" } ;
+{ $subsections "parametrized-constructors" } ;
ARTICLE: "tuple-inheritance-example" "Tuple subclassing example"
"Rectangles, parallelograms and circles are all shapes. We support two operations on shapes:"
{ $code
"TUPLE: subclass < superclass ... ;"
}
-{ $subsection "tuple-inheritance-example" }
-{ $subsection "tuple-inheritance-anti-example" }
+{ $subsections
+ "tuple-inheritance-example"
+ "tuple-inheritance-anti-example"
+}
{ $see-also "call-next-method" "parametrized-constructors" "unions" "mixins" } ;
ARTICLE: "tuple-introspection" "Tuple introspection"
"In addition to the slot reader and writer words which " { $link POSTPONE: TUPLE: } " defines for every tuple class, it is possible to construct and take apart entire tuples in a generic way."
-{ $subsection >tuple }
-{ $subsection tuple>array }
-{ $subsection tuple-slots }
+{ $subsections
+ >tuple
+ tuple>array
+ tuple-slots
+}
"Tuple classes can also be defined at run time:"
-{ $subsection define-tuple-class }
+{ $subsections define-tuple-class }
{ $see-also "slots" "mirrors" } ;
ARTICLE: "tuple-examples" "Tuple examples"
"A " { $emphasis "protocol slot" } " is one which is assumed to exist by the implementation of a class, without being defined on the class itself. The burden is on subclasses (or mixin instances) to provide this slot."
$nl
"Protocol slots are defined using a parsing word:"
-{ $subsection POSTPONE: SLOT: }
+{ $subsections POSTPONE: SLOT: }
"Protocol slots are used where the implementation of a superclass needs to assume that each subclass defines certain slots, however the slots of each subclass are potentially declared with different class specializers, thus preventing the slots from being defined in the superclass."
$nl
"For example, the " { $link growable } " mixin provides an implementation of the sequence protocol which wraps an underlying sequence, resizing it as necessary when elements are added beyond the length of the sequence. It assumes that the concrete mixin instances define two slots, " { $snippet "length" } " and " { $snippet "underlying" } ". These slots are defined as protocol slots: " { $snippet "SLOT: length" } " and " { $snippet "SLOT: underlying" } ". "
ARTICLE: "tuples" "Tuples"
"Tuples are user-defined classes composed of named slots. They are the central data type of Factor's object system."
-{ $subsection "tuple-examples" }
+{ $subsections "tuple-examples" }
"A parsing word defines tuple classes:"
-{ $subsection POSTPONE: TUPLE: }
+{ $subsections POSTPONE: TUPLE: }
"For each tuple class, several words are defined, the class word, a class predicate, and accessor words for each slot."
$nl
"The class word is used for defining methods on the tuple class; it has the same name as the tuple class. The predicate is named " { $snippet { $emphasis "name" } "?" } ". Initially, no specific words are defined for constructing new instances of the tuple. Constructors must be defined explicitly, and tuple slots are accessed via automatically-generated accessor words."
-{ $subsection "accessors" }
-{ $subsection "tuple-constructors" }
-{ $subsection "tuple-subclassing" }
-{ $subsection "tuple-declarations" }
-{ $subsection "protocol-slots" }
-{ $subsection "tuple-introspection" }
+{ $subsections
+ "accessors"
+ "tuple-constructors"
+ "tuple-subclassing"
+ "tuple-declarations"
+ "protocol-slots"
+ "tuple-introspection"
+}
"Tuple classes can be redefined; this updates existing instances:"
-{ $subsection "tuple-redefinition" }
+{ $subsections "tuple-redefinition" }
"Tuple literal syntax is documented in " { $link "syntax-tuples" } "." ;
ABOUT: "tuples"
[ ] [ "IN: classes.tuple.tests TUPLE: redefine-tuple-twice ;" eval( -- ) ] unit-test
[ t ] [ \ redefine-tuple-twice symbol? ] unit-test
+
+ERROR: base-error x y ;
+ERROR: derived-error < base-error z ;
+
+[ (( x y z -- * )) ] [ \ derived-error stack-effect ] unit-test
slots>tuple ;
: outdated-tuple? ( tuple assoc -- ? )
- over tuple? [
- [ [ layout-of ] dip key? ]
- [ drop class "forgotten" word-prop not ]
- 2bi and
- ] [ 2drop f ] if ;
+ [ [ layout-of ] dip key? ]
+ [ drop class "forgotten" word-prop not ]
+ 2bi and ;
: update-tuples ( -- )
outdated-tuples get
dup assoc-empty? [ drop ] [
- [ outdated-tuple? ] curry instances
+ [ [ tuple? ] instances ] dip [ outdated-tuple? ] curry filter
dup [ update-tuple ] map become
] if ;
[ [ "slots" word-prop ] dip = ]
bi-curry* bi and ;
-: valid-superclass? ( class -- ? )
- [ tuple-class? ] [ tuple eq? ] bi or ;
+GENERIC: valid-superclass? ( class -- ? )
+
+M: tuple-class valid-superclass? drop t ;
+
+M: builtin-class valid-superclass? tuple eq? ;
+
+M: class valid-superclass? drop f ;
: check-superclass ( superclass -- )
dup valid-superclass? [ bad-superclass ] unless drop ;
[ 2drop ?define-symbol ] [ redefine-tuple-class ] if ;
: thrower-effect ( slots -- effect )
- [ dup array? [ first ] when ] map { "*" } <effect> ;
+ [ name>> ] map { "*" } <effect> ;
: define-error-class ( class superclass slots -- )
[ define-tuple-class ]
[ 2drop reset-generic ]
[
+ 2drop
[ dup [ boa throw ] curry ]
- [ drop ]
- [ thrower-effect ]
- tri* define-declared
+ [ all-slots thrower-effect ]
+ bi define-declared
] 3tri ;
: boa-effect ( class -- effect )
ARTICLE: "unions" "Union classes"
"An object is an instance of a union class if it is an instance of one of its members."
-{ $subsection POSTPONE: UNION: }
-{ $subsection define-union-class }
+{ $subsections
+ POSTPONE: UNION:
+ define-union-class
+}
"Union classes can be introspected:"
-{ $subsection members }
+{ $subsections members }
"The set of union classes is a class:"
-{ $subsection union-class }
-{ $subsection union-class? }
+{ $subsections
+ union-class
+ union-class?
+}
"Unions are used to define behavior shared between a fixed set of classes, as well as to conveniently define predicates."
{ $see-also "mixins" "tuple-subclassing" } ;
"The cleave combinators apply multiple quotations to a single value."
$nl
"Two quotations:"
-{ $subsection bi }
-{ $subsection 2bi }
-{ $subsection 3bi }
+{ $subsections
+ bi
+ 2bi
+ 3bi
+}
"Three quotations:"
-{ $subsection tri }
-{ $subsection 2tri }
-{ $subsection 3tri }
+{ $subsections
+ tri
+ 2tri
+ 3tri
+}
"An array of quotations:"
-{ $subsection cleave }
-{ $subsection 2cleave }
-{ $subsection 3cleave }
+{ $subsections
+ cleave
+ 2cleave
+ 3cleave
+}
+$nl
"Technically, the cleave combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on the top of the stack can be written in one of two ways:"
{ $code
"! First alternative; uses keep"
"[ 2 * ] tri"
}
"The latter is more aesthetically pleasing than the former."
-{ $subsection "cleave-shuffle-equivalence" } ;
+$nl
+{ $subsections "cleave-shuffle-equivalence" } ;
ARTICLE: "spread-shuffle-equivalence" "Expressing shuffle words with spread combinators"
"Spread combinators are defined in terms of shuffle words, and mappings from certain shuffle idioms to spread combinators are discussed in the documentation for " { $link bi* } ", " { $link 2bi* } ", " { $link tri* } ", and " { $link 2tri* } "."
} ;
ARTICLE: "spread-combinators" "Spread combinators"
-"The spread combinators apply multiple quotations to multiple values. The " { $snippet "*" } " suffix signifies spreading."
+"The spread combinators apply multiple quotations to multiple values. In this case, " { $snippet "*" } " suffix signify spreading."
$nl
"Two quotations:"
-{ $subsection bi* }
-{ $subsection 2bi* }
+{ $subsections bi* 2bi* }
"Three quotations:"
-{ $subsection tri* }
-{ $subsection 2tri* }
+{ $subsections tri* 2tri* }
"An array of quotations:"
-{ $subsection spread }
+{ $subsections spread }
"Technically, the spread combinators are redundant because they can be simulated using shuffle words and other combinators, and in addition, they do not reduce token counts by much, if at all. However, they can make code more readable by expressing intention and exploiting any inherent symmetry. For example, a piece of code which performs three operations on three related values can be written in one of two ways:"
{ $code
"! First alternative; uses dip"
"[ 1 + ] [ 1 - ] [ 2 * ] tri*"
}
"A generalization of the above combinators to any number of quotations can be found in " { $link "combinators" } "."
-{ $subsection "spread-shuffle-equivalence" } ;
+$nl
+{ $subsections "spread-shuffle-equivalence" } ;
ARTICLE: "apply-combinators" "Apply combinators"
"The apply combinators apply a single quotation to multiple values. The " { $snippet "@" } " suffix signifies application."
$nl
"Two quotations:"
-{ $subsection bi@ }
-{ $subsection 2bi@ }
+{ $subsections bi@ 2bi@ }
"Three quotations:"
-{ $subsection tri@ }
-{ $subsection 2tri@ }
+{ $subsections tri@ 2tri@ }
"A pair of utility words built from " { $link bi@ } ":"
-{ $subsection both? }
-{ $subsection either? } ;
+{ $subsections both? either? } ;
ARTICLE: "retainstack-combinators" "Retain stack combinators"
"Sometimes an additional storage area is needed to hold objects. The " { $emphasis "retain stack" } " is an auxilliary stack for this purpose. Objects can be moved between the data and retain stacks using a set of combinators."
$nl
"The dip combinators invoke the quotation at the top of the stack, hiding the values underneath:"
-{ $subsection dip }
-{ $subsection 2dip }
-{ $subsection 3dip }
-{ $subsection 4dip }
+{ $subsections dip 2dip 3dip 4dip }
"The keep combinators invoke a quotation which takes a number of values off the stack, and then they restore those values:"
-{ $subsection keep }
-{ $subsection 2keep }
-{ $subsection 3keep } ;
+{ $subsections keep 2keep 3keep } ;
ARTICLE: "curried-dataflow" "Curried dataflow combinators"
"Curried cleave combinators:"
-{ $subsection bi-curry }
-{ $subsection tri-curry }
+{ $subsections bi-curry tri-curry }
"Curried spread combinators:"
-{ $subsection bi-curry* }
-{ $subsection tri-curry* }
+{ $subsections bi-curry* tri-curry* }
"Curried apply combinators:"
-{ $subsection bi-curry@ }
-{ $subsection tri-curry@ }
+{ $subsections bi-curry@ tri-curry@ }
{ $see-also "dataflow-combinators" } ;
ARTICLE: "compositional-examples" "Examples of compositional combinator usage"
ARTICLE: "compositional-combinators" "Compositional combinators"
"Certain combinators transform quotations to produce a new quotation."
-{ $subsection "compositional-examples" }
+{ $subsections "compositional-examples" }
"Fundamental operations:"
-{ $subsection curry }
-{ $subsection compose }
+{ $subsections curry compose }
"Derived operations:"
-{ $subsection 2curry }
-{ $subsection 3curry }
-{ $subsection with }
-{ $subsection prepose }
+{ $subsections 2curry 3curry with prepose }
"These operations run in constant time, and in many cases are optimized out altogether by the " { $link "compiler" } ". " { $link "fry" } " are an abstraction built on top of these operations, and code that uses this abstraction is often clearer than direct calls to the below words."
$nl
"Curried dataflow combinators can be used to build more complex dataflow by combining cleave, spread and apply patterns in various ways."
-{ $subsection "curried-dataflow" }
+{ $subsections "curried-dataflow" }
"Quotations also implement the sequence protocol, and can be manipulated with sequence words; see " { $link "quotations" } ". However, such runtime quotation manipulation will not be optimized by the optimizing compiler." ;
ARTICLE: "booleans" "Booleans"
"In Factor, any object that is not " { $link f } " has a true value, and " { $link f } " has a false value. The " { $link t } " object is the canonical true value."
-{ $subsection f }
-{ $subsection t }
+{ $subsections f t }
"A union class of the above:"
-{ $subsection boolean }
+{ $subsections boolean }
"There are some logical operations on booleans:"
-{ $subsection >boolean }
-{ $subsection not }
-{ $subsection and }
-{ $subsection or }
-{ $subsection xor }
+{ $subsections
+ >boolean
+ not
+ and
+ or
+ xor
+}
"Boolean values are most frequently used for " { $link "conditionals" } "."
{ $heading "The f object and f class" }
"The " { $link f } " object is the unique instance of the " { $link f } " class; the two are distinct objects. The latter is also a parsing word which adds the " { $link f } " object to the parse tree at parse time. To refer to the class itself you must use " { $link POSTPONE: POSTPONE: } " or " { $link POSTPONE: \ } " to prevent the parsing word from executing."
ARTICLE: "conditionals" "Conditional combinators"
"The basic conditionals:"
-{ $subsection if }
-{ $subsection when }
-{ $subsection unless }
+{ $subsections if when unless }
"Forms abstracting a common stack shuffle pattern:"
-{ $subsection if* }
-{ $subsection when* }
-{ $subsection unless* }
+{ $subsections if* when* unless* }
"Another form abstracting a common stack shuffle pattern:"
-{ $subsection ?if }
+{ $subsections ?if }
"Sometimes instead of branching, you just need to pick one of two values:"
-{ $subsection ? }
+{ $subsections ? }
"Two combinators which abstract out nested chains of " { $link if } ":"
-{ $subsection cond }
-{ $subsection case }
-{ $subsection "conditionals-boolean-equivalence" }
+{ $subsections cond case }
+{ $subsections "conditionals-boolean-equivalence" }
{ $see-also "booleans" "bitwise-arithmetic" both? either? } ;
ARTICLE: "dataflow-combinators" "Data flow combinators"
"Data flow combinators pass values between quotations:"
-{ $subsection "retainstack-combinators" }
-{ $subsection "cleave-combinators" }
-{ $subsection "spread-combinators" }
-{ $subsection "apply-combinators" }
+{ $subsections
+ "retainstack-combinators"
+ "cleave-combinators"
+ "spread-combinators"
+ "apply-combinators"
+}
{ $see-also "curried-dataflow" } ;
ARTICLE: "combinators-quot" "Quotation construction utilities"
"Some words for creating quotations which can be useful for implementing method combinations and compiler transforms:"
-{ $subsection cond>quot }
-{ $subsection case>quot }
-{ $subsection alist>quot } ;
+{ $subsections cond>quot case>quot alist>quot } ;
ARTICLE: "call-unsafe" "Unsafe combinators"
"Unsafe calls declare an effect statically without any runtime checking:"
-{ $subsection call-effect-unsafe }
-{ $subsection execute-effect-unsafe } ;
+{ $subsections call-effect-unsafe execute-effect-unsafe } ;
ARTICLE: "call" "Fundamental combinators"
"The most basic combinators are those that take either a quotation or word, and invoke it immediately."
"There are two sets of combinators; they differ in whether or not the stack effect of the expected code is declared."
$nl
"The simplest combinators do not take an effect declaration. The compiler checks the stack effect at compile time, rejecting the program if this cannot be done:"
-{ $subsection call }
-{ $subsection execute }
-"The second set of combinators takes an effect declaration. The stack effect of the quotation or word is checked at runtime:"
-{ $subsection POSTPONE: call( }
-{ $subsection POSTPONE: execute( }
+{ $subsections call execute }
+"The second set of combinators takes an effect declaration. Note that the opening parenthesis is actually part of the word name; these are parsing words, and they read a stack effect until the corresponding closing parenthesis. The stack effect of the quotation or word is then checked at runtime:"
+{ $subsections POSTPONE: call( POSTPONE: execute( }
"The above are syntax sugar. The underlying words are a bit more verbose but allow non-constant effects to be passed in:"
-{ $subsection call-effect }
-{ $subsection execute-effect }
+{ $subsections call-effect execute-effect }
"The combinator variants that do not take an effect declaration can only be used if the compiler is able to infer the stack effect by other means. See " { $link "inference-combinators" } "."
-{ $subsection "call-unsafe" }
+{ $subsections "call-unsafe" }
{ $see-also "effects" "inference" } ;
ARTICLE: "combinators" "Combinators"
"A central concept in Factor is that of a " { $emphasis "combinator" } ", which is a word taking code as input."
-{ $subsection "call" }
-{ $subsection "dataflow-combinators" }
-{ $subsection "conditionals" }
-{ $subsection "looping-combinators" }
-{ $subsection "compositional-combinators" }
-{ $subsection "combinators.short-circuit" }
-{ $subsection "combinators.smart" }
+{ $subsections
+ "call"
+ "dataflow-combinators"
+ "conditionals"
+ "looping-combinators"
+ "compositional-combinators"
+ "combinators.short-circuit"
+ "combinators.smart"
+ "combinators-quot"
+ "generalizations"
+}
"More combinators are defined for working on data structures, such as " { $link "sequences-combinators" } " and " { $link "assocs-combinators" } "."
-{ $subsection "combinators-quot" }
-{ $subsection "generalizations" }
{ $see-also "quotations" } ;
ABOUT: "combinators"
HELP: call-effect
{ $values { "quot" quotation } { "effect" effect } }
-{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." } ;
+{ $description "Given a quotation and a stack effect, calls the quotation, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary quotation which is not required at compile time." }
+{ $examples
+ "The following two lines are equivalent:"
+ { $code
+ "call( a b -- c )"
+ "(( a b -- c )) call-effect"
+ }
+} ;
HELP: execute-effect
{ $values { "word" word } { "effect" effect } }
-{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." } ;
+{ $description "Given a word and a stack effect, executes the word, asserting at runtime that it has the given stack effect. This is a macro which expands given a literal effect parameter, and an arbitrary word which is not required at compile time." }
+{ $examples
+ "The following two lines are equivalent:"
+ { $code
+ "execute( a b -- c )"
+ "(( a b -- c )) execute-effect"
+ }
+} ;
HELP: execute-effect-unsafe
{ $values { "word" word } { "effect" effect } }
"Words defined in a compilation unit may not be called until the compilation unit is finished. The parser detects this case for parsing words and throws a " { $link staging-violation } "; calling any other word from within its own compilation unit throws an " { $link undefined } " error."
$nl
"The parser groups all definitions in a source file into one compilation unit, and parsing words do not need to concern themselves with compilation units. However, if definitions are being created at run time, a compilation unit must be created explicitly:"
-{ $subsection with-compilation-unit }
+{ $subsections with-compilation-unit }
"Compiling a set of words:"
-{ $subsection compile }
+{ $subsections compile }
"Words called to associate a definition with a compilation unit and a source file location:"
-{ $subsection remember-definition }
-{ $subsection remember-class }
+{ $subsections
+ remember-definition
+ remember-class
+}
"Forward reference checking (see " { $link "definition-checking" } "):"
-{ $subsection forward-reference? }
+{ $subsections forward-reference? }
"A hook to be called at the end of the compilation unit. If the optimizing compiler is loaded, this compiles new words with the " { $link "compiler" } ":"
-{ $subsection recompile }
+{ $subsections recompile }
"Low-level compiler interface exported by the Factor VM:"
-{ $subsection modify-code-heap } ;
+{ $subsections modify-code-heap } ;
ABOUT: "compilation-units"
ARTICLE: "errors-restartable" "Restartable errors"
"Support for restartable errors is built on top of the basic error handling facility. The following words signals recoverable errors:"
-{ $subsection throw-restarts }
-{ $subsection rethrow-restarts }
+{ $subsections
+ throw-restarts
+ rethrow-restarts
+}
"The list of restarts from the most recently-thrown error is stored in a global variable:"
-{ $subsection restarts }
+{ $subsections restarts }
"To invoke restarts, see " { $link "debugger" } "." ;
ARTICLE: "errors-post-mortem" "Post-mortem error inspection"
"The most recently thrown error, together with the continuation at that point, are stored in a pair of global variables:"
-{ $subsection error }
-{ $subsection error-continuation }
+{ $subsections
+ error
+ error-continuation
+}
"Developer tools for inspecting these values are found in " { $link "debugger" } "." ;
ARTICLE: "errors-anti-examples" "Common error handling pitfalls"
"Support for handling exceptional situations such as bad user input, implementation bugs, and input/output errors is provided by a set of words built using continuations."
$nl
"Two words raise an error in the innermost error handler for the current dynamic extent:"
-{ $subsection throw }
-{ $subsection rethrow }
+{ $subsections
+ throw
+ rethrow
+}
"Words for establishing an error handler:"
-{ $subsection cleanup }
-{ $subsection recover }
-{ $subsection ignore-errors }
+{ $subsections
+ cleanup
+ recover
+ ignore-errors
+}
"Syntax sugar for defining errors:"
-{ $subsection POSTPONE: ERROR: }
+{ $subsections POSTPONE: ERROR: }
"Unhandled errors are reported in the listener and can be debugged using various tools. See " { $link "debugger" } "."
-{ $subsection "errors-restartable" }
-{ $subsection "debugger" }
-{ $subsection "errors-post-mortem" }
-{ $subsection "errors-anti-examples" }
+{ $subsections
+ "errors-restartable"
+ "debugger"
+ "errors-post-mortem"
+ "errors-anti-examples"
+}
"When Factor encouters a critical error, it calls the following word:"
-{ $subsection die } ;
+{ $subsections die } ;
ARTICLE: "continuations.private" "Continuation implementation details"
"A continuation is simply a tuple holding the contents of the five stacks:"
-{ $subsection continuation }
-{ $subsection >continuation< }
+{ $subsections
+ continuation
+ >continuation<
+}
"The five stacks can be read and written:"
-{ $subsection datastack }
-{ $subsection set-datastack }
-{ $subsection retainstack }
-{ $subsection set-retainstack }
-{ $subsection callstack }
-{ $subsection set-callstack }
-{ $subsection namestack }
-{ $subsection set-namestack }
-{ $subsection catchstack }
-{ $subsection set-catchstack } ;
+{ $subsections
+ datastack
+ set-datastack
+ retainstack
+ set-retainstack
+ callstack
+ set-callstack
+ namestack
+ set-namestack
+ catchstack
+ set-catchstack
+} ;
ARTICLE: "continuations" "Continuations"
"At any point in the execution of a program, the " { $emphasis "current continuation" } " represents the future of the computation."
"Words for working with continuations are found in the " { $vocab-link "continuations" } " vocabulary; implementation details are in " { $vocab-link "continuations.private" } "."
$nl
"Continuations can be reified with the following two words:"
-{ $subsection callcc0 }
-{ $subsection callcc1 }
+{ $subsections
+ callcc0
+ callcc1
+}
"Another two words resume continuations:"
-{ $subsection continue }
-{ $subsection continue-with }
+{ $subsections
+ continue
+ continue-with
+}
"Continuations as control-flow:"
-{ $subsection attempt-all }
-{ $subsection with-return }
+{ $subsections
+ attempt-all
+ with-return
+}
"Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
-{ $subsection "continuations.private" } ;
+{ $subsections "continuations.private" } ;
ABOUT: "continuations"
"A common protocol is used to build generic tools for working with all definitions."
$nl
"Definitions must know what source file they were loaded from, and provide a way to set this:"
-{ $subsection where }
-{ $subsection set-where }
+{ $subsections
+ where
+ set-where
+}
"Definitions can be removed:"
-{ $subsection forget }
+{ $subsections forget }
"Definitions must implement a few operations used for printing them in source form:"
-{ $subsection definer }
-{ $subsection definition }
+{ $subsections
+ definer
+ definition
+}
{ $see-also "see" } ;
ARTICLE: "definition-checking" "Definition sanity checking"
"Since this is undesirable, the parser explicitly raises a " { $link no-word } " error if a source file refers to a word which is in the dictionary, but defined after it is used."
$nl
"The parser also catches duplicate definitions. If an artifact is defined twice in the same source file, the earlier definition will never be accessible, and this is almost always a mistake, perhaps due to a bad choice of word names, or a copy and paste error. The parser raises an error in this case."
-{ $subsection redefine-error } ;
+{ $subsections redefine-error } ;
ARTICLE: "definitions" "Definitions"
"A " { $emphasis "definition" } " is an artifact read from a source file. Words for working with definitions are found in the " { $vocab-link "definitions" } " vocabulary."
"Instances of the definition may be introspected and modified with the definition protocol"
}
"For every source file loaded into the system, a list of definitions is maintained. Pathname objects implement the definition protocol, acting over the definitions their source files contain. See " { $link "source-files" } " for details."
-{ $subsection "definition-protocol" }
-{ $subsection "definition-checking" }
-{ $subsection "compilation-units" }
+{ $subsections
+ "definition-protocol"
+ "definition-checking"
+ "compilation-units"
+}
"A parsing word to remove definitions:"
-{ $subsection POSTPONE: FORGET: }
+{ $subsections POSTPONE: FORGET: }
{ $see-also "see" "parser" "source-files" "words" "generic" "help-impl" } ;
ABOUT: "definitions"
GENERIC: forget* ( defspec -- )
-M: f forget* drop ;
-
-M: wrapper forget* wrapped>> forget* ;
-
SYMBOL: forgotten-definitions
: forgotten-definition ( defspec -- )
: forget ( defspec -- ) [ forgotten-definition ] [ forget* ] bi ;
+M: f forget* drop ;
+
+M: wrapper forget* wrapped>> forget ;
+
: forget-all ( definitions -- ) [ forget ] each ;
GENERIC: definer ( defspec -- start end )
ARTICLE: "destructors-using" "Using destructors"
"Disposing of an object:"
-{ $subsection dispose }
+{ $subsections dispose }
"Utility word for scoped disposal:"
-{ $subsection with-disposal }
+{ $subsections with-disposal }
"Utility word for disposing multiple objects:"
-{ $subsection dispose-each }
+{ $subsections dispose-each }
"Utility words for more complex disposal patterns:"
-{ $subsection with-destructors }
-{ $subsection &dispose }
-{ $subsection |dispose } ;
+{ $subsections
+ with-destructors
+ &dispose
+ |dispose
+} ;
ARTICLE: "destructors-extending" "Writing new destructors"
"Superclass for disposable objects:"
-{ $subsection disposable }
+{ $subsections disposable }
"Parametrized constructor for disposable objects:"
-{ $subsection new-disposable }
+{ $subsections new-disposable }
"Generic disposal word:"
-{ $subsection dispose* }
+{ $subsections dispose* }
"Global set of disposable objects:"
-{ $subsection disposables } ;
+{ $subsections disposables } ;
ARTICLE: "destructors" "Deterministic resource disposal"
"Operating system resources such as streams, memory mapped files, and so on are not managed by Factor's garbage collector and must be released when you are done with them. Failing to release a resource can lead to reduced performance and instability."
-{ $subsection "destructors-using" }
-{ $subsection "destructors-extending" }
-{ $subsection "destructors-anti-patterns" }
+{ $subsections
+ "destructors-using"
+ "destructors-extending"
+ "destructors-anti-patterns"
+}
{ $see-also "tools.destructors" } ;
ABOUT: "destructors"
-USING: effects tools.test prettyprint accessors sequences ;
+USING: effects kernel tools.test prettyprint accessors
+quotations sequences ;
IN: effects.tests
[ t ] [ 1 1 <effect> 2 2 <effect> effect<= ] unit-test
[ t ] [ (( -- )) (( -- )) compose-effects (( -- )) effect= ] unit-test
[ t ] [ (( -- * )) (( -- )) compose-effects (( -- * )) effect= ] unit-test
[ t ] [ (( -- )) (( -- * )) compose-effects (( -- * )) effect= ] unit-test
+
+[ { object object } ] [ (( a b -- )) effect-in-types ] unit-test
+[ { object sequence } ] [ (( a b: sequence -- )) effect-in-types ] unit-test
! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.parser math.order namespaces make sequences strings
-words assocs combinators accessors arrays ;
+words assocs combinators accessors arrays quotations ;
IN: effects
TUPLE: effect { in read-only } { out read-only } { terminated? read-only } ;
")" %
] "" make ;
+GENERIC: effect>type ( obj -- type )
+M: object effect>type drop object ;
+M: word effect>type ;
+! attempting to specialize on callable breaks compiling
+! M: effect effect>type drop callable ;
+M: pair effect>type second effect>type ;
+
GENERIC: stack-effect ( word -- effect/f )
M: word stack-effect "declared-effect" word-prop ;
[ [ [ "obj" ] replicate ] bi@ ] dip
effect boa
] if ; inline
+
+: effect-in-types ( effect -- input-types )
+ in>> [ effect>type ] map ;
+: effect-out-types ( effect -- input-types )
+ out>> [ effect>type ] map ;
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: lexer sets sequences kernel splitting effects
-combinators arrays ;
+combinators arrays vocabs.parser classes ;
IN: effects.parser
DEFER: parse-effect
dup { f "(" "((" } member? [ bad-effect ] [
":" ?tail [
scan {
- { "(" [ ")" parse-effect ] }
- { f [ ")" unexpected-eof ] }
+ { [ dup "(" = ] [ drop ")" parse-effect ] }
+ { [ dup search class? ] [ search ] }
+ { [ dup f = ] [ ")" unexpected-eof ] }
[ bad-effect ]
- } case 2array
+ } cond 2array
] when
] if
] if ;
"Now, the linear order is the following, from least-specific to most-specific:"
{ $code "{ object sequence number integer }" }
"The " { $link order } " word can be useful to clarify method dispatch order:"
-{ $subsection order } ;
+{ $subsections order } ;
ARTICLE: "generic-introspection" "Generic word introspection"
"In most cases, generic words and methods are defined at parse time with " { $link POSTPONE: GENERIC: } " (or some other parsing word) and " { $link POSTPONE: M: } "."
"Sometimes, generic words need to be inspected defined at run time; words for performing these tasks are found in the " { $vocab-link "generic" } " vocabulary."
$nl
"The set of generic words is a class which implements the " { $link "definition-protocol" } ":"
-{ $subsection generic }
-{ $subsection generic? }
+{ $subsections
+ generic
+ generic?
+}
"New generic words can be defined:"
-{ $subsection define-generic }
-{ $subsection define-simple-generic }
+{ $subsections
+ define-generic
+ define-simple-generic
+}
"Methods can be added to existing generic words:"
-{ $subsection create-method }
+{ $subsections create-method }
"Method definitions can be looked up:"
-{ $subsection method }
+{ $subsections method }
"Finding the most specific method for an object:"
-{ $subsection effective-method }
+{ $subsections effective-method }
"A generic word contains methods; the list of methods specializing on a class can also be obtained:"
-{ $subsection implementors }
+{ $subsections implementors }
"Low-level word which rebuilds the generic word after methods are added or removed, or the method combination is changed:"
-{ $subsection make-generic }
+{ $subsections make-generic }
"Low-level method constructor:"
-{ $subsection <method> }
+{ $subsections <method> }
"Methods may be pushed on the stack with a literal syntax:"
-{ $subsection POSTPONE: M\ }
+{ $subsections POSTPONE: M\ }
{ $see-also "see" } ;
ARTICLE: "method-combination" "Custom method combination"
"If a generic word is called with an object and multiple methods specialize on classes that this object is an instance of, usually the most specific method is called (" { $link "method-order" } ")."
$nl
"Less-specific methods can be called directly:"
-{ $subsection POSTPONE: call-next-method }
+{ $subsections POSTPONE: call-next-method }
"A lower-level word which the above expands into:"
-{ $subsection (call-next-method) }
+{ $subsections (call-next-method) }
"To look up the next applicable method reflectively:"
-{ $subsection next-method }
+{ $subsections next-method }
"Errors thrown by improper calls to " { $link POSTPONE: call-next-method } ":"
-{ $subsection inconsistent-next-method }
-{ $subsection no-next-method } ;
+{ $subsections
+ inconsistent-next-method
+ no-next-method
+} ;
ARTICLE: "generic" "Generic words and methods"
"A " { $emphasis "generic word" } " is composed of zero or more " { $emphasis "methods" } " together with a " { $emphasis "method combination" } ". A method " { $emphasis "specializes" } " on a class; when a generic word executed, the method combination chooses the most appropriate method and calls its definition."
"A generic word behaves roughly like a long series of class predicate conditionals in a " { $link cond } " form, however methods can be defined in independent source files, reducing coupling and increasing extensibility. The method combination determines which object the generic word will " { $emphasis "dispatch" } " on; this could be the top of the stack, or some other value."
$nl
"Generic words which dispatch on the object at the top of the stack:"
-{ $subsection POSTPONE: GENERIC: }
+{ $subsections POSTPONE: GENERIC: }
"A method combination which dispatches on a specified stack position:"
-{ $subsection POSTPONE: GENERIC# }
+{ $subsections POSTPONE: GENERIC# }
"A method combination which dispatches on the value of a variable at the time the generic word is called:"
-{ $subsection POSTPONE: HOOK: }
+{ $subsections POSTPONE: HOOK: }
"A method combination which dispatches on a pair of stack values, which must be numbers, and upgrades both to the same type of number:"
-{ $subsection POSTPONE: MATH: }
+{ $subsections POSTPONE: MATH: }
"Method definition:"
-{ $subsection POSTPONE: M: }
+{ $subsections POSTPONE: M: }
"Generic words must declare their stack effect in order to compile. See " { $link "effects" } "."
-{ $subsection "method-order" }
-{ $subsection "call-next-method" }
-{ $subsection "method-combination" }
-{ $subsection "generic-introspection" }
+{ $subsections
+ "method-order"
+ "call-next-method"
+ "method-combination"
+ "generic-introspection"
+}
"Generic words specialize behavior based on the class of an object; sometimes behavior needs to be specialized on the object's " { $emphasis "structure" } "; this is known as " { $emphasis "pattern matching" } " and is implemented in the " { $vocab-link "match" } " vocabulary." ;
ABOUT: "generic"
-USING: accessors alien arrays definitions generic generic.standard
-generic.math assocs hashtables io kernel math namespaces parser
-prettyprint sequences strings tools.test vectors words
-quotations classes classes.algebra classes.tuple continuations
-layouts classes.union sorting compiler.units eval multiline
-io.streams.string ;
+USING: accessors alien arrays assocs classes classes.algebra
+classes.tuple classes.union compiler.units continuations
+definitions eval generic generic.math generic.standard
+hashtables io io.streams.string kernel layouts math math.order
+namespaces parser prettyprint quotations sequences sorting
+strings tools.test vectors words generic.single ;
IN: generic.tests
GENERIC: foobar ( x -- y )
! erg's regression
[ ] [
- <"
- IN: compiler.tests
+ """IN: compiler.tests
GENERIC: jeah ( a -- b )
TUPLE: boii ;
M: boii jeah ;
GENERIC: jeah* ( a -- b )
- M: boii jeah* jeah ;
- "> eval( -- )
+ M: boii jeah* jeah ;""" eval( -- )
- <"
- IN: compiler.tests
- FORGET: boii
- "> eval( -- )
+ """IN: compiler.tests
+ FORGET: boii""" eval( -- )
- <"
- IN: compiler.tests
+ """IN: compiler.tests
TUPLE: boii ;
- M: boii jeah ;
- "> eval( -- )
+ M: boii jeah ;""" eval( -- )
] unit-test
! call-next-method cache test
[ ] [ "IN: generic.tests.a" <string-reader> "move-method-test-1" parse-stream drop ] unit-test
[ { string } ] [ \ move-method-generic order ] unit-test
+
+GENERIC: foozul ( a -- b )
+M: reversed foozul ;
+M: integer foozul ;
+M: slice foozul ;
+
+[ t ] [
+ reversed \ foozul method-for-class
+ reversed \ foozul method
+ eq?
+] unit-test
+
+[ t ] [
+ fixnum \ <=> method-for-class
+ real \ <=> method
+ eq?
+] unit-test
+
+! FORGET: on method wrappers
+GENERIC: forget-test ( a -- b )
+
+M: integer forget-test 3 + ;
+
+[ ] [ "IN: generic.tests USE: math FORGET: M\\ integer forget-test" eval( -- ) ] unit-test
+
+[ { } ] [
+ \ + compiled-usage keys
+ [ method-body? ] filter
+ [ "method-generic" word-prop \ forget-test eq? ] filter
+] unit-test
+
+[ 10 forget-test ] [ no-method? ] must-fail-with
: method ( class generic -- method/f )
"methods" word-prop at ;
+<PRIVATE
+
+: interesting-class? ( class1 class2 -- ? )
+ {
+ ! Case 1: no intersection. Discard and keep going
+ { [ 2dup classes-intersect? not ] [ 2drop t ] }
+ ! Case 2: class1 contained in class2. Add to
+ ! interesting set and keep going.
+ { [ 2dup class<= ] [ nip , t ] }
+ ! Case 3: class1 and class2 are incomparable. Give up
+ [ 2drop f ]
+ } cond ;
+
+: interesting-classes ( class classes -- interesting/f )
+ [ [ interesting-class? ] with all? ] { } make and ;
+
+PRIVATE>
+
+: method-classes ( generic -- classes )
+ "methods" word-prop keys ;
+
: order ( generic -- seq )
- "methods" word-prop keys sort-classes ;
+ method-classes sort-classes ;
+
+: nearest-class ( class generic -- class/f )
+ method-classes interesting-classes smallest-class ;
-: specific-method ( class generic -- method/f )
- [ nip ] [ order min-class ] 2bi
- dup [ swap method ] [ 2drop f ] if ;
+: method-for-class ( class generic -- method/f )
+ [ nip ] [ nearest-class ] 2bi dup [ swap method ] [ 2drop f ] if ;
GENERIC: effective-method ( generic -- method )
\ effective-method t "no-compile" set-word-prop
: next-method-class ( class generic -- class/f )
- order [ class<= ] with filter reverse dup length 1 =
- [ drop f ] [ second ] if ;
+ method-classes [ class< ] with filter smallest-class ;
: next-method ( class generic -- method/f )
[ next-method-class ] keep method ;
[ drop remake-generic drop ]
3tri ; inline
-: method-word-name ( class word -- string )
+: method-word-name ( class generic -- string )
[ name>> ] bi@ "=>" glue ;
PREDICATE: method-body < word
: <method> ( class generic -- method )
check-method
- [ method-word-props ] 2keep
- method-word-name f <word>
- swap >>props ;
+ [ method-word-name f <word> ] [ method-word-props ] 2bi
+ >>props ;
: with-implementors ( class generic quot -- )
[ swap implementors-map get at ] dip call ; inline
M: hook-generic definer drop \ HOOK: f ;
M: hook-generic effective-method
- [ "combination" word-prop var>> get ] keep (effective-method) ;
\ No newline at end of file
+ [ "combination" word-prop var>> get ] keep method-for-object ;
\ No newline at end of file
<PRIVATE
-: applicable-method ( generic class -- quot )
+: (math-method) ( generic class -- quot )
over method
[ 1quotation ]
[ default-math-method ] ?if ;
PRIVATE>
: object-method ( generic -- quot )
- object bootstrap-word applicable-method ;
+ object bootstrap-word (math-method) ;
: math-method ( word class1 class2 -- quot )
2dup and [
[ 2array [ declare ] curry nip ]
[ math-upgrade nip ]
- [ math-class-max over order min-class applicable-method ]
+ [ math-class-max over nearest-class (math-method) ]
3tri 3append
] [
2drop object-method
-USING: tools.test math math.functions math.constants generic.standard
-generic.single strings sequences arrays kernel accessors words
-specialized-arrays.double byte-arrays bit-arrays parser namespaces
-make quotations stack-checker vectors growable hashtables sbufs
-prettyprint byte-vectors bit-vectors specialized-vectors.double
+USING: tools.test math math.functions math.constants
+generic.standard generic.single strings sequences arrays kernel
+accessors words byte-arrays bit-arrays parser namespaces make
+quotations stack-checker vectors growable hashtables sbufs
+prettyprint byte-vectors bit-vectors specialized-vectors
definitions generic sets graphs assocs grouping see eval ;
+SPECIALIZED-VECTOR: double
IN: generic.single.tests
GENERIC: lo-tag-test ( obj -- obj' )
] [ 3drop f ] if
] with-combination ;
-: (effective-method) ( obj word -- method )
- [ [ order [ instance? ] with find-last nip ] keep method ]
+: method-for-object ( obj word -- method )
+ [ [ method-classes [ instance? ] with filter smallest-class ] keep method ]
[ "default-method" word-prop ]
bi or ;
M: standard-generic effective-method
[ datastack ] dip [ "combination" word-prop #>> swap <reversed> nth ] keep
- (effective-method) ;
+ method-for-object ;
: inline-cache-quot ( word methods miss-word -- quot )
[ [ literalize , ] [ , ] [ combination get #>> , { } , , ] tri* ] [ ] make ;
"Words for treating associative mappings as directed graphs can be found in the " { $vocab-link "graphs" } " vocabulary. A directed graph is represented as an assoc mapping each vertex to a set of edges entering that vertex, where the set is itself an assoc, with equal keys and values."
$nl
"To create a new graph, just create an assoc, for example by calling " { $link <hashtable> } ". To add vertices and edges to a graph:"
-{ $subsection add-vertex }
+{ $subsections add-vertex }
"To remove vertices from the graph:"
-{ $subsection remove-vertex }
+{ $subsections remove-vertex }
"Since graphs are represented as assocs, they can be cleared out by calling " { $link clear-assoc } "."
$nl
"You can perform queries on the graph:"
-{ $subsection closure }
+{ $subsections closure }
"Directed graphs are used to maintain cross-referencing information for " { $link "definitions" } "." ;
ABOUT: "graphs"
"Resizable sequences are implementing by having a wrapper object hold a reference to an underlying sequence, together with a fill pointer indicating how many elements of the underlying sequence are occupied. When the fill pointer exceeds the underlying sequence capacity, the underlying sequence grows."
$nl
"There is a resizable sequence mixin:"
-{ $subsection growable }
+{ $subsections growable }
"This mixin implements the sequence protocol by assuming the object has two specific slots:"
{ $list
{ { $snippet "length" } " - the fill pointer (number of occupied elements in the underlying storage)" }
{ { $snippet "underlying" } " - the underlying storage" }
}
"The underlying sequence must implement a generic word:"
-{ $subsection resize }
+{ $subsections resize }
{ $link "vectors" } " and " { $link "sbufs" } " are implemented using the resizable sequence facility." ;
ABOUT: "growable"
"There are two special objects: the " { $link ((tombstone)) } " marker and the " { $link ((empty)) } " marker. Neither of these markers can be used as hashtable keys."
$nl
"The " { $snippet "count" } " slot is the number of entries including deleted entries, and " { $snippet "deleted" } " is the number of deleted entries."
-{ $subsection <hash-array> }
-{ $subsection set-nth-pair }
+{ $subsections
+ <hash-array>
+ set-nth-pair
+}
"If a hashtable's keys are mutated, or if hashing algorithms change, hashtables can be rehashed:"
-{ $subsection rehash } ;
+{ $subsections rehash } ;
ARTICLE: "hashtables" "Hashtables"
"A hashtable provides efficient (expected constant time) lookup and storage of key/value pairs. Keys are compared for equality, and a hashing function is used to reduce the number of comparisons made. The literal syntax is covered in " { $link "syntax-hashtables" } "."
"Words for constructing hashtables are in the " { $vocab-link "hashtables" } " vocabulary. Hashtables implement the " { $link "assocs-protocol" } ", and all " { $link "assocs" } " can be used on them; there are no hashtable-specific words to access and modify keys, because associative mapping operations are generic and work with all associative mappings."
$nl
"Hashtables are a class of objects."
-{ $subsection hashtable }
-{ $subsection hashtable? }
+{ $subsections
+ hashtable
+ hashtable?
+}
"You can create a new hashtable with an initial capacity."
-{ $subsection <hashtable> }
+{ $subsections <hashtable> }
"If you don't care about initial capacity, a more elegant way to create a new hashtable is to write:"
{ $code "H{ } clone" }
"To convert an assoc to a hashtable:"
-{ $subsection >hashtable }
+{ $subsections >hashtable }
"Further topics:"
-{ $subsection "hashtables.keys" }
-{ $subsection "hashtables.utilities" }
-{ $subsection "hashtables.private" } ;
+{ $subsections
+ "hashtables.keys"
+ "hashtables.utilities"
+ "hashtables.private"
+} ;
ARTICLE: "hashtables.keys" "Hashtable keys"
"Hashtables rely on the " { $link hashcode } " word to rapidly locate values associated with keys. The objects used as keys in a hashtable must obey certain restrictions."
ARTICLE: "hashtables.utilities" "Hashtable utilities"
"Utility words to create a new hashtable from a single key/value pair:"
-{ $subsection associate }
-{ $subsection ?set-at } ;
+{ $subsections
+ associate
+ ?set-at
+} ;
ABOUT: "hashtables"
ARTICLE: "init" "Initialization and startup"
"When Factor starts, the first thing it does is call a word:"
-{ $subsection boot }
+{ $subsections boot }
"Next, initialization hooks are called:"
-{ $subsection do-init-hooks }
+{ $subsections do-init-hooks }
"Initialization hooks can be defined:"
-{ $subsection add-init-hook }
+{ $subsections add-init-hook }
"The boot quotation can be changed:"
-{ $subsection boot-quot }
-{ $subsection set-boot-quot } ;
+{ $subsections
+ boot-quot
+ set-boot-quot
+} ;
ABOUT: "init"
{ "Value:" { $snippet "ca" } { $snippet "fe" } { $snippet "ba" } { $snippet "be" } }
}
"Two words convert a sequence of bytes into an integer:"
-{ $subsection be> }
-{ $subsection le> }
+{ $subsections
+ be>
+ le>
+}
"Two words convert an integer into a sequence of bytes:"
-{ $subsection >be }
-{ $subsection >le }
+{ $subsections
+ >be
+ >le
+}
"Words for taking larger integers apart into smaller integers:"
-{ $subsection d>w/w }
-{ $subsection w>h/h }
-{ $subsection h>b/b } ;
+{ $subsections
+ d>w/w
+ w>h/h
+ h>b/b
+} ;
ABOUT: "stream-binary"
ARTICLE: "encodings-descriptors" "Encoding descriptors"
"An encoding descriptor is something which can be used with binary input or output streams to encode or decode bytes stored in a certain representation. It must conform to the " { $link "encodings-protocol" } ". Encodings which you can use are defined in the following vocabularies:"
-{ $subsection "io.encodings.binary" }
-{ $subsection "io.encodings.utf8" }
+{ $subsections
+ "io.encodings.binary"
+ "io.encodings.utf8"
+}
{ $vocab-subsection "UTF-16 encoding" "io.encodings.utf16" }
{ $vocab-subsection "UTF-32 encoding" "io.encodings.utf32" }
{ $vocab-subsection "Strict encodings" "io.encodings.strict" }
ARTICLE: "encodings-protocol" "Encoding protocol"
"There are two parts to implementing a new encoding. First, methods for creating an encoded or decoded stream must be provided. These have defaults, however, which wrap a stream in an encoder or decoder wrapper with the given encoding descriptor."
-{ $subsection <encoder> }
-{ $subsection <decoder> }
+{ $subsections
+ <encoder>
+ <decoder>
+}
"If an encoding might be contained in the code slot of an encoder or decoder tuple, then the following methods must be implemented to read or write one code point from a stream:"
-{ $subsection decode-char }
-{ $subsection encode-char }
+{ $subsections
+ decode-char
+ encode-char
+}
{ $see-also "encodings-introduction" } ;
ARTICLE: "encodings-constructors" "Manually constructing an encoded stream"
"The following words can be used to construct encoded streams. Note that they are usually not used directly, but rather by the stream constructors themselves. Most stream constructors take an encoding descriptor as a parameter and call these constructors internally."
-{ $subsection <encoder> }
-{ $subsection <decoder> } ;
+{ $subsections
+ <encoder>
+ <decoder>
+} ;
ARTICLE: "io.encodings" "I/O encodings"
"The " { $vocab-link "io.encodings" } " vocabulary provides utilities for encoding and decoding bytes that represent text. Encodings can be used in the following situations:"
"With byte arrays, to convert bytes to characters"
"With strings, to convert characters to bytes"
}
-{ $subsection "encodings-descriptors" }
-{ $subsection "encodings-constructors" }
-{ $subsection "io.encodings.string" }
+{ $subsections
+ "encodings-descriptors"
+ "encodings-constructors"
+ "io.encodings.string"
+}
"New types of encodings can be defined:"
-{ $subsection "encodings-protocol" }
+{ $subsections "encodings-protocol" }
"Setting encodings on the current streams:"
-{ $subsection encode-output }
-{ $subsection decode-input }
+{ $subsections
+ encode-output
+ decode-input
+}
"Setting encodings on streams:"
-{ $subsection re-encode }
-{ $subsection re-decode }
+{ $subsections
+ re-encode
+ re-decode
+}
"Combinators to change the encoding:"
-{ $subsection with-encoded-output }
-{ $subsection with-decoded-input }
+{ $subsections
+ with-encoded-output
+ with-decoded-input
+}
{ $see-also "encodings-introduction" } ;
ABOUT: "io.encodings"
USING: io.files io.streams.string io io.streams.byte-array
tools.test kernel io.encodings.ascii io.encodings.utf8
-namespaces accessors io.encodings ;
+namespaces accessors io.encodings io.streams.limited ;
IN: io.streams.encodings.tests
[ { } ]
M: decoder stream-element-type
drop +character+ ;
+M: decoder stream-tell stream>> stream-tell ;
+
+M: decoder stream-seek stream>> stream-seek ;
+
M: decoder stream-read1
dup >decoder< decode-char fix-read1 ;
ARTICLE: "io.encodings.utf16" "UTF-16 encoding"
"The UTF-16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences. There are three encoding descriptor classes for working with UTF-16, depending on endianness or the presence of a BOM:"
-{ $subsection utf16 }
-{ $subsection utf16le }
-{ $subsection utf16be } ;
+{ $subsections
+ utf16
+ utf16le
+ utf16be
+} ;
ABOUT: "io.encodings.utf16"
ARTICLE: "io.encodings.utf8" "UTF-8 encoding"
"UTF-8 is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences."
-{ $subsection utf8 } ;
+{ $subsections utf8 } ;
ABOUT: "io.encodings.utf8"
} ;
ARTICLE: "io.files" "Reading and writing files"
-{ $subsection "io.files.examples" }
+{ $subsections "io.files.examples" }
"File streams:"
-{ $subsection <file-reader> }
-{ $subsection <file-writer> }
-{ $subsection <file-appender> }
+{ $subsections
+ <file-reader>
+ <file-writer>
+ <file-appender>
+}
"Reading and writing the entire contents of a file; this is only recommended for smaller files:"
-{ $subsection file-contents }
-{ $subsection set-file-contents }
-{ $subsection file-lines }
-{ $subsection set-file-lines }
+{ $subsections
+ file-contents
+ set-file-contents
+ file-lines
+ set-file-lines
+}
"Utility combinators:"
-{ $subsection with-file-reader }
-{ $subsection with-file-writer }
-{ $subsection with-file-appender } ;
+{ $subsections
+ with-file-reader
+ with-file-writer
+ with-file-appender
+} ;
ABOUT: "io.files"
{ $description "Copies the contents of one stream into another, closing both streams when done." }
$io-error ;
+HELP: stream-tell
+{ $values
+ { "stream" "a stream" } { "n" integer }
+}
+{ $description "Returns the index of the stream pointer if the stream is seekable." }
+{ $notes "Stream seeking is not supported on streams that do not have a known length, e.g. TCP/IP streams." } ;
+
+
HELP: stream-seek
{ $values
{ "n" integer } { "seek-type" "a seek singleton" } { "stream" "a stream" }
"All streams must implement the " { $link dispose } " word in addition to the stream protocol."
$nl
"The following word is required for all input and output streams:"
-{ $subsection stream-element-type }
+{ $subsections stream-element-type }
"These words are required for binary and string input streams:"
-{ $subsection stream-read1 }
-{ $subsection stream-read }
-{ $subsection stream-read-until }
-{ $subsection stream-read-partial }
+{ $subsections
+ stream-read1
+ stream-read
+ stream-read-until
+ stream-read-partial
+}
"This word is only required for string input streams:"
-{ $subsection stream-readln }
+{ $subsections stream-readln }
"These words are required for binary and string output streams:"
-{ $subsection stream-flush }
-{ $subsection stream-write1 }
-{ $subsection stream-write }
+{ $subsections
+ stream-flush
+ stream-write1
+ stream-write
+}
"This word is only required for string output streams:"
-{ $subsection stream-nl }
-"This word is for streams that allow seeking:"
-{ $subsection stream-seek }
+{ $subsections stream-nl }
+"These words are for seekable streams:"
+{ $subsections
+ stream-tell
+ stream-seek
+}
{ $see-also "io.timeouts" } ;
ARTICLE: "stdio-motivation" "Motivation for default streams"
} ;
ARTICLE: "stdio" "Default input and output streams"
-{ $subsection "stdio-motivation" }
+{ $subsections "stdio-motivation" }
"The default input stream is stored in a dynamically-scoped variable:"
-{ $subsection input-stream }
+{ $subsections input-stream }
"Unless rebound in a child namespace, this variable will be set to a console stream for reading input from the user."
$nl
"Words reading from the default input stream:"
-{ $subsection read1 }
-{ $subsection read }
-{ $subsection read-until }
-{ $subsection read-partial }
+{ $subsections
+ read1
+ read
+ read-until
+ read-partial
+}
"If the default input stream is a character stream (" { $link stream-element-type } " outputs " { $link +character+ } "), lines of text can be read:"
-{ $subsection readln }
+{ $subsections readln }
"Seeking on the default input stream:"
-{ $subsection seek-input }
+{ $subsections seek-input }
"A pair of combinators for rebinding the " { $link input-stream } " variable:"
-{ $subsection with-input-stream }
-{ $subsection with-input-stream* }
+{ $subsections
+ with-input-stream
+ with-input-stream*
+}
"The default output stream is stored in a dynamically-scoped variable:"
-{ $subsection output-stream }
+{ $subsections output-stream }
"Unless rebound in a child namespace, this variable will be set to a console stream for showing output to the user."
$nl
"Words writing to the default output stream:"
-{ $subsection flush }
-{ $subsection write1 }
-{ $subsection write }
+{ $subsections
+ flush
+ write1
+ write
+}
"If the default output stream is a character stream (" { $link stream-element-type } " outputs " { $link +character+ } "), lines of text can be written:"
-{ $subsection print }
-{ $subsection nl }
-{ $subsection bl }
+{ $subsections
+ print
+ nl
+ bl
+}
"Seeking on the default output stream:"
-{ $subsection seek-output }
+{ $subsections seek-output }
"Seeking descriptors:"
-{ $subsection seek-absolute }
-{ $subsection seek-relative }
-{ $subsection seek-end }
+{ $subsections
+ seek-absolute
+ seek-relative
+ seek-end
+}
"A pair of combinators for rebinding the " { $link output-stream } " variable:"
-{ $subsection with-output-stream }
-{ $subsection with-output-stream* }
+{ $subsections
+ with-output-stream
+ with-output-stream*
+}
"A pair of combinators for rebinding both default streams at once:"
-{ $subsection with-streams }
-{ $subsection with-streams* } ;
+{ $subsections
+ with-streams
+ with-streams*
+} ;
ARTICLE: "stream-utils" "Stream utilities"
"There are a few useful stream-related words which are not generic, but merely built up from the stream protocol."
$nl
"First, a simple composition of " { $link stream-write } " and " { $link stream-nl } ":"
-{ $subsection stream-print }
+{ $subsections stream-print }
"Processing lines one by one:"
-{ $subsection stream-lines }
-{ $subsection lines }
-{ $subsection each-line }
+{ $subsections
+ stream-lines
+ lines
+ each-line
+}
"Processing blocks of data:"
-{ $subsection stream-contents }
-{ $subsection contents }
-{ $subsection each-block }
+{ $subsections
+ stream-contents
+ contents
+ each-block
+}
"Copying the contents of one stream to another:"
-{ $subsection stream-copy } ;
+{ $subsections stream-copy } ;
ARTICLE: "stream-examples" "Stream example"
"Ask the user for their age, and print it back:"
ARTICLE: "streams" "Streams"
"Input and output centers on the concept of a " { $emphasis "stream" } ", which is a source or sink of " { $emphasis "elements" } "."
-{ $subsection "stream-examples" }
+{ $subsections "stream-examples" }
"A stream can either be passed around on the stack or bound to a dynamic variable and used as one of the two implicit " { $emphasis "default streams" } "."
-{ $subsection "stream-protocol" }
-{ $subsection "stdio" }
-{ $subsection "stream-utils" }
+{ $subsections
+ "stream-protocol"
+ "stdio"
+ "stream-utils"
+}
{ $see-also "io.streams.string" "io.streams.plain" "io.streams.duplex" } ;
ABOUT: "streams"
! Copyright (C) 2003, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: hashtables generic kernel math namespaces make sequences
-continuations destructors assocs combinators ;
+USING: accessors combinators continuations destructors kernel
+math namespaces sequences ;
IN: io
SYMBOLS: +byte+ +character+ ;
SINGLETONS: seek-absolute seek-relative seek-end ;
+GENERIC: stream-tell ( stream -- n )
GENERIC: stream-seek ( n seek-type stream -- )
-: stream-print ( str stream -- ) [ stream-write ] keep stream-nl ;
+<PRIVATE
+
+SLOT: i
+
+: (stream-seek) ( n seek-type stream -- )
+ swap {
+ { seek-absolute [ (>>i) ] }
+ { seek-relative [ [ + ] change-i drop ] }
+ { seek-end [ [ underlying>> length + ] [ (>>i) ] bi ] }
+ [ bad-seek-type ]
+ } case ;
+
+PRIVATE>
+
+: stream-print ( str stream -- ) [ stream-write ] [ stream-nl ] bi ;
! Default streams
SYMBOL: input-stream
: read ( n -- seq ) input-stream get stream-read ;
: read-until ( seps -- seq sep/f ) input-stream get stream-read-until ;
: read-partial ( n -- seq ) input-stream get stream-read-partial ;
+: tell-input ( -- n ) input-stream get stream-tell ;
+: tell-output ( -- n ) output-stream get stream-tell ;
: seek-input ( n seek-type -- ) input-stream get stream-seek ;
: seek-output ( n seek-type -- ) output-stream get stream-seek ;
ARTICLE: "io.pathnames" "Pathname manipulation"
"Pathname manipulation:"
-{ $subsection parent-directory }
-{ $subsection file-name }
-{ $subsection file-stem }
-{ $subsection file-extension }
-{ $subsection last-path-separator }
-{ $subsection path-components }
-{ $subsection prepend-path }
-{ $subsection append-path }
-{ $subsection canonicalize-path }
+{ $subsections
+ parent-directory
+ file-name
+ file-stem
+ file-extension
+ last-path-separator
+ path-components
+ prepend-path
+ append-path
+ canonicalize-path
+}
"Pathname presentations:"
-{ $subsection pathname }
-{ $subsection <pathname> }
+{ $subsections
+ pathname
+ <pathname>
+}
"Literal pathnames:"
-{ $subsection POSTPONE: P" }
+{ $subsections POSTPONE: P" }
"Low-level word:"
-{ $subsection normalize-path } ;
+{ $subsections normalize-path } ;
ABOUT: "io.pathnames"
ARTICLE: "io.streams.byte-array" "Byte-array streams"
"Byte array streams:"
-{ $subsection <byte-reader> }
-{ $subsection <byte-writer> }
+{ $subsections
+ <byte-reader>
+ <byte-writer>
+}
"Utility combinators:"
-{ $subsection with-byte-reader }
-{ $subsection with-byte-writer } ;
+{ $subsections
+ with-byte-reader
+ with-byte-writer
+} ;
HELP: <byte-reader>
{ $values { "byte-array" byte-array }
] with-byte-reader
] unit-test
+[ 0 ] [
+ B{ 1 2 3 4 5 6 7 8 9 10 11 12 } binary [ tell-input ] with-byte-reader
+] unit-test
+
! Overly aggressive compiler optimizations
[ B{ 123 } ] [
binary [ 123 >bignum write1 ] with-byte-writer
-] unit-test
\ No newline at end of file
+] unit-test
! Copyright (C) 2008, 2009 Daniel Ehrenberg
! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays byte-vectors kernel io.encodings sequences io
-namespaces io.encodings.private accessors sequences.private
-io.streams.sequence destructors math combinators ;
+USING: accessors byte-arrays byte-vectors destructors io
+io.encodings io.private io.streams.sequence kernel namespaces
+sequences sequences.private ;
IN: io.streams.byte-array
M: byte-vector stream-element-type drop +byte+ ;
M: byte-reader stream-read-until sequence-read-until ;
M: byte-reader dispose drop ;
-M: byte-reader stream-seek ( n seek-type stream -- )
- swap {
- { seek-absolute [ (>>i) ] }
- { seek-relative [ [ + ] change-i drop ] }
- { seek-end [ [ underlying>> length + ] keep (>>i) ] }
- [ bad-seek-type ]
- } case ;
+M: byte-reader stream-tell i>> ;
+M: byte-reader stream-seek (stream-seek) ;
: <byte-reader> ( byte-array encoding -- stream )
[ B{ } like 0 byte-reader boa ] dip <decoder> ;
ARTICLE: "io.streams.c" "ANSI C streams"
"C streams are found in the " { $vocab-link "io.streams.c" } " vocabulary; they are " { $link "stream-protocol" } " implementations which read and write C " { $snippet "FILE*" } " handles."
-{ $subsection <c-reader> }
-{ $subsection <c-writer> }
+{ $subsections
+ <c-reader>
+ <c-writer>
+}
"Underlying primitives used to implement the above:"
-{ $subsection fopen }
-{ $subsection fwrite }
-{ $subsection fflush }
-{ $subsection fclose }
-{ $subsection fgetc }
-{ $subsection fread }
+{ $subsections
+ fopen
+ fwrite
+ fflush
+ fclose
+ fgetc
+ fread
+}
"The three standard file handles:"
-{ $subsection stdin-handle }
-{ $subsection stdout-handle }
-{ $subsection stderr-handle } ;
+{ $subsections
+ stdin-handle
+ stdout-handle
+ stderr-handle
+} ;
ABOUT: "io.streams.c"
USING: tools.test io.files io.files.temp io io.streams.c
-io.encodings.ascii strings ;
+io.encodings.ascii strings destructors kernel ;
IN: io.streams.c.tests
[ "hello world" ] [
"test.txt" temp-file "rb" fopen <c-reader> stream-contents
>string
] unit-test
+
+[ 0 ]
+[ "test.txt" temp-file "rb" fopen <c-reader> [ stream-tell ] [ dispose ] bi ] unit-test
+
+[ 3 ] [
+ "test.txt" temp-file "rb" fopen <c-reader>
+ 3 over stream-read drop
+ [ stream-tell ] [ dispose ] bi
+] unit-test
M: c-stream dispose* handle>> fclose ;
+M: c-stream stream-tell handle>> ftell ;
+
M: c-stream stream-seek
handle>> swap {
{ seek-absolute [ 0 ] }
ARTICLE: "looping-combinators" "Looping combinators"
"In most cases, loops should be written using high-level combinators (such as " { $link "sequences-combinators" } ") or tail recursion. However, sometimes, the best way to express intent is with a loop."
-{ $subsection while }
-{ $subsection until }
+{ $subsections
+ while
+ until
+}
"To execute one iteration of a loop, use the following word:"
-{ $subsection do }
+{ $subsections do }
"This word is intended as a modifier. The normal " { $link while } " loop never executes the body if the predicate returns false on the first iteration. To ensure the body executes at least once, use " { $link do } ":"
{ $code
"[ P ] [ Q ] do while"
}
"A simpler looping combinator which executes a single quotation until it returns " { $link f } ":"
-{ $subsection loop } ;
+{ $subsections loop } ;
HELP: assert
{ $values { "got" "the obtained value" } { "expect" "the expected value" } }
"The " { $link "cleave-combinators" } ", " { $link "spread-combinators" } " and " { $link "apply-combinators" } " are closely related to shuffle words and should be used instead where possible because they can result in clearer code; also, see the advice in " { $link "cookbook-philosophy" } "."
$nl
"Removing stack elements:"
-{ $subsection drop }
-{ $subsection 2drop }
-{ $subsection 3drop }
-{ $subsection nip }
-{ $subsection 2nip }
+{ $subsections
+ drop
+ 2drop
+ 3drop
+ nip
+ 2nip
+}
"Duplicating stack elements:"
-{ $subsection dup }
-{ $subsection 2dup }
-{ $subsection 3dup }
-{ $subsection dupd }
-{ $subsection over }
-{ $subsection 2over }
-{ $subsection pick }
-{ $subsection tuck }
+{ $subsections
+ dup
+ 2dup
+ 3dup
+ dupd
+ over
+ 2over
+ pick
+ tuck
+}
"Permuting stack elements:"
-{ $subsection swap }
-{ $subsection swapd }
-{ $subsection rot }
-{ $subsection -rot }
-{ $subsection spin }
-{ $subsection roll }
-{ $subsection -roll } ;
+{ $subsections
+ swap
+ swapd
+ rot
+ -rot
+ spin
+ roll
+ -roll
+} ;
ARTICLE: "equality" "Equality"
"There are two distinct notions of “sameness” when it comes to objects."
$nl
"You can test if two references point to the same object (" { $emphasis "identity comparison" } "). This is rarely used; it is mostly useful with large, mutable objects where the object identity matters but the value is transient:"
-{ $subsection eq? }
+{ $subsections eq? }
"You can test if two objects are equal in a domain-specific sense, usually by being instances of the same class, and having equal slot values (" { $emphasis "value comparison" } "):"
-{ $subsection = }
+{ $subsections = }
"A third form of equality is provided by " { $link number= } ". It compares numeric value while disregarding types."
$nl
"Custom value comparison methods for use with " { $link = } " can be defined on a generic word:"
-{ $subsection equal? }
+{ $subsections equal? }
"Utility class:"
-{ $subsection identity-tuple }
+{ $subsections identity-tuple }
"An object can be cloned; the clone has distinct identity but equal value:"
-{ $subsection clone } ;
+{ $subsections clone } ;
ARTICLE: "assertions" "Assertions"
"Some words to make assertions easier to enforce:"
-{ $subsection assert }
-{ $subsection assert= } ;
+{ $subsections
+ assert
+ assert=
+} ;
ARTICLE: "layouts-types" "Type numbers"
"Corresponding to every built-in class is a built-in type number. An object can be asked for its built-in type number:"
-{ $subsection hi-tag }
+{ $subsections hi-tag }
"Built-in type numbers can be converted to classes, and vice versa:"
-{ $subsection type>class }
-{ $subsection type-number }
-{ $subsection num-types }
+{ $subsections
+ type>class
+ type-number
+ num-types
+}
{ $see-also "builtin-classes" } ;
ARTICLE: "layouts-tags" "Tagged pointers"
"Getting the tag of an object:"
{ $link tag }
"Words for working with tagged pointers:"
-{ $subsection tag-bits }
-{ $subsection num-tags }
-{ $subsection tag-mask }
-{ $subsection tag-number }
+{ $subsections
+ tag-bits
+ num-tags
+ tag-mask
+ tag-number
+}
"The Factor VM does not actually expose any words for working with tagged pointers directly. The above words operate on integers; they are used in the bootstrap image generator and the optimizing compiler." ;
ARTICLE: "layouts-limits" "Sizes and limits"
"Processor cell size:"
-{ $subsection cell }
-{ $subsection cells }
-{ $subsection cell-bits }
+{ $subsections
+ cell
+ cells
+ cell-bits
+}
"Range of integers representable by " { $link fixnum } "s:"
-{ $subsection most-negative-fixnum }
-{ $subsection most-positive-fixnum }
+{ $subsections
+ most-negative-fixnum
+ most-positive-fixnum
+}
"Maximum array size:"
-{ $subsection max-array-capacity } ;
+{ $subsections max-array-capacity } ;
ARTICLE: "layouts-bootstrap" "Bootstrap support"
"Processor cell size for the target architecture:"
-{ $subsection bootstrap-cell }
-{ $subsection bootstrap-cells }
-{ $subsection bootstrap-cell-bits }
+{ $subsections
+ bootstrap-cell
+ bootstrap-cells
+ bootstrap-cell-bits
+}
"Range of integers representable by " { $link fixnum } "s of the target architecture:"
-{ $subsection bootstrap-most-negative-fixnum }
-{ $subsection bootstrap-most-positive-fixnum }
+{ $subsections
+ bootstrap-most-negative-fixnum
+ bootstrap-most-positive-fixnum
+}
"Maximum array size for the target architecture:"
-{ $subsection bootstrap-max-array-capacity } ;
+{ $subsections bootstrap-max-array-capacity } ;
ARTICLE: "layouts" "VM memory layouts"
"The words documented in this section do not ever need to be called by user code. They are documented for the benefit of those wishing to explore the internals of Factor's implementation."
-{ $subsection "layouts-types" }
-{ $subsection "layouts-tags" }
-{ $subsection "layouts-limits" }
-{ $subsection "layouts-bootstrap" } ;
+{ $subsections
+ "layouts-types"
+ "layouts-tags"
+ "layouts-limits"
+ "layouts-bootstrap"
+} ;
ABOUT: "layouts"
\r
! Smoke test\r
[ t ] [ max-array-capacity cell-bits 2^ < ] unit-test\r
+\r
+[ t ] [ most-negative-fixnum fixnum? ] unit-test\r
+[ t ] [ most-positive-fixnum fixnum? ] unit-test\r
cell-bits (first-bignum) ; inline
: most-positive-fixnum ( -- n )
- first-bignum 1 - ; inline
+ first-bignum 1 - >fixnum ; inline
: most-negative-fixnum ( -- n )
- first-bignum neg ; inline
+ first-bignum neg >fixnum ; inline
: (max-array-capacity) ( b -- n )
5 - 2^ 1 - ; inline
ARTICLE: "parser-lexer" "The lexer"
"A variable that encapsulate internal parser state:"
-{ $subsection lexer }
+{ $subsections lexer }
"Creating a default lexer:"
-{ $subsection <lexer> }
+{ $subsections <lexer> }
"A word to test of the end of input has been reached:"
-{ $subsection still-parsing? }
+{ $subsections still-parsing? }
"A word to advance the lexer to the next line:"
-{ $subsection next-line }
+{ $subsections next-line }
"Two generic words to override the lexer's token boundary detection:"
-{ $subsection skip-blank }
-{ $subsection skip-word }
+{ $subsections
+ skip-blank
+ skip-word
+}
"Utility combinator:"
-{ $subsection with-lexer } ;
+{ $subsections with-lexer } ;
"and"
{ $code "[ [ reverse % ] each ] \"\" make" }
"is equivalent to"
-{ $code "[ [ reverse ] map concat" }
+{ $code "[ reverse ] map concat" }
{ $heading "Utilities for simple make patterns" }
"Sometimes, an existing word already implements a specific " { $link make } " usage. For example, " { $link suffix } " is equivalent to the following, with the added caveat that the below example always outputs an array:"
{ $code "[ , % ] { } make" }
"The " { $vocab-link "make" } " vocabulary implements a facility for constructing sequences by holding an accumulator sequence in a variable. Storing the accumulator sequence in a variable rather than the stack may allow code to be written with less stack manipulation."
$nl
"Sequence construction is wrapped in a combinator:"
-{ $subsection make }
+{ $subsections make }
"Inside the quotation passed to " { $link make } ", several words accumulate values:"
-{ $subsection , }
-{ $subsection % }
-{ $subsection # }
+{ $subsections
+ ,
+ %
+ #
+}
"The accumulator sequence can be accessed directly from inside a " { $link make } ":"
-{ $subsection building }
+{ $subsections building }
{ $example
"USING: make math.parser ;"
"[ \"Language #\" % CHAR: \\s , 5 # ] \"\" make print"
"Language # 5"
}
-{ $subsection "make-philosophy" } ;
+{ $subsections "make-philosophy" } ;
ABOUT: "namespaces-make"
HELP: %
{ $values { "seq" sequence } }
-{ $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ;
\ No newline at end of file
+{ $description "Appends a sequence to the end of the sequence being constructed by " { $link make } "." } ;
HELP: float>= ( x y -- ? )
{ $values { "x" float } { "y" float } { "?" "a boolean" } }
-{ $description "Primitive version of " { $link >= } "." }
-{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link >= } " instead." } ;
+{ $description "Primitive version of " { $link u>= } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link u>= } " instead." } ;
+
+HELP: float-u< ( x y -- ? )
+{ $values { "x" float } { "y" float } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link u< } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link u< } " instead." } ;
+
+HELP: float-u<= ( x y -- ? )
+{ $values { "x" float } { "y" float } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link u<= } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link u<= } " instead." } ;
+
+HELP: float-u> ( x y -- ? )
+{ $values { "x" float } { "y" float } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link u> } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link u> } " instead." } ;
+
+HELP: float-u>= ( x y -- ? )
+{ $values { "x" float } { "y" float } { "?" "a boolean" } }
+{ $description "Primitive version of " { $link u>= } "." }
+{ $warning "This word does not perform type checking, and passing objects of the wrong type can crash the runtime. User code should call the generic word " { $link u>= } " instead." } ;
+
+ARTICLE: "math.floats.compare" "Floating point comparison operations"
+"In mathematics, real numbers are linearly ordered; for any two numbers " { $snippet "a" } " and " { $snippet "b" } ", exactly one of the following is true:"
+{ $code
+ "a < b"
+ "a = b"
+ "a > b"
+}
+"With floating point values, there is a fourth possibility; " { $snippet "a" } " and " { $snippet "b" } " may be " { $emphasis "unordered" } ". This happens if one or both values are Not-a-Number values."
+$nl
+"All comparison operators, including " { $link number= } ", return " { $link f } " in the unordered case (and in particular, this means that a NaN is not equal to itself)."
+$nl
+"The " { $emphasis "ordered" } " comparison operators set floating point exception flags if the result of the comparison is unordered. The standard comparison operators (" { $link < } ", " { $link <= } ", " { $link > } ", " { $link >= } ") perform ordered comparisons."
+$nl
+"The " { $link number= } " operation performs an unordered comparison. The following set of operators also perform unordered comparisons:"
+{ $subsections
+ u<
+ u<=
+ u>
+ u>=
+}
+"A word to check if two values are unordered with respect to each other:"
+{ $subsections unordered? }
+"To test for floating point exceptions, use the " { $vocab-link "math.floats.env" } " vocabulary."
+$nl
+"If neither input to a comparison operator is a floating point value, then " { $link u< } ", " { $link u<= } ", " { $link u> } " and " { $link u>= } " are equivalent to the ordered operators." ;
+
+ARTICLE: "math.floats.bitwise" "Bitwise operations on floats"
+"Floating point numbers are represented internally in IEEE 754 double-precision format. This internal representation can be accessed for advanced operations and input/output purposes."
+{ $subsections
+ float>bits
+ double>bits
+ bits>float
+ bits>double
+}
+"Constructing floating point NaNs:"
+{ $subsections <fp-nan> }
+"Floating point numbers are discrete:"
+{ $subsections
+ prev-float
+ next-float
+}
+"Introspection on floating point numbers:"
+{ $subsections
+ fp-special?
+ fp-nan?
+ fp-qnan?
+ fp-snan?
+ fp-infinity?
+ fp-nan-payload
+}
+"Comparing two floating point numbers for bitwise equality:"
+{ $subsections fp-bitwise= }
+{ $see-also POSTPONE: NAN: } ;
ARTICLE: "floats" "Floats"
-{ $subsection float }
+{ $subsections float }
"Rational numbers represent " { $emphasis "exact" } " quantities. On the other hand, a floating point number is an " { $emphasis "approximate" } " value. While rationals can grow to any required precision, floating point numbers have limited precision, and manipulating them is usually faster than manipulating ratios or bignums."
$nl
"Introducing a floating point number in a computation forces the result to be expressed in floating point."
{ $example "5/4 1/2 + ." "1+3/4" }
{ $example "5/4 0.5 + ." "1.75" }
+"Floating point literal syntax is documented in " { $link "syntax-floats" } "."
+$nl
"Integers and rationals can be converted to floats:"
-{ $subsection >float }
+{ $subsections >float }
"Two real numbers can be divided yielding a float result:"
-{ $subsection /f }
-"Floating point numbers are represented internally in IEEE 754 double-precision format. This internal representation can be accessed for advanced operations and input/output purposes."
-{ $subsection float>bits }
-{ $subsection double>bits }
-{ $subsection bits>float }
-{ $subsection bits>double }
-"Constructing floating point NaNs:"
-{ $subsection <fp-nan> }
-"Floating point numbers are discrete:"
-{ $subsection prev-float }
-{ $subsection next-float }
-"Introspection on floating point numbers:"
-{ $subsection fp-special? }
-{ $subsection fp-nan? }
-{ $subsection fp-qnan? }
-{ $subsection fp-snan? }
-{ $subsection fp-infinity? }
-{ $subsection fp-nan-payload }
-"Comparing two floating point numbers:"
-{ $subsection fp-bitwise= }
-{ $see-also "syntax-floats" } ;
+{ $subsections
+ /f
+ "math.floats.bitwise"
+ "math.floats.compare"
+}
+"The " { $vocab-link "math.floats.env" } " vocabulary provides functionality for controlling floating point exceptions, rounding modes, and denormal behavior." ;
ABOUT: "floats"
[ t ] [ 64 [ 2^ 0.5 * ] map [ < ] monotonic? ] unit-test
[ 5 ] [ 10.5 1.9 /i ] unit-test
+
+[ t ] [ 0/0. 0/0. unordered? ] unit-test
+[ t ] [ 1.0 0/0. unordered? ] unit-test
+[ t ] [ 0/0. 1.0 unordered? ] unit-test
+[ f ] [ 1.0 1.0 unordered? ] unit-test
+
+[ t ] [ -0.0 fp-sign ] unit-test
+[ t ] [ -1.0 fp-sign ] unit-test
+[ f ] [ 0.0 fp-sign ] unit-test
+[ f ] [ 1.0 fp-sign ] unit-test
+
+[ t ] [ -0.0 abs 0.0 fp-bitwise= ] unit-test
+[ 1.5 ] [ -1.5 abs ] unit-test
+[ 1.5 ] [ 1.5 abs ] unit-test
USING: kernel math math.private ;
IN: math.floats.private
+: float-unordered? ( x y -- ? ) [ fp-nan? ] bi@ or ;
: float-min ( x y -- z ) [ float< ] most ; foldable
: float-max ( x y -- z ) [ float> ] most ; foldable
M: float equal? over float? [ float= ] [ 2drop f ] if ; inline
M: float number= float= ; inline
-M: float < float< ; inline
+M: float < float< ; inline
M: float <= float<= ; inline
-M: float > float> ; inline
+M: float > float> ; inline
M: float >= float>= ; inline
+M: float unordered? float-unordered? ; inline
+M: float u< float-u< ; inline
+M: float u<= float-u<= ; inline
+M: float u> float-u> ; inline
+M: float u>= float-u>= ; inline
+
M: float + float+ ; inline
M: float - float- ; inline
M: float * float* ; inline
double>bits 52 2^ 1 - bitand ; inline
M: float fp-nan?
- dup fp-special? [ fp-nan-payload zero? not ] [ drop f ] if ; inline
+ dup float= not ;
M: float fp-qnan?
dup fp-nan? [ fp-nan-payload 51 2^ bitand zero? not ] [ drop f ] if ; inline
M: float fp-infinity?
dup fp-special? [ fp-nan-payload zero? ] [ drop f ] if ; inline
-M: float next-float ( m -- n )
+M: float next-float
double>bits
dup -0.0 double>bits > [ 1 - bits>double ] [ ! negative non-zero
dup -0.0 double>bits = [ drop 0.0 ] [ ! negative zero
] if
] if ; inline
-M: float prev-float ( m -- n )
+M: float prev-float
double>bits
dup -0.0 double>bits >= [ 1 + bits>double ] [ ! negative
dup 0.0 double>bits = [ drop -0.0 ] [ ! positive zero
1 - bits>double ! positive non-zero
] if
] if ; inline
+
+M: float fp-sign double>bits 63 bit? ; inline
+
+M: float abs double>bits 63 2^ bitnot bitand bits>double ; inline
IN: math.integers
ARTICLE: "integers" "Integers"
-{ $subsection integer }
+{ $subsections integer }
"Integers come in two varieties -- fixnums and bignums. Fixnums fit in a machine word and are faster to manipulate; if the result of a fixnum operation is too large to fit in a fixnum, the result is upgraded to a bignum. Here is an example where two fixnums are multiplied yielding a bignum:"
{ $example "USE: classes" "134217728 class ." "fixnum" }
{ $example "USE: classes" "128 class ." "fixnum" }
"Integers can be entered using a different base; see " { $link "syntax-numbers" } "."
$nl
"Integers can be tested for, and real numbers can be converted to integers:"
-{ $subsection fixnum? }
-{ $subsection bignum? }
-{ $subsection >fixnum }
-{ $subsection >integer }
-{ $subsection >bignum }
+{ $subsections
+ fixnum?
+ bignum?
+ >fixnum
+ >integer
+ >bignum
+}
{ $see-also "prettyprint-numbers" "modular-arithmetic" "bitwise-arithmetic" "integer-functions" "syntax-integers" } ;
ABOUT: "integers"
M: fixnum > fixnum> ; inline
M: fixnum >= fixnum>= ; inline
+M: fixnum u< fixnum< ; inline
+M: fixnum u<= fixnum<= ; inline
+M: fixnum u> fixnum> ; inline
+M: fixnum u>= fixnum>= ; inline
+
M: fixnum + fixnum+ ; inline
M: fixnum - fixnum- ; inline
M: fixnum * fixnum* ; inline
M: bignum > bignum> ; inline
M: bignum >= bignum>= ; inline
+M: bignum u< bignum< ; inline
+M: bignum u<= bignum<= ; inline
+M: bignum u> bignum> ; inline
+M: bignum u>= bignum>= ; inline
+
M: bignum + bignum+ ; inline
M: bignum - bignum- ; inline
M: bignum * bignum* ; inline
HELP: number=
{ $values { "x" number } { "y" number } { "?" "a boolean" } }
{ $description "Tests if two numbers have the same numeric value." }
-{ $notes "This word differs from " { $link = } " in that it disregards differences in type when comparing numbers." }
+{ $notes "This word differs from " { $link = } " in that it disregards differences in type when comparing numbers."
+$nl
+"This word performs an unordered comparison on floating point numbers. See " { $link "math.floats.compare" } " for an explanation." }
{ $examples
{ $example "USING: math prettyprint ;" "3.0 3 number= ." "t" }
{ $example "USING: kernel math prettyprint ;" "3.0 3 = ." "f" }
HELP: <
{ $values { "x" real } { "y" real } { "?" boolean } }
-{ $description "Tests if " { $snippet "x" } " is less than " { $snippet "y" } "." } ;
+{ $description "Tests if " { $snippet "x" } " is less than " { $snippet "y" } "." }
+{ $notes "This word performs an ordered comparison on floating point numbers. See " { $link "math.floats.compare" } " for an explanation." } ;
HELP: <=
{ $values { "x" real } { "y" real } { "?" boolean } }
-{ $description "Tests if " { $snippet "x" } " is less than or equal to " { $snippet "y" } "." } ;
+{ $description "Tests if " { $snippet "x" } " is less than or equal to " { $snippet "y" } "." }
+{ $notes "This word performs an ordered comparison on floating point numbers. See " { $link "math.floats.compare" } " for an explanation." } ;
HELP: >
{ $values { "x" real } { "y" real } { "?" boolean } }
-{ $description "Tests if " { $snippet "x" } " is greater than " { $snippet "y" } "." } ;
+{ $description "Tests if " { $snippet "x" } " is greater than " { $snippet "y" } "." }
+{ $notes "This word performs an ordered comparison on floating point numbers. See " { $link "math.floats.compare" } " for an explanation." } ;
HELP: >=
{ $values { "x" real } { "y" real } { "?" boolean } }
-{ $description "Tests if " { $snippet "x" } " is greater than or equal to " { $snippet "y" } "." } ;
+{ $description "Tests if " { $snippet "x" } " is greater than or equal to " { $snippet "y" } "." }
+{ $notes "This word performs an ordered comparison on floating point numbers. See " { $link "math.floats.compare" } " for an explanation." } ;
+
+HELP: unordered?
+{ $values { "x" real } { "y" real } { "?" boolean } }
+{ $description "Tests if " { $snippet "x" } " is unordered with respect to " { $snippet "y" } ". This can only occur if one or both values is a floating-point Not-a-Number value." } ;
+
+HELP: u<
+{ $values { "x" real } { "y" real } { "?" boolean } }
+{ $description "Tests if " { $snippet "x" } " is less than " { $snippet "y" } "." }
+{ $notes "This word performs an unordered comparison on floating point numbers. On rational numbers it is equivalent to " { $link < } ". See " { $link "math.floats.compare" } " for an explanation." } ;
+
+HELP: u<=
+{ $values { "x" real } { "y" real } { "?" boolean } }
+{ $description "Tests if " { $snippet "x" } " is less than or equal to " { $snippet "y" } "." }
+{ $notes "This word performs an unordered comparison on floating point numbers. On rational numbers it is equivalent to " { $link <= } ". See " { $link "math.floats.compare" } " for an explanation." } ;
+HELP: u>
+{ $values { "x" real } { "y" real } { "?" boolean } }
+{ $description "Tests if " { $snippet "x" } " is greater than " { $snippet "y" } "." }
+{ $notes "This word performs an unordered comparison on floating point numbers. On rational numbers it is equivalent to " { $link > } ". See " { $link "math.floats.compare" } " for an explanation." } ;
+
+HELP: u>=
+{ $values { "x" real } { "y" real } { "?" boolean } }
+{ $description "Tests if " { $snippet "x" } " is greater than or equal to " { $snippet "y" } "." }
+{ $notes "This word performs an unordered comparison on floating point numbers. On rational numbers it is equivalent to " { $link >= } ". See " { $link "math.floats.compare" } " for an explanation." } ;
HELP: +
{ $values { "x" number } { "y" number } { "z" number } }
{ "x" float } { "y" float }
{ "?" boolean }
}
-{ $description "Compares two floating point numbers for bit equality." } ;
+{ $description "Compares two floating point numbers for bit equality." }
+{ $notes "Unlike " { $link = } " or " { $link number= } ", this word will consider NaNs with equal payloads to be equal, and positive zero and negative zero to be not equal." }
+{ $examples
+ "Not-a-number equality:"
+ { $example
+ "USING: kernel math prettyprint ;"
+ "0.0 0.0 / dup number= ."
+ "f"
+ }
+ { $example
+ "USING: kernel math prettyprint ;"
+ "0.0 0.0 / dup fp-bitwise= ."
+ "t"
+ }
+ "Signed zero equality:"
+ { $example
+ "USING: math prettyprint ;"
+ "-0.0 0.0 fp-bitwise= ."
+ "f"
+ }
+ { $example
+ "USING: math prettyprint ;"
+ "-0.0 0.0 number= ."
+ "t"
+ }
+} ;
HELP: fp-special?
{ $values { "x" real } { "?" "a boolean" } }
{ $example "USING: io kernel math ;" "-1/0. [ fp-infinity? ] [ 0 < ] bi and [ \"negative infinity\" print ] when" "negative infinity" }
} ;
+HELP: fp-sign
+{ $values { "x" float } { "?" "a boolean" } }
+{ $description "Outputs the sign bit of " { $snippet "x" } ". For ordered non-zero values, this is equivalent to calling " { $snippet "0 <" } ". For zero values, this outputs the zero's sign bit." } ;
+
HELP: fp-nan-payload
{ $values { "x" real } { "bits" integer } }
{ $description "If " { $snippet "x" } " is an IEEE Not-a-Number value, returns the payload encoded in the value. Returns " { $link f } " if " { $snippet "x" } " is not a " { $link float } "." } ;
{ $description "Converts a byte-array, interpreted as little-endian, into a bignum integer. User code should call " { $link le> } " or " { $link be> } " instead." } ;
ARTICLE: "division-by-zero" "Division by zero"
-"Floating point division never raises an error if the denominator is zero. This means that if at least one of the two inputs to " { $link / } ", " { $link /f } " or " { $link mod } " is a float, the result will be a floating point infinity or not a number value."
+"Behavior of division operations when a denominator of zero is used depends on the data types in question, as well as the platform being used."
+$nl
+"Floating point division only throws an error if the appropriate traps are enabled in the floating point environment. If traps are disabled, a Not-a-number value or an infinity is output, depending on whether the numerator is zero or non-zero."
+$nl
+"Floating point traps are disabled by default and the " { $vocab-link "math.floats.env" } " vocabulary provides words to enable them. Floating point division is performed by " { $link / } ", " { $link /f } " or " { $link mod } " if at least one of the two inputs is a float. Floating point division is always performed by " { $link /f } "."
$nl
"The behavior of integer division is hardware specific. On x86 processors, " { $link /i } " and " { $link mod } " raise an error if both inputs are integers and the denominator is zero. On PowerPC, integer division by zero yields a result of zero."
$nl
-"On the other hand, the " { $link / } " word, when given integer arguments, implements a much more expensive division algorithm which always yields an exact rational answer, and this word always tests for division by zero explicitly." ;
+"The " { $link / } " word, when given integer arguments, implements a much more expensive division algorithm which always yields an exact rational answer, and this word always tests for division by zero explicitly." ;
ARTICLE: "number-protocol" "Number protocol"
"Math operations obey certain numerical upgrade rules. If one of the inputs is a bignum and the other is a fixnum, the latter is first coerced to a bignum; if one of the inputs is a float, the other is coerced to a float."
{ $example "USE: classes" "3 >fixnum 6 >bignum * class ." "bignum" }
{ $example "1/2 2.0 + ." "2.5" }
"The following usual operations are supported by all numbers."
-{ $subsection + }
-{ $subsection - }
-{ $subsection * }
-{ $subsection / }
+{ $subsections
+ +
+ -
+ *
+ /
+}
"Non-commutative operations take operands from the stack in the natural order; " { $snippet "6 2 /" } " divides 6 by 2."
-{ $subsection "division-by-zero" }
+{ $subsections "division-by-zero" }
"Real numbers (but not complex numbers) can be ordered:"
-{ $subsection < }
-{ $subsection <= }
-{ $subsection > }
-{ $subsection >= }
+{ $subsections
+ <
+ <=
+ >
+ >=
+}
"Numbers can be compared for equality using " { $link = } ", or a less precise test which disregards types:"
-{ $subsection number= } ;
+{ $subsections number= }
+{ $see-also "math.floats.compare" } ;
ARTICLE: "modular-arithmetic" "Modular arithmetic"
-{ $subsection mod }
-{ $subsection rem }
-{ $subsection /mod }
-{ $subsection /i }
+{ $subsections
+ mod
+ rem
+ /mod
+ /i
+}
{ $see-also "integer-functions" } ;
ARTICLE: "bitwise-arithmetic" "Bitwise arithmetic"
"There are two ways of looking at an integer -- as an abstract mathematical entity, or as a string of bits. The latter representation motivates " { $emphasis "bitwise operations" } "."
-{ $subsection bitand }
-{ $subsection bitor }
-{ $subsection bitxor }
-{ $subsection bitnot }
-{ $subsection shift }
-{ $subsection 2/ }
-{ $subsection 2^ }
-{ $subsection bit? }
-{ $subsection "math.bitwise" }
-{ $subsection "math.bits" }
+{ $subsections
+ bitand
+ bitor
+ bitxor
+ bitnot
+ shift
+ 2/
+ 2^
+ bit?
+}
+"Advanced topics:"
+{ $subsections
+ "math.bitwise"
+ "math.bits"
+}
{ $see-also "booleans" } ;
ARTICLE: "arithmetic" "Arithmetic"
"Factor attempts to preserve natural mathematical semantics for numbers. Multiplying two large integers never results in overflow, and dividing two integers yields an exact ratio. Floating point numbers are also supported, along with complex numbers."
$nl
"Math words are in the " { $vocab-link "math" } " vocabulary. Implementation details are in the " { $vocab-link "math.private" } " vocabulary."
-{ $subsection "number-protocol" }
-{ $subsection "modular-arithmetic" }
-{ $subsection "bitwise-arithmetic" }
+{ $subsections
+ "number-protocol"
+ "modular-arithmetic"
+ "bitwise-arithmetic"
+}
{ $see-also "integers" "rationals" "floats" "complex-numbers" } ;
ABOUT: "arithmetic"
[ -0.0 ] [ 0.0 prev-float ] unit-test
[ t ] [ 1.0 dup prev-float > ] unit-test
[ t ] [ -1.0 dup prev-float > ] unit-test
+
+[ f ] [ 0/0. 0/0. = ] unit-test
+[ f ] [ 0/0. 1.0 = ] unit-test
+[ f ] [ 0/0. 1/0. = ] unit-test
+[ f ] [ 0/0. -1/0. = ] unit-test
+
+[ f ] [ 0/0. 0/0. = ] unit-test
+[ f ] [ 1.0 0/0. = ] unit-test
+[ f ] [ -1/0. 0/0. = ] unit-test
+[ f ] [ 1/0. 0/0. = ] unit-test
+
+[ f ] [ 0/0. 0/0. < ] unit-test
+[ f ] [ 0/0. 1.0 < ] unit-test
+[ f ] [ 0/0. 1/0. < ] unit-test
+[ f ] [ 0/0. -1/0. < ] unit-test
+
+[ f ] [ 0/0. 0/0. <= ] unit-test
+[ f ] [ 0/0. 1.0 <= ] unit-test
+[ f ] [ 0/0. 1/0. <= ] unit-test
+[ f ] [ 0/0. -1/0. <= ] unit-test
+
+[ f ] [ 0/0. 0/0. > ] unit-test
+[ f ] [ 1.0 0/0. > ] unit-test
+[ f ] [ -1/0. 0/0. > ] unit-test
+[ f ] [ 1/0. 0/0. > ] unit-test
+
+[ f ] [ 0/0. 0/0. >= ] unit-test
+[ f ] [ 1.0 0/0. >= ] unit-test
+[ f ] [ -1/0. 0/0. >= ] unit-test
+[ f ] [ 1/0. 0/0. >= ] unit-test
+
+
-! Copyright (C) 2003, 2009 Slava Pestov.
+! Copyright (C) 2003, 2009 Slava Pestov, Joe Groff.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private ;
IN: math
MATH: > ( x y -- ? ) foldable
MATH: >= ( x y -- ? ) foldable
+MATH: unordered? ( x y -- ? ) foldable
+MATH: u< ( x y -- ? ) foldable
+MATH: u<= ( x y -- ? ) foldable
+MATH: u> ( x y -- ? ) foldable
+MATH: u>= ( x y -- ? ) foldable
+
+M: object unordered? 2drop f ;
+
MATH: + ( x y -- z ) foldable
MATH: - ( x y -- z ) foldable
MATH: * ( x y -- z ) foldable
GENERIC: fp-snan? ( x -- ? )
GENERIC: fp-infinity? ( x -- ? )
GENERIC: fp-nan-payload ( x -- bits )
+GENERIC: fp-sign ( x -- ? )
M: object fp-special? drop f ; inline
M: object fp-nan? drop f ; inline
M: object fp-qnan? drop f ; inline
M: object fp-snan? drop f ; inline
M: object fp-infinity? drop f ; inline
-M: object fp-nan-payload drop f ; inline
: <fp-nan> ( payload -- nan )
HEX: 7ff0000000000000 bitor bits>double ; inline
} ;
HELP: max
-{ $values { "x" real } { "y" real } { "z" real } }
-{ $description "Outputs the greatest of two real numbers." } ;
+{ $values { "x" object } { "y" object } { "z" object } }
+{ $description "Outputs the greatest of two ordered values." }
+{ $notes "If one value is a floating point positive zero and the other is a negative zero, the result is undefined." } ;
HELP: min
-{ $values { "x" real } { "y" real } { "z" real } }
-{ $description "Outputs the smallest of two real numbers." } ;
+{ $values { "x" object } { "y" object } { "z" object } }
+{ $description "Outputs the smallest of two ordered values." }
+{ $notes "If one value is a floating point positive zero and the other is a negative zero, the result is undefined." } ;
HELP: clamp
-{ $values { "x" real } { "min" real } { "max" real } { "y" real } }
+{ $values { "x" object } { "min" object } { "max" object } { "y" object } }
{ $description "Outputs " { $snippet "x" } " if contained in the interval " { $snippet "[min,max]" } " or outputs one of the endpoints." } ;
HELP: between?
-{ $values { "x" real } { "y" real } { "z" real } { "?" "a boolean" } }
+{ $values { "x" object } { "y" object } { "z" real } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "x" } " is in the interval " { $snippet "[y,z]" } "." }
{ $notes "As per the closed interval notation, the end-points are included in the interval." } ;
HELP: before?
-{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } }
+{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "obj1" } " comes before " { $snippet "obj2" } " using an intrinsic total order." }
{ $notes "Implemented using " { $link <=> } "." } ;
HELP: after?
-{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } }
+{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "obj1" } " comes after " { $snippet "obj2" } " using an intrinsic total order." }
{ $notes "Implemented using " { $link <=> } "." } ;
HELP: before=?
-{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } }
+{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "obj1" } " comes before or equals " { $snippet "obj2" } " using an intrinsic total order." }
{ $notes "Implemented using " { $link <=> } "." } ;
HELP: after=?
-{ $values { "obj1" "an object" } { "obj2" "an object" } { "?" "a boolean" } }
+{ $values { "obj1" object } { "obj2" object } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "obj1" } " comes after or equals " { $snippet "obj2" } " using an intrinsic total order." }
{ $notes "Implemented using " { $link <=> } "." } ;
ARTICLE: "order-specifiers" "Ordering specifiers"
"Ordering words such as " { $link <=> } " output one of the following values, indicating that of two objects being compared, the first is less than the second, the two are equal, or that the first is greater than the second:"
-{ $subsection +lt+ }
-{ $subsection +eq+ }
-{ $subsection +gt+ } ;
+{ $subsections
+ +lt+
+ +eq+
+ +gt+
+} ;
ARTICLE: "math.order.example" "Linear order example"
"A tuple class which defines an ordering among instances by comparing the values of the " { $snippet "id" } " slot:"
} ;
ARTICLE: "math.order" "Linear order protocol"
-"Some classes have an intrinsic order amongst instances:"
-{ $subsection <=> }
-{ $subsection >=< }
-{ $subsection compare }
-{ $subsection invert-comparison }
+"Some classes define an intrinsic order amongst instances. This includes numbers, sequences (in particular, strings), and words."
+{ $subsections
+ <=>
+ >=<
+ compare
+ invert-comparison
+}
"The above words output order specifiers."
-{ $subsection "order-specifiers" }
+{ $subsections "order-specifiers" }
"Utilities for comparing objects:"
-{ $subsection after? }
-{ $subsection before? }
-{ $subsection after=? }
-{ $subsection before=? }
+{ $subsections
+ after?
+ before?
+ after=?
+ before=?
+}
+"Minimum, maximum, clamping:"
+{ $subsections
+ min
+ max
+ clamp
+}
"Out of the above generic words, it suffices to implement " { $link <=> } " alone. The others may be provided as an optimization."
-{ $subsection "math.order.example" }
+{ $subsections "math.order.example" }
{ $see-also "sequences-sorting" } ;
ABOUT: "math.order"
ARTICLE: "number-strings" "Converting between numbers and strings"
"These words only convert between real numbers and strings. Complex numbers are constructed by the parser (" { $link "parser" } ") and printed by the prettyprinter (" { $link "prettyprint" } ")."
$nl
-"Note that only integers can be converted to and from strings using a representation other than base 10. Calling a word such as " { $link >oct } " on a float will give a result in base 10."
+"Integers can be converted to and from arbitrary bases. Floating point numbers can only be converted to and from base 10 and 16."
$nl
"Converting numbers to strings:"
-{ $subsection number>string }
-{ $subsection >bin }
-{ $subsection >oct }
-{ $subsection >hex }
-{ $subsection >base }
+{ $subsections
+ number>string
+ >bin
+ >oct
+ >hex
+ >base
+}
"Converting strings to numbers:"
-{ $subsection string>number }
-{ $subsection bin> }
-{ $subsection oct> }
-{ $subsection hex> }
-{ $subsection base> }
+{ $subsections
+ string>number
+ bin>
+ oct>
+ hex>
+ base>
+}
"You can also input literal numbers in a different base (" { $link "syntax-integers" } ")."
{ $see-also "prettyprint-numbers" } ;
$nl
"Outputs " { $link f } " if the string does not represent a number." } ;
-{ bin> POSTPONE: BIN: bin> .b } related-words
+{ >bin POSTPONE: BIN: bin> .b } related-words
HELP: oct>
{ $values { "str" string } { "n/f" "a real number or " { $link f } } }
$nl
"Outputs " { $link f } " if the string does not represent a number." } ;
-{ oct> POSTPONE: OCT: oct> .o } related-words
+{ >oct POSTPONE: OCT: oct> .o } related-words
HELP: hex>
{ $values { "str" string } { "n/f" "a real number or " { $link f } } }
$nl
"Outputs " { $link f } " if the string does not represent a number." } ;
-{ hex> POSTPONE: HEX: hex> .h } related-words
+{ >hex POSTPONE: HEX: hex> .h } related-words
HELP: >base
{ $values { "n" real } { "radix" "an integer between 2 and 36" } { "str" string } }
HELP: >hex
{ $values { "n" real } { "str" string } }
-{ $description "Outputs a string representation of a number using base 16." } ;
+{ $description "Outputs a string representation of a number using base 16." }
+{ $examples
+ { $example
+ "USING: math.parser prettyprint ;"
+ "3735928559 >hex ."
+ "\"deadbeef\""
+ }
+ { $example
+ "USING: math.parser prettyprint ;"
+ "-15.5 >hex ."
+ "\"-1.fp3\""
+ }
+} ;
HELP: string>float ( str -- n/f )
{ $values { "str" string } { "n/f" "a real number or " { $link f } } }
-USING: kernel math math.parser sequences tools.test ;
+USING: kernel literals math math.parser sequences tools.test ;
IN: math.parser.tests
[ f ]
[ "e" string>number ]
unit-test
-[ 100000 ]
-[ "100,000" string>number ]
-unit-test
+[ 100000 ] [ "100,000" string>number ] unit-test
-[ 100000.0 ]
-[ "100,000.0" string>number ]
-unit-test
+[ 100000.0 ] [ "100,000.0" string>number ] unit-test
+
+[ f ] [ "," string>number ] unit-test
+[ f ] [ "-," string>number ] unit-test
+[ f ] [ "1," string>number ] unit-test
+[ f ] [ "-1," string>number ] unit-test
+[ f ] [ ",2" string>number ] unit-test
+[ f ] [ "-,2" string>number ] unit-test
+
+[ 2.0 ] [ "2." string>number ] unit-test
+
+[ 255 ] [ "ff" hex> ] unit-test
[ "100.0" ]
[ "1.0e2" string>number number>string ]
[ "-3/4" ] [ -3/4 number>string ] unit-test
[ "-1-1/4" ] [ -5/4 number>string ] unit-test
+
+[ "1.0p0" ] [ 1.0 >hex ] unit-test
+[ "1.8p2" ] [ 6.0 >hex ] unit-test
+[ "1.08p2" ] [ 4.125 >hex ] unit-test
+[ "1.8p-2" ] [ 0.375 >hex ] unit-test
+[ "-1.8p2" ] [ -6.0 >hex ] unit-test
+[ "1.8p10" ] [ 1536.0 >hex ] unit-test
+[ "0.0" ] [ 0.0 >hex ] unit-test
+[ "1.0p-1074" ] [ 1 bits>double >hex ] unit-test
+[ "-0.0" ] [ -0.0 >hex ] unit-test
+
+[ 1.0 ] [ "1.0" hex> ] unit-test
+[ 1.5 ] [ "1.8" hex> ] unit-test
+[ 1.03125 ] [ "1.08" hex> ] unit-test
+[ 15.5 ] [ "f.8" hex> ] unit-test
+[ 15.53125 ] [ "f.88" hex> ] unit-test
+[ -15.5 ] [ "-f.8" hex> ] unit-test
+[ 15.5 ] [ "f.8p0" hex> ] unit-test
+[ -15.5 ] [ "-f.8p0" hex> ] unit-test
+[ 62.0 ] [ "f.8p2" hex> ] unit-test
+[ 3.875 ] [ "f.8p-2" hex> ] unit-test
+[ $[ 1 bits>double ] ] [ "1.0p-1074" hex> ] unit-test
+[ 0.0 ] [ "1.0p-1075" hex> ] unit-test
+[ 1/0. ] [ "1.0p1024" hex> ] unit-test
+[ -1/0. ] [ "-1.0p1024" hex> ] unit-test
+
string>natural
] if ; inline
-: string>float ( str -- n/f )
+: dec>float ( str -- n/f )
[ CHAR: , eq? not ] filter
>byte-array 0 suffix (string>float) ;
+: hex>float-parts ( str -- neg? mantissa-str expt )
+ "-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ;
+
+: make-mantissa ( str -- bits )
+ 16 base> dup log2 52 swap - shift ;
+
+: combine-hex-float-parts ( neg? mantissa expt -- float )
+ dup 2046 > [ 2drop -1/0. 1/0. ? ] [
+ dup 0 <= [ 1 - shift 0 ] when
+ [ HEX: 8000,0000,0000,0000 0 ? ]
+ [ 52 2^ 1 - bitand ]
+ [ 52 shift ] tri* bitor bitor
+ bits>double
+ ] if ;
+
+: hex>float ( str -- n/f )
+ hex>float-parts
+ [ "." split1 [ append make-mantissa ] [ drop 16 base> log2 ] 2bi ]
+ [ + 1023 + ] bi*
+ combine-hex-float-parts ;
+
+: base>float ( str base -- n/f )
+ {
+ { 16 [ hex>float ] }
+ [ drop dec>float ]
+ } case ;
+
+: number-char? ( char -- ? )
+ "0123456789ABCDEFabcdef." member? ;
+
+: numeric-looking? ( str -- ? )
+ "-" ?head drop
+ dup empty? [ drop f ] [
+ dup first number-char? [
+ last number-char?
+ ] [ drop f ] if
+ ] if ;
+
PRIVATE>
+: string>float ( str -- n/f )
+ 10 base>float ;
+
: base> ( str radix -- n/f )
- over empty? [ 2drop f ] [
+ over numeric-looking? [
over [ "/." member? ] find nip {
{ CHAR: / [ string>ratio ] }
- { CHAR: . [ drop string>float ] }
+ { CHAR: . [ base>float ] }
[ drop string>integer ]
} case
- ] if ;
+ ] [ 2drop f ] if ;
: string>number ( str -- n/f ) 10 base> ;
: bin> ( str -- n/f ) 2 base> ;
[ ".0" append ]
} cond ;
-: float>string ( n -- str )
+<PRIVATE
+
+: mantissa-expt-normalize ( mantissa expt -- mantissa' expt' )
+ dup zero?
+ [ over log2 52 swap - [ shift 52 2^ 1 - bitand ] [ 1022 + - ] bi-curry bi* ]
+ [ 1023 - ] if ;
+
+: mantissa-expt ( float -- mantissa expt )
+ [ 52 2^ 1 - bitand ]
+ [ -0.0 double>bits bitnot bitand -52 shift ] bi
+ mantissa-expt-normalize ;
+
+: float>hex-sign ( bits -- str )
+ -0.0 double>bits bitand zero? "" "-" ? ;
+
+: float>hex-value ( mantissa -- str )
+ 16 >base 13 CHAR: 0 pad-head [ CHAR: 0 = ] trim-tail
+ [ "0" ] [ ] if-empty "1." prepend ;
+
+: float>hex-expt ( mantissa -- str )
+ 10 >base "p" prepend ;
+
+: float>hex ( n -- str )
+ double>bits
+ [ float>hex-sign ] [
+ mantissa-expt [ float>hex-value ] [ float>hex-expt ] bi*
+ ] bi 3append ;
+
+: float>decimal ( n -- str )
(float>string)
[ 0 = ] trim-tail >string
fix-float ;
+: float>base ( n base -- str )
+ {
+ { 16 [ float>hex ] }
+ [ drop float>decimal ]
+ } case ;
+
+PRIVATE>
+
+: float>string ( n -- str )
+ 10 float>base ;
+
M: float >base
- drop {
- { [ dup fp-nan? ] [ drop "0/0." ] }
- { [ dup 1/0. = ] [ drop "1/0." ] }
- { [ dup -1/0. = ] [ drop "-1/0." ] }
- { [ dup double>bits HEX: 8000000000000000 = ] [ drop "-0.0" ] }
- [ float>string ]
+ {
+ { [ over fp-nan? ] [ 2drop "0/0." ] }
+ { [ over 1/0. = ] [ 2drop "1/0." ] }
+ { [ over -1/0. = ] [ 2drop "-1/0." ] }
+ { [ over 0.0 fp-bitwise= ] [ 2drop "0.0" ] }
+ { [ over -0.0 fp-bitwise= ] [ 2drop "-0.0" ] }
+ [ float>base ]
} cond ;
: number>string ( n -- str ) 10 >base ;
ARTICLE: "images" "Images"
"Factor has the ability to save the entire state of the system into an " { $emphasis "image file" } ". The image contains a complete dump of all data and code in the current Factor instance."
-{ $subsection save }
-{ $subsection save-image }
-{ $subsection save-image-and-exit }
+{ $subsections
+ save
+ save-image
+ save-image-and-exit
+}
"To start Factor with a custom image, use the " { $snippet "-i=" { $emphasis "image" } } " command line switch; see " { $link "runtime-cli-args" } "."
$nl
"One reason to save a custom image is if you find yourself loading the same libraries in every Factor session; some libraries take a little while to compile, so saving an image with those libraries loaded can save you a lot of time."
"For example, to save an image with the web framework loaded,"
{ $code "USE: furnace" "save" }
"New images can be created from scratch:"
-{ $subsection "bootstrap.image" }
+{ $subsections "bootstrap.image" }
"The " { $link "tools.deploy" } " tool creates stripped-down images containing just enough code to run a single application."
{ $see-also "tools.memory" } ;
IN: namespaces
ARTICLE: "namespaces-combinators" "Namespace combinators"
-{ $subsection make-assoc }
-{ $subsection with-scope }
-{ $subsection with-variable }
-{ $subsection bind } ;
+{ $subsections
+ make-assoc
+ with-scope
+ with-variable
+ bind
+} ;
ARTICLE: "namespaces-change" "Changing variable values"
-{ $subsection on }
-{ $subsection off }
-{ $subsection inc }
-{ $subsection dec }
-{ $subsection change }
-{ $subsection change-global } ;
+{ $subsections
+ on
+ off
+ inc
+ dec
+ change
+ change-global
+} ;
ARTICLE: "namespaces-global" "Global variables"
-{ $subsection namespace }
-{ $subsection global }
-{ $subsection get-global }
-{ $subsection set-global }
-{ $subsection initialize } ;
+{ $subsections
+ namespace
+ global
+ get-global
+ set-global
+ initialize
+} ;
ARTICLE: "namespaces.private" "Namespace implementation details"
"The namestack holds namespaces."
-{ $subsection namestack }
-{ $subsection set-namestack }
-{ $subsection namespace }
+{ $subsections
+ namestack
+ set-namestack
+ namespace
+}
"A pair of words push and pop namespaces on the namestack."
-{ $subsection >n }
-{ $subsection ndrop } ;
+{ $subsections
+ >n
+ ndrop
+} ;
ARTICLE: "namespaces" "Dynamic variables and namespaces"
"The " { $vocab-link "namespaces" } " vocabulary implements simple dynamically-scoped variables."
"A variable is an entry in an assoc of bindings, where the assoc is implicit rather than passed on the stack. These assocs are termed " { $emphasis "namespaces" } ". Nesting of scopes is implemented with a search order on namespaces, defined by a " { $emphasis "namestack" } ". Since namespaces are just assoc, any object can be used as a variable, however by convention, variables are keyed by symbols (see " { $link "words.symbol" } ")."
$nl
"The " { $link get } " and " { $link set } " words read and write variable values. The " { $link get } " word searches up the chain of nested namespaces, while " { $link set } " always sets variable values in the current namespace only. Namespaces are dynamically scoped; when a quotation is called from a nested scope, any words called by the quotation also execute in that scope."
-{ $subsection get }
-{ $subsection set }
+{ $subsections
+ get
+ set
+}
"Various utility words abstract away common variable access patterns:"
-{ $subsection "namespaces-change" }
-{ $subsection "namespaces-combinators" }
+{ $subsections
+ "namespaces-change"
+ "namespaces-combinators"
+}
"Implementation details your code probably does not care about:"
-{ $subsection "namespaces.private" }
+{ $subsections "namespaces.private" }
"An alternative to dynamic scope is lexical scope. Lexically-scoped values and closures are implemented in the " { $vocab-link "locals" } " vocabulary." ;
ABOUT: "namespaces"
ARTICLE: "reading-ahead" "Reading ahead"
"Parsing words can consume input:"
-{ $subsection scan }
-{ $subsection scan-word }
+{ $subsections
+ scan
+ scan-word
+}
"For example, the " { $link POSTPONE: HEX: } " word uses this feature to read hexadecimal literals:"
{ $see POSTPONE: HEX: }
"It is defined in terms of a lower-level word that takes the numerical base on the data stack, but reads the number from the parser and then adds it to the parse tree:"
"A simple example is the parsing word that reads a quotation:"
{ $see POSTPONE: [ }
"This word uses a utility word which recursively invokes the parser, reading objects into a new accumulator until an occurrence of " { $link POSTPONE: ] } ":"
-{ $subsection parse-literal }
+{ $subsections parse-literal }
"There is another, lower-level word for reading nested structure, which is also useful when called directly:"
-{ $subsection parse-until }
+{ $subsections parse-until }
"Words such as " { $link POSTPONE: ] } " use a declaration which causes them to throw an error when an unpaired occurrence is encountered:"
-{ $subsection POSTPONE: delimiter }
+{ $subsections POSTPONE: delimiter }
{ $see-also POSTPONE: { POSTPONE: H{ POSTPONE: V{ POSTPONE: W{ POSTPONE: T{ POSTPONE: } } ;
ARTICLE: "defining-words" "Defining words"
"Defining words add definitions to the dictionary without modifying the parse tree. The simplest example is the " { $link POSTPONE: SYMBOL: } " word."
{ $see POSTPONE: SYMBOL: }
"The key factor in the definition of " { $link POSTPONE: SYMBOL: } " is " { $link CREATE } ", which reads a token from the input and creates a word with that name. This word is then passed to " { $link define-symbol } "."
-{ $subsection CREATE }
-{ $subsection CREATE-WORD }
+{ $subsections
+ CREATE
+ CREATE-WORD
+}
"Colon definitions are defined in a more elaborate way:"
-{ $subsection POSTPONE: : }
+{ $subsections POSTPONE: : }
"The " { $link POSTPONE: : } " word first calls " { $link CREATE } ", and then reads input until reaching " { $link POSTPONE: ; } " using a utility word:"
-{ $subsection parse-definition }
+{ $subsections parse-definition }
"The " { $link POSTPONE: ; } " word is just a delimiter; an unpaired occurrence throws a parse error:"
{ $see POSTPONE: ; }
"There are additional parsing words whose syntax is delimited by " { $link POSTPONE: ; } ", and they are all implemented by calling " { $link parse-definition } "." ;
"One example is the " { $link POSTPONE: USING: } " parsing word."
{ $see POSTPONE: USING: }
"It reads a list of vocabularies terminated by " { $link POSTPONE: ; } ". However, the vocabulary names do not name words, except by coincidence; so " { $link parse-until } " cannot be used here. Instead, a lower-level word is called:"
-{ $subsection parse-tokens } ;
+{ $subsections parse-tokens } ;
ARTICLE: "parsing-words" "Parsing words"
"The Factor parser follows a simple recursive-descent design. The parser reads successive tokens from the input; if the token identifies a number or an ordinary word, it is added to an accumulator vector. Otherwise if the token identifies a parsing word, the parsing word is executed immediately."
$nl
"Parsing words are defined using the defining word:"
-{ $subsection POSTPONE: SYNTAX: }
+{ $subsections POSTPONE: SYNTAX: }
"Parsing words have uppercase names by convention. Here is the simplest possible parsing word; it prints a greeting at parse time:"
{ $code "SYNTAX: HELLO \"Hello world\" print ;" }
"Parsing words must not pop or push items from the stack; however, they are permitted to access the accumulator vector supplied by the parser at the top of the stack. That is, parsing words must have stack effect " { $snippet "( accum -- accum )" } ", where " { $snippet "accum" } " is the accumulator vector supplied by the parser."
"Because of the stack restriction, parsing words cannot pass data to other words by leaving values on the stack; instead, use " { $link parsed } " to add the data to the parse tree so that it can be evaluated later."
$nl
"Parsing words cannot be called from the same source file where they are defined, because new definitions are only compiled at the end of the source file. An attempt to use a parsing word in its own source file raises an error:"
-{ $subsection staging-violation }
+{ $subsections staging-violation }
"Tools for implementing parsing words:"
-{ $subsection "reading-ahead" }
-{ $subsection "parsing-word-nest" }
-{ $subsection "defining-words" }
-{ $subsection "parsing-tokens" }
-{ $subsection "word-search-parsing" } ;
+{ $subsections
+ "reading-ahead"
+ "parsing-word-nest"
+ "defining-words"
+ "parsing-tokens"
+ "word-search-parsing"
+} ;
ARTICLE: "parser-files" "Parsing source files"
"The parser can run source files:"
-{ $subsection run-file }
-{ $subsection parse-file }
+{ $subsections
+ run-file
+ parse-file
+}
"The parser cross-references source files and definitions. This allows it to keep track of removed definitions, and prevent forward references and accidental redefinitions."
$nl
"While the above words are useful for one-off experiments, real programs should be written to use the vocabulary system instead; see " { $link "vocabs.loader" } "."
"This parser is a general facility for reading textual representations of objects and definitions. The parser is implemented in the " { $vocab-link "parser" } " and " { $vocab-link "syntax" } " vocabularies."
$nl
"This section concerns itself with usage and extension of the parser. Standard syntax is described in " { $link "syntax" } "."
-{ $subsection "parser-files" }
+{ $subsections "parser-files" }
"The parser can be extended."
-{ $subsection "parser-lexer" }
+{ $subsections "parser-lexer" }
"The parser can be invoked reflectively;"
-{ $subsection parse-stream }
+{ $subsections parse-stream }
{ $see-also "parsing-words" "definitions" "definition-checking" } ;
ABOUT: "parser"
ERROR: bad-number ;
+: scan-base ( base -- n )
+ scan swap base> [ bad-number ] unless* ;
+
: parse-base ( parsed base -- parsed )
- scan swap base> [ bad-number ] unless* parsed ;
+ scan-base parsed ;
SYMBOL: bootstrap-syntax
"Concretely, a quotation is an immutable sequence of objects, some of which may be words, together with a block of machine code which may be executed to achieve the effect of evaluating the quotation. The machine code is generated by a fast non-optimizing quotation compiler which is always running and is transparent to the developer."
$nl
"Quotations form a class of objects, however in most cases, methods should dispatch on " { $link callable } " instead, so that " { $link curry } " and " { $link compose } " values can participate."
-{ $subsection quotation }
-{ $subsection quotation? }
+{ $subsections
+ quotation
+ quotation?
+}
"Quotations evaluate sequentially from beginning to end. Literals are pushed on the stack and words are executed. Details can be found in " { $link "evaluator" } "."
$nl
"Quotation literal syntax is documented in " { $link "syntax-quots" } "."
$nl
"Quotations implement the " { $link "sequence-protocol" } ", and existing sequences can be converted into quotations:"
-{ $subsection >quotation }
-{ $subsection 1quotation }
+{ $subsections
+ >quotation
+ 1quotation
+}
"Wrappers:"
-{ $subsection "wrappers" } ;
+{ $subsections "wrappers" } ;
ARTICLE: "wrappers" "Wrappers"
"Wrappers are used to push words on the data stack; they evaluate to the object being wrapped:"
-{ $subsection wrapper }
-{ $subsection literalize }
+{ $subsections
+ wrapper
+ literalize
+}
"Wrapper literal syntax is documented in " { $link "syntax-words" } "."
{ $example
"IN: scratchpad"
"String buffers implement the " { $link "sequence-protocol" } " and thus all " { $link "sequences" } " can be used with them. String buffers can be used to construct new strings by accumilating substrings and characters, however usually they are only used indirectly, since the sequence construction words are more convenient to use in most cases (see " { $link "namespaces-make" } ")."
$nl
"String buffers form a class of objects:"
-{ $subsection sbuf }
-{ $subsection sbuf? }
+{ $subsections
+ sbuf
+ sbuf?
+}
"Words for creating string buffers:"
-{ $subsection >sbuf }
-{ $subsection <sbuf> }
+{ $subsections
+ >sbuf
+ <sbuf>
+}
"If you don't care about initial capacity, a more elegant way to create a new string buffer is to write:"
{ $code "SBUF\" \" clone" } ;
"153"
} } ;
+HELP: accumulate-as
+{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "exemplar" sequence } { "final" "the final result" } { "newseq" "a new sequence" } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of the same type as " { $snippet "exemplar" } " containing intermediate results, together with the final result."
+$nl
+"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
+$nl
+"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." } ;
+
HELP: accumulate
-{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new sequence" } }
-{ $description "Combines successive elements of the sequence using a binary operation, and outputs a sequence of intermediate results together with the final result. On the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the sequence."
+{ $values { "identity" object } { "seq" sequence } { "quot" { $quotation "( prev elt -- next )" } } { "final" "the final result" } { "newseq" "a new array" } }
+{ $description "Combines successive elements of the sequence using a binary operation, and outputs an array of intermediate results, together with the final result."
+$nl
+"The first element of the new sequence is " { $snippet "identity" } ". Then, on the first iteration, the two inputs to the quotation are " { $snippet "identity" } ", and the first element of the old sequence. On successive iterations, the first input is the result of the previous iteration, and the second input is the corresponding element of the old sequence."
$nl
"When given the empty sequence, outputs an empty sequence together with the " { $snippet "identity" } "." }
{ $examples
ARTICLE: "sequence-protocol" "Sequence protocol"
"All sequences must be instances of a mixin class:"
-{ $subsection sequence }
-{ $subsection sequence? }
+{ $subsections sequence sequence? }
"All sequences must know their length:"
-{ $subsection length }
+{ $subsections length }
"At least one of the following two generic words must have a method for accessing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
-{ $subsection nth }
-{ $subsection nth-unsafe }
+{ $subsections nth nth-unsafe }
"Note that sequences are always indexed starting from zero."
$nl
"At least one of the following two generic words must have a method for storing elements; the " { $link sequence } " mixin has default definitions which are mutually recursive:"
-{ $subsection set-nth }
-{ $subsection set-nth-unsafe }
-"Note that even if the sequence is immutable, at least one of the generic words must be specialized, otherwise calling them will result in an infinite recursion. There is a standard word which throws an error indicating a sequence is immutable:"
-{ $subsection immutable }
+{ $subsections set-nth set-nth-unsafe }
+"If your sequence is immutable, then you must implement either " { $link set-nth } " or " { $link set-nth-unsafe } " to simply call " { $link immutable } " to signal an error."
+$nl
"The following two generic words are optional, as not all sequences are resizable:"
-{ $subsection set-length }
-{ $subsection lengthen }
+{ $subsections set-length lengthen }
"An optional generic word for creating sequences of the same class as a given sequence:"
-{ $subsection like }
+{ $subsections like }
"Optional generic words for optimization purposes:"
-{ $subsection new-sequence }
-{ $subsection new-resizable }
+{ $subsections new-sequence new-resizable }
{ $see-also "sequences-unsafe" } ;
ARTICLE: "virtual-sequences-protocol" "Virtual sequence protocol"
"Virtual sequences must know their length:"
-{ $subsection length }
+{ $subsections length }
"The underlying sequence to look up a value in:"
-{ $subsection virtual-seq }
+{ $subsections virtual-seq }
"The index of the value in the underlying sequence:"
-{ $subsection virtual@ } ;
+{ $subsections virtual@ } ;
ARTICLE: "virtual-sequences" "Virtual sequences"
"A virtual sequence is an implementation of the " { $link "sequence-protocol" } " which does not store its own elements, and instead computes them, either from scratch or by retrieving them from another sequence."
$nl
"Implementations include the following:"
-{ $list
- { $link reversed }
- { $link slice }
- { $link iota }
-}
-"Virtual sequences can be implemented with the " { $link "virtual-sequences-protocol" } ", by translating an index in the virtual sequence into an index in another sequence:"
-{ $subsection "virtual-sequences-protocol" } ;
+{ $subsections reversed slice iota }
+"Virtual sequences can be implemented with the " { $link "virtual-sequences-protocol" } ", by translating an index in the virtual sequence into an index in another sequence." ;
ARTICLE: "sequences-integers" "Counted loops"
"Integers support the sequence protocol in a trivial fashion; a non-negative integer presents its non-negative predecessors as elements. For example, the integer 3, when viewed as a sequence, contains the elements 0, 1, and 2. This is very useful for performing counted loops."
"To reduce the boilerplate of checking if a sequence is empty, several combinators are provided."
$nl
"Checking if a sequence is empty:"
-{ $subsection if-empty }
-{ $subsection when-empty }
-{ $subsection unless-empty } ;
+{ $subsections if-empty when-empty unless-empty } ;
ARTICLE: "sequences-access" "Accessing sequence elements"
-{ $subsection ?nth }
+"Element access by index, without raising exceptions:"
+{ $subsections ?nth }
"Concise way of extracting one of the first four elements:"
-{ $subsection first }
-{ $subsection second }
-{ $subsection third }
-{ $subsection fourth }
+{ $subsections first second third fourth }
"Extracting the last element:"
-{ $subsection last }
+{ $subsections last }
"Unpacking sequences:"
-{ $subsection first2 }
-{ $subsection first3 }
-{ $subsection first4 }
+{ $subsections first2 first3 first4 }
{ $see-also nth } ;
ARTICLE: "sequences-add-remove" "Adding and removing sequence elements"
"Adding elements:"
-{ $subsection prefix }
-{ $subsection suffix }
+{ $subsections prefix suffix insert-nth }
"Removing elements:"
-{ $subsection remove }
-{ $subsection remq }
-{ $subsection remove-nth } ;
+{ $subsections remove remq remove-nth } ;
ARTICLE: "sequences-reshape" "Reshaping sequences"
"A " { $emphasis "repetition" } " is a virtual sequence consisting of a single element repeated multiple times:"
-{ $subsection repetition }
-{ $subsection <repetition> }
+{ $subsections repetition <repetition> }
"Reversing a sequence:"
-{ $subsection reverse }
+{ $subsections reverse }
"A " { $emphasis "reversal" } " presents a reversed view of an underlying sequence:"
-{ $subsection reversed }
-{ $subsection <reversed> }
+{ $subsections reversed <reversed> }
"Transposing a matrix:"
-{ $subsection flip } ;
+{ $subsections flip } ;
ARTICLE: "sequences-appending" "Appending sequences"
-{ $subsection append }
-{ $subsection append-as }
-{ $subsection prepend }
-{ $subsection 3append }
-{ $subsection 3append-as }
-{ $subsection surround }
-{ $subsection glue }
-{ $subsection concat }
-{ $subsection join }
+"Basic append operations:"
+{ $subsections
+ append
+ append-as
+ prepend
+ 3append
+ 3append-as
+ surround
+ glue
+}
+"Collapse a sequence unto itself:"
+{ $subsections concat join }
"A pair of words useful for aligning strings:"
-{ $subsection pad-head }
-{ $subsection pad-tail } ;
+{ $subsections pad-head pad-tail } ;
ARTICLE: "sequences-slices" "Subsequences and slices"
"There are two ways to extract a subrange of elements from a sequence. The first approach creates a new sequence of the same type as the input, which does not share storage with the underlying sequence. This takes time proportional to the number of elements being extracted. The second approach creates a " { $emphasis "slice" } ", which is a virtual sequence (see " { $link "virtual-sequences" } ") sharing storage with the original sequence. Slices are constructed in constant time."
}
{ $heading "Subsequence operations" }
"Extracting a subsequence:"
-{ $subsection subseq }
-{ $subsection head }
-{ $subsection tail }
-{ $subsection head* }
-{ $subsection tail* }
+{ $subsections
+ subseq
+ head
+ tail
+ head*
+ tail*
+}
"Removing the first or last element:"
-{ $subsection rest }
-{ $subsection but-last }
+{ $subsections rest but-last }
"Taking a sequence apart into a head and a tail:"
-{ $subsection unclip }
-{ $subsection unclip-last }
-{ $subsection cut }
-{ $subsection cut* }
+{ $subsections
+ unclip
+ unclip-last
+ cut
+ cut*
+}
{ $heading "Slice operations" }
"The slice data type:"
-{ $subsection slice }
-{ $subsection slice? }
+{ $subsections slice slice? }
"Extracting a slice:"
-{ $subsection <slice> }
-{ $subsection head-slice }
-{ $subsection tail-slice }
-{ $subsection head-slice* }
-{ $subsection tail-slice* }
+{ $subsections
+ <slice>
+ head-slice
+ tail-slice
+ head-slice*
+ tail-slice*
+}
"Removing the first or last element:"
-{ $subsection rest-slice }
-{ $subsection but-last-slice }
+{ $subsections rest-slice but-last-slice }
"Taking a sequence apart into a head and a tail:"
-{ $subsection unclip-slice }
-{ $subsection unclip-last-slice }
-{ $subsection cut-slice }
+{ $subsections unclip-slice unclip-last-slice cut-slice }
"A utility for words which use slices as iterators:"
-{ $subsection <flat-slice> }
+{ $subsections <flat-slice> }
"Replacing slices with new elements:"
-{ $subsection replace-slice } ;
+{ $subsections replace-slice } ;
ARTICLE: "sequences-combinators" "Sequence combinators"
"Iteration:"
-{ $subsection each }
-{ $subsection each-index }
-{ $subsection reduce }
-{ $subsection interleave }
-{ $subsection replicate }
-{ $subsection replicate-as }
+{ $subsections
+ each
+ each-index
+ reduce
+ interleave
+ replicate
+ replicate-as
+}
"Mapping:"
-{ $subsection map }
-{ $subsection map-as }
-{ $subsection map-index }
-{ $subsection map-reduce }
-{ $subsection accumulate }
-{ $subsection produce }
-{ $subsection produce-as }
+{ $subsections
+ map
+ map-as
+ map-index
+ map-reduce
+ accumulate
+ accumulate-as
+ produce
+ produce-as
+}
"Filtering:"
-{ $subsection filter }
-{ $subsection partition }
+{ $subsections
+ filter
+ partition
+}
"Testing if a sequence contains elements satisfying a predicate:"
-{ $subsection any? }
-{ $subsection all? }
-{ $subsection "sequence-2combinators" }
-{ $subsection "sequence-3combinators" } ;
+{ $subsections
+ any?
+ all?
+}
+{ $heading "Related Articles" }
+{ $subsections
+ "sequence-2combinators"
+ "sequence-3combinators"
+} ;
ARTICLE: "sequence-2combinators" "Pair-wise sequence combinators"
"There is a set of combinators which traverse two sequences pairwise. If one sequence is shorter than the other, then only the prefix having the length of the minimum of the two is examined."
-{ $subsection 2each }
-{ $subsection 2reduce }
-{ $subsection 2map }
-{ $subsection 2map-as }
-{ $subsection 2map-reduce }
-{ $subsection 2all? } ;
+{ $subsections
+ 2each
+ 2reduce
+ 2map
+ 2map-as
+ 2map-reduce
+ 2all?
+} ;
ARTICLE: "sequence-3combinators" "Triple-wise sequence combinators"
"There is a set of combinators which traverse three sequences triple-wise. If one sequence is shorter than the others, then only the prefix having the length of the minimum of the three is examined."
-{ $subsection 3each }
-{ $subsection 3map }
-{ $subsection 3map-as } ;
+{ $subsections 3each 3map 3map-as } ;
ARTICLE: "sequences-tests" "Testing sequences"
"Testing for an empty sequence:"
-{ $subsection empty? }
+{ $subsections empty? }
"Testing indices:"
-{ $subsection bounds-check? }
+{ $subsections bounds-check? }
"Testing if a sequence contains an object:"
-{ $subsection member? }
-{ $subsection memq? }
+{ $subsections member? memq? }
"Testing if a sequence contains a subsequence:"
-{ $subsection head? }
-{ $subsection tail? }
-{ $subsection subseq? } ;
+{ $subsections head? tail? subseq? } ;
ARTICLE: "sequences-search" "Searching sequences"
"Finding the index of an element:"
-{ $subsection index }
-{ $subsection index-from }
-{ $subsection last-index }
-{ $subsection last-index-from }
+{ $subsections
+ index
+ index-from
+ last-index
+ last-index-from
+}
"Finding the start of a subsequence:"
-{ $subsection start }
-{ $subsection start* }
+{ $subsections start start* }
"Finding the index of an element satisfying a predicate:"
-{ $subsection find }
-{ $subsection find-from }
-{ $subsection find-last }
-{ $subsection find-last-from }
-{ $subsection map-find } ;
+{ $subsections
+ find
+ find-from
+ find-last
+ find-last-from
+ map-find
+} ;
ARTICLE: "sequences-trimming" "Trimming sequences"
"Trimming words:"
-{ $subsection trim }
-{ $subsection trim-head }
-{ $subsection trim-tail }
+{ $subsections trim trim-head trim-tail }
"Potentially more efficient trim:"
-{ $subsection trim-slice }
-{ $subsection trim-head-slice }
-{ $subsection trim-tail-slice } ;
+{ $subsections trim-slice trim-head-slice trim-tail-slice } ;
ARTICLE: "sequences-destructive-discussion" "When to use destructive operations"
"Constructive (non-destructive) operations should be preferred where possible because code without side-effects is usually more re-usable and easier to reason about. There are two main reasons to use destructive operations:"
"The second reason is much weaker than the first one. In particular, many combinators (see " { $link map } ", " { $link produce } " and " { $link "namespaces-make" } ") as well as more advanced data structures (such as " { $vocab-link "persistent.vectors" } ") alleviate the need for explicit use of side effects." ;
ARTICLE: "sequences-destructive" "Destructive operations"
-"These words modify their input, instead of creating a new sequence."
-{ $subsection "sequences-destructive-discussion" }
"Changing elements:"
-{ $subsection change-each }
-{ $subsection change-nth }
+{ $subsections change-each change-nth }
"Deleting elements:"
-{ $subsection delete }
-{ $subsection delq }
-{ $subsection delete-nth }
-{ $subsection delete-slice }
-{ $subsection delete-all }
-{ $subsection filter-here }
+{ $subsections
+ delete
+ delq
+ delete-nth
+ delete-slice
+ delete-all
+ filter-here
+}
"Other destructive words:"
-{ $subsection reverse-here }
-{ $subsection push-all }
-{ $subsection move }
-{ $subsection exchange }
-{ $subsection copy }
+{ $subsections
+ reverse-here
+ push-all
+ move
+ exchange
+ copy
+}
"Many operations have constructive and destructive variants:"
{ $table
{ "Constructive" "Destructive" }
{ { $link map } { $link change-each } }
{ { $link filter } { $link filter-here } }
}
-{ $see-also set-nth push pop "sequences-stacks" } ;
+{ $heading "Related Articles" }
+{ $subsections
+ "sequences-destructive-discussion"
+ "sequences-stacks"
+}
+{ $see-also set-nth push pop } ;
ARTICLE: "sequences-stacks" "Treating sequences as stacks"
"The classical stack operations, modifying a sequence in place:"
-{ $subsection push }
-{ $subsection pop }
-{ $subsection pop* }
+{ $subsections push pop pop* }
{ $see-also empty? } ;
ARTICLE: "sequences-comparing" "Comparing sequences"
"Element equality testing:"
-{ $subsection sequence= }
-{ $subsection mismatch }
-{ $subsection drop-prefix }
-{ $subsection assert-sequence= }
+{ $subsections
+ sequence=
+ mismatch
+ drop-prefix
+ assert-sequence=
+}
"The " { $link <=> } " generic word performs lexicographic comparison when applied to sequences." ;
ARTICLE: "sequences-f" "The f object as a sequence"
"A " { $emphasis "sequence" } " is a finite, linearly-ordered collection of elements. Words for working with sequences are in the " { $vocab-link "sequences" } " vocabulary."
$nl
"Sequences implement a protocol:"
-{ $subsection "sequence-protocol" }
-{ $subsection "sequences-f" }
+{ $subsections
+ "sequence-protocol"
+ "sequences-f"
+}
"Sequence utility words can operate on any object whose class implements the sequence protocol. Most implementations are backed by storage. Some implementations obtain their elements from an underlying sequence, or compute them on the fly. These are known as " { $link "virtual-sequences" } "."
-{ $subsection "sequences-access" }
-{ $subsection "sequences-combinators" }
-{ $subsection "sequences-add-remove" }
-{ $subsection "sequences-appending" }
-{ $subsection "sequences-slices" }
-{ $subsection "sequences-reshape" }
-{ $subsection "sequences-tests" }
-{ $subsection "sequences-search" }
-{ $subsection "sequences-comparing" }
-{ $subsection "sequences-split" }
-{ $subsection "grouping" }
-{ $subsection "sequences-destructive" }
-{ $subsection "sequences-stacks" }
-{ $subsection "sequences-sorting" }
-{ $subsection "binary-search" }
-{ $subsection "sets" }
-{ $subsection "sequences-trimming" }
-{ $subsection "sequences.deep" }
+{ $subsections
+ "sequences-access"
+ "sequences-combinators"
+ "sequences-add-remove"
+ "sequences-appending"
+ "sequences-slices"
+ "sequences-reshape"
+ "sequences-tests"
+ "sequences-search"
+ "sequences-comparing"
+ "sequences-split"
+ "grouping"
+ "sequences-destructive"
+ "sequences-stacks"
+ "sequences-sorting"
+ "binary-search"
+ "sets"
+ "sequences-trimming"
+ "sequences.deep"
+}
"Using sequences for looping:"
-{ $subsection "sequences-integers" }
-{ $subsection "math.ranges" }
+{ $subsections
+ "sequences-integers"
+ "math.ranges"
+}
"Using sequences for control flow:"
-{ $subsection "sequences-if" }
+{ $subsections "sequences-if" }
"For inner loops:"
-{ $subsection "sequences-unsafe" } ;
+{ $subsections "sequences-unsafe" } ;
ABOUT: "sequences"
INSTANCE: f immutable-sequence
! Integers used to support the sequence protocol
-M: integer length ; inline deprecated
-M: integer nth-unsafe drop ; inline deprecated
+M: integer length ; inline
+M: integer nth-unsafe drop ; inline
INSTANCE: integer immutable-sequence
: change-each ( seq quot -- )
over map-into ; inline
+: accumulate-as ( seq identity quot exemplar -- final newseq )
+ [ [ swap ] dip [ curry keep ] curry ] dip map-as ; inline
+
: accumulate ( seq identity quot -- final newseq )
- swapd [ [ call ] [ 2drop ] 3bi ] curry { } map-as ; inline
+ { } accumulate-as ; inline
: 2each ( seq1 seq2 quot -- )
(2each) each-integer ; inline
: last-index-from ( obj i seq -- n )
rot [ = ] curry find-last-from drop ;
+<PRIVATE
+
: (indices) ( elt i obj accum -- )
[ swap [ = ] dip ] dip [ push ] 2curry when ; inline
+PRIVATE>
+
: indices ( obj seq -- indices )
swap V{ } clone
[ [ (indices) ] 2curry each-index ] keep ;
"Set-theoretic operations on sequences are defined on the " { $vocab-link "sets" } " vocabulary. All of these operations use hashtables internally to achieve linear running time."
$nl
"Remove duplicates:"
-{ $subsection prune }
+{ $subsections prune }
"Test for duplicates:"
-{ $subsection all-unique? }
-{ $subsection duplicates }
+{ $subsections
+ all-unique?
+ duplicates
+}
"Set operations on sequences:"
-{ $subsection diff }
-{ $subsection intersect }
-{ $subsection union }
+{ $subsections
+ diff
+ intersect
+ union
+}
"Set-theoretic predicates:"
-{ $subsection intersects? }
-{ $subsection subset? }
-{ $subsection set= }
+{ $subsections
+ intersects?
+ subset?
+ set=
+}
"A word used to implement the above:"
-{ $subsection unique }
+{ $subsections unique }
"Adding elements to sets:"
-{ $subsection adjoin }
-{ $subsection conjoin }
-{ $subsection conjoin-at }
+{ $subsections
+ adjoin
+ conjoin
+ conjoin-at
+}
{ $see-also member? memq? any? all? "assocs-sets" } ;
ABOUT: "sets"
{ "Otherwise, a " { $link no-initial-value } " error is thrown. In this case, an initial value must be specified explicitly using " { $link initial: } "." }
}
"A word can be used to check if a class has an initial value or not:"
-{ $subsection initial-value } ;
+{ $subsections initial-value } ;
ARTICLE: "slots" "Low-level slot operations"
"The " { $vocab-link "slots" } " vocabulary contains words for introspecting the slots of an object. A " { $emphasis "slot" } " is a component of an object which can store a value."
{ $link "tuples" } " are composed entirely of slots, and instances of " { $link "builtin-classes" } " consist of slots together with intrinsic data."
$nl
"The " { $snippet "\"slots\"" } " word property of built-in and tuple classes holds an array of " { $emphasis "slot specifiers" } " describing the slot layout of each instance."
-{ $subsection slot-spec }
+{ $subsections slot-spec }
"The four words associated with a slot can be looked up in the " { $vocab-link "accessors" } " vocabulary:"
-{ $subsection reader-word }
-{ $subsection writer-word }
-{ $subsection setter-word }
-{ $subsection changer-word }
+{ $subsections
+ reader-word
+ writer-word
+ setter-word
+ changer-word
+}
"Looking up a slot by name:"
-{ $subsection slot-named }
+{ $subsections slot-named }
"Defining slots dynamically:"
-{ $subsection define-reader }
-{ $subsection define-writer }
-{ $subsection define-setter }
-{ $subsection define-changer }
-{ $subsection define-slot-methods }
-{ $subsection define-accessors }
+{ $subsections
+ define-reader
+ define-writer
+ define-setter
+ define-changer
+ define-slot-methods
+ define-accessors
+}
"Unsafe slot access:"
-{ $subsection slot }
-{ $subsection set-slot }
+{ $subsections
+ slot
+ set-slot
+}
{ $see-also "accessors" "mirrors" } ;
ABOUT: "slots"
"Sorting combinators all take comparator quotations with stack effect " { $snippet "( elt1 elt2 -- <=> )" } ", where the output value is one of the three " { $link "order-specifiers" } "."
$nl
"Sorting a sequence with a custom comparator:"
-{ $subsection sort }
+{ $subsections sort }
"Sorting a sequence with common comparators:"
-{ $subsection sort-with }
-{ $subsection inv-sort-with }
-{ $subsection natural-sort }
-{ $subsection sort-keys }
-{ $subsection sort-values } ;
+{ $subsections
+ sort-with
+ inv-sort-with
+ natural-sort
+ sort-keys
+ sort-values
+} ;
ABOUT: "sequences-sorting"
"Words in the " { $vocab-link "source-files" } " vocabulary are used to keep track of loaded source files. This is used to implement " { $link "vocabs.refresh" } "."
$nl
"The source file database:"
-{ $subsection source-files }
+{ $subsections source-files }
"The class of source files:"
-{ $subsection source-file }
+{ $subsections source-file }
"Words intended for the parser:"
-{ $subsection record-checksum }
-{ $subsection record-definitions }
+{ $subsections
+ record-checksum
+ record-definitions
+}
"Removing a source file from the database:"
-{ $subsection forget-source }
+{ $subsections forget-source }
"Updating the database:"
-{ $subsection reset-checksums }
+{ $subsections reset-checksums }
"The " { $link pathname } " class implements the definition protocol by working with the corresponding source file; see " { $link "definitions" } "." ;
ABOUT: "source-files"
ARTICLE: "sequences-split" "Splitting sequences"
"Splitting sequences at occurrences of subsequences:"
-{ $subsection ?head }
-{ $subsection ?head-slice }
-{ $subsection ?tail }
-{ $subsection ?tail-slice }
-{ $subsection split1 }
-{ $subsection split1-slice }
-{ $subsection split1-last }
-{ $subsection split1-last-slice }
-{ $subsection split }
+{ $subsections
+ ?head
+ ?head-slice
+ ?tail
+ ?tail-slice
+ split1
+ split1-slice
+ split1-last
+ split1-last-slice
+ split
+}
"Splitting a string into lines:"
-{ $subsection string-lines } ;
+{ $subsections string-lines } ;
ABOUT: "sequences-split"
+USING: accessors eval strings.parser strings.parser.private
+tools.test ;
IN: strings.parser.tests
-USING: strings.parser tools.test ;
[ "Hello\n\rworld" ] [ "Hello\\n\\rworld" unescape-string ] unit-test
+
+[ "Hello\n\rworld" ] [ "Hello\n\rworld" ] unit-test
+[ "Hello\n\rworld" ] [ """Hello\n\rworld""" ] unit-test
+[ "Hello\n\rworld\n" ] [ "Hello\n\rworld
+" ] unit-test
+[ "Hello\n\rworld" "hi" ] [ "Hello\n\rworld" "hi" ] unit-test
+[ "Hello\n\rworld" "hi" ] [ """Hello\n\rworld""" """hi""" ] unit-test
+[ "Hello\n\rworld\n" "hi" ] [ """Hello\n\rworld
+""" """hi""" ] unit-test
+[ "Hello\n\rworld\"" "hi" ] [ """Hello\n\rworld\"""" """hi""" ] unit-test
+
+[
+ "\"\"\"Hello\n\rworld\\\n\"\"\"" eval( -- obj )
+] [
+ error>> escaped-char-expected?
+] must-fail-with
+
+[
+ " \" abc \" "
+] [
+ "\"\"\" \" abc \" \"\"\"" eval( -- string )
+] unit-test
+
+[
+ "\"abc\""
+] [
+ "\"\"\"\"abc\"\"\"\"" eval( -- string )
+] unit-test
+
+
+[ "\"\\" ] [ "\"\\" ] unit-test
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel assocs namespaces make splitting sequences
-strings math.parser lexer accessors ;
+USING: accessors assocs kernel lexer make math math.parser
+namespaces parser sequences splitting strings arrays
+math.order ;
IN: strings.parser
-ERROR: bad-escape ;
+ERROR: bad-escape char ;
: escape ( escape -- ch )
H{
{ CHAR: 0 CHAR: \0 }
{ CHAR: \\ CHAR: \\ }
{ CHAR: \" CHAR: \" }
- } at [ bad-escape ] unless* ;
+ } ?at [ bad-escape ] unless ;
SYMBOL: name>char-hook
unclip-slice escape swap
] if ;
+: (unescape-string) ( str -- )
+ CHAR: \\ over index dup [
+ cut-slice [ % ] dip rest-slice
+ next-escape [ , ] dip
+ (unescape-string)
+ ] [
+ drop %
+ ] if ;
+
+: unescape-string ( str -- str' )
+ [ (unescape-string) ] "" make ;
+
: (parse-string) ( str -- m )
dup [ "\"\\" member? ] find dup [
[ cut-slice [ % ] dip rest-slice ] dip
[ swap tail-slice (parse-string) ] "" make swap
] change-lexer-column ;
-: (unescape-string) ( str -- )
- CHAR: \\ over index dup [
- cut-slice [ % ] dip rest-slice
- next-escape [ , ] dip
- (unescape-string)
+<PRIVATE
+
+: lexer-subseq ( i -- before )
+ [
+ [
+ lexer get
+ [ column>> ] [ line-text>> ] bi
+ ] dip swap subseq
] [
- drop %
+ lexer get (>>column)
+ ] bi ;
+
+: rest-of-line ( lexer -- seq )
+ [ line-text>> ] [ column>> ] bi tail-slice ;
+
+: current-char ( lexer -- ch/f )
+ [ column>> ] [ line-text>> ] bi ?nth ;
+
+: advance-char ( lexer -- )
+ [ 1 + ] change-column drop ;
+
+ERROR: escaped-char-expected ;
+
+: next-char ( lexer -- ch )
+ dup still-parsing-line? [
+ [ current-char ] [ advance-char ] bi
+ ] [
+ escaped-char-expected
] if ;
-: unescape-string ( str -- str' )
- [ (unescape-string) ] "" make ;
+: lexer-head? ( string -- ? )
+ [
+ lexer get [ line-text>> ] [ column>> ] bi tail-slice
+ ] dip head? ;
+
+: advance-lexer ( n -- )
+ [ lexer get ] dip [ + ] curry change-column drop ; inline
+
+: find-next-token ( ch -- i elt )
+ CHAR: \ 2array
+ [ lexer get [ column>> ] [ line-text>> ] bi ] dip
+ [ member? ] curry find-from ;
+
+: next-line% ( lexer -- )
+ [ rest-of-line % ]
+ [ next-line "\n" % ] bi ;
+
+: take-double-quotes ( -- string )
+ lexer get dup current-char CHAR: " = [
+ [ ] [ column>> ] [ line-text>> ] tri
+ [ CHAR: " = not ] find-from drop [
+ swap column>> - CHAR: " <repetition>
+ ] [
+ rest-of-line
+ ] if*
+ ] [
+ drop f
+ ] if dup length advance-lexer ;
+
+: end-string-parse ( delimiter -- )
+ length 3 = [
+ take-double-quotes 3 tail %
+ ] [
+ lexer get advance-char
+ ] if ;
+
+DEFER: (parse-multiline-string)
+
+: parse-found-token ( i string token -- )
+ [ lexer-subseq % ] dip
+ CHAR: \ = [
+ lexer get [ next-char , ] [ next-char , ] bi (parse-multiline-string)
+ ] [
+ dup lexer-head? [
+ end-string-parse
+ ] [
+ lexer get next-char , (parse-multiline-string)
+ ] if
+ ] if ;
+
+ERROR: trailing-characters string ;
+
+: (parse-multiline-string) ( string -- )
+ lexer get still-parsing? [
+ dup first find-next-token [
+ parse-found-token
+ ] [
+ drop lexer get next-line%
+ (parse-multiline-string)
+ ] if*
+ ] [
+ unexpected-eof
+ ] if ;
+
+PRIVATE>
+
+: parse-multiline-string ( -- string )
+ lexer get rest-of-line "\"\"" head? [
+ lexer get [ 2 + ] change-column drop
+ "\"\"\""
+ ] [
+ "\""
+ ] if [ (parse-multiline-string) ] "" make unescape-string ;
"Since strings implement the " { $link "sequence-protocol" } ", basic string manipulation can be performed with " { $link "sequences" } " in the " { $vocab-link "sequences" } " vocabulary. More text processing functionality can be found in vocabularies carrying the " { $link T{ vocab-tag { name "text" } } } " tag."
$nl
"Strings form a class:"
-{ $subsection string }
-{ $subsection string? }
+{ $subsections
+ string
+ string?
+}
"Creating new strings:"
-{ $subsection >string }
-{ $subsection <string> }
+{ $subsections
+ >string
+ <string>
+}
"Creating a string from a single character:"
-{ $subsection 1string } ;
+{ $subsections 1string } ;
ABOUT: "strings"
M: string equal?
over string? [
- over hashcode over hashcode eq?
+ 2dup [ hashcode ] bi@ eq?
[ sequence= ] [ 2drop f ] if
] [
2drop f
"While parsing words supporting arbitrary syntax can be defined, the default set is found in the " { $vocab-link "syntax" } " vocabulary and provides the basis for all further syntactic interaction with Factor." ;
ARTICLE: "syntax-comments" "Comments"
-{ $subsection POSTPONE: ! }
-{ $subsection POSTPONE: #! } ;
+{ $subsections
+ POSTPONE: !
+ POSTPONE: #!
+} ;
ARTICLE: "syntax-immediate" "Parse time evaluation"
"Code can be evaluated at parse time. This is a rarely-used feature; one use-case is " { $link "loading-libs" } ", where you want to execute some code before the words in a source file are compiled."
-{ $subsection POSTPONE: << }
-{ $subsection POSTPONE: >> } ;
+{ $subsections
+ POSTPONE: <<
+ POSTPONE: >>
+} ;
ARTICLE: "syntax-integers" "Integer syntax"
"The printed representation of an integer consists of a sequence of digits, optionally prefixed by a sign."
"2432902008176640000"
}
"Integers are entered in base 10 unless prefixed with a base change parsing word."
-{ $subsection POSTPONE: BIN: }
-{ $subsection POSTPONE: OCT: }
-{ $subsection POSTPONE: HEX: }
+{ $subsections
+ POSTPONE: BIN:
+ POSTPONE: OCT:
+ POSTPONE: HEX:
+}
"More information on integers can be found in " { $link "integers" } "." ;
ARTICLE: "syntax-ratios" "Ratio syntax"
"More information on ratios can be found in " { $link "rationals" } ;
ARTICLE: "syntax-floats" "Float syntax"
-"Floating point literals must contain a decimal point, and may contain an exponent:"
+"Floating point literals can be input in base 10 or 16. Base 10 literals must contain a decimal point, and may contain an exponent after " { $snippet "e" } ":"
{ $code
"10.5"
"-3.1456"
"7.e13"
"1.0e-5"
}
-"There are three special float values:"
+"Base 16 literals use " { $snippet "p" } " instead of " { $snippet "e" } " for the exponent, which is still decimal:"
+{ $example
+ "10.125 HEX: 1.44p3 = ."
+ "t"
+}
+"Syntax for special float values:"
{ $table
{ "Positive infinity" { $snippet "1/0." } }
{ "Negative infinity" { $snippet "-1/0." } }
{ "Not-a-number" { $snippet "0/0." } }
}
+"A Not-a-number with an arbitrary payload can also be parsed in:"
+{ $subsections POSTPONE: NAN: }
"More information on floats can be found in " { $link "floats" } "." ;
ARTICLE: "syntax-complex-numbers" "Complex number syntax"
"C{ 1/2 1/3 } ! the complex number 1/2+1/3i"
"C{ 0 1 } ! the imaginary unit"
}
-{ $subsection POSTPONE: C{ }
+{ $subsections POSTPONE: C{ }
"More information on complex numbers can be found in " { $link "complex-numbers" } "." ;
ARTICLE: "syntax-numbers" "Number syntax"
"If a vocabulary lookup of a token fails, the parser attempts to parse it as a number."
-{ $subsection "syntax-integers" }
-{ $subsection "syntax-ratios" }
-{ $subsection "syntax-floats" }
-{ $subsection "syntax-complex-numbers" } ;
+{ $subsections
+ "syntax-integers"
+ "syntax-ratios"
+ "syntax-floats"
+ "syntax-complex-numbers"
+} ;
ARTICLE: "syntax-words" "Word syntax"
"A word occurring inside a quotation is executed when the quotation is called. Sometimes a word needs to be pushed on the data stack instead. The canonical use-case for this is passing the word to the " { $link execute } " combinator, or alternatively, reflectively accessing word properties (" { $link "word-props" } ")."
-{ $subsection POSTPONE: \ }
-{ $subsection POSTPONE: POSTPONE: }
+{ $subsections
+ POSTPONE: \
+ POSTPONE: POSTPONE:
+}
"The implementation of the " { $link POSTPONE: \ } " word is discussed in detail in " { $link "reading-ahead" } ". Words are documented in " { $link "words" } "." ;
ARTICLE: "escape" "Character escape codes"
ARTICLE: "syntax-strings" "Character and string syntax"
"Factor has no distinct character type, however Unicode character value integers can be read by specifying a literal character, or an escaped representation thereof."
-{ $subsection POSTPONE: CHAR: }
-{ $subsection POSTPONE: " }
-{ $subsection "escape" }
+{ $subsections
+ POSTPONE: CHAR:
+ POSTPONE: "
+ "escape"
+}
"Strings are documented in " { $link "strings" } "." ;
ARTICLE: "syntax-sbufs" "String buffer syntax"
-{ $subsection POSTPONE: SBUF" }
+{ $subsections POSTPONE: SBUF" }
"String buffers are documented in " { $link "sbufs" } "." ;
ARTICLE: "syntax-arrays" "Array syntax"
-{ $subsection POSTPONE: { }
-{ $subsection POSTPONE: } }
+{ $subsections
+ POSTPONE: {
+ POSTPONE: }
+}
"Arrays are documented in " { $link "arrays" } "." ;
ARTICLE: "syntax-vectors" "Vector syntax"
-{ $subsection POSTPONE: V{ }
+{ $subsections POSTPONE: V{ }
"Vectors are documented in " { $link "vectors" } "." ;
ARTICLE: "syntax-hashtables" "Hashtable syntax"
-{ $subsection POSTPONE: H{ }
+{ $subsections POSTPONE: H{ }
"Hashtables are documented in " { $link "hashtables" } "." ;
ARTICLE: "syntax-tuples" "Tuple syntax"
-{ $subsection POSTPONE: T{ }
+{ $subsections POSTPONE: T{ }
"Tuples are documented in " { $link "tuples" } "." ;
ARTICLE: "syntax-quots" "Quotation syntax"
-{ $subsection POSTPONE: [ }
-{ $subsection POSTPONE: ] }
+{ $subsections
+ POSTPONE: [
+ POSTPONE: ]
+}
"Quotations are documented in " { $link "quotations" } "." ;
ARTICLE: "syntax-byte-arrays" "Byte array syntax"
-{ $subsection POSTPONE: B{ }
+{ $subsections POSTPONE: B{ }
"Byte arrays are documented in " { $link "byte-arrays" } "." ;
ARTICLE: "syntax-pathnames" "Pathname syntax"
-{ $subsection POSTPONE: P" }
+{ $subsections POSTPONE: P" }
"Pathnames are documented in " { $link "io.pathnames" } "." ;
ARTICLE: "syntax-effects" "Stack effect syntax"
"Note that this is " { $emphasis "not" } " syntax to declare stack effects of words. This pushes an " { $link effect } " instance on the stack for reflection, for use with words such as " { $link define-declared } ", " { $link call-effect } " and " { $link execute-effect } "."
-{ $subsection POSTPONE: (( }
+{ $subsections POSTPONE: (( }
{ $see-also "effects" "inference" "tools.inference" } ;
ARTICLE: "syntax-literals" "Literals"
"If a quotation contains a literal object, the same literal object instance is used each time the quotation executes; that is, literals are “live”."
$nl
"Using mutable object literals in word definitions requires care, since if those objects are mutated, the actual word definition will be changed, which is in most cases not what you would expect. Literals should be " { $link clone } "d before being passed to word which may potentially mutate them."
-{ $subsection "syntax-numbers" }
-{ $subsection "syntax-words" }
-{ $subsection "syntax-quots" }
-{ $subsection "syntax-arrays" }
-{ $subsection "syntax-strings" }
-{ $subsection "syntax-byte-arrays" }
-{ $subsection "syntax-vectors" }
-{ $subsection "syntax-sbufs" }
-{ $subsection "syntax-hashtables" }
-{ $subsection "syntax-tuples" }
-{ $subsection "syntax-pathnames" }
-{ $subsection "syntax-effects" } ;
+{ $subsections
+ "syntax-numbers"
+ "syntax-words"
+ "syntax-quots"
+ "syntax-arrays"
+ "syntax-strings"
+ "syntax-byte-arrays"
+ "syntax-vectors"
+ "syntax-sbufs"
+ "syntax-hashtables"
+ "syntax-tuples"
+ "syntax-pathnames"
+ "syntax-effects"
+} ;
ARTICLE: "syntax" "Syntax"
"Factor has two main forms of syntax: " { $emphasis "definition" } " syntax and " { $emphasis "literal" } " syntax. Code is data, so the syntax for code is a special case of object literal syntax. This section documents literal syntax. Definition syntax is covered in " { $link "words" } ". Extending the parser is the main topic of " { $link "parser" } "."
-{ $subsection "parser-algorithm" }
-{ $subsection "word-search" }
-{ $subsection "top-level-forms" }
-{ $subsection "syntax-comments" }
-{ $subsection "syntax-literals" }
-{ $subsection "syntax-immediate" } ;
+{ $subsections
+ "parser-algorithm"
+ "word-search"
+ "top-level-forms"
+ "syntax-comments"
+ "syntax-literals"
+ "syntax-immediate"
+} ;
ABOUT: "syntax"
{ $description "Parses a complex number given in rectangular form as a pair of real numbers. Literal complex numbers are terminated by " { $link POSTPONE: } } "." } ;
HELP: T{
-{ $syntax "T{ class slots... }" }
+{ $syntax "T{ class }" "T{ class f slot-values... }" "T{ class { slot-name slot-value } ... }" }
{ $values { "class" "a tuple class word" } { "slots" "slot values" } }
{ $description "Marks the beginning of a literal tuple."
$nl
} ;
HELP: "
-{ $syntax "\"string...\"" }
+{ $syntax "\"string...\"" "\"\"\"string...\"\"\"" }
{ $values { "string" "literal and escaped characters" } }
-{ $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", and appends the resulting string to the parse tree. String literals cannot span multiple lines. Strings containing the " { $link POSTPONE: " } " character and various other special characters can be read by inserting " { $link "escape" } "." }
+{ $description "Reads from the input string until the next occurrence of " { $snippet "\"" } " or " { $snippet "\"\"\"" } ", and appends the resulting string to the parse tree. String literals can span multiple lines. Various special characters can be read by inserting " { $link "escape" } ". For triple quoted strings, the double-quote character does not require escaping." }
{ $examples
- "A string with a newline in it:"
- { $example "USE: io" "\"Hello\\nworld\" print" "Hello\nworld" }
- "A string with a named Unicode code point:"
- { $example "USE: io" "\"\\u{greek-capital-letter-sigma}\" print" "\u{greek-capital-letter-sigma}" }
+ "A string with an escaped newline in it:"
+ { $example "USE: io" "\"Hello\\nworld\" print" "Hello\nworld" }
+ "A string with an actual newline in it:"
+ { $example "USE: io" "\"Hello\nworld\" print" "Hello\nworld" }
+ "A string with a named Unicode code point:"
+ { $example "USE: io" "\"\\u{greek-capital-letter-sigma}\" print" "\u{greek-capital-letter-sigma}" }
+ "A triple-quoted string:"
+ { $example "USE: io \"\"\"Teach a man to \"fish\"...\nand fish will go extinct\"\"\" print" """Teach a man to \"fish\"...
+and fish will go extinct""" }
} ;
HELP: SBUF"
{ $description "Discards all input until the end of the line." } ;
HELP: HEX:
-{ $syntax "HEX: integer" }
-{ $values { "integer" "hexadecimal digits (0-9, a-f, A-F)" } }
-{ $description "Adds an integer read from a hexadecimal literal to the parse tree." }
-{ $examples { $example "USE: prettyprint" "HEX: ff ." "255" } } ;
+{ $syntax "HEX: NNN" "HEX: NNN.NNNpEEE" }
+{ $values { "N" "hexadecimal digit (0-9, a-f, A-F)" } { "pEEE" "decimal exponent value" } }
+{ $description "Adds an integer or floating-point value read from a hexadecimal literal to the parse tree." }
+{ $examples
+ { $example "USE: prettyprint" "HEX: ff ." "255" }
+ { $example "USE: prettyprint" "HEX: 1.8p5 ." "48.0" }
+} ;
HELP: OCT:
{ $syntax "OCT: integer" }
{ $description "Adds an integer read from an binary literal to the parse tree." }
{ $examples { $example "USE: prettyprint" "BIN: 100 ." "4" } } ;
+HELP: NAN:
+{ $syntax "NAN: payload" }
+{ $values { "payload" "64-bit hexadecimal integer" } }
+{ $description "Adds a floating point Not-a-Number literal to the parse tree." }
+{ $examples
+ { $example
+ "USE: prettyprint"
+ "NAN: 80000deadbeef ."
+ "NAN: 80000deadbeef"
+ }
+} ;
+
HELP: GENERIC:
{ $syntax "GENERIC: word ( stack -- effect )" }
{ $values { "word" "a new word to define" } }
HELP: execute(
{ $syntax "execute( stack -- effect )" }
-{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." } ;
+{ $description "Calls the word on the top of the stack, asserting that it has the given stack effect. The word does not need to be known at compile time." }
+{ $examples
+ { $code
+ "IN: scratchpad"
+ ""
+ ": eat ( -- ) ; : sleep ( -- ) ; : hack ( -- ) ;"
+ "{ eat sleep hack } [ execute( -- ) ] each"
+ }
+} ;
{ POSTPONE: call( POSTPONE: execute( } related-words
"OCT:" [ 8 parse-base ] define-core-syntax
"BIN:" [ 2 parse-base ] define-core-syntax
+ "NAN:" [ 16 scan-base <fp-nan> parsed ] define-core-syntax
+
"f" [ f parsed ] define-core-syntax
"t" "syntax" lookup define-singleton-class
} cond parsed
] define-core-syntax
- "\"" [ parse-string parsed ] define-core-syntax
+ "\"" [ parse-multiline-string parsed ] define-core-syntax
"SBUF\"" [
lexer get skip-blank parse-string >sbuf parsed
ABOUT: "system"
ARTICLE: "system" "System interface"
-{ $subsection "cpu" }
-{ $subsection "os" }
+{ $subsections
+ "cpu"
+ "os"
+}
"Getting the path to the Factor VM and image:"
-{ $subsection vm }
-{ $subsection image }
+{ $subsections
+ vm
+ image
+}
"Getting the current time:"
-{ $subsection micros }
-{ $subsection millis }
+{ $subsections
+ micros
+ millis
+}
"Exiting the Factor VM:"
-{ $subsection exit } ;
+{ $subsections exit } ;
ARTICLE: "cpu" "Processor detection"
"Processor detection:"
-{ $subsection cpu }
+{ $subsections cpu }
"Supported processors:"
-{ $subsection x86.32 }
-{ $subsection x86.64 }
-{ $subsection ppc }
-{ $subsection arm }
+{ $subsections
+ x86.32
+ x86.64
+ ppc
+ arm
+}
"Processor families:"
-{ $subsection x86 } ;
+{ $subsections x86 } ;
ARTICLE: "os" "Operating system detection"
"Operating system detection:"
-{ $subsection os }
+{ $subsections os }
"Supported operating systems:"
-{ $subsection freebsd }
-{ $subsection linux }
-{ $subsection macosx }
-{ $subsection openbsd }
-{ $subsection netbsd }
-{ $subsection solaris }
-{ $subsection wince }
-{ $subsection winnt }
+{ $subsections
+ freebsd
+ linux
+ macosx
+ openbsd
+ netbsd
+ solaris
+ wince
+ winnt
+}
"Operating system families:"
-{ $subsection bsd }
-{ $subsection unix }
-{ $subsection windows } ;
+{ $subsections
+ bsd
+ unix
+ windows
+} ;
HELP: cpu
"Vectors are intended to be used with " { $link "sequences-destructive" } ". Code that does not modify sequences in-place can use fixed-size arrays without loss of generality; see " { $link "arrays" } "."
$nl
"Vectors form a class of objects:"
-{ $subsection vector }
-{ $subsection vector? }
+{ $subsections
+ vector
+ vector?
+}
"Creating new vectors:"
-{ $subsection >vector }
-{ $subsection <vector> }
+{ $subsections
+ >vector
+ <vector>
+}
"Creating a vector from a single element:"
-{ $subsection 1vector }
+{ $subsections 1vector }
"If you don't care about initial capacity, an elegant way to create a new vector is to write:"
{ $code "V{ } clone" } ;
"The first way is to use an environment variable. Factor looks at the " { $snippet "FACTOR_ROOTS" } " environment variable for a list of " { $snippet ":" } "-separated paths (on Unix) or a list of " { $snippet ";" } "-separated paths (on Windows)."
$nl
"The second way is to create a configuration file. You can list additional vocabulary roots in a file that Factor reads at startup:"
-{ $subsection "factor-roots" }
+{ $subsections "factor-roots" }
"Finally, you can add vocabulary roots dynamically using a word:"
-{ $subsection add-vocab-root } ;
+{ $subsections add-vocab-root } ;
ARTICLE: "vocabs.roots" "Vocabulary roots"
"The vocabulary loader searches for it in one of the root directories:"
-{ $subsection vocab-roots }
+{ $subsections vocab-roots }
"The default set of roots includes the following directories in the Factor source directory:"
{ $list
{ { $snippet "core" } " - essential system vocabularies such as " { $vocab-link "parser" } " and " { $vocab-link "sequences" } ". The vocabularies in this root constitute the boot image; see " { $link "bootstrap.image" } "." }
{ { $snippet "work" } " - a root for vocabularies which are not intended to be contributed back to Factor." }
}
"You can store your own vocabularies in the " { $snippet "work" } " directory."
-{ $subsection "add-vocab-roots" } ;
+{ $subsections "add-vocab-roots" } ;
ARTICLE: "vocabs.loader" "Vocabulary loader"
"The vocabulary loader is defined in the " { $vocab-link "vocabs.loader" } " vocabulary."
$nl
"Vocabularies are searched for in vocabulary roots."
-{ $subsection "vocabs.roots" }
+{ $subsections "vocabs.roots" }
"Vocabulary names map directly to source files. A vocabulary named " { $snippet "foo.bar" } " must be defined in a " { $snippet "bar" } " directory nested inside a " { $snippet "foo" } " directory of a vocabulary root. Any level of vocabulary nesting is permitted."
$nl
"The vocabulary directory - " { $snippet "bar" } " in our example - contains a source file:"
{ { $snippet "foo/bar/tags.txt" } " - a whitespace-separated list of tags which classify the vocabulary. Consult " { $link "vocab-tags" } " for a list of existing tags you can re-use" }
}
"While " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " load vocabularies which have not been loaded before adding them to the search path, it is also possible to load a vocabulary without adding it to the search path:"
-{ $subsection require }
+{ $subsections require }
"Forcing a reload of a vocabulary, even if it has already been loaded:"
-{ $subsection reload }
+{ $subsections reload }
"Application vocabularies can define a main entry point, giving the user a convenient way to run the application:"
-{ $subsection POSTPONE: MAIN: }
-{ $subsection run }
-{ $subsection runnable-vocab }
+{ $subsections
+ POSTPONE: MAIN:
+ run
+ runnable-vocab
+}
{ $see-also "vocabularies" "parser-files" "source-files" } ;
ABOUT: "vocabs.loader"
"If " { $link auto-use? } " mode is on and only one vocabulary has a word with this name, the vocabulary is added to the search path and parsing continues."
$nl
"If any restarts were invoked, or if " { $link auto-use? } " is on, the parser will print the correct " { $link POSTPONE: USING: } " after parsing completes. This form can be copy and pasted back into the source file."
-{ $subsection auto-use? } ;
+{ $subsections auto-use? } ;
ARTICLE: "word-search-syntax" "Syntax to control word lookup"
"Parsing words which make all words in a vocabulary available:"
-{ $subsection POSTPONE: USE: }
-{ $subsection POSTPONE: USING: }
-{ $subsection POSTPONE: QUALIFIED: }
-{ $subsection POSTPONE: QUALIFIED-WITH: }
+{ $subsections
+ POSTPONE: USE:
+ POSTPONE: USING:
+ POSTPONE: QUALIFIED:
+ POSTPONE: QUALIFIED-WITH:
+}
"Parsing words which make a subset of all words in a vocabulary available:"
-{ $subsection POSTPONE: FROM: }
-{ $subsection POSTPONE: EXCLUDE: }
-{ $subsection POSTPONE: RENAME: }
+{ $subsections
+ POSTPONE: FROM:
+ POSTPONE: EXCLUDE:
+ POSTPONE: RENAME:
+}
"Removing vocabularies from the search path:"
-{ $subsection POSTPONE: UNUSE: }
+{ $subsections POSTPONE: UNUSE: }
"In the listener, the " { $vocab-link "scratchpad" } " is the default vocabulary for new word definitions. In source files, there is no default vocabulary. Defining words before declaring a vocabulary with " { $link POSTPONE: IN: } " results in an error."
-{ $subsection POSTPONE: IN: } ;
+{ $subsections POSTPONE: IN: } ;
ARTICLE: "word-search-semantics" "Resolution of ambiguous word names"
"There is a distinction between parsing words which perform “open” imports versus “closed” imports. An open import introduces all words from a vocabulary as identifiers, except possibly a finite set of exclusions. The " { $link POSTPONE: USE: } ", " { $link POSTPONE: USING: } " and " { $link POSTPONE: EXCLUDE: } " words perform open imports. A closed import only adds a fixed set of identifiers. The " { $link POSTPONE: FROM: } ", " { $link POSTPONE: RENAME: } ", " { $link POSTPONE: QUALIFIED: } " and " { $link POSTPONE: QUALIFIED-WITH: } " words perform closed imports. Note that the latter two are considered as closed imports, due to the fact that all identifiers they introduce are unambiguously qualified with a prefix. The " { $link POSTPONE: IN: } " parsing word also performs a closed import of the newly-created vocabulary."
$nl
"When the parser encounters a reference to a word, it first searches the closed imports, in order. Closed imports are searched from the most recent to least recent. If the word could not be found this way, it searches open imports. Unlike closed imports, with open imports, the order does not matter -- instead, if more than one vocabulary defines a word with this name, an error is thrown."
-{ $subsection ambiguous-use-error }
+{ $subsections ambiguous-use-error }
"To resolve the error, add a closed import, using " { $link POSTPONE: FROM: } ", " { $link POSTPONE: QUALIFIED: } " or " { $link POSTPONE: QUALIFIED-WITH: } ". The closed import will then take precedence over the open imports, and the ambiguity will be resolved."
$nl
"The rationale for this behavior is as follows. Open imports are named such because they are open to future extension; if a future version of a vocabulary that you use adds new words, those new words will now be in scope in your source file, too. To avoid problems, any references to the new word have to be resolved since the parser cannot safely determine which vocabulary was meant. This problem can be avoided entirely by using only closed imports, but this leads to additional verbosity."
ARTICLE: "word-search-private" "Private words"
"Words which only serve as implementation detail should be defined in a private code block. Words in a private code blocks get defined in a vocabulary whose name is the name of the current vocabulary suffixed with " { $snippet ".private" } ". Privacy is not enforced by the system; private words can be called from other vocabularies, and from the listener. However, this should be avoided where possible."
-{ $subsection POSTPONE: <PRIVATE }
-{ $subsection POSTPONE: PRIVATE> } ;
+{ $subsections
+ POSTPONE: <PRIVATE
+ POSTPONE: PRIVATE>
+} ;
ARTICLE: "word-search" "Parse-time word lookup"
"When the parser reads a word name, it resolves the word at parse-time, looking up the " { $link word } " instance in the right vocabulary and adding it to the parse tree."
$nl
"Initially, only words from the " { $vocab-link "syntax" } " vocabulary are available in source files. Since most files will use words in other vocabularies, they will need to make those words available using a set of parsing words."
-{ $subsection "word-search-syntax" }
-{ $subsection "word-search-private" }
-{ $subsection "word-search-semantics" }
-{ $subsection "word-search-errors" }
+{ $subsections
+ "word-search-syntax"
+ "word-search-private"
+ "word-search-semantics"
+ "word-search-errors"
+}
{ $see-also "words" } ;
ARTICLE: "word-search-parsing" "Word lookup in parsing words"
"The parsing words described in " { $link "word-search-syntax" } " are implemented using the below words, which you can also call from your own parsing words."
$nl
"The current state used for word search is stored in a " { $emphasis "manifest" } ":"
-{ $subsection manifest }
+{ $subsections manifest }
"Words for working with the current manifest:"
-{ $subsection use-vocab }
-{ $subsection unuse-vocab }
-{ $subsection add-qualified }
-{ $subsection add-words-from }
-{ $subsection add-words-excluding }
+{ $subsections
+ use-vocab
+ unuse-vocab
+ add-qualified
+ add-words-from
+ add-words-excluding
+}
"Words used to implement " { $link POSTPONE: IN: } ":"
-{ $subsection current-vocab }
-{ $subsection set-current-vocab }
+{ $subsections
+ current-vocab
+ set-current-vocab
+}
"Words used to implement " { $link "word-search-private" } ":"
-{ $subsection begin-private }
-{ $subsection end-private } ;
+{ $subsections
+ begin-private
+ end-private
+} ;
ABOUT: "word-search"
[ manifest get (>>current-vocab) ]
[ words>> <extra-words> (add-qualified) ] bi ;
+: with-current-vocab ( name quot -- )
+ manifest get clone manifest [
+ [ set-current-vocab ] dip call
+ ] with-variable ; inline
+
TUPLE: no-current-vocab ;
: no-current-vocab ( -- vocab )
"A " { $emphasis "vocabulary" } " is a named collection of words. Vocabularies are defined in the " { $vocab-link "vocabs" } " vocabulary."
$nl
"Vocabularies are stored in a global hashtable:"
-{ $subsection dictionary }
+{ $subsections dictionary }
"Vocabularies form a class."
-{ $subsection vocab }
-{ $subsection vocab? }
+{ $subsections
+ vocab
+ vocab?
+}
"Various vocabulary words are overloaded to accept a " { $emphasis "vocabulary specifier" } ", which is a string naming the vocabulary, the " { $link vocab } " instance itself, or a " { $link vocab-link } ":"
-{ $subsection vocab-link }
-{ $subsection >vocab-link }
+{ $subsections
+ vocab-link
+ >vocab-link
+}
"Looking up vocabularies by name:"
-{ $subsection vocab }
+{ $subsections vocab }
"Accessors for various vocabulary attributes:"
-{ $subsection vocab-name }
-{ $subsection vocab-main }
-{ $subsection vocab-help }
+{ $subsections
+ vocab-name
+ vocab-main
+ vocab-help
+}
"Looking up existing vocabularies and creating new vocabularies:"
-{ $subsection vocab }
-{ $subsection child-vocabs }
-{ $subsection create-vocab }
+{ $subsections
+ vocab
+ child-vocabs
+ create-vocab
+}
"Getting words from a vocabulary:"
-{ $subsection vocab-words }
-{ $subsection words }
-{ $subsection all-words }
-{ $subsection words-named }
+{ $subsections
+ vocab-words
+ words
+ all-words
+ words-named
+}
"Removing a vocabulary:"
-{ $subsection forget-vocab }
+{ $subsections forget-vocab }
{ $see-also "words" "vocabs.loader" } ;
ABOUT: "vocabularies"
"There is a syntax for defining new names for existing words. This useful for C library bindings, for example in the Win32 API, where words need to be renamed for symmetry."
$nl
"Define a new word that aliases another word:"
-{ $subsection POSTPONE: ALIAS: }
+{ $subsections POSTPONE: ALIAS: }
"Define an alias at run-time:"
-{ $subsection define-alias } ;
+{ $subsections define-alias } ;
ABOUT: "words.alias"
"There is a syntax for defining words which push literals on the stack."
$nl
"Define a new word that pushes a literal on the stack:"
-{ $subsection POSTPONE: CONSTANT: }
+{ $subsections POSTPONE: CONSTANT: }
"Define an constant at run-time:"
-{ $subsection define-constant } ;
+{ $subsections define-constant } ;
ABOUT: "words.constant"
ARTICLE: "words.symbol" "Symbols"
"A symbol pushes itself on the stack when executed. By convention, symbols are used as variable names (" { $link "namespaces" } ")."
-{ $subsection symbol }
-{ $subsection symbol? }
+{ $subsections
+ symbol
+ symbol?
+}
"Defining symbols at parse time:"
-{ $subsection POSTPONE: SYMBOL: }
-{ $subsection POSTPONE: SYMBOLS: }
+{ $subsections
+ POSTPONE: SYMBOL:
+ POSTPONE: SYMBOLS:
+}
"Defining symbols at run time:"
-{ $subsection define-symbol }
+{ $subsections define-symbol }
"Symbols are just compound definitions in disguise. The following two lines are equivalent:"
{ $code
"SYMBOL: foo"
"Words whose names are known at parse time -- that is, most words making up your program -- can be referenced in source code by stating their name. However, the parser itself, and sometimes code you write, will need to create look up words dynamically."
$nl
"Parsing words add definitions to the current vocabulary. When a source file is being parsed, the current vocabulary is initially set to " { $vocab-link "scratchpad" } ". The current vocabulary may be changed with the " { $link POSTPONE: IN: } " parsing word (see " { $link "word-search" } ")."
-{ $subsection create }
-{ $subsection create-in }
-{ $subsection lookup } ;
+{ $subsections
+ create
+ create-in
+ lookup
+} ;
ARTICLE: "uninterned-words" "Uninterned words"
"A word that is not a member of any vocabulary is said to be " { $emphasis "uninterned" } "."
$nl
"There are several ways of creating an uninterned word:"
-{ $subsection <word> }
-{ $subsection gensym }
-{ $subsection define-temp } ;
+{ $subsections
+ <word>
+ gensym
+ define-temp
+} ;
ARTICLE: "colon-definition" "Colon definitions"
"Every word has an associated quotation definition that is called when the word is executed. A " { $emphasis "colon definition" } " is a word where this quotation is supplied directly by the user. This is the simplest and most common type of word definition."
$nl
"Defining words at parse time:"
-{ $subsection POSTPONE: : }
-{ $subsection POSTPONE: ; }
+{ $subsections
+ POSTPONE: :
+ POSTPONE: ;
+}
"Defining words at run time:"
-{ $subsection define }
-{ $subsection define-declared }
-{ $subsection define-inline }
+{ $subsections
+ define
+ define-declared
+ define-inline
+}
"Word definitions must declare their stack effect. See " { $link "effects" } "."
$nl
"All other types of word definitions, such as " { $link "words.symbol" } " and " { $link "generic" } ", are just special cases of the above." ;
ARTICLE: "primitives" "Primitives"
"Primitives are words defined in the Factor VM. They provide the essential low-level services to the rest of the system."
-{ $subsection primitive }
-{ $subsection primitive? } ;
+{ $subsections
+ primitive
+ primitive?
+} ;
ARTICLE: "deferred" "Deferred words and mutual recursion"
"Words cannot be referenced before they are defined; that is, source files must order definitions in a strictly bottom-up fashion. This is done to simplify the implementation, facilitate better parse time checking and remove some odd corner cases; it also encourages better coding style."
$nl
"Sometimes this restriction gets in the way, for example when defining mutually-recursive words; one way to get around this limitation is to make a forward definition."
-{ $subsection POSTPONE: DEFER: }
+{ $subsections POSTPONE: DEFER: }
"The class of deferred word definitions:"
-{ $subsection deferred }
-{ $subsection deferred? }
+{ $subsections
+ deferred
+ deferred?
+}
"Deferred words throw an error when called:"
-{ $subsection undefined }
+{ $subsections undefined }
"Deferred words are just compound definitions in disguise. The following two lines are equivalent:"
{ $code
"DEFER: foo"
"Compiler declarations are parsing words that set a word property in the most recently defined word. They appear after the final " { $link POSTPONE: ; } " of a word definition:"
{ $code ": cubed ( x -- y ) dup dup * * ; foldable" }
"Compiler declarations assert that the word follows a certain contract, enabling certain optimizations that are not valid in general."
-{ $subsection POSTPONE: inline }
-{ $subsection POSTPONE: foldable }
-{ $subsection POSTPONE: flushable }
-{ $subsection POSTPONE: recursive }
+{ $subsections
+ POSTPONE: inline
+ POSTPONE: foldable
+ POSTPONE: flushable
+ POSTPONE: recursive
+}
"It is entirely up to the programmer to ensure that the word satisfies the contract of a declaration. Furthermore, if a generic word is declared " { $link POSTPONE: foldable } " or " { $link POSTPONE: flushable } ", all methods must satisfy the contract. Unspecified behavior may result if a word does not follow the contract of one of its declarations."
{ $see-also "effects" } ;
ARTICLE: "word-props" "Word properties"
"Each word has a hashtable of properties."
-{ $subsection word-prop }
-{ $subsection set-word-prop }
+{ $subsections
+ word-prop
+ set-word-prop
+}
"The stack effect of the above two words is designed so that it is most convenient when " { $snippet "name" } " is a literal pushed on the stack right before executing this word."
$nl
"The following are some of the properties used by the library:"
"The " { $snippet "def" } " slot of a word holds a " { $link quotation } " instance that is called when the word is executed."
$nl
"An " { $emphasis "XT" } " (execution token) is the machine code address of a word:"
-{ $subsection word-xt } ;
+{ $subsections word-xt } ;
ARTICLE: "words.introspection" "Word introspection"
"Word introspection facilities and implementation details are found in the " { $vocab-link "words" } " vocabulary."
{ { $snippet "props" } "an assoc of word properties, including documentation and other meta-data" }
}
"Words are instances of a class."
-{ $subsection word }
-{ $subsection word? }
+{ $subsections
+ word
+ word?
+}
"Words implement the definition protocol; see " { $link "definitions" } "."
-{ $subsection "interned-words" }
-{ $subsection "uninterned-words" }
-{ $subsection "word-props" }
-{ $subsection "word.private" } ;
+{ $subsections
+ "interned-words"
+ "uninterned-words"
+ "word-props"
+ "word.private"
+} ;
ARTICLE: "words" "Words"
"Words are the Factor equivalent of functions or procedures; a word is essentially a named quotation."
"The latter is a more dynamic feature that can be used to implement code generation and such, and in fact parse time defining words are implemented in terms of run time defining words."
$nl
"Types of words:"
-{ $subsection "colon-definition" }
-{ $subsection "words.symbol" }
-{ $subsection "words.alias" }
-{ $subsection "words.constant" }
-{ $subsection "primitives" }
+{ $subsections
+ "colon-definition"
+ "words.symbol"
+ "words.alias"
+ "words.constant"
+ "primitives"
+}
"Advanced topics:"
-{ $subsection "deferred" }
-{ $subsection "declarations" }
-{ $subsection "words.introspection" }
+{ $subsections
+ "deferred"
+ "declarations"
+ "words.introspection"
+}
{ $see-also "vocabularies" "vocabs.loader" "definitions" "see" } ;
ABOUT: "words"
keys [ "forgotten" word-prop ] filter
] map harvest
] unit-test
+
+[ "hi" word-xt ] must-fail
USING: accessors arrays definitions graphs kernel
kernel.private slots.private math namespaces sequences
strings vectors sbufs quotations assocs hashtables sorting vocabs
-math.order sets ;
+math.order sets words.private ;
IN: words
: word ( -- word ) \ word get-global ;
} reset-props
] tri ;
+: <word> ( name vocab -- word )
+ 2dup [ hashcode ] bi@ bitxor >fixnum (word) ;
+
: gensym ( -- word )
- "( gensym )" f <word> ;
+ "( gensym )" f \ gensym counter >fixnum (word) ;
: define-temp ( quot effect -- word )
[ gensym dup ] 2dip define-declared ;
ARTICLE: "24-game" "The Game of 24"
"A classic math game, where one attempts to create 24, by applying "
"arithmetical operations and some shuffle words to a stack of 4 numbers. "
-{ $subsection play-game }
-{ $subsection 24-able }
-{ $subsection 24-able? }
-{ $subsection build-quad } ;
+{ $subsections
+ play-game
+ 24-able
+ 24-able?
+ build-quad
+} ;
ABOUT: "24-game"
! Copyright (C) 2008 Jean-François Bigot.
! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations strings multiline ;
+USING: help.markup help.syntax kernel quotations strings ;
IN: 4DNav
ARTICLE: "implementation details" "How 4DNav is done"
"4DNav is build using :"
-{ $subsection "4DNav.camera" }
-{ $subsection "adsoda-main-page" }
+{ $subsections
+ "4DNav.camera"
+ "adsoda-main-page"
+}
;
ARTICLE: "Space file" "Create a new space file"
$nl
"An example is:"
-{ $code <"
+{ $code """
<model>
<space>
<dimension>4</dimension>
</light>
<color>0.8,0.9,0.9</color>
</space>
-</model> "> } ;
+</model>""" } ;
ARTICLE: "TODO" "Todo"
{ $list
}
{ $heading "Links" }
-{ $subsection "Space file" }
-
-{ $subsection "TODO" }
-{ $subsection "implementation details" }
+{ $subsections
+ "Space file"
+ "TODO"
+ "implementation details"
+}
;
! Copyright (C) 2008 Jeff Bigot\r
! See http://factorcode.org/license.txt for BSD license.\r
-USING: help.markup help.syntax multiline ;\r
+USING: help.markup help.syntax ;\r
IN: adsoda\r
\r
! --------------------------------------------------------------\r
"halfspace touching-corners adjacent-faces" $nl\r
"touching-corners list of pointers to the corners which touch this face" $nl\r
"adjacent-faces list of pointers to the faces which touch this face"\r
-{ $subsection face }\r
-{ $subsection <face> }\r
+{ $subsections\r
+ face\r
+ <face>\r
+}\r
"test relative position"\r
-{ $subsection point-inside-or-on-face? } \r
-{ $subsection point-inside-face? }\r
+{ $subsections\r
+ point-inside-or-on-face?\r
+ point-inside-face?\r
+}\r
"handling face"\r
-{ $subsection flip-face }\r
-{ $subsection face-translate }\r
-{ $subsection face-transform }\r
+{ $subsections\r
+ flip-face\r
+ face-translate\r
+ face-transform\r
+}\r
\r
;\r
\r
"explanation of solids"\r
$nl\r
"link to functions"\r
-{ $subsection solid }\r
-{ $subsection <solid> }\r
+{ $subsections\r
+ solid\r
+ <solid>\r
+}\r
"test relative position"\r
-{ $subsection point-inside-solid? }\r
-{ $subsection point-inside-or-on-solid? }\r
+{ $subsections\r
+ point-inside-solid?\r
+ point-inside-or-on-solid?\r
+}\r
"playing with faces and solids"\r
-{ $subsection add-face }\r
-{ $subsection cut-solid }\r
-{ $subsection slice-solid }\r
+{ $subsections\r
+ add-face\r
+ cut-solid\r
+ slice-solid\r
+}\r
"solid handling"\r
-{ $subsection solid-project }\r
-{ $subsection solid-translate }\r
-{ $subsection solid-transform }\r
-{ $subsection subtract }\r
-\r
-{ $subsection get-silhouette }\r
-\r
-{ $subsection solid= }\r
-\r
-\r
+{ $subsections\r
+ solid-project\r
+ solid-translate\r
+ solid-transform\r
+ subtract\r
+ get-silhouette \r
+ solid=\r
+}\r
;\r
\r
HELP: solid \r
"link to functions"\r
$nl\r
"Defining words"\r
-{ $subsection space }\r
-{ $subsection <space> } \r
-{ $subsection suffix-solids }\r
-{ $subsection suffix-lights }\r
-{ $subsection clear-space-solids }\r
-{ $subsection describe-space }\r
+{ $subsections\r
+ space\r
+ <space>\r
+ suffix-solids \r
+ suffix-lights\r
+ clear-space-solids \r
+ describe-space\r
+}\r
\r
\r
"Handling space"\r
-{ $subsection space-ensure-solids }\r
-{ $subsection eliminate-empty-solids }\r
-{ $subsection space-transform }\r
-{ $subsection space-translate }\r
-{ $subsection remove-hidden-solids }\r
-{ $subsection space-project }\r
+{ $subsections\r
+ space-ensure-solids\r
+ eliminate-empty-solids\r
+ space-transform\r
+ space-translate\r
+ remove-hidden-solids\r
+ space-project\r
+}\r
\r
\r
;\r
"explanation of 3D rendering"\r
$nl\r
"link to functions"\r
-{ $subsection face->GL }\r
-{ $subsection solid->GL }\r
-{ $subsection space->GL }\r
+{ $subsections\r
+ face->GL\r
+ solid->GL\r
+ space->GL\r
+}\r
\r
;\r
\r
;\r
\r
ARTICLE: { "adsoda" "light" } "ADSODA : lights"\r
-{ $code <"\r
+{ $code """\r
! HELP: light position color\r
! <light> ( -- tuple ) light new ;\r
! light est un vecteur avec 3 variables pour les couleurs\n\r
if (cRed > 1.0) cRed = 1.0;\r
if (cGreen > 1.0) cGreen = 1.0;\r
if (cBlue > 1.0) cBlue = 1.0;\r
-"> }\r
+""" }\r
;\r
\r
\r
"full explanation on adsoda page at " { $url "http://www.flowerfire.com/ADSODA/" }\r
$nl\r
"Useful words are describe on the following pages: "\r
-{ $subsection "face-page" }\r
-{ $subsection "solid-page" }\r
-{ $subsection "space-page" }\r
-{ $subsection "light-page" }\r
-{ $subsection "3D-rendering-page" }\r
- ;\r
+{ $subsections\r
+ "face-page"\r
+ "solid-page"\r
+ "space-page"\r
+ "light-page"\r
+ "3D-rendering-page"\r
+} ;\r
\r
ABOUT: "adsoda-main-page"\r
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.cxx.parser alien.marshall
-alien.inline.types classes.mixin classes.tuple kernel namespaces
-assocs sequences parser classes.parser alien.marshall.syntax
-interpolate locals effects io strings make vocabs.parser words
-generic fry quotations ;
-IN: alien.cxx
-
-<PRIVATE
-: class-mixin ( str -- word )
- create-class-in [ define-mixin-class ] keep ;
-
-: class-tuple-word ( word -- word' )
- "#" append create-in ;
-
-: define-class-tuple ( word mixin -- )
- [ drop class-wrapper { } define-tuple-class ]
- [ add-mixin-instance ] 2bi ;
-PRIVATE>
-
-: define-c++-class ( name superclass-mixin -- )
- [ [ class-tuple-word ] [ class-mixin ] bi dup ] dip
- add-mixin-instance define-class-tuple ;
-
-:: define-c++-method ( class-name generic name types effect virtual -- )
- [ name % "_" % class-name { { CHAR: : CHAR: _ } } substitute % ] "" make :> name'
- effect [ in>> "self" suffix ] [ out>> ] bi <effect> :> effect'
- types class-name "*" append suffix :> types'
- effect in>> "," join :> args
- class-name virtual [ "#" append ] unless current-vocab lookup :> class
- SBUF" " clone dup [ I[ return self->${name}(${args});]I ] with-output-stream >string :> body
- name' types' effect' body define-c-marshalled
- class generic create-method name' current-vocab lookup 1quotation define ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: parser lexer alien.inline ;
-IN: alien.cxx.parser
-
-: parse-c++-class-definition ( -- class superclass-mixin )
- scan scan-word ;
-
-: parse-c++-method-definition ( -- class-name generic name types effect )
- scan scan-word function-types-effect ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test alien.cxx.syntax alien.inline.syntax
-alien.marshall.syntax alien.marshall accessors kernel ;
-IN: alien.cxx.syntax.tests
-
-DELETE-C-LIBRARY: test
-C-LIBRARY: test
-
-COMPILE-AS-C++
-
-C-INCLUDE: <string>
-
-C-TYPEDEF: std::string string
-
-C++-CLASS: std::string c++-root
-
-GENERIC: to-string ( obj -- str )
-
-C++-METHOD: std::string to-string const-char* c_str ( )
-
-CM-FUNCTION: std::string* new_string ( const-char* s )
- return new std::string(s);
-;
-
-;C-LIBRARY
-
-ALIAS: <std::string> new_string
-
-{ 1 1 } [ new_string ] must-infer-as
-{ 1 1 } [ c_str_std__string ] must-infer-as
-[ t ] [ "abc" <std::string> std::string? ] unit-test
-[ "abc" ] [ "abc" <std::string> to-string ] unit-test
-
-
-DELETE-C-LIBRARY: inheritance
-C-LIBRARY: inheritance
-
-COMPILE-AS-C++
-
-C-INCLUDE: <cstring>
-
-<RAW-C
-class alpha {
- public:
- alpha(const char* s) {
- str = s;
- };
- const char* render() {
- return str;
- };
- virtual const char* chop() {
- return str;
- };
- virtual int length() {
- return strlen(str);
- };
- const char* str;
-};
-
-class beta : alpha {
- public:
- beta(const char* s) : alpha(s + 1) { };
- const char* render() {
- return str + 1;
- };
- virtual const char* chop() {
- return str + 2;
- };
-};
-RAW-C>
-
-C++-CLASS: alpha c++-root
-C++-CLASS: beta alpha
-
-CM-FUNCTION: alpha* new_alpha ( const-char* s )
- return new alpha(s);
-;
-
-CM-FUNCTION: beta* new_beta ( const-char* s )
- return new beta(s);
-;
-
-ALIAS: <alpha> new_alpha
-ALIAS: <beta> new_beta
-
-GENERIC: render ( obj -- obj )
-GENERIC: chop ( obj -- obj )
-GENERIC: length ( obj -- n )
-
-C++-METHOD: alpha render const-char* render ( )
-C++-METHOD: beta render const-char* render ( )
-C++-VIRTUAL: alpha chop const-char* chop ( )
-C++-VIRTUAL: beta chop const-char* chop ( )
-C++-VIRTUAL: alpha length int length ( )
-
-;C-LIBRARY
-
-{ 1 1 } [ render_alpha ] must-infer-as
-{ 1 1 } [ chop_beta ] must-infer-as
-{ 1 1 } [ length_alpha ] must-infer-as
-[ t ] [ "x" <alpha> alpha#? ] unit-test
-[ t ] [ "x" <alpha> alpha? ] unit-test
-[ t ] [ "x" <beta> alpha? ] unit-test
-[ f ] [ "x" <beta> alpha#? ] unit-test
-[ 5 ] [ "hello" <alpha> length ] unit-test
-[ 4 ] [ "hello" <beta> length ] unit-test
-[ "hello" ] [ "hello" <alpha> render ] unit-test
-[ "llo" ] [ "hello" <beta> render ] unit-test
-[ "ello" ] [ "hello" <beta> underlying>> \ alpha# new swap >>underlying render ] unit-test
-[ "hello" ] [ "hello" <alpha> chop ] unit-test
-[ "lo" ] [ "hello" <beta> chop ] unit-test
-[ "lo" ] [ "hello" <beta> underlying>> \ alpha# new swap >>underlying chop ] unit-test
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.cxx alien.cxx.parser ;
-IN: alien.cxx.syntax
-
-SYNTAX: C++-CLASS:
- parse-c++-class-definition define-c++-class ;
-
-SYNTAX: C++-METHOD:
- parse-c++-method-definition f define-c++-method ;
-
-SYNTAX: C++-VIRTUAL:
- parse-c++-method-definition t define-c++-method ;
+++ /dev/null
-Jeremy Hughes
+++ /dev/null
-Jeremy Hughes
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel strings words.symbol sequences ;
-IN: alien.inline.compiler
-
-HELP: C
-{ $var-description "A symbol representing C source." } ;
-
-HELP: C++
-{ $var-description "A symbol representing C++ source." } ;
-
-HELP: compile-to-library
-{ $values
- { "lang" symbol } { "args" sequence } { "contents" string } { "name" string }
-}
-{ $description "Compiles and links " { $snippet "contents" } " into a shared library called " { $snippet "libname.suffix" }
- "in " { $snippet "resource:alien-inline-libs" } ". " { $snippet "suffix" } " is OS specific. "
- { $snippet "args" } " is a sequence of arguments for the linking stage." }
-{ $notes
- { $list
- "C and C++ are the only supported languages."
- { "Source and object files are placed in " { $snippet "resource:temp" } "." } }
-} ;
-
-HELP: compiler
-{ $values
- { "lang" symbol }
- { "str" string }
-}
-{ $description "Returns a compiler name based on OS and source language." }
-{ $see-also compiler-descr } ;
-
-HELP: compiler-descr
-{ $values
- { "lang" symbol }
- { "descr" "a process description" }
-}
-{ $description "Returns a compiler process description based on OS and source language." }
-{ $see-also compiler } ;
-
-HELP: inline-library-file
-{ $values
- { "name" string }
- { "path" "a pathname string" }
-}
-{ $description "Appends " { $snippet "name" } " to the " { $link inline-libs-directory } "." } ;
-
-HELP: inline-libs-directory
-{ $values
- { "path" "a pathname string" }
-}
-{ $description "The directory where libraries created using " { $snippet "alien.inline" } " are stored." } ;
-
-HELP: library-path
-{ $values
- { "str" string }
- { "path" "a pathname string" }
-}
-{ $description "Converts " { $snippet "name" } " into a full path to the corresponding inline library." } ;
-
-HELP: library-suffix
-{ $values
- { "str" string }
-}
-{ $description "The appropriate shared library suffix for the current OS." } ;
-
-HELP: link-descr
-{ $values
- { "lang" "a language" }
- { "descr" sequence }
-}
-{ $description "Returns part of a process description. OS dependent." } ;
-
-ARTICLE: "alien.inline.compiler" "Inline C compiler"
-{ $vocab-link "alien.inline.compiler" }
-;
-
-ABOUT: "alien.inline.compiler"
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators fry generalizations
-io.encodings.ascii io.files io.files.temp io.launcher kernel
-locals make sequences system vocabs.parser words io.directories
-io.pathnames ;
-IN: alien.inline.compiler
-
-SYMBOL: C
-SYMBOL: C++
-
-: inline-libs-directory ( -- path )
- "alien-inline-libs" resource-path dup make-directories ;
-
-: inline-library-file ( name -- path )
- inline-libs-directory prepend-path ;
-
-: library-suffix ( -- str )
- os {
- { [ dup macosx? ] [ drop ".dylib" ] }
- { [ dup unix? ] [ drop ".so" ] }
- { [ dup windows? ] [ drop ".dll" ] }
- } cond ;
-
-: library-path ( str -- path )
- '[ "lib" % _ % library-suffix % ] "" make inline-library-file ;
-
-HOOK: compiler os ( lang -- str )
-
-M: word compiler
- {
- { C [ "gcc" ] }
- { C++ [ "g++" ] }
- } case ;
-
-M: openbsd compiler
- {
- { C [ "gcc" ] }
- { C++ [ "eg++" ] }
- } case ;
-
-M: windows compiler
- {
- { C [ "gcc" ] }
- { C++ [ "g++" ] }
- } case ;
-
-HOOK: compiler-descr os ( lang -- descr )
-
-M: word compiler-descr compiler 1array ;
-M: macosx compiler-descr
- call-next-method cpu x86.64?
- [ { "-arch" "x86_64" } append ] when ;
-
-HOOK: link-descr os ( lang -- descr )
-
-M: word link-descr drop { "-shared" "-o" } ;
-M: macosx link-descr
- drop { "-g" "-prebind" "-dynamiclib" "-o" }
- cpu x86.64? [ { "-arch" "x86_64" } prepend ] when ;
-M: windows link-descr
- {
- { C [ { "-mno-cygwin" "-shared" "-o" } ] }
- { C++ [ { "-lstdc++" "-mno-cygwin" "-shared" "-o" } ] }
- } case ;
-
-<PRIVATE
-: src-suffix ( lang -- str )
- {
- { C [ ".c" ] }
- { C++ [ ".cpp" ] }
- } case ;
-
-: link-command ( args in out lang -- descr )
- [ 2array ] dip [ compiler 1array ] [ link-descr ] bi
- append prepend prepend ;
-
-:: compile-to-object ( lang contents name -- )
- name ".o" append temp-file
- contents name lang src-suffix append temp-file
- [ ascii set-file-contents ] keep 2array
- lang compiler-descr { "-fPIC" "-c" "-o" } append prepend
- try-process ;
-
-:: link-object ( lang args name -- )
- args name [ library-path ]
- [ ".o" append temp-file ] bi
- lang link-command try-process ;
-PRIVATE>
-
-:: compile-to-library ( lang args contents name -- )
- lang contents name compile-to-object
- lang args name link-object ;
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel strings effects quotations ;
-IN: alien.inline
-
-<PRIVATE
-: $binding-note ( x -- )
- drop
- { "This word requires that certain variables are correctly bound. "
- "Call " { $link POSTPONE: define-c-library } " to set them up." } print-element ;
-PRIVATE>
-
-HELP: compile-c-library
-{ $description "Writes, compiles, and links code generated since last invocation of " { $link POSTPONE: define-c-library } ". "
- "Also calls " { $snippet "add-library" } ". "
- "This word does nothing if the shared library is younger than the factor source file." }
-{ $notes $binding-note } ;
-
-HELP: c-use-framework
-{ $values
- { "str" string }
-}
-{ $description "OS X only. Adds " { $snippet "-framework name" } " to linker command." }
-{ $notes $binding-note }
-{ $see-also c-link-to c-link-to/use-framework } ;
-
-HELP: define-c-function
-{ $values
- { "function" "function name" } { "types" "a sequence of C types" } { "effect" effect } { "body" string }
-}
-{ $description "Defines a C function and a factor word which calls it." }
-{ $notes
- { $list
- { "The number of " { $snippet "types" } " must match the " { $snippet "in" } " count of the " { $snippet "effect" } "." }
- { "There must be only one " { $snippet "out" } " element. It must be a legal C return type with dashes (-) instead of spaces." }
- $binding-note
- }
-}
-{ $see-also POSTPONE: define-c-function' } ;
-
-HELP: define-c-function'
-{ $values
- { "function" "function name" } { "effect" effect } { "body" string }
-}
-{ $description "Defines a C function and a factor word which calls it. See " { $link define-c-function } " for more information." }
-{ $notes
- { $list
- { "Each effect element must be a legal C type with dashes (-) instead of spaces. "
- "C argument names will be generated alphabetically, starting with " { $snippet "a" } "." }
- $binding-note
- }
-}
-{ $see-also define-c-function } ;
-
-HELP: c-include
-{ $values
- { "str" string }
-}
-{ $description "Appends an include line to the C library in scope." }
-{ $notes $binding-note } ;
-
-HELP: define-c-library
-{ $values
- { "name" string }
-}
-{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " words can be used after this one." } ;
-
-HELP: c-link-to
-{ $values
- { "str" string }
-}
-{ $description "Adds " { $snippet "-lname" } " to linker command." }
-{ $notes $binding-note }
-{ $see-also c-use-framework c-link-to/use-framework } ;
-
-HELP: c-link-to/use-framework
-{ $values
- { "str" string }
-}
-{ $description "Equivalent to " { $link c-use-framework } " on OS X and " { $link c-link-to } " everywhere else." }
-{ $notes $binding-note }
-{ $see-also c-link-to c-use-framework } ;
-
-HELP: define-c-struct
-{ $values
- { "name" string } { "fields" "type/name pairs" }
-}
-{ $description "Defines a C struct and factor words which operate on it." }
-{ $notes $binding-note } ;
-
-HELP: define-c-typedef
-{ $values
- { "old" "C type" } { "new" "C type" }
-}
-{ $description "Define C and factor typedefs." }
-{ $notes $binding-note } ;
-
-HELP: delete-inline-library
-{ $values
- { "name" string }
-}
-{ $description "Delete the shared library file corresponding to " { $snippet "name" } "." }
-{ $notes "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " } ;
-
-HELP: with-c-library
-{ $values
- { "name" string } { "quot" quotation }
-}
-{ $description "Calls " { $link define-c-library } ", then the quotation, then " { $link compile-c-library } ", then sets all variables bound by " { $snippet "define-c-library" } " to " { $snippet "f" } "." } ;
-
-HELP: raw-c
-{ $values { "str" string } }
-{ $description "Insert a string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ;
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.inline.compiler alien.inline.types
-alien.libraries alien.parser arrays assocs effects fry
-generalizations grouping io.directories io.files
-io.files.info io.files.temp kernel lexer math math.order
-math.ranges multiline namespaces sequences source-files
-splitting strings system vocabs.loader vocabs.parser words
-alien.c-types alien.structs make parser continuations ;
-IN: alien.inline
-
-SYMBOL: c-library
-SYMBOL: library-is-c++
-SYMBOL: linker-args
-SYMBOL: c-strings
-
-<PRIVATE
-: cleanup-variables ( -- )
- { c-library library-is-c++ linker-args c-strings }
- [ off ] each ;
-
-: arg-list ( types -- params )
- CHAR: a swap length CHAR: a + [a,b]
- [ 1string ] map ;
-
-: compile-library? ( -- ? )
- c-library get library-path dup exists? [
- file get [
- path>>
- [ file-info modified>> ] bi@ <=> +lt+ =
- ] [ drop t ] if*
- ] [ drop t ] if ;
-
-: compile-library ( -- )
- library-is-c++ get [ C++ ] [ C ] if
- linker-args get
- c-strings get "\n" join
- c-library get compile-to-library ;
-
-: c-library-name ( name -- name' )
- [ current-vocab name>> % "_" % % ] "" make ;
-PRIVATE>
-
-: append-function-body ( prototype-str body -- str )
- [ swap % " {\n" % % "\n}\n" % ] "" make ;
-
-: function-types-effect ( -- function types effect )
- scan scan swap ")" parse-tokens
- [ "(" subseq? not ] filter swap parse-arglist ;
-
-: prototype-string ( function types effect -- str )
- [ [ cify-type ] map ] dip
- types-effect>params-return cify-type -rot
- [ " " join ] map ", " join
- "(" prepend ")" append 3array " " join
- library-is-c++ get [ "extern \"C\" " prepend ] when ;
-
-: prototype-string' ( function types return -- str )
- [ dup arg-list ] <effect> prototype-string ;
-
-: factor-function ( function types effect -- word quot effect )
- annotate-effect [ c-library get ] 3dip
- [ [ factorize-type ] map ] dip
- types-effect>params-return factorize-type -roll
- concat make-function ;
-
-: define-c-library ( name -- )
- c-library-name [ c-library set ] [ "c-library" set ] bi
- V{ } clone c-strings set
- V{ } clone linker-args set ;
-
-: compile-c-library ( -- )
- compile-library? [ compile-library ] when
- c-library get dup library-path "cdecl" add-library ;
-
-: define-c-function ( function types effect body -- )
- [
- [ factor-function define-declared ]
- [ prototype-string ] 3bi
- ] dip append-function-body c-strings get push ;
-
-: define-c-function' ( function effect body -- )
- [
- [ in>> ] keep
- [ factor-function define-declared ]
- [ out>> prototype-string' ] 3bi
- ] dip append-function-body c-strings get push ;
-
-: c-link-to ( str -- )
- "-l" prepend linker-args get push ;
-
-: c-use-framework ( str -- )
- "-framework" swap linker-args get '[ _ push ] bi@ ;
-
-: c-link-to/use-framework ( str -- )
- os macosx? [ c-use-framework ] [ c-link-to ] if ;
-
-: c-include ( str -- )
- "#include " prepend c-strings get push ;
-
-: define-c-typedef ( old new -- )
- [ typedef ] [
- [ swap "typedef " % % " " % % ";" % ]
- "" make c-strings get push
- ] 2bi ;
-
-: define-c-struct ( name fields -- )
- [ current-vocab swap define-struct ] [
- over
- [
- "typedef struct " % "_" % % " {\n" %
- [ first2 swap % " " % % ";\n" % ] each
- "} " % % ";\n" %
- ] "" make c-strings get push
- ] 2bi ;
-
-: delete-inline-library ( name -- )
- c-library-name [ remove-library ]
- [ library-path dup exists? [ delete-file ] [ drop ] if ] bi ;
-
-: with-c-library ( name quot -- )
- [ [ define-c-library ] dip call compile-c-library ]
- [ cleanup-variables ] [ ] cleanup ; inline
-
-: raw-c ( str -- )
- [ "\n" % % "\n" % ] "" make c-strings get push ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax alien.inline ;
-IN: alien.inline.syntax
-
-HELP: ;C-LIBRARY
-{ $syntax ";C-LIBRARY" }
-{ $description "Writes, compiles, and links code generated since previous invocation of " { $link POSTPONE: C-LIBRARY: } "." }
-{ $see-also POSTPONE: compile-c-library } ;
-
-HELP: C-FRAMEWORK:
-{ $syntax "C-FRAMEWORK: name" }
-{ $description "OS X only. Link to named framework. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
-{ $see-also POSTPONE: c-use-framework } ;
-
-HELP: C-FUNCTION:
-{ $syntax "C-FUNCTION: return name ( args ... )\nbody\n;" }
-{ $description "Appends a function to the C library in scope and defines an FFI word that calls it." }
-{ $examples
- { $example
- "USING: alien.inline.syntax prettyprint ;"
- "IN: cmath.ffi"
- ""
- "C-LIBRARY: cmathlib"
- ""
- "C-FUNCTION: int add ( int a, int b )"
- " return a + b;"
- ";"
- ""
- ";C-LIBRARY"
- ""
- "1 2 add ."
- "3" }
-}
-{ $see-also POSTPONE: define-c-function } ;
-
-HELP: C-INCLUDE:
-{ $syntax "C-INCLUDE: name" }
-{ $description "Appends an include line to the C library in scope." }
-{ $see-also POSTPONE: c-include } ;
-
-HELP: C-LIBRARY:
-{ $syntax "C-LIBRARY: name" }
-{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " syntax can be used after this word." }
-{ $examples
- { $example
- "USING: alien.inline.syntax ;"
- "IN: rectangle.ffi"
- ""
- "C-LIBRARY: rectlib"
- ""
- "C-STRUCTURE: rectangle { \"int\" \"width\" } { \"int\" \"height\" } ;"
- ""
- "C-FUNCTION: int area ( rectangle c )"
- " return c.width * c.height;"
- ";"
- ""
- ";C-LIBRARY"
- "" }
-}
-{ $see-also POSTPONE: define-c-library } ;
-
-HELP: C-LINK/FRAMEWORK:
-{ $syntax "C-LINK/FRAMEWORK: name" }
-{ $description "Equivalent to " { $link POSTPONE: C-FRAMEWORK: } " on OS X and " { $link POSTPONE: C-LINK: } " everywhere else." }
-{ $see-also POSTPONE: c-link-to/use-framework } ;
-
-HELP: C-LINK:
-{ $syntax "C-LINK: name" }
-{ $description "Link to named library. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
-{ $see-also POSTPONE: c-link-to } ;
-
-HELP: C-STRUCTURE:
-{ $syntax "C-STRUCTURE: name pairs ... ;" }
-{ $description "Like " { $snippet "C-STRUCT:" } " but also generates equivalent C code."}
-{ $see-also POSTPONE: define-c-struct } ;
-
-HELP: C-TYPEDEF:
-{ $syntax "C-TYPEDEF: old new" }
-{ $description "Like " { $snippet "TYPEDEF:" } " but generates a C typedef statement too." }
-{ $see-also POSTPONE: define-c-typedef } ;
-
-HELP: COMPILE-AS-C++
-{ $syntax "COMPILE-AS-C++" }
-{ $description "Insert this word anywhere between " { $link POSTPONE: C-LIBRARY: } " and " { $link POSTPONE: ;C-LIBRARY } " and the generated code will be treated as C++ with " { $snippet "extern \"C\"" } " prepended to each function prototype." } ;
-
-HELP: DELETE-C-LIBRARY:
-{ $syntax "DELETE-C-LIBRARY: name" }
-{ $description "Deletes the shared library file corresponding to " { $snippet "name" } " . " }
-{ $notes
- { $list
- { "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " }
- "This word is mainly useful for unit tests."
- }
-}
-{ $see-also POSTPONE: delete-inline-library } ;
-
-HELP: <RAW-C
-{ $syntax "<RAW-C code RAW-C>" }
-{ $description "Insert a (multiline) string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ;
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.inline alien.inline.syntax io.directories io.files
-kernel namespaces tools.test alien.c-types alien.structs ;
-IN: alien.inline.syntax.tests
-
-DELETE-C-LIBRARY: test
-C-LIBRARY: test
-
-C-FUNCTION: const-int add ( int a, int b )
- return a + b;
-;
-
-C-TYPEDEF: double bigfloat
-
-C-FUNCTION: bigfloat smaller ( bigfloat a )
- return a / 10;
-;
-
-C-STRUCTURE: rectangle
- { "int" "width" }
- { "int" "height" } ;
-
-C-FUNCTION: int area ( rectangle c )
- return c.width * c.height;
-;
-
-;C-LIBRARY
-
-{ 2 1 } [ add ] must-infer-as
-[ 5 ] [ 2 3 add ] unit-test
-
-[ t ] [ "double" "bigfloat" [ resolve-typedef ] bi@ = ] unit-test
-{ 1 1 } [ smaller ] must-infer-as
-[ 1.0 ] [ 10 smaller ] unit-test
-
-[ t ] [ "rectangle" resolve-typedef struct-type? ] unit-test
-{ 1 1 } [ area ] must-infer-as
-[ 20 ] [
- "rectangle" <c-object>
- 4 over set-rectangle-width
- 5 over set-rectangle-height
- area
-] unit-test
-
-
-DELETE-C-LIBRARY: cpplib
-C-LIBRARY: cpplib
-
-COMPILE-AS-C++
-
-C-INCLUDE: <string>
-
-C-FUNCTION: const-char* hello ( )
- std::string s("hello world");
- return s.c_str();
-;
-
-;C-LIBRARY
-
-{ 0 1 } [ hello ] must-infer-as
-[ "hello world" ] [ hello ] unit-test
-
-
-DELETE-C-LIBRARY: compile-error
-C-LIBRARY: compile-error
-
-C-FUNCTION: char* breakme ( )
- return not a string;
-;
-
-<< [ compile-c-library ] must-fail >>
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.inline lexer multiline namespaces parser ;
-IN: alien.inline.syntax
-
-
-SYNTAX: C-LIBRARY: scan define-c-library ;
-
-SYNTAX: COMPILE-AS-C++ t library-is-c++ set ;
-
-SYNTAX: C-LINK: scan c-link-to ;
-
-SYNTAX: C-FRAMEWORK: scan c-use-framework ;
-
-SYNTAX: C-LINK/FRAMEWORK: scan c-link-to/use-framework ;
-
-SYNTAX: C-INCLUDE: scan c-include ;
-
-SYNTAX: C-FUNCTION:
- function-types-effect parse-here define-c-function ;
-
-SYNTAX: C-TYPEDEF: scan scan define-c-typedef ;
-
-SYNTAX: C-STRUCTURE:
- scan parse-definition define-c-struct ;
-
-SYNTAX: ;C-LIBRARY compile-c-library ;
-
-SYNTAX: DELETE-C-LIBRARY: scan delete-inline-library ;
-
-SYNTAX: <RAW-C "RAW-C>" parse-multiline-string raw-c ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types assocs combinators.short-circuit
-continuations effects fry kernel math memoize sequences
-splitting strings peg.ebnf make ;
-IN: alien.inline.types
-
-: cify-type ( str -- str' )
- { { CHAR: - CHAR: space } } substitute ;
-
-: factorize-type ( str -- str' )
- cify-type
- "const " ?head drop
- "unsigned " ?head [ "u" prepend ] when
- "long " ?head [ "long" prepend ] when
- " const" ?tail drop ;
-
-: const-pointer? ( str -- ? )
- cify-type { [ " const" tail? ] [ "&" tail? ] } 1|| ;
-
-: pointer-to-const? ( str -- ? )
- cify-type "const " head? ;
-
-: template-class? ( str -- ? )
- [ CHAR: < = ] any? ;
-
-MEMO: resolved-primitives ( -- seq )
- primitive-types [ resolve-typedef ] map ;
-
-: primitive-type? ( type -- ? )
- [
- factorize-type resolve-typedef [ resolved-primitives ] dip
- '[ _ = ] any?
- ] [ 2drop f ] recover ;
-
-: pointer? ( type -- ? )
- factorize-type [ "*" tail? ] [ "&" tail? ] bi or ;
-
-: type-sans-pointer ( type -- type' )
- factorize-type [ '[ _ = ] "*&" swap any? ] trim-tail ;
-
-: pointer-to-primitive? ( type -- ? )
- factorize-type
- { [ pointer? ] [ type-sans-pointer primitive-type? ] } 1&& ;
-
-: pointer-to-non-const-primitive? ( str -- ? )
- {
- [ pointer-to-const? not ]
- [ factorize-type pointer-to-primitive? ]
- } 1&& ;
-
-: types-effect>params-return ( types effect -- params return )
- [ in>> zip ]
- [ nip out>> dup length 0 > [ first ] [ drop "void" ] if ]
- 2bi ;
-
-: annotate-effect ( types effect -- types effect' )
- [ in>> ] [ out>> ] bi [
- zip
- [ over pointer-to-primitive? [ ">" prepend ] when ]
- assoc-map unzip
- ] dip <effect> ;
-
-TUPLE: c++-type name params ptr ;
-C: <c++-type> c++-type
-
-EBNF: (parse-c++-type)
-dig = [0-9]
-alpha = [a-zA-Z]
-alphanum = [1-9a-zA-Z]
-name = [_a-zA-Z] [_a-zA-Z1-9:]* => [[ first2 swap prefix >string ]]
-ptr = [*&] => [[ empty? not ]]
-
-param = "," " "* type " "* => [[ third ]]
-
-params = "<" " "* type " "* param* ">" => [[ [ 4 swap nth ] [ third ] bi prefix ]]
-
-type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3 <c++-type> ]]
-;EBNF
-
-: parse-c++-type ( str -- c++-type )
- factorize-type (parse-c++-type) ;
-
-DEFER: c++-type>string
-
-: params>string ( params -- str )
- [ "<" % [ c++-type>string ] map "," join % ">" % ] "" make ;
-
-: c++-type>string ( c++-type -- str )
- [
- [ name>> % ]
- [ params>> [ params>string % ] when* ]
- [ ptr>> [ "*" % ] when ]
- tri
- ] "" make ;
-
-GENERIC: c++-type ( obj -- c++-type/f )
-
-M: object c++-type drop f ;
-
-M: c++-type c-type ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations sequences
-strings alien alien.c-types math byte-arrays ;
-IN: alien.marshall
-
-<PRIVATE
-: $memory-note ( arg -- )
- drop "This word returns a pointer to unmanaged memory."
- print-element ;
-
-: $c-ptr-note ( arg -- )
- drop "Does nothing if its argument is a non false c-ptr."
- print-element ;
-
-: $see-article ( arg -- )
- drop { "See " { $vocab-link "alien.inline" } "." }
- print-element ;
-PRIVATE>
-
-HELP: ?malloc-byte-array
-{ $values
- { "c-type" c-type }
- { "alien" alien }
-}
-{ $description "Does nothing if input is an alien, otherwise assumes it is a byte array and calls "
- { $snippet "malloc-byte-array" } "."
-}
-{ $notes $memory-note } ;
-
-HELP: alien-wrapper
-{ $var-description "For wrapping C pointers in a structure factor can dispatch on." } ;
-
-HELP: unmarshall-cast
-{ $values
- { "alien-wrapper" alien-wrapper }
- { "alien-wrapper'" alien-wrapper }
-}
-{ $description "Called immediately after unmarshalling. Useful for automatically casting to subtypes." } ;
-
-HELP: marshall-bool
-{ $values
- { "?" "a generalized boolean" }
- { "n" "0 or 1" }
-}
-{ $description "Marshalls objects to bool." }
-{ $notes "Will treat " { $snippet "0" } " as " { $snippet "t" } "." } ;
-
-HELP: marshall-bool*
-{ $values
- { "?/seq" "t/f or sequence" }
- { "alien" alien }
-}
-{ $description "When the argument is a sequence, returns a pointer to an array of bool, "
- "otherwise returns a pointer to a single bool value."
-}
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-bool**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description "Takes a one or two dimensional array of generalized booleans "
- "and returns a pointer to the equivalent C structure."
-}
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-primitive
-{ $values
- { "n" number }
- { "n" number }
-}
-{ $description "Marshall numbers to C primitives."
- $nl
- "Factor marshalls numbers to primitives for FFI calls, so all "
- "this word does is convert " { $snippet "t" } " to " { $snippet "1" }
- ", " { $snippet "f" } " to " { $snippet "0" } ", and lets anything else "
- "pass through untouched."
-} ;
-
-HELP: marshall-char*
-{ $values
- { "n/seq" "number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-char**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-char**-or-strings
-{ $values
- { "seq" "a sequence of strings" }
- { "alien" alien }
-}
-{ $description "Marshalls an array of strings or characters to an array of C strings." }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-char*-or-string
-{ $values
- { "n/string" "a number or string" }
- { "alien" alien }
-}
-{ $description "Marshalls a string to a C string or a number to a pointer to " { $snippet "char" } "." }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-double*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-double**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-float*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-float**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-int*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-int**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-long*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-long**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-longlong*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-longlong**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-non-pointer
-{ $values
- { "alien-wrapper/byte-array" "an alien-wrapper or byte-array" }
- { "byte-array" byte-array }
-}
-{ $description "Converts argument to a byte array." }
-{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ;
-
-HELP: marshall-pointer
-{ $values
- { "obj" object }
- { "alien" alien }
-}
-{ $description "Converts argument to a C pointer." }
-{ $notes "Can marshall the following types: " { $snippet "alien, f, byte-array, alien-wrapper, struct-array" } "." } ;
-
-HELP: marshall-short*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-short**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-uchar*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-uchar**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-uint*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-uint**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-ulong*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-ulong**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-ulonglong*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-ulonglong**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-ushort*
-{ $values
- { "n/seq" "a number or sequence" }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-ushort**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description $see-article }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshall-void**
-{ $values
- { "seq" sequence }
- { "alien" alien }
-}
-{ $description "Marshalls a sequence of objects to an array of pointers to void." }
-{ $notes { $list $c-ptr-note $memory-note } } ;
-
-HELP: marshaller
-{ $values
- { "type" "a C type string" }
- { "quot" quotation }
-}
-{ $description "Given a C type, returns a quotation that will marshall its argument to that type." } ;
-
-HELP: out-arg-unmarshaller
-{ $values
- { "type" "a C type string" }
- { "quot" quotation }
-}
-{ $description "Like " { $link unmarshaller } " but returns an empty quotation "
- "for all types except pointers to non-const primitives."
-} ;
-
-HELP: class-unmarshaller
-{ $values
- { "type" " a C type string" }
- { "quot/f" quotation }
-}
-{ $description "If in the vocab in which this word is called, there is a subclass of " { $link alien-wrapper }
- " named after the type argument, " { $snippet "pointer-unmarshaller" } " will return a quotation which "
- "wraps its argument in an instance of that subclass. In any other case it returns an empty quotation."
-}
-{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ;
-
-HELP: primitive-marshaller
-{ $values
- { "type" "a C type string" }
- { "quot/f" "a quotation or f" }
-}
-{ $description "Returns a quotation to marshall objects to the argument type." }
-{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ;
-
-HELP: primitive-unmarshaller
-{ $values
- { "type" "a C type string" }
- { "quot/f" "a quotation or f" }
-}
-{ $description "Returns a quotation to unmarshall objects from the argument type." }
-{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
-
-HELP: struct-field-unmarshaller
-{ $values
- { "type" "a C type string" }
- { "quot" quotation }
-}
-{ $description "Like " { $link unmarshaller } " but returns a quotation that "
- "does not call " { $snippet "free" } " on its argument."
-}
-{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
-
-HELP: struct-primitive-unmarshaller
-{ $values
- { "type" "a C type string" }
- { "quot/f" "a quotation or f" }
-}
-{ $description "Like " { $link primitive-unmarshaller } " but returns a quotation that "
- "does not call " { $snippet "free" } " on its argument." }
-{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
-
-HELP: struct-unmarshaller
-{ $values
- { "type" "a C type string" }
- { "quot/f" quotation }
-}
-{ $description "Returns a quotation which wraps its argument in the subclass of "
- { $link struct-wrapper } " which matches the " { $snippet "type" } " arg."
-}
-{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
-
-HELP: struct-wrapper
-{ $var-description "For wrapping C structs in a structure factor can dispatch on." } ;
-
-HELP: unmarshall-bool
-{ $values
- { "n" number }
- { "?" "a boolean" }
-}
-{ $description "Unmarshalls a number to a boolean." } ;
-
-HELP: unmarshall-bool*
-{ $values
- { "alien" alien }
- { "?" "a boolean" }
-}
-{ $description "Unmarshalls a C pointer to a boolean." } ;
-
-HELP: unmarshall-bool*-free
-{ $values
- { "alien" alien }
- { "?" "a boolean" }
-}
-{ $description "Unmarshalls a C pointer to a boolean and frees the pointer." } ;
-
-HELP: unmarshall-char*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-char*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-char*-to-string
-{ $values
- { "alien" alien }
- { "string" string }
-}
-{ $description "Unmarshalls a " { $snippet "char" } " pointer to a factor string." } ;
-
-HELP: unmarshall-char*-to-string-free
-{ $values
- { "alien" alien }
- { "string" string }
-}
-{ $description "Unmarshalls a " { $snippet "char" } " pointer to a factor string and frees the pointer." } ;
-
-HELP: unmarshall-double*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-double*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-float*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-float*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-int*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-int*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-long*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-long*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-longlong*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-longlong*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-short*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-short*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-uchar*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-uchar*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-uint*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-uint*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-ulong*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-ulong*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-ulonglong*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-ulonglong*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-ushort*
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshall-ushort*-free
-{ $values
- { "alien" alien }
- { "n" number }
-}
-{ $description $see-article } ;
-
-HELP: unmarshaller
-{ $values
- { "type" "a C type string" }
- { "quot" quotation }
-}
-{ $description "Given a C type, returns a quotation that will unmarshall values of that type." } ;
-
-ARTICLE: "alien.marshall" "C marshalling"
-{ $vocab-link "alien.marshall" } " provides alien wrappers and marshalling words for the "
-"automatic marshalling and unmarshalling of C function arguments, return values, and output parameters."
-
-{ $subheading "Important words" }
-"Wrap an alien:" { $subsection alien-wrapper }
-"Wrap a struct:" { $subsection struct-wrapper }
-"Get the marshaller for a C type:" { $subsection marshaller }
-"Get the unmarshaller for a C type:" { $subsection unmarshaller }
-"Get the unmarshaller for an output parameter:" { $subsection out-arg-unmarshaller }
-"Get the unmarshaller for a struct field:" { $subsection struct-field-unmarshaller }
-$nl
-"Other marshalling and unmarshalling words in this vocabulary are not intended to be "
-"invoked directly."
-$nl
-"Most marshalling words allow non false c-ptrs to pass through unchanged."
-
-{ $subheading "Primitive marshallers" }
-{ $subsection marshall-primitive } "for marshalling primitive values."
-{ $subsection marshall-int* }
- "marshalls a number or sequence of numbers. If argument is a sequence, returns a pointer "
- "to a C array, otherwise returns a pointer to a single value."
-{ $subsection marshall-int** }
-"marshalls a 1D or 2D array of numbers. Returns an array of pointers to arrays."
-
-{ $subheading "Primitive unmarshallers" }
-{ $snippet "unmarshall-<prim>*" } " and " { $snippet "unmarshall-<prim>*-free" }
-" for all values of " { $snippet "<prim>" } " in " { $link primitive-types } "."
-{ $subsection unmarshall-int* }
-"unmarshalls a pointer to primitive. Returns a number. "
-"Assumes the pointer is not an array (if it is, only the first value is returned). "
-"C functions that return arrays are not handled correctly by " { $snippet "alien.marshall" }
-" and must be unmarshalled by hand."
-{ $subsection unmarshall-int*-free }
-"unmarshalls a pointer to primitive, and then frees the pointer."
-$nl
-"Primitive values require no unmarshalling. The factor FFI already does this."
-;
-
-ABOUT: "alien.marshall"
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.inline.types
-alien.marshall.private alien.strings byte-arrays classes
-combinators combinators.short-circuit destructors fry
-io.encodings.utf8 kernel libc sequences
-specialized-arrays.alien specialized-arrays.bool
-specialized-arrays.char specialized-arrays.double
-specialized-arrays.float specialized-arrays.int
-specialized-arrays.long specialized-arrays.longlong
-specialized-arrays.short specialized-arrays.uchar
-specialized-arrays.uint specialized-arrays.ulong
-specialized-arrays.ulonglong specialized-arrays.ushort strings
-unix.utilities vocabs.parser words libc.private struct-arrays
-locals generalizations math ;
-IN: alien.marshall
-
-<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
-filter [ define-primitive-marshallers ] each >>
-
-TUPLE: alien-wrapper { underlying alien } ;
-TUPLE: struct-wrapper < alien-wrapper disposed ;
-TUPLE: class-wrapper < alien-wrapper disposed ;
-
-MIXIN: c++-root
-
-GENERIC: unmarshall-cast ( alien-wrapper -- alien-wrapper' )
-
-M: alien-wrapper unmarshall-cast ;
-M: struct-wrapper unmarshall-cast ;
-
-M: struct-wrapper dispose* underlying>> free ;
-
-M: class-wrapper c++-type class name>> parse-c++-type ;
-
-: marshall-pointer ( obj -- alien )
- {
- { [ dup alien? ] [ ] }
- { [ dup not ] [ ] }
- { [ dup byte-array? ] [ malloc-byte-array ] }
- { [ dup alien-wrapper? ] [ underlying>> ] }
- { [ dup struct-array? ] [ underlying>> ] }
- } cond ;
-
-: marshall-primitive ( n -- n )
- [ bool>arg ] ptr-pass-through ;
-
-ALIAS: marshall-void* marshall-pointer
-
-: marshall-void** ( seq -- alien )
- [ marshall-void* ] void*-array{ } map-as malloc-underlying ;
-
-: (marshall-char*-or-string) ( n/string -- alien )
- dup string?
- [ utf8 string>alien malloc-byte-array ]
- [ (marshall-char*) ] if ;
-
-: marshall-char*-or-string ( n/string -- alien )
- [ (marshall-char*-or-string) ] ptr-pass-through ;
-
-: (marshall-char**-or-strings) ( seq -- alien )
- [ marshall-char*-or-string ] void*-array{ } map-as
- malloc-underlying ;
-
-: marshall-char**-or-strings ( seq -- alien )
- [ (marshall-char**-or-strings) ] ptr-pass-through ;
-
-: marshall-bool ( ? -- n )
- >boolean [ 1 ] [ 0 ] if ;
-
-: (marshall-bool*) ( ?/seq -- alien )
- [ marshall-bool <bool> malloc-byte-array ]
- [ >bool-array malloc-underlying ]
- marshall-x* ;
-
-: marshall-bool* ( ?/seq -- alien )
- [ (marshall-bool*) ] ptr-pass-through ;
-
-: (marshall-bool**) ( seq -- alien )
- [ marshall-bool* ] map >void*-array malloc-underlying ;
-
-: marshall-bool** ( seq -- alien )
- [ (marshall-bool**) ] ptr-pass-through ;
-
-: unmarshall-bool ( n -- ? )
- 0 = not ;
-
-: unmarshall-bool* ( alien -- ? )
- *bool unmarshall-bool ;
-
-: unmarshall-bool*-free ( alien -- ? )
- [ *bool unmarshall-bool ] keep add-malloc free ;
-
-: primitive-marshaller ( type -- quot/f )
- {
- { "bool" [ [ ] ] }
- { "boolean" [ [ marshall-bool ] ] }
- { "char" [ [ marshall-primitive ] ] }
- { "uchar" [ [ marshall-primitive ] ] }
- { "short" [ [ marshall-primitive ] ] }
- { "ushort" [ [ marshall-primitive ] ] }
- { "int" [ [ marshall-primitive ] ] }
- { "uint" [ [ marshall-primitive ] ] }
- { "long" [ [ marshall-primitive ] ] }
- { "ulong" [ [ marshall-primitive ] ] }
- { "long" [ [ marshall-primitive ] ] }
- { "ulong" [ [ marshall-primitive ] ] }
- { "float" [ [ marshall-primitive ] ] }
- { "double" [ [ marshall-primitive ] ] }
- { "bool*" [ [ marshall-bool* ] ] }
- { "boolean*" [ [ marshall-bool* ] ] }
- { "char*" [ [ marshall-char*-or-string ] ] }
- { "uchar*" [ [ marshall-uchar* ] ] }
- { "short*" [ [ marshall-short* ] ] }
- { "ushort*" [ [ marshall-ushort* ] ] }
- { "int*" [ [ marshall-int* ] ] }
- { "uint*" [ [ marshall-uint* ] ] }
- { "long*" [ [ marshall-long* ] ] }
- { "ulong*" [ [ marshall-ulong* ] ] }
- { "longlong*" [ [ marshall-longlong* ] ] }
- { "ulonglong*" [ [ marshall-ulonglong* ] ] }
- { "float*" [ [ marshall-float* ] ] }
- { "double*" [ [ marshall-double* ] ] }
- { "bool&" [ [ marshall-bool* ] ] }
- { "boolean&" [ [ marshall-bool* ] ] }
- { "char&" [ [ marshall-char* ] ] }
- { "uchar&" [ [ marshall-uchar* ] ] }
- { "short&" [ [ marshall-short* ] ] }
- { "ushort&" [ [ marshall-ushort* ] ] }
- { "int&" [ [ marshall-int* ] ] }
- { "uint&" [ [ marshall-uint* ] ] }
- { "long&" [ [ marshall-long* ] ] }
- { "ulong&" [ [ marshall-ulong* ] ] }
- { "longlong&" [ [ marshall-longlong* ] ] }
- { "ulonglong&" [ [ marshall-ulonglong* ] ] }
- { "float&" [ [ marshall-float* ] ] }
- { "double&" [ [ marshall-double* ] ] }
- { "void*" [ [ marshall-void* ] ] }
- { "bool**" [ [ marshall-bool** ] ] }
- { "boolean**" [ [ marshall-bool** ] ] }
- { "char**" [ [ marshall-char**-or-strings ] ] }
- { "uchar**" [ [ marshall-uchar** ] ] }
- { "short**" [ [ marshall-short** ] ] }
- { "ushort**" [ [ marshall-ushort** ] ] }
- { "int**" [ [ marshall-int** ] ] }
- { "uint**" [ [ marshall-uint** ] ] }
- { "long**" [ [ marshall-long** ] ] }
- { "ulong**" [ [ marshall-ulong** ] ] }
- { "longlong**" [ [ marshall-longlong** ] ] }
- { "ulonglong**" [ [ marshall-ulonglong** ] ] }
- { "float**" [ [ marshall-float** ] ] }
- { "double**" [ [ marshall-double** ] ] }
- { "void**" [ [ marshall-void** ] ] }
- [ drop f ]
- } case ;
-
-: marshall-non-pointer ( alien-wrapper/byte-array -- byte-array )
- {
- { [ dup byte-array? ] [ ] }
- { [ dup alien-wrapper? ]
- [ [ underlying>> ] [ class name>> heap-size ] bi
- memory>byte-array ] }
- } cond ;
-
-
-: marshaller ( type -- quot )
- factorize-type dup primitive-marshaller [ nip ] [
- pointer?
- [ [ marshall-pointer ] ]
- [ [ marshall-non-pointer ] ] if
- ] if* ;
-
-
-: unmarshall-char*-to-string ( alien -- string )
- utf8 alien>string ;
-
-: unmarshall-char*-to-string-free ( alien -- string )
- [ unmarshall-char*-to-string ] keep add-malloc free ;
-
-: primitive-unmarshaller ( type -- quot/f )
- {
- { "bool" [ [ ] ] }
- { "boolean" [ [ unmarshall-bool ] ] }
- { "char" [ [ ] ] }
- { "uchar" [ [ ] ] }
- { "short" [ [ ] ] }
- { "ushort" [ [ ] ] }
- { "int" [ [ ] ] }
- { "uint" [ [ ] ] }
- { "long" [ [ ] ] }
- { "ulong" [ [ ] ] }
- { "longlong" [ [ ] ] }
- { "ulonglong" [ [ ] ] }
- { "float" [ [ ] ] }
- { "double" [ [ ] ] }
- { "bool*" [ [ unmarshall-bool*-free ] ] }
- { "boolean*" [ [ unmarshall-bool*-free ] ] }
- { "char*" [ [ ] ] }
- { "uchar*" [ [ unmarshall-uchar*-free ] ] }
- { "short*" [ [ unmarshall-short*-free ] ] }
- { "ushort*" [ [ unmarshall-ushort*-free ] ] }
- { "int*" [ [ unmarshall-int*-free ] ] }
- { "uint*" [ [ unmarshall-uint*-free ] ] }
- { "long*" [ [ unmarshall-long*-free ] ] }
- { "ulong*" [ [ unmarshall-ulong*-free ] ] }
- { "longlong*" [ [ unmarshall-long*-free ] ] }
- { "ulonglong*" [ [ unmarshall-ulong*-free ] ] }
- { "float*" [ [ unmarshall-float*-free ] ] }
- { "double*" [ [ unmarshall-double*-free ] ] }
- { "bool&" [ [ unmarshall-bool*-free ] ] }
- { "boolean&" [ [ unmarshall-bool*-free ] ] }
- { "char&" [ [ ] ] }
- { "uchar&" [ [ unmarshall-uchar*-free ] ] }
- { "short&" [ [ unmarshall-short*-free ] ] }
- { "ushort&" [ [ unmarshall-ushort*-free ] ] }
- { "int&" [ [ unmarshall-int*-free ] ] }
- { "uint&" [ [ unmarshall-uint*-free ] ] }
- { "long&" [ [ unmarshall-long*-free ] ] }
- { "ulong&" [ [ unmarshall-ulong*-free ] ] }
- { "longlong&" [ [ unmarshall-longlong*-free ] ] }
- { "ulonglong&" [ [ unmarshall-ulonglong*-free ] ] }
- { "float&" [ [ unmarshall-float*-free ] ] }
- { "double&" [ [ unmarshall-double*-free ] ] }
- [ drop f ]
- } case ;
-
-: struct-primitive-unmarshaller ( type -- quot/f )
- {
- { "bool" [ [ unmarshall-bool ] ] }
- { "boolean" [ [ unmarshall-bool ] ] }
- { "char" [ [ ] ] }
- { "uchar" [ [ ] ] }
- { "short" [ [ ] ] }
- { "ushort" [ [ ] ] }
- { "int" [ [ ] ] }
- { "uint" [ [ ] ] }
- { "long" [ [ ] ] }
- { "ulong" [ [ ] ] }
- { "longlong" [ [ ] ] }
- { "ulonglong" [ [ ] ] }
- { "float" [ [ ] ] }
- { "double" [ [ ] ] }
- { "bool*" [ [ unmarshall-bool* ] ] }
- { "boolean*" [ [ unmarshall-bool* ] ] }
- { "char*" [ [ ] ] }
- { "uchar*" [ [ unmarshall-uchar* ] ] }
- { "short*" [ [ unmarshall-short* ] ] }
- { "ushort*" [ [ unmarshall-ushort* ] ] }
- { "int*" [ [ unmarshall-int* ] ] }
- { "uint*" [ [ unmarshall-uint* ] ] }
- { "long*" [ [ unmarshall-long* ] ] }
- { "ulong*" [ [ unmarshall-ulong* ] ] }
- { "longlong*" [ [ unmarshall-long* ] ] }
- { "ulonglong*" [ [ unmarshall-ulong* ] ] }
- { "float*" [ [ unmarshall-float* ] ] }
- { "double*" [ [ unmarshall-double* ] ] }
- { "bool&" [ [ unmarshall-bool* ] ] }
- { "boolean&" [ [ unmarshall-bool* ] ] }
- { "char&" [ [ unmarshall-char* ] ] }
- { "uchar&" [ [ unmarshall-uchar* ] ] }
- { "short&" [ [ unmarshall-short* ] ] }
- { "ushort&" [ [ unmarshall-ushort* ] ] }
- { "int&" [ [ unmarshall-int* ] ] }
- { "uint&" [ [ unmarshall-uint* ] ] }
- { "long&" [ [ unmarshall-long* ] ] }
- { "ulong&" [ [ unmarshall-ulong* ] ] }
- { "longlong&" [ [ unmarshall-longlong* ] ] }
- { "ulonglong&" [ [ unmarshall-ulonglong* ] ] }
- { "float&" [ [ unmarshall-float* ] ] }
- { "double&" [ [ unmarshall-double* ] ] }
- [ drop f ]
- } case ;
-
-
-: ?malloc-byte-array ( c-type -- alien )
- dup alien? [ malloc-byte-array ] unless ;
-
-:: x-unmarshaller ( type type-quot superclass def clean -- quot/f )
- type type-quot call current-vocab lookup [
- dup superclasses superclass swap member?
- [ def call ] [ drop clean call f ] if
- ] [ clean call f ] if* ; inline
-
-: struct-unmarshaller ( type -- quot/f )
- [ ] \ struct-wrapper
- [ '[ ?malloc-byte-array _ new swap >>underlying ] ]
- [ ]
- x-unmarshaller ;
-
-: class-unmarshaller ( type -- quot/f )
- [ type-sans-pointer "#" append ] \ class-wrapper
- [ '[ _ new swap >>underlying ] ]
- [ ]
- x-unmarshaller ;
-
-: non-primitive-unmarshaller ( type -- quot/f )
- {
- { [ dup pointer? ] [ class-unmarshaller ] }
- [ struct-unmarshaller ]
- } cond ;
-
-: unmarshaller ( type -- quot )
- factorize-type {
- [ primitive-unmarshaller ]
- [ non-primitive-unmarshaller ]
- [ drop [ ] ]
- } 1|| ;
-
-: struct-field-unmarshaller ( type -- quot )
- factorize-type {
- [ struct-primitive-unmarshaller ]
- [ non-primitive-unmarshaller ]
- [ drop [ ] ]
- } 1|| ;
-
-: out-arg-unmarshaller ( type -- quot )
- dup pointer-to-non-const-primitive?
- [ factorize-type primitive-unmarshaller ]
- [ drop [ drop ] ] if ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien alien.c-types alien.inline arrays
-combinators fry functors kernel lexer libc macros math
-sequences specialized-arrays.alien libc.private
-combinators.short-circuit ;
-IN: alien.marshall.private
-
-: bool>arg ( ? -- 1/0/obj )
- {
- { t [ 1 ] }
- { f [ 0 ] }
- [ ]
- } case ;
-
-MACRO: marshall-x* ( num-quot seq-quot -- alien )
- '[ bool>arg dup number? _ _ if ] ;
-
-: ptr-pass-through ( obj quot -- alien )
- over { [ c-ptr? ] [ ] } 1&& [ drop ] [ call ] if ; inline
-
-: malloc-underlying ( obj -- alien )
- underlying>> malloc-byte-array ;
-
-FUNCTOR: define-primitive-marshallers ( TYPE -- )
-<TYPE> IS <${TYPE}>
-*TYPE IS *${TYPE}
->TYPE-array IS >${TYPE}-array
-marshall-TYPE DEFINES marshall-${TYPE}
-(marshall-TYPE*) DEFINES (marshall-${TYPE}*)
-(marshall-TYPE**) DEFINES (marshall-${TYPE}**)
-marshall-TYPE* DEFINES marshall-${TYPE}*
-marshall-TYPE** DEFINES marshall-${TYPE}**
-marshall-TYPE*-free DEFINES marshall-${TYPE}*-free
-marshall-TYPE**-free DEFINES marshall-${TYPE}**-free
-unmarshall-TYPE* DEFINES unmarshall-${TYPE}*
-unmarshall-TYPE*-free DEFINES unmarshall-${TYPE}*-free
-WHERE
-<PRIVATE
-: (marshall-TYPE*) ( n/seq -- alien )
- [ <TYPE> malloc-byte-array ]
- [ >TYPE-array malloc-underlying ]
- marshall-x* ;
-PRIVATE>
-: marshall-TYPE* ( n/seq -- alien )
- [ (marshall-TYPE*) ] ptr-pass-through ;
-<PRIVATE
-: (marshall-TYPE**) ( seq -- alien )
- [ marshall-TYPE* ] void*-array{ } map-as malloc-underlying ;
-PRIVATE>
-: marshall-TYPE** ( seq -- alien )
- [ (marshall-TYPE**) ] ptr-pass-through ;
-: unmarshall-TYPE* ( alien -- n )
- *TYPE ; inline
-: unmarshall-TYPE*-free ( alien -- n )
- [ unmarshall-TYPE* ] keep add-malloc free ;
-;FUNCTOR
-
-SYNTAX: PRIMITIVE-MARSHALLERS:
-";" parse-tokens [ define-primitive-marshallers ] each ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: classes help.markup help.syntax kernel quotations words
-alien.marshall.structs strings alien.structs alien.marshall ;
-IN: alien.marshall.structs
-
-HELP: define-marshalled-struct
-{ $values
- { "name" string } { "vocab" "a vocabulary specifier" } { "fields" "an alist" }
-}
-{ $description "Calls " { $link define-struct } " and " { $link define-struct-tuple } "." } ;
-
-HELP: define-struct-tuple
-{ $values
- { "name" string }
-}
-{ $description "Defines a subclass of " { $link struct-wrapper } ", a constructor, "
- "and accessor words."
-} ;
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.marshall arrays assocs
-classes.tuple combinators destructors generalizations generic
-kernel libc locals parser quotations sequences slots words
-alien.structs lexer vocabs.parser fry effects ;
-IN: alien.marshall.structs
-
-<PRIVATE
-: define-struct-accessor ( class name quot -- )
- [ "accessors" create create-method dup make-inline ] dip define ;
-
-: define-struct-getter ( class name word type -- )
- [ ">>" append \ underlying>> ] 2dip
- struct-field-unmarshaller \ call 4array >quotation
- define-struct-accessor ;
-
-: define-struct-setter ( class name word type -- )
- [ "(>>" prepend ")" append ] 2dip
- marshaller [ underlying>> ] \ bi* roll 4array >quotation
- define-struct-accessor ;
-
-: define-struct-accessors ( class name type reader writer -- )
- [ dup define-protocol-slot ] 3dip
- [ drop swap define-struct-getter ]
- [ nip swap define-struct-setter ] 5 nbi ;
-
-: define-struct-constructor ( class -- )
- {
- [ name>> "<" prepend ">" append create-in ]
- [ '[ _ new ] ]
- [ name>> '[ _ malloc-object >>underlying ] append ]
- [ name>> 1array ]
- } cleave { } swap <effect> define-declared ;
-PRIVATE>
-
-:: define-struct-tuple ( name -- )
- name create-in :> class
- class struct-wrapper { } define-tuple-class
- class define-struct-constructor
- name c-type fields>> [
- class swap
- {
- [ name>> { { CHAR: space CHAR: - } } substitute ]
- [ type>> ] [ reader>> ] [ writer>> ]
- } cleave define-struct-accessors
- ] each ;
-
-: define-marshalled-struct ( name vocab fields -- )
- [ define-struct ] [ 2drop define-struct-tuple ] 3bi ;
+++ /dev/null
-Jeremy Hughes
\ No newline at end of file
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: help.markup help.syntax kernel quotations words
-alien.inline alien.syntax effects alien.marshall
-alien.marshall.structs strings sequences alien.inline.syntax ;
-IN: alien.marshall.syntax
-
-HELP: CM-FUNCTION:
-{ $syntax "CM-FUNCTION: return name args\n body\n;" }
-{ $description "Like " { $link POSTPONE: C-FUNCTION: } " but with marshalling "
- "of arguments and return values."
-}
-{ $examples
- { $example
- "USING: alien.inline.syntax alien.marshall.syntax prettyprint ;"
- "IN: example"
- ""
- "C-LIBRARY: exlib"
- ""
- "C-INCLUDE: <stdio.h>"
- "C-INCLUDE: <stdlib.h>"
- "CM-FUNCTION: char* sum_diff ( const-int a, const-int b, int* x, int* y )"
- " *x = a + b;"
- " *y = a - b;"
- " char* s = (char*) malloc(sizeof(char) * 64);"
- " sprintf(s, \"sum %i, diff %i\", *x, *y);"
- " return s;"
- ";"
- ""
- ";C-LIBRARY"
- ""
- "8 5 0 0 sum_diff . . ."
- "3\n13\n\"sum 13, diff 3\""
- }
-}
-{ $see-also define-c-marshalled POSTPONE: C-FUNCTION: POSTPONE: M-FUNCTION: } ;
-
-HELP: CM-STRUCTURE:
-{ $syntax "CM-STRUCTURE: name fields ... ;" }
-{ $description "Like " { $link POSTPONE: C-STRUCTURE: } " but with marshalling of fields. "
- "Defines a subclass of " { $link struct-wrapper } " a constructor, and slot-like accessor words."
-}
-{ $see-also POSTPONE: C-STRUCTURE: POSTPONE: M-STRUCTURE: } ;
-
-HELP: M-FUNCTION:
-{ $syntax "M-FUNCTION: return name args ;" }
-{ $description "Like " { $link POSTPONE: FUNCTION: } " but with marshalling "
- "of arguments and return values."
-}
-{ $see-also marshalled-function POSTPONE: C-FUNCTION: POSTPONE: CM-FUNCTION: } ;
-
-HELP: M-STRUCTURE:
-{ $syntax "M-STRUCTURE: name fields ... ;" }
-{ $description "Like " { $link POSTPONE: C-STRUCT: } " but with marshalling of fields. "
- "Defines a subclass of " { $link struct-wrapper } " a constructor, and slot-like accessor words."
-}
-{ $see-also define-marshalled-struct POSTPONE: C-STRUCTURE: POSTPONE: CM-STRUCTURE: } ;
-
-HELP: define-c-marshalled
-{ $values
- { "name" string } { "types" sequence } { "effect" effect } { "body" string }
-}
-{ $description "Defines a C function and a factor word which calls it with marshalling of "
- "args and return values."
-}
-{ $see-also define-c-marshalled' } ;
-
-HELP: define-c-marshalled'
-{ $values
- { "name" string } { "effect" effect } { "body" string }
-}
-{ $description "Like " { $link define-c-marshalled } ". "
- "The effect elements must be C type strings."
-} ;
-
-HELP: marshalled-function
-{ $values
- { "name" string } { "types" sequence } { "effect" effect }
- { "word" word } { "quot" quotation } { "effect" effect }
-}
-{ $description "Defines a word which calls the named C function. Arguments, "
- "return value, and output parameters are marshalled and unmarshalled."
-} ;
-
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.inline.syntax alien.marshall.syntax destructors
-tools.test accessors kernel ;
-IN: alien.marshall.syntax.tests
-
-DELETE-C-LIBRARY: test
-C-LIBRARY: test
-
-C-INCLUDE: <stdlib.h>
-C-INCLUDE: <string.h>
-C-INCLUDE: <stdbool.h>
-
-CM-FUNCTION: void outarg1 ( int* a )
- *a += 2;
-;
-
-CM-FUNCTION: unsigned-long* outarg2 ( unsigned-long a, unsigned-long* b )
- unsigned long* x = malloc(sizeof(unsigned long*));
- *b = 10 + *b;
- *x = a + *b;
- return x;
-;
-
-CM-STRUCTURE: wedge
- { "double" "degrees" } ;
-
-CM-STRUCTURE: sundial
- { "double" "radius" }
- { "wedge" "wedge" } ;
-
-CM-FUNCTION: double hours ( sundial* d )
- return d->wedge.degrees / 30;
-;
-
-CM-FUNCTION: void change_time ( double hours, sundial* d )
- d->wedge.degrees = hours * 30;
-;
-
-CM-FUNCTION: bool c_not ( bool p )
- return !p;
-;
-
-CM-FUNCTION: char* upcase ( const-char* s )
- int len = strlen(s);
- char* t = malloc(sizeof(char) * len);
- int i;
- for (i = 0; i < len; i++)
- t[i] = toupper(s[i]);
- t[i] = '\0';
- return t;
-;
-
-;C-LIBRARY
-
-{ 1 1 } [ outarg1 ] must-infer-as
-[ 3 ] [ 1 outarg1 ] unit-test
-[ 3 ] [ t outarg1 ] unit-test
-[ 2 ] [ f outarg1 ] unit-test
-
-{ 2 2 } [ outarg2 ] must-infer-as
-[ 18 15 ] [ 3 5 outarg2 ] unit-test
-
-{ 1 1 } [ hours ] must-infer-as
-[ 5.0 ] [ <sundial> <wedge> 150 >>degrees >>wedge hours ] unit-test
-
-{ 2 0 } [ change_time ] must-infer-as
-[ 150.0 ] [ 5 <sundial> <wedge> 11 >>degrees >>wedge [ change_time ] keep wedge>> degrees>> ] unit-test
-
-{ 1 1 } [ c_not ] must-infer-as
-[ f ] [ "x" c_not ] unit-test
-[ f ] [ 0 c_not ] unit-test
-
-{ 1 1 } [ upcase ] must-infer-as
-[ "ABC" ] [ "abc" upcase ] unit-test
+++ /dev/null
-! Copyright (C) 2009 Jeremy Hughes.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.inline alien.inline.types alien.marshall
-combinators effects generalizations kernel locals make namespaces
-quotations sequences words alien.marshall.structs lexer parser
-vocabs.parser multiline ;
-IN: alien.marshall.syntax
-
-:: marshalled-function ( name types effect -- word quot effect )
- name types effect factor-function
- [ in>> ]
- [ out>> types [ pointer-to-non-const-primitive? ] filter append ]
- bi <effect>
- [
- [
- types [ marshaller ] map , \ spread , ,
- types length , \ nkeep ,
- types [ out-arg-unmarshaller ] map
- effect out>> dup empty?
- [ drop ] [ first unmarshaller prefix ] if
- , \ spread ,
- ] [ ] make
- ] dip ;
-
-: define-c-marshalled ( name types effect body -- )
- [
- [ marshalled-function define-declared ]
- [ prototype-string ] 3bi
- ] dip append-function-body c-strings get push ;
-
-: define-c-marshalled' ( name effect body -- )
- [
- [ in>> ] keep
- [ marshalled-function define-declared ]
- [ out>> prototype-string' ] 3bi
- ] dip append-function-body c-strings get push ;
-
-SYNTAX: CM-FUNCTION:
- function-types-effect parse-here define-c-marshalled ;
-
-SYNTAX: M-FUNCTION:
- function-types-effect marshalled-function define-declared ;
-
-SYNTAX: M-STRUCTURE:
- scan current-vocab parse-definition
- define-marshalled-struct ;
-
-SYNTAX: CM-STRUCTURE:
- scan current-vocab parse-definition
- [ define-marshalled-struct ] [ nip define-c-struct ] 3bi ;
"that use rates which do not change across platforms. The speed of the "
"computer should correlate with the smoothness of the animation, not "
"the speed of the animation!"
-{ $subsection animate }
-{ $subsection reset-progress }
-{ $subsection progress }
+{ $subsections
+ animate
+ reset-progress
+ progress
+}
! A little talk about when to use progress and when to use animate
{ $link progress } " specifically provides the length of time since "
{ $link reset-progress } " was called, and also calls "
ARTICLE: "assoc-heaps" "Associative heaps"
"The " { $vocab-link "assoc-heaps" } " vocabulary combines exists to synthesize data structures with better time properties than either of the two component data structures alone." $nl
"Associative heap constructor:"
-{ $subsection <assoc-heap> }
+{ $subsection
s <assoc-heap> }
"Unique heaps:"
-{ $subsection <unique-min-heap> }
-{ $subsection <unique-max-heap> } ;
+{ $subsections
+ <unique-min-heap>
+ <unique-max-heap>
+} ;
ABOUT: "assoc-heaps"
USING: alien.c-types alien.syntax audio combinators
combinators.short-circuit io io.binary io.encodings.binary
io.files io.streams.byte-array kernel locals math
-sequences ;
+sequences alien alien.data classes.struct accessors ;
IN: audio.wav
CONSTANT: RIFF-MAGIC "RIFF"
CONSTANT: FMT-MAGIC "fmt "
CONSTANT: DATA-MAGIC "data"
-C-STRUCT: riff-chunk-header
- { "char[4]" "id" }
- { "uchar[4]" "size" }
- ;
+STRUCT: riff-chunk-header
+ { id char[4] }
+ { size char[4] } ;
-C-STRUCT: riff-chunk
- { "riff-chunk-header" "header" }
- { "char[4]" "format" }
- ;
+STRUCT: riff-chunk
+ { header riff-chunk-header }
+ { format char[4] } ;
-C-STRUCT: wav-fmt-chunk
- { "riff-chunk-header" "header" }
- { "uchar[2]" "audio-format" }
- { "uchar[2]" "num-channels" }
- { "uchar[4]" "sample-rate" }
- { "uchar[4]" "byte-rate" }
- { "uchar[2]" "block-align" }
- { "uchar[2]" "bits-per-sample" }
- ;
+STRUCT: wav-fmt-chunk
+ { header riff-chunk-header }
+ { audio-format uchar[2] }
+ { num-channels uchar[2] }
+ { sample-rate uchar[4] }
+ { byte-rate uchar[4] }
+ { block-align uchar[2] }
+ { bits-per-sample uchar[2] } ;
-C-STRUCT: wav-data-chunk
- { "riff-chunk-header" "header" }
- { "uchar[0]" "body" }
- ;
+STRUCT: wav-data-chunk
+ { header riff-chunk-header }
+ { body uchar[0] } ;
ERROR: invalid-wav-file ;
: read-chunk ( -- byte-array/f )
4 ensured-read [ 4 ensured-read* dup le> ensured-read* 3append ] [ f ] if* ;
: read-riff-chunk ( -- byte-array/f )
- "riff-chunk" heap-size ensured-read* ;
+ riff-chunk heap-size ensured-read* ;
: id= ( chunk id -- ? )
- [ 4 head ] dip sequence= ;
+ [ 4 head ] dip sequence= ; inline
-: check-chunk ( chunk id min-size -- ? )
- [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
+: check-chunk ( chunk id class -- ? )
+ heap-size [ id= ] [ [ length ] dip >= ] bi-curry* bi and ;
:: read-wav-chunks ( -- fmt data )
f :> fmt! f :> data!
[ { [ fmt data and not ] [ read-chunk ] } 0&& dup ]
[ {
- { [ dup FMT-MAGIC "wav-fmt-chunk" heap-size check-chunk ] [ fmt! ] }
- { [ dup DATA-MAGIC "wav-data-chunk" heap-size check-chunk ] [ data! ] }
+ { [ dup FMT-MAGIC wav-fmt-chunk check-chunk ] [ wav-fmt-chunk memory>struct fmt! ] }
+ { [ dup DATA-MAGIC wav-data-chunk check-chunk ] [ wav-data-chunk memory>struct data! ] }
} cond ] while drop
fmt data 2dup and [ invalid-wav-file ] unless ;
: verify-wav ( chunk -- )
{
[ RIFF-MAGIC id= ]
- [ riff-chunk-format 4 memory>byte-array WAVE-MAGIC id= ]
+ [ riff-chunk memory>struct format>> 4 memory>byte-array WAVE-MAGIC id= ]
} 1&&
[ invalid-wav-file ] unless ;
: (read-wav) ( -- audio )
read-wav-chunks
[
- [ wav-fmt-chunk-num-channels 2 memory>byte-array le> ]
- [ wav-fmt-chunk-bits-per-sample 2 memory>byte-array le> ]
- [ wav-fmt-chunk-sample-rate 4 memory>byte-array le> ] tri
+ [ num-channels>> 2 memory>byte-array le> ]
+ [ bits-per-sample>> 2 memory>byte-array le> ]
+ [ sample-rate>> 4 memory>byte-array le> ] tri
] [
- [ riff-chunk-header-size 4 memory>byte-array le> dup ]
- [ wav-data-chunk-body ] bi swap memory>byte-array
+ [ header>> size>> 4 memory>byte-array le> dup ]
+ [ body>> >c-ptr ] bi swap memory>byte-array
] bi* <audio> ;
: read-wav ( filename -- audio )
--- /dev/null
+USING: kernel locals math math.matrices math.order math.vectors
+prettyprint sequences ;
+IN: benchmark.3d-matrix-scalar
+
+:: p-matrix ( dim fov near far -- matrix )
+ dim dup first2 min v/n fov v*n near v*n
+ near far frustum-matrix4 ;
+
+:: mv-matrix ( pitch yaw location -- matrix )
+ { 1.0 0.0 0.0 } pitch rotation-matrix4
+ { 0.0 1.0 0.0 } yaw rotation-matrix4
+ location vneg translation-matrix4 m. m. ;
+
+:: 3d-matrix ( -- )
+ f :> result!
+ 100000 [
+ { 1024.0 768.0 } 0.7 0.25 1024.0 p-matrix :> p
+ 3.0 1.0 { 10.0 -0.0 2.0 } mv-matrix :> mv
+ mv p m. result!
+ ] times
+ result . ;
+
+MAIN: 3d-matrix
--- /dev/null
+USING: kernel locals math math.matrices.simd math.order math.vectors
+math.vectors.simd prettyprint sequences typed ;
+QUALIFIED-WITH: alien.c-types c
+SIMD: c:float
+IN: benchmark.3d-matrix-vector
+
+: v2min ( xy -- xx )
+ dup { 1 0 2 3 } vshuffle vmin ; inline
+
+TYPED:: p-matrix ( dim: float-4 fov: float near: float far: float -- matrix: matrix4 )
+ dim dup v2min v/ fov v*n near v*n
+ near far frustum-matrix4 ;
+
+TYPED:: mv-matrix ( pitch: float yaw: float location: float-4 -- matrix: matrix4 )
+ float-4{ 1.0 0.0 0.0 0.0 } pitch rotation-matrix4
+ float-4{ 0.0 1.0 0.0 0.0 } yaw rotation-matrix4
+ location vneg translation-matrix4 m4. m4. ;
+
+:: 3d-matrix ( -- )
+ f :> result!
+ 100000 [
+ float-4{ 1024.0 768.0 0.0 0.0 } 0.7 0.25 1024.0 p-matrix :> p
+ 3.0 1.0 float-4{ 10.0 -0.0 2.0 0.0 } mv-matrix :> mv
+ mv p m4. result!
+ ] times
+ result . ;
+
+MAIN: 3d-matrix
PRIVATE>
-: (run-benchmark) ( vocab -- time )
+: run-benchmark ( vocab -- time )
[ 5 ] dip '[ gc [ _ run ] benchmark ] replicate infimum ;
-: run-benchmark ( vocab -- )
+<PRIVATE
+
+: record-benchmark ( vocab -- )
[ "=== " write print flush ] [
- [ [ require ] [ (run-benchmark) ] [ ] tri timings ]
+ [ [ require ] [ run-benchmark ] [ ] tri timings ]
[ swap errors ]
recover get set-at
] bi ;
+PRIVATE>
+
: run-benchmarks ( -- timings errors )
[
V{ } clone timings set
V{ } clone errors set
"benchmark" child-vocab-names
[ find-vocab-root ] filter
- [ run-benchmark ] each
+ [ record-benchmark ] each
timings get
errors get
] with-scope ;
-USING: sequences hints kernel math specialized-arrays.int fry ;
+USING: alien.c-types sequences kernel math specialized-arrays
+fry ;
+SPECIALIZED-ARRAY: int
IN: benchmark.dawes
! Phil Dawes's performance problem
: count-ones ( int-array -- n ) [ 1 = ] count ; inline
-HINTS: count-ones int-array ;
-
: make-int-array ( -- int-array )
- 120000 [ 255 bitand ] int-array{ } map-as ;
+ 120000 [ 255 bitand ] int-array{ } map-as ; inline
: dawes-benchmark ( -- )
- make-int-array 200 swap '[ _ count-ones ] replicate drop ;
+ 200 make-int-array '[ _ count-ones ] replicate drop ;
MAIN: dawes-benchmark
-USING: make math sequences splitting grouping
-kernel columns specialized-arrays.double bit-arrays ;
+USING: alien.c-types make math sequences splitting grouping
+kernel columns specialized-arrays bit-arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.dispatch2
: sequences ( -- seq )
1000000 sequences
[ [ 0 swap nth don't-flush-me ] each ] curry times ;
-MAIN: dispatch-test
\ No newline at end of file
+MAIN: dispatch-test
-USING: sequences math mirrors splitting grouping
+USING: alien.c-types sequences math mirrors splitting grouping
kernel make assocs alien.syntax columns
-specialized-arrays.double bit-arrays ;
+specialized-arrays bit-arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.dispatch3
GENERIC: g ( obj -- str )
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: decimals kernel locals math math.combinatorics math.ranges
+sequences ;
+IN: benchmark.e-decimals
+
+: D-factorial ( n -- D! )
+ D: 1 [ 0 <decimal> D: 1 D+ D* ] reduce ; inline
+
+:: calculate-e-decimals ( n -- e )
+ n [1,b] D: 1
+ [ D-factorial D: 1 swap n D/ D+ ] reduce ;
+
+: calculate-e-decimals-benchmark ( -- )
+ 5 [ 800 calculate-e-decimals drop ] times ;
+
+MAIN: calculate-e-decimals-benchmark
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.combinatorics math.ranges sequences ;
+IN: benchmark.e-ratios
+
+: calculate-e-ratios ( n -- e )
+ iota [ factorial recip ] sigma ;
+
+: calculate-e-ratios-benchmark ( -- )
+ 5 [ 300 calculate-e-ratios drop ] times ;
+
+MAIN: calculate-e-ratios-benchmark
+++ /dev/null
-IN: benchmark.euler186
-USING: kernel project-euler.186 ;
-
-: euler186-benchmark ( -- )
- euler186 2325629 assert= ;
-
-MAIN: euler186-benchmark
! Based on http://shootout.alioth.debian.org/gp4/benchmark.php?test=fasta&lang=java&id=2
-USING: math kernel io io.files locals multiline assocs sequences
-sequences.private benchmark.reverse-complement hints io.encodings.ascii
-byte-arrays specialized-arrays.double ;
+USING: alien.c-types math kernel io io.files locals multiline
+assocs sequences sequences.private benchmark.reverse-complement
+hints io.encodings.ascii byte-arrays specialized-arrays ;
+SPECIALIZED-ARRAY: double
IN: benchmark.fasta
CONSTANT: IM 139968
USING: math sequences kernel ;
IN: benchmark.gc1
-: gc1 ( -- ) 6000000 [ >bignum 1 + ] map drop ;
+: gc1 ( -- ) 10 [ 600000 [ >bignum 1 + ] map drop ] times ;
MAIN: gc1
USING: math math.order kernel arrays byte-arrays sequences
-colors.hsv benchmark.mandel.params accessors colors ;
+colors.hsv accessors colors fry benchmark.mandel.params ;
IN: benchmark.mandel.colors
: scale ( x -- y ) 255 * >fixnum ; inline
CONSTANT: val 0.85
: <color-map> ( nb-cols -- map )
- dup [
- 360 * swap 1 + / sat val
+ [ iota ] keep '[
+ 360 * _ 1 + / sat val
1 <hsva> >rgba scale-rgb
- ] with map ;
+ ] map ;
: color-map ( -- map )
max-iterations max-color min <color-map> ; foldable
-! Copyright (C) 2005, 2008 Slava Pestov.
+! Copyright (C) 2005, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: io kernel math math.functions sequences prettyprint
io.files io.files.temp io.encodings io.encodings.ascii
benchmark.mandel.colors ;
IN: benchmark.mandel
-: x-inc ( -- x ) width 200000 zoom-fact * / ; inline
-: y-inc ( -- y ) height 150000 zoom-fact * / ; inline
+: x-scale ( -- x ) width 200000 zoom-fact * / ; inline
+: y-scale ( -- y ) height 150000 zoom-fact * / ; inline
-: c ( i j -- c )
- [ x-inc * center real-part x-inc width 2 / * - + >float ]
- [ y-inc * center imaginary-part y-inc height 2 / * - + >float ] bi*
- rect> ; inline
+: scale ( x y -- z ) [ x-scale * ] [ y-scale * ] bi* rect> ; inline
+
+: c ( i j -- c ) scale center width height scale 2 / - + ; inline
: count-iterations ( z max-iterations step-quot test-quot -- #iters )
'[ drop @ dup @ ] find-last-integer nip ; inline
[ color-map [ length mod ] keep nth ] [ B{ 0 0 0 } ] if* ; inline
: render ( -- )
- height [ width swap '[ _ c pixel color write ] each ] each ; inline
+ height iota [ width iota swap '[ _ c pixel color write ] each ] each ; inline
: ppm-header ( -- )
ascii encode-output
--- /dev/null
+USING: locals math math.combinatorics math.matrices
+prettyprint sequences typed ;
+IN: benchmark.matrix-exponential-scalar
+
+:: e^m ( m iterations -- e^m )
+ {
+ { 0.0 0.0 0.0 0.0 }
+ { 0.0 0.0 0.0 0.0 }
+ { 0.0 0.0 0.0 0.0 }
+ { 0.0 0.0 0.0 0.0 }
+ }
+ iterations iota [| i |
+ m i m^n i factorial >float m/n m+
+ ] each ;
+
+:: matrix-e ( -- )
+ f :> result!
+ 4 identity-matrix :> i4
+ 10000 [
+ i4 20 e^m result!
+ ] times
+ result . ;
+
+MAIN: matrix-e
--- /dev/null
+USING: locals math math.combinatorics math.matrices.simd
+prettyprint sequences typed ;
+IN: benchmark.matrix-exponential-simd
+
+TYPED:: e^m4 ( m: matrix4 iterations: fixnum -- e^m: matrix4 )
+ zero-matrix4
+ iterations iota [| i |
+ m i m4^n i factorial >float m4/n m4+
+ ] each ;
+
+:: matrix-e ( -- )
+ f :> result!
+ 10000 [
+ identity-matrix4 20 e^m4 result!
+ ] times
+ result . ;
+
+MAIN: matrix-e
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2008, 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types fry kernel locals math
+math.constants math.functions math.vectors math.vectors.simd
+prettyprint combinators.smart sequences hints classes.struct
+specialized-arrays ;
+SIMD: double
+IN: benchmark.nbody-simd
+
+: solar-mass ( -- x ) 4 pi sq * ; inline
+CONSTANT: days-per-year 365.24
+
+STRUCT: body
+{ location double-4 }
+{ velocity double-4 }
+{ mass double } ;
+
+SPECIALIZED-ARRAY: body
+
+: <body> ( location velocity mass -- body )
+ [ days-per-year v*n ] [ solar-mass * ] bi* body <struct-boa> ; inline
+
+: <jupiter> ( -- body )
+ double-4{ 4.84143144246472090e+00 -1.16032004402742839e+00 -1.03622044471123109e-01 0.0 }
+ double-4{ 1.66007664274403694e-03 7.69901118419740425e-03 -6.90460016972063023e-05 0.0 }
+ 9.54791938424326609e-04
+ <body> ;
+
+: <saturn> ( -- body )
+ double-4{ 8.34336671824457987e+00 4.12479856412430479e+00 -4.03523417114321381e-01 0.0 }
+ double-4{ -2.76742510726862411e-03 4.99852801234917238e-03 2.30417297573763929e-05 0.0 }
+ 2.85885980666130812e-04
+ <body> ;
+
+: <uranus> ( -- body )
+ double-4{ 1.28943695621391310e+01 -1.51111514016986312e+01 -2.23307578892655734e-01 0.0 }
+ double-4{ 2.96460137564761618e-03 2.37847173959480950e-03 -2.96589568540237556e-05 0.0 }
+ 4.36624404335156298e-05
+ <body> ;
+
+: <neptune> ( -- body )
+ double-4{ 1.53796971148509165e+01 -2.59193146099879641e+01 1.79258772950371181e-01 0.0 }
+ double-4{ 2.68067772490389322e-03 1.62824170038242295e-03 -9.51592254519715870e-05 0.0 }
+ 5.15138902046611451e-05
+ <body> ;
+
+: <sun> ( -- body )
+ double-4{ 0 0 0 0 } double-4{ 0 0 0 0 } 1 <body> ;
+
+: offset-momentum ( body offset -- body )
+ vneg solar-mass v/n >>velocity ; inline
+
+: init-bodies ( bodies -- )
+ [ first ] [ [ [ velocity>> ] [ mass>> ] bi v*n ] [ v+ ] map-reduce ] bi
+ offset-momentum drop ; inline
+
+: <nbody-system> ( -- system )
+ [ <sun> <jupiter> <saturn> <uranus> <neptune> ]
+ body-array{ } output>sequence
+ dup init-bodies ; inline
+
+:: each-pair ( bodies pair-quot: ( other-body body -- ) each-quot: ( body -- ) -- )
+ bodies [| body i |
+ body each-quot call
+ bodies i 1 + tail-slice [
+ body pair-quot call
+ ] each
+ ] each-index ; inline
+
+: update-position ( body dt -- )
+ [ dup velocity>> ] dip '[ _ _ v*n v+ ] change-location drop ; inline
+
+: mag ( dt body other-body -- mag d )
+ [ location>> ] bi@ v- [ norm-sq dup sqrt * / ] keep ; inline
+
+:: update-velocity ( other-body body dt -- )
+ dt body other-body mag
+ [ [ body ] 2dip '[ other-body mass>> _ * _ n*v v- ] change-velocity drop ]
+ [ [ other-body ] 2dip '[ body mass>> _ * _ n*v v+ ] change-velocity drop ] 2bi ; inline
+
+: advance ( system dt -- )
+ [ '[ _ update-velocity ] [ drop ] each-pair ]
+ [ '[ _ update-position ] each ]
+ 2bi ; inline
+
+: inertia ( body -- e )
+ [ mass>> ] [ velocity>> norm-sq ] bi * 0.5 * ; inline
+
+: newton's-law ( other-body body -- e )
+ [ [ mass>> ] bi@ * ] [ [ location>> ] bi@ distance ] 2bi / ; inline
+
+: energy ( system -- x )
+ [ 0.0 ] dip [ newton's-law - ] [ inertia + ] each-pair ; inline
+
+: nbody ( n -- )
+ >fixnum
+ <nbody-system>
+ [ energy . ] [ '[ _ 0.01 advance ] times ] [ energy . ] tri ;
+
+: nbody-main ( -- ) 1000000 nbody ;
+
+MAIN: nbody-main
! Copyright (C) 2008, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors specialized-arrays.double fry kernel locals math
-math.constants math.functions math.vectors prettyprint combinators.smart
-sequences hints arrays ;
+USING: accessors specialized-arrays fry kernel
+locals math math.constants math.functions math.vectors
+prettyprint combinators.smart sequences hints arrays ;
+FROM: alien.c-types => double ;
+SPECIALIZED-ARRAY: double
IN: benchmark.nbody
: solar-mass ( -- x ) 4 pi sq * ; inline
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Factor port of the raytracer benchmark from
+! http://www.ffconsultancy.com/free/ray_tracer/languages.html
+
+USING: arrays accessors io io.files io.files.temp
+io.encodings.binary kernel math math.constants math.functions
+math.vectors math.vectors.simd math.parser make sequences
+sequences.private words hints classes.struct ;
+QUALIFIED-WITH: alien.c-types c
+SIMD: c:double
+IN: benchmark.raytracer-simd
+
+! parameters
+
+! Normalized { -1 -3 2 }.
+CONSTANT: light
+ double-4{
+ -0.2672612419124244
+ -0.8017837257372732
+ 0.5345224838248488
+ 0.0
+ }
+
+CONSTANT: oversampling 4
+
+CONSTANT: levels 3
+
+CONSTANT: size 200
+
+: delta ( -- n ) epsilon sqrt ; inline
+
+TUPLE: ray { orig double-4 read-only } { dir double-4 read-only } ;
+
+C: <ray> ray
+
+TUPLE: hit { normal double-4 read-only } { lambda float read-only } ;
+
+C: <hit> hit
+
+GENERIC: intersect-scene ( hit ray scene -- hit )
+
+TUPLE: sphere { center double-4 read-only } { radius float read-only } ;
+
+C: <sphere> sphere
+
+: sphere-v ( sphere ray -- v )
+ [ center>> ] [ orig>> ] bi* v- ; inline
+
+: sphere-b ( v ray -- b )
+ dir>> v. ; inline
+
+: sphere-d ( sphere b v -- d )
+ [ radius>> sq ] [ sq ] [ norm-sq ] tri* - + ; inline
+
+: -+ ( x y -- x-y x+y )
+ [ - ] [ + ] 2bi ; inline
+
+: sphere-t ( b d -- t )
+ -+ dup 0.0 <
+ [ 2drop 1/0. ] [ [ [ 0.0 > ] keep ] dip ? ] if ; inline
+
+: sphere-b&v ( sphere ray -- b v )
+ [ sphere-v ] [ nip ] 2bi
+ [ sphere-b ] [ drop ] 2bi ; inline
+
+: ray-sphere ( sphere ray -- t )
+ [ drop ] [ sphere-b&v ] 2bi
+ [ drop ] [ sphere-d ] 3bi
+ dup 0.0 < [ 3drop 1/0. ] [ sqrt sphere-t nip ] if ; inline
+
+: if-ray-sphere ( hit ray sphere quot -- hit )
+ #! quot: hit ray sphere l -- hit
+ [
+ [ ] [ swap ray-sphere nip ] [ 2drop lambda>> ] 3tri
+ [ drop ] [ < ] 2bi
+ ] dip [ 3drop ] if ; inline
+
+: sphere-n ( ray sphere l -- n )
+ [ [ orig>> ] [ dir>> ] bi ] [ center>> ] [ ] tri*
+ swap [ v*n ] dip v- v+ ; inline
+
+M: sphere intersect-scene ( hit ray sphere -- hit )
+ [ [ sphere-n normalize ] keep <hit> nip ] if-ray-sphere ;
+
+HINTS: M\ sphere intersect-scene { hit ray sphere } ;
+
+TUPLE: group < sphere { objs array read-only } ;
+
+: <group> ( objs bound -- group )
+ [ center>> ] [ radius>> ] bi rot group boa ; inline
+
+: make-group ( bound quot -- )
+ swap [ { } make ] dip <group> ; inline
+
+M: group intersect-scene ( hit ray group -- hit )
+ [ drop objs>> [ intersect-scene ] with each ] if-ray-sphere ;
+
+HINTS: M\ group intersect-scene { hit ray group } ;
+
+CONSTANT: initial-hit T{ hit f double-4{ 0.0 0.0 0.0 0.0 } 1/0. }
+
+: initial-intersect ( ray scene -- hit )
+ [ initial-hit ] 2dip intersect-scene ; inline
+
+: ray-o ( ray hit -- o )
+ [ [ orig>> ] [ normal>> delta v*n ] bi* ]
+ [ [ dir>> ] [ lambda>> ] bi* v*n ]
+ 2bi v+ v+ ; inline
+
+: sray-intersect ( ray scene hit -- ray )
+ swap [ ray-o light vneg <ray> ] dip initial-intersect ; inline
+
+: ray-g ( hit -- g ) normal>> light v. ; inline
+
+: cast-ray ( ray scene -- g )
+ 2dup initial-intersect dup lambda>> 1/0. = [
+ 3drop 0.0
+ ] [
+ [ sray-intersect lambda>> 1/0. = ] keep swap
+ [ ray-g neg ] [ drop 0.0 ] if
+ ] if ; inline
+
+: create-center ( c r d -- c2 )
+ [ 3.0 12.0 sqrt / * ] dip n*v v+ ; inline
+
+DEFER: create ( level c r -- scene )
+
+: create-step ( level c r d -- scene )
+ over [ create-center ] dip 2.0 / [ 1 - ] 2dip create ;
+
+: create-offsets ( quot -- )
+ {
+ double-4{ -1.0 1.0 -1.0 0.0 }
+ double-4{ 1.0 1.0 -1.0 0.0 }
+ double-4{ -1.0 1.0 1.0 0.0 }
+ double-4{ 1.0 1.0 1.0 0.0 }
+ } swap each ; inline
+
+: create-bound ( c r -- sphere ) 3.0 * <sphere> ;
+
+: create-group ( level c r -- scene )
+ 2dup create-bound [
+ 2dup <sphere> ,
+ [ [ 3dup ] dip create-step , ] create-offsets 3drop
+ ] make-group ;
+
+: create ( level c r -- scene )
+ pick 1 = [ <sphere> nip ] [ create-group ] if ;
+
+: ss-point ( dx dy -- point )
+ [ oversampling /f ] bi@ 0.0 0.0 double-4-boa ;
+
+: ss-grid ( -- ss-grid )
+ oversampling [ oversampling [ ss-point ] with map ] map ;
+
+: ray-grid ( point ss-grid -- ray-grid )
+ [
+ [ v+ normalize double-4{ 0.0 0.0 -4.0 0.0 } swap <ray> ] with map
+ ] with map ;
+
+: ray-pixel ( scene point -- n )
+ ss-grid ray-grid [ 0.0 ] 2dip
+ [ [ swap cast-ray + ] with each ] with each ;
+
+: pixel-grid ( -- grid )
+ size reverse [
+ size [
+ [ size 0.5 * - ] bi@ swap size
+ 0.0 double-4-boa
+ ] with map
+ ] map ;
+
+: pgm-header ( w h -- )
+ "P5\n" % swap # " " % # "\n255\n" % ;
+
+: pgm-pixel ( n -- ) 255 * 0.5 + >fixnum , ;
+
+: ray-trace ( scene -- pixels )
+ pixel-grid [ [ ray-pixel ] with map ] with map ;
+
+: run ( -- string )
+ levels double-4{ 0.0 -1.0 0.0 0.0 } 1.0 create ray-trace [
+ size size pgm-header
+ [ [ oversampling sq / pgm-pixel ] each ] each
+ ] B{ } make ;
+
+: raytracer-main ( -- )
+ run "raytracer.pnm" temp-file binary set-file-contents ;
+
+MAIN: raytracer-main
! Factor port of the raytracer benchmark from
! http://www.ffconsultancy.com/free/ray_tracer/languages.html
-
-USING: arrays accessors specialized-arrays.double io io.files
-io.files.temp io.encodings.binary kernel math math.functions
-math.vectors math.parser make sequences sequences.private words
-hints ;
+USING: arrays accessors specialized-arrays io
+io.files io.files.temp io.encodings.binary kernel math
+math.constants math.functions math.vectors math.parser make
+sequences sequences.private words hints ;
+FROM: alien.c-types => double ;
+SPECIALIZED-ARRAY: double
IN: benchmark.raytracer
! parameters
CONSTANT: size 200
-CONSTANT: delta 1.4901161193847656E-8
+: delta ( -- n ) epsilon sqrt ; inline
TUPLE: ray { orig double-array read-only } { dir double-array read-only } ;
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: fry kernel math random random.sfmt ;
+IN: benchmark.sfmt
+
+: sfmt-benchmark ( n -- )
+ >fixnum HEX: 533d <sfmt-19937> '[ _ random-32* drop ] times ;
+
+: sfmt-main ( -- ) 100000000 sfmt-benchmark ;
+
+MAIN: sfmt-main
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel io math math.functions math.parser math.vectors
+math.vectors.simd sequences specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+SIMD: c:float
+SPECIALIZED-ARRAY: float-4
+IN: benchmark.simd-1
+
+: <point> ( n -- float-4 )
+ >float [ sin ] [ cos 3 * ] [ sin sq 2 / ] tri
+ 0.0 float-4-boa ; inline
+
+: make-points ( len -- points )
+ iota [ <point> ] float-4-array{ } map-as ; inline
+
+: normalize-points ( points -- )
+ [ normalize ] change-each ; inline
+
+: max-points ( points -- point )
+ [ ] [ vmax ] map-reduce ; inline
+
+: print-point ( point -- )
+ [ number>string ] { } map-as ", " join print ; inline
+
+: simd-benchmark ( len -- )
+ >fixnum make-points [ normalize-points ] [ max-points ] bi print-point ;
+
+: main ( -- )
+ 10 [ 500000 simd-benchmark ] times ;
+
+MAIN: main
] [
number-of-requests
[ read1 write1 flush ] times
- counter get count-down
] if
] with-stream
] curry "Client handler" spawn drop server-loop ;
: clients ( n -- )
dup pprint " clients: " write [
<promise> port-promise set
- dup 2 * <count-down> counter set
+ dup <count-down> counter set
[ simple-server ] "Simple server" spawn drop
yield yield
[ [ simple-client ] "Simple client" spawn drop ] times
! Factor port of
! http://shootout.alioth.debian.org/gp4/benchmark.php?test=spectralnorm&lang=all
-USING: specialized-arrays.double kernel math math.functions
-math.vectors sequences sequences.private prettyprint words hints
+USING: alien.c-types specialized-arrays kernel math
+math.functions math.vectors sequences prettyprint words hints
locals ;
+SPECIALIZED-ARRAY: double
IN: benchmark.spectral-norm
:: inner-loop ( u n quot -- seq )
+ 1 + recip ; inline
: (eval-A-times-u) ( u i j -- x )
- tuck [ swap nth-unsafe ] [ eval-A ] 2bi* * ; inline
+ [ swap nth ] [ eval-A ] bi-curry bi* * ; inline
: eval-A-times-u ( n u -- seq )
[ (eval-A-times-u) ] inner-loop ; inline
: (eval-At-times-u) ( u i j -- x )
- tuck [ swap nth-unsafe ] [ swap eval-A ] 2bi* * ; inline
+ [ swap nth ] [ swap eval-A ] bi-curry bi* * ; inline
: eval-At-times-u ( u n -- seq )
[ (eval-At-times-u) ] inner-loop ; inline
! See http://factorcode.org/license.txt for BSD license.
USING: accessors classes.struct combinators.smart fry kernel
math math.functions math.order math.parser sequences
-struct-arrays io ;
+specialized-arrays io ;
+FROM: alien.c-types => float ;
IN: benchmark.struct-arrays
STRUCT: point { x float } { y float } { z float } ;
+SPECIALIZED-ARRAY: point
+
: xyz ( point -- x y z )
[ x>> ] [ y>> ] [ z>> ] tri ; inline
1 + ; inline
: make-points ( len -- points )
- point <struct-array> dup 0 [ init-point ] reduce drop ; inline
+ <point-array> dup 0 [ init-point ] reduce drop ; inline
: point-norm ( point -- norm )
[ xyz [ absq ] tri@ ] sum-outputs sqrt ; inline
: struct-array-benchmark ( len -- )
make-points [ normalize-points ] [ max-points ] bi print-point ;
-: main ( -- ) 5000000 struct-array-benchmark ;
+: main ( -- ) 10 [ 500000 struct-array-benchmark ] times ;
MAIN: main
! See http://factorcode.org/license.txt for BSD license.
USING: alien.accessors alien.c-types alien.syntax byte-arrays
destructors generalizations hints kernel libc locals math math.order
-sequences sequences.private ;
+sequences sequences.private classes.struct accessors alien.data ;
IN: benchmark.yuv-to-rgb
-C-STRUCT: yuv_buffer
- { "int" "y_width" }
- { "int" "y_height" }
- { "int" "y_stride" }
- { "int" "uv_width" }
- { "int" "uv_height" }
- { "int" "uv_stride" }
- { "void*" "y" }
- { "void*" "u" }
- { "void*" "v" } ;
+STRUCT: yuv_buffer
+ { y_width int }
+ { y_height int }
+ { y_stride int }
+ { uv_width int }
+ { uv_height int }
+ { uv_stride int }
+ { y void* }
+ { u void* }
+ { v void* } ;
:: fake-data ( -- rgb yuv )
[let* | w [ 1600 ]
h [ 1200 ]
- buffer [ "yuv_buffer" <c-object> ]
+ buffer [ yuv_buffer <struct> ]
rgb [ w h * 3 * <byte-array> ] |
- w buffer set-yuv_buffer-y_width
- h buffer set-yuv_buffer-y_height
- h buffer set-yuv_buffer-uv_height
- w buffer set-yuv_buffer-y_stride
- w buffer set-yuv_buffer-uv_stride
- w h * [ dup * ] B{ } map-as malloc-byte-array &free buffer set-yuv_buffer-y
- w h * 2/ [ dup dup * * ] B{ } map-as malloc-byte-array &free buffer set-yuv_buffer-u
- w h * 2/ [ dup * dup * ] B{ } map-as malloc-byte-array &free buffer set-yuv_buffer-v
rgb buffer
+ w >>y_width
+ h >>y_height
+ h >>uv_height
+ w >>y_stride
+ w >>uv_stride
+ w h * [ dup * ] B{ } map-as malloc-byte-array &free >>y
+ w h * 2/ [ dup dup * * ] B{ } map-as malloc-byte-array &free >>u
+ w h * 2/ [ dup * dup * ] B{ } map-as malloc-byte-array &free >>v
] ;
: clamp ( n -- n )
255 min 0 max ; inline
: stride ( line yuv -- uvy yy )
- [ yuv_buffer-uv_stride swap 2/ * ] [ yuv_buffer-y_stride * ] 2bi ; inline
+ [ uv_stride>> swap 2/ * ] [ y_stride>> * ] 2bi ; inline
: compute-y ( yuv uvy yy x -- y )
- + >fixnum nip swap yuv_buffer-y swap alien-unsigned-1 16 - ; inline
+ + >fixnum nip swap y>> swap alien-unsigned-1 16 - ; inline
: compute-v ( yuv uvy yy x -- v )
- nip 2/ + >fixnum swap yuv_buffer-u swap alien-unsigned-1 128 - ; inline
+ nip 2/ + >fixnum swap u>> swap alien-unsigned-1 128 - ; inline
: compute-u ( yuv uvy yy x -- v )
- nip 2/ + >fixnum swap yuv_buffer-v swap alien-unsigned-1 128 - ; inline
+ nip 2/ + >fixnum swap v>> swap alien-unsigned-1 128 - ; inline
:: compute-yuv ( yuv uvy yy x -- y u v )
yuv uvy yy x compute-y
: yuv>rgb-row ( index rgb yuv y -- index )
over stride
- pick yuv_buffer-y_width
+ pick y_width>>
[ yuv>rgb-pixel ] with with with with each ; inline
: yuv>rgb ( rgb yuv -- )
[ 0 ] 2dip
- dup yuv_buffer-y_height
+ dup y_height>>
[ yuv>rgb-row ] with with each
drop ;
-HINTS: yuv>rgb byte-array byte-array ;
+HINTS: yuv>rgb byte-array yuv_buffer ;
: yuv>rgb-benchmark ( -- )
[ fake-data yuv>rgb ] with-destructors ;
$nl
"Bloom filters cannot be resized and do not support removal."
$nl
-{ $subsection <bloom-filter> }
-{ $subsection bloom-filter-insert }
-{ $subsection bloom-filter-member? } ;
+{ $subsections
+ <bloom-filter>
+ bloom-filter-insert
+ bloom-filter-member?
+} ;
ABOUT: "bloom-filters"
! Make sure it's a fixnum here to speed up double-hashing.
: hashcodes-from-hashcode ( n -- n n )
- dup most-positive-fixnum >fixnum bitxor ;
+ dup most-positive-fixnum bitxor ;
: hashcodes-from-object ( obj -- n n )
hashcode abs hashcodes-from-hashcode ;
! See http://factorcode.org/license.txt for BSD license
USING: brainfuck kernel io.streams.string math math.parser math.ranges
-multiline quotations sequences tools.test ;
+quotations sequences tools.test ;
+IN: brainfuck.tests
[ "+" run-brainfuck ] must-infer
! Hello World!
-[ "Hello World!\n" ] [ <" ++++++++++[>+++++++>++++++++++>+++>+<<<<-]
+[ "Hello World!\n" ] [ """++++++++++[>+++++++>++++++++++>+++>+<<<<-]
>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.
- ------.--------.>+.>. "> get-brainfuck ] unit-test
+ ------.--------.>+.>.""" get-brainfuck ] unit-test
! Addition (single-digit)
! Multiplication (single-digit)
-[ "8\0" ] [ "24" [ <" ,>,>++++++++[<------<------>>-]
+[ "8\0" ] [ "24" [ """,>,>++++++++[<------<------>>-]
<<[>[>+>+<<-]>>[<<+>>-]<<<-]
- >>>++++++[<++++++++>-],<.>. ">
+ >>>++++++[<++++++++>-],<.>."""
get-brainfuck ] with-string-reader ] unit-test
! Division (single-digit, integer)
-[ "3" ] [ "62" [ <" ,>,>++++++[-<--------<-------->>]
+[ "3" ] [ "62" [ """,>,>++++++[-<--------<-------->>]
<<[
>[->+>+<<]
>[-<<-
<<[-<<+>>]
<<<]
>[-]>>>>[-<<<<<+>>>>>]
- <<<<++++++[-<++++++++>]<. ">
+ <<<<++++++[-<++++++++>]<."""
get-brainfuck ] with-string-reader ] unit-test
! Uppercase
! Squares of numbers from 0 to 100
100 [0,b] [ dup * number>string ] map "\n" join "\n" append 1quotation
-[ <" ++++[>+++++<-]>[<+++++>-]+<+[
+[ """++++[>+++++<-]>[<+++++>-]+<+[
>[>+>+<<-]++>>[<<+>>-]>>>[-]++>[-]+
>>>+[[-]++++++>>>]<<<[[<++++++++<++>>-]+<.<[>----<-]<]
<<[>>>>>[>>>[-]+++++++++<[>-<-]+++++++++>
- [-[<->-]+[<<<]]<[>+<-]>]<<-]<<-] ">
+ [-[<->-]+[<<<]]<[>+<-]>]<<-]<<-]"""
get-brainfuck ] unit-test
USING: alien.c-types continuations destructors kernel
-opengl opengl.gl bunny.model specialized-arrays.float
-accessors ;
+opengl opengl.gl bunny.model specialized-arrays accessors ;
+SPECIALIZED-ARRAY: float
IN: bunny.fixed-pipeline
TUPLE: bunny-fixed-pipeline ;
http.client io io.encodings.ascii io.files io.files.temp kernel
math math.matrices math.parser math.vectors opengl
opengl.capabilities opengl.gl opengl.demo-support sequences
-splitting vectors words specialized-arrays.float
-specialized-arrays.uint ;
+splitting vectors words specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
+SPECIALIZED-ARRAY: c:uint
IN: bunny.model
: numbers ( str -- seq )
ARTICLE: "combinators.tuple" "Tuple-constructing combinators"
"The " { $vocab-link "combinators.tuple" } " vocabulary provides dataflow combinators that construct " { $link tuple } " objects."
-{ $subsection make-tuple }
-{ $subsection 2make-tuple }
-{ $subsection 3make-tuple }
-{ $subsection nmake-tuple }
-;
+{ $subsections
+ make-tuple
+ 2make-tuple
+ 3make-tuple
+ nmake-tuple
+} ;
ABOUT: "combinators.tuple"
--- /dev/null
+IN: compiler.graphviz.tests
+USING: compiler.graphviz io.files kernel tools.test ;
+
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-cfg exists? ] unit-test
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-dom exists? ] unit-test
+[ t ] [ [ [ 1 ] [ 2 ] if ] render-call-graph exists? ] unit-test
"}" ,
] { } make , ; inline
-: render-graph ( quot -- )
+: render-graph ( quot -- name )
{ } make
"cfg" ".dot" make-unique-file
dup "Wrote " prepend print
[ [ concat ] dip ascii set-file-lines ]
[ { "dot" "-Tpng" "-O" } swap suffix try-process ]
- [ ".png" append "open" swap 2array try-process ]
+ [ ".png" append ]
tri ; inline
+: display-graph ( name -- )
+ "open" swap 2array try-process ;
+
: attrs>string ( seq -- str )
[ "" ] [ "," join "[" "]" surround ] if-empty ;
: optimized-cfg ( quot -- cfgs )
{
{ [ dup cfg? ] [ 1array ] }
- { [ dup quotation? ] [ test-cfg [ optimize-cfg ] map ] }
- { [ dup word? ] [ test-cfg [ optimize-cfg ] map ] }
+ { [ dup quotation? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
+ { [ dup word? ] [ test-cfg [ dup cfg set optimize-cfg ] map ] }
[ ]
} cond ;
-: render-cfg ( cfg -- )
+: render-cfg ( cfg -- name )
optimized-cfg [ cfgs ] render-graph ;
: dom-trees ( cfgs -- )
] over cfg-title graph,
] each ;
-: render-dom ( cfg -- )
+: render-dom ( cfg -- name )
optimized-cfg [ dom-trees ] render-graph ;
SYMBOL: word-counts
H{ } clone vertex-names set
[ "ROOT" ] dip (call-graph-edges) ;
-: render-call-graph ( tree -- )
+: render-call-graph ( tree -- name )
dup quotation? [ build-tree ] when
analyze-recursive drop
[ [ call-graph get call-graph-edges ] "Call graph" graph, ]
"The " { $vocab-link "crypto.passwd-md5" } " vocabulary can encode passwords for use in an MD5 shadow password file." $nl
"Encoding a password:"
-{ $subsection passwd-md5 }
+{ $subsections passwd-md5 }
"Parsing a shadowed password entry:"
-{ $subsection parse-shadow-password }
+{ $subsections parse-shadow-password }
"Authenticating against a shadowed password:"
-{ $subsection authenticate-password } ;
+{ $subsections authenticate-password } ;
ABOUT: "crypto.passwd-md5"
ARTICLE: "ctags" "Ctags file"
{ $emphasis "ctags" } " generates a index file of every factor word in ctags format as supported by vi and other editors. More information can be found at " { $url "http://en.wikipedia.org/wiki/Ctags" } "."
-{ $subsection ctags }
-{ $subsection ctags-write }
-{ $subsection ctag-strings }
-{ $subsection ctag }
-{ $subsection ctag-word }
-{ $subsection ctag-path }
-{ $subsection ctag-lineno } ;
+{ $subsections
+ ctags
+ ctags-write
+ ctag-strings
+ ctag
+ ctag-word
+ ctag-path
+ ctag-lineno
+} ;
HELP: ctags ( path -- )
{ $values { "path" "a pathname string" } }
ARTICLE: "etags" "Etags file"
{ $emphasis "Etags" } " generates a index file of every factor word in etags format as supported by emacs and other editors. More information can be found at " { $url "http://en.wikipedia.org/wiki/Ctags#Etags_2" } "."
-{ $subsection etags }
-{ $subsection etags-write }
-{ $subsection etag-strings }
-{ $subsection etag-header }
+{ $subsections
+ etags
+ etags-write
+ etag-strings
+ etag-header
+}
HELP: etags ( path -- )
{ $values { "path" string } }
USING: accessors alien.c-types alien.strings assocs byte-arrays
combinators continuations destructors fry io.encodings.8-bit
io io.encodings.string io.encodings.utf8 kernel math
-namespaces prettyprint sequences
+namespaces prettyprint sequences classes.struct
strings threads curses.ffi ;
IN: curses
: move-cursor ( window-name y x -- )
[
- window-ptr
+ window-ptr c-window memory>struct
{
[ ]
[ (curses-window-refresh) ]
- [ c-window-_curx ]
- [ c-window-_cury ]
+ [ _curx>> ]
+ [ _cury>> ]
} cleave
] 2dip mvcur curses-error (curses-window-refresh) ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.syntax combinators kernel system
-alien.libraries ;
+alien.libraries classes.struct ;
IN: curses.ffi
<< "curses" {
{ [ os unix? ] [ "libcurses.so" ] }
} cond "cdecl" add-library >>
-TYPEDEF: void* WINDOW*
-TYPEDEF: void* SCREEN*
+C-TYPE: WINDOW
+C-TYPE: SCREEN
TYPEDEF: void* va_list
TYPEDEF: uint chtype
CONSTANT: CCHARW_MAX 5
-C-STRUCT: cchar_t
- { "attr_t" "attr" }
- { { "wchar_t" CCHARW_MAX } "chars" } ;
+STRUCT: cchar_t
+ { attr attr_t }
+ { chars { wchar_t CCHARW_MAX } } ;
-C-STRUCT: pdat
- { "NCURSES_SIZE_T" "_pad_y" }
- { "NCURSES_SIZE_T" "_pad_x" }
- { "NCURSES_SIZE_T" "_pad_top" }
- { "NCURSES_SIZE_T" "_pad_left" }
- { "NCURSES_SIZE_T" "_pad_bottom" }
- { "NCURSES_SIZE_T" "_pad_right" } ;
+STRUCT: pdat
+ { _pad_y NCURSES_SIZE_T }
+ { _pad_x NCURSES_SIZE_T }
+ { _pad_top NCURSES_SIZE_T }
+ { _pad_left NCURSES_SIZE_T }
+ { _pad_bottom NCURSES_SIZE_T }
+ { _pad_right NCURSES_SIZE_T } ;
-C-STRUCT: c-window
- { "NCURSES_SIZE_T" "_cury" }
- { "NCURSES_SIZE_T" "_curx" }
+STRUCT: c-window
+ { _cury NCURSES_SIZE_T }
+ { _curx NCURSES_SIZE_T }
- { "NCURSES_SIZE_T" "_maxy" }
- { "NCURSES_SIZE_T" "_maxx" }
- { "NCURSES_SIZE_T" "_begy" }
- { "NCURSES_SIZE_T" "_begx" }
+ { _maxy NCURSES_SIZE_T }
+ { _maxx NCURSES_SIZE_T }
+ { _begy NCURSES_SIZE_T }
+ { _begx NCURSES_SIZE_T }
- { "short" " _flags" }
+ { _flags short }
- { "attr_t" "_attrs" }
- { "chtype" "_bkgd" }
+ { _attrs attr_t }
+ { _bkgd chtype }
- { "bool" "_notimeout" }
- { "bool" "_clear" }
- { "bool" "_leaveok" }
- { "bool" "_scroll" }
- { "bool" "_idlok" }
- { "bool" "_idcok" }
- { "bool" "_immed" }
- { "bool" "_sync" }
- { "bool" "_use_keypad" }
- { "int" "_delay" }
+ { _notimeout bool }
+ { _clear bool }
+ { _leaveok bool }
+ { _scroll bool }
+ { _idlok bool }
+ { _idcok bool }
+ { _immed bool }
+ { _sync bool }
+ { _use_keypad bool }
+ { _delay int }
- { "char*" "_line" }
- { "NCURSES_SIZE_T" "_regtop" }
- { "NCURSES_SIZE_T" "_regbottom" }
+ { _line char* }
+ { _regtop NCURSES_SIZE_T }
+ { _regbottom NCURSES_SIZE_T }
- { "int" "_parx" }
- { "int" "_pary" }
- { "WINDOW*" "_parent" }
+ { _parx int }
+ { _pary int }
+ { _parent WINDOW* }
- { "pdat" "_pad" }
+ { _pad pdat }
- { "NCURSES_SIZE_T" "_yoffset" }
+ { _yoffset NCURSES_SIZE_T }
- { "cchar_t" "_bkgrnd" } ;
+ { _bkgrnd cchar_t } ;
LIBRARY: curses
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: continuations decimals grouping kernel locals math
+math.functions math.order math.ratios prettyprint random
+sequences tools.test ;
+IN: decimals.tests
+
+[ t ] [
+ D: 12.34 D: 00012.34000 =
+] unit-test
+
+: random-test-int ( -- n )
+ 10 random 2 random 0 = [ neg ] when ;
+
+: random-test-decimal ( -- decimal )
+ random-test-int random-test-int <decimal> ;
+
+ERROR: decimal-test-failure D1 D2 quot ;
+
+:: (test-decimal-op) ( D1 D2 quot1 quot2 -- ? )
+ D1 D2
+ quot1 [ decimal>ratio >float ] compose
+ [ [ decimal>ratio ] bi@ quot2 call( obj obj -- obj ) >float ] 2bi -.1 ~
+ [ t ] [ D1 D2 quot1 decimal-test-failure ] if ; inline
+
+: test-decimal-op ( quot1 quot2 -- ? )
+ [ random-test-decimal random-test-decimal ] 2dip (test-decimal-op) ; inline
+
+[ t ] [ 1000 [ drop [ D+ ] [ + ] test-decimal-op ] all? ] unit-test
+[ t ] [ 1000 [ drop [ D- ] [ - ] test-decimal-op ] all? ] unit-test
+[ t ] [ 1000 [ drop [ D* ] [ * ] test-decimal-op ] all? ] unit-test
+[ t ] [
+ 1000 [
+ drop
+ [ [ 100 D/ ] [ /f ] test-decimal-op ]
+ [ { "kernel-error" 4 f f } = ] recover
+ ] all?
+] unit-test
+
+[ t ] [
+ { D: 0. D: .0 D: 0.0 D: 00.00 D: . } all-equal?
+] unit-test
+
+[ t ] [ T{ decimal f 90 0 } T{ decimal f 9 1 } = ] unit-test
+
+[ t ] [ D: 1 D: 2 before? ] unit-test
+[ f ] [ D: 2 D: 2 before? ] unit-test
+[ f ] [ D: 3 D: 2 before? ] unit-test
+[ f ] [ D: -1 D: -2 before? ] unit-test
+[ f ] [ D: -2 D: -2 before? ] unit-test
+[ t ] [ D: -3 D: -2 before? ] unit-test
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors combinators.short-circuit kernel lexer math
+math.functions math.parser parser sequences splitting
+locals math.order ;
+IN: decimals
+
+TUPLE: decimal { mantissa read-only } { exponent read-only } ;
+
+: <decimal> ( mantissa exponent -- decimal ) decimal boa ;
+
+: >decimal< ( decimal -- mantissa exponent )
+ [ mantissa>> ] [ exponent>> ] bi ; inline
+
+: string>decimal ( string -- decimal )
+ "." split1
+ [ [ CHAR: 0 = ] trim-head [ "0" ] when-empty ]
+ [ [ CHAR: 0 = ] trim-tail [ "" ] when-empty ] bi*
+ [ append string>number ] [ nip length neg ] 2bi <decimal> ;
+
+: parse-decimal ( -- decimal ) scan string>decimal ;
+
+SYNTAX: D: parse-decimal parsed ;
+
+: decimal>ratio ( decimal -- ratio ) >decimal< 10^ * ;
+: decimal>float ( decimal -- ratio ) decimal>ratio >float ;
+
+: scale-mantissas ( D1 D2 -- m1 m2 exp )
+ [ [ mantissa>> ] bi@ ]
+ [
+ [ exponent>> ] bi@
+ [
+ - dup 0 <
+ [ neg 10^ * t ]
+ [ 10^ [ * ] curry dip f ] if
+ ] [ ? ] 2bi
+ ] 2bi ;
+
+: scale-decimals ( D1 D2 -- D1' D2' )
+ [ drop ]
+ [ scale-mantissas <decimal> nip ] 2bi ;
+
+ERROR: decimal-types-expected d1 d2 ;
+
+: guard-decimals ( obj1 obj2 -- D1 D2 )
+ 2dup [ decimal? ] both?
+ [ decimal-types-expected ] unless ;
+
+M: decimal equal?
+ {
+ [ [ decimal? ] both? ]
+ [
+ scale-decimals
+ {
+ [ [ mantissa>> ] bi@ = ]
+ [ [ exponent>> ] bi@ = ]
+ } 2&&
+ ]
+ } 2&& ;
+
+M: decimal before?
+ guard-decimals scale-decimals
+ [ mantissa>> ] bi@ < ;
+
+: D-abs ( D -- D' )
+ [ mantissa>> abs ] [ exponent>> ] bi <decimal> ;
+
+: D+ ( D1 D2 -- D3 )
+ guard-decimals scale-mantissas [ + ] dip <decimal> ;
+
+: D- ( D1 D2 -- D3 )
+ guard-decimals scale-mantissas [ - ] dip <decimal> ;
+
+: D* ( D1 D2 -- D3 )
+ guard-decimals [ >decimal< ] bi@ swapd + [ * ] dip <decimal> ;
+
+:: D/ ( D1 D2 a -- D3 )
+ D1 D2 guard-decimals 2drop
+ D1 >decimal< :> e1 :> m1
+ D2 >decimal< :> e2 :> m2
+ m1 a 10^ *
+ m2 /i
+
+ e1
+ e2 a + - <decimal> ;
\r
ARTICLE: "descriptive" "Descriptive errors"\r
"This vocabulary defines automatic descriptive errors. Using it, you can define a word which acts as normal, except when it throws an error, the error is wrapped in an instance of a class:"\r
-{ $subsection descriptive-error }\r
+{ $subsections descriptive-error }\r
"The wrapper contains the word itself, the input parameters, as well as the original error."\r
$nl\r
"To annotate an existing word with descriptive error checking:"\r
-{ $subsection make-descriptive }\r
+{ $subsections make-descriptive }\r
"To define words which throw descriptive errors, use the following words:"\r
-{ $subsection POSTPONE: DESCRIPTIVE: }\r
-{ $subsection POSTPONE: DESCRIPTIVE:: } ;\r
+{ $subsections\r
+ POSTPONE: DESCRIPTIVE:\r
+ POSTPONE: DESCRIPTIVE::\r
+} ;\r
\r
ABOUT: "descriptive"\r
USING: kernel accessors sequences sequences.private destructors math namespaces
locals openssl openssl.libcrypto byte-arrays bit-arrays.private
- alien.c-types alien.destructors ;
+ alien.c-types alien.destructors alien.data ;
IN: ecdsa
ARTICLE: "env" "Accessing the environment via the assoc protocol"
"The " { $vocab-link "env" } " vocabulary defines a " { $link env } " word which implements the " { $link "assocs-protocol" } " over " { $link "environment" } "."
-{ $subsection env }
+{ $subsections env }
;
ABOUT: "env"
! Copyright (C) 2005, 2007 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel system combinators
-alien.libraries ;
+USING: alien alien.c-types alien.syntax kernel system combinators
+alien.libraries classes.struct ;
IN: freetype
<< "freetype" {
TYPEDEF: long FT_Long
TYPEDEF: ulong FT_ULong
TYPEDEF: uchar FT_Bool
-TYPEDEF: cell FT_Offset
+TYPEDEF: ulong FT_Offset
TYPEDEF: int FT_PtrDist
TYPEDEF: char FT_String
TYPEDEF: int FT_Tag
FUNCTION: FT_Error FT_Init_FreeType ( void* library ) ;
! circular reference between glyph and face
-TYPEDEF: void face
-TYPEDEF: void glyph
+C-TYPE: face
+C-TYPE: glyph
-C-STRUCT: glyph
- { "void*" "library" }
- { "face*" "face" }
- { "glyph*" "next" }
- { "FT_UInt" "reserved" }
- { "void*" "generic" }
- { "void*" "generic" }
+STRUCT: glyph
+ { library void* }
+ { face face* }
+ { next glyph* }
+ { reserved FT_UInt }
+ { generic void* }
+ { generic2 void* }
- { "FT_Pos" "width" }
- { "FT_Pos" "height" }
+ { width FT_Pos }
+ { height FT_Pos }
- { "FT_Pos" "hori-bearing-x" }
- { "FT_Pos" "hori-bearing-y" }
- { "FT_Pos" "hori-advance" }
+ { hori-bearing-x FT_Pos }
+ { hori-bearing-y FT_Pos }
+ { hori-advance FT_Pos }
- { "FT_Pos" "vert-bearing-x" }
- { "FT_Pos" "vert-bearing-y" }
- { "FT_Pos" "vert-advance" }
+ { vert-bearing-x FT_Pos }
+ { vert-bearing-y FT_Pos }
+ { vert-advance FT_Pos }
- { "FT_Fixed" "linear-hori-advance" }
- { "FT_Fixed" "linear-vert-advance" }
- { "FT_Pos" "advance-x" }
- { "FT_Pos" "advance-y" }
+ { linear-hori-advance FT_Fixed }
+ { linear-vert-advance FT_Fixed }
+ { advance-x FT_Pos }
+ { advance-y FT_Pos }
- { "intptr_t" "format" }
+ { format intptr_t }
- { "int" "bitmap-rows" }
- { "int" "bitmap-width" }
- { "int" "bitmap-pitch" }
- { "void*" "bitmap-buffer" }
- { "short" "bitmap-num-grays" }
- { "char" "bitmap-pixel-mode" }
- { "char" "bitmap-palette-mode" }
- { "void*" "bitmap-palette" }
+ { bitmap-rows int }
+ { bitmap-width int }
+ { bitmap-pitch int }
+ { bitmap-buffer void* }
+ { bitmap-num-grays short }
+ { bitmap-pixel-mode char }
+ { bitmap-palette-mode char }
+ { bitmap-palette void* }
- { "FT_Int" "bitmap-left" }
- { "FT_Int" "bitmap-top" }
+ { bitmap-left FT_Int }
+ { bitmap-top FT_Int }
- { "short" "n-contours" }
- { "short" "n-points" }
+ { n-contours short }
+ { n-points short }
- { "void*" "points" }
- { "char*" "tags" }
- { "short*" "contours" }
+ { points void* }
+ { tags char* }
+ { contours short* }
- { "int" "outline-flags" }
+ { outline-flags int }
- { "FT_UInt" "num_subglyphs" }
- { "void*" "subglyphs" }
+ { num_subglyphs FT_UInt }
+ { subglyphs void* }
- { "void*" "control-data" }
- { "long" "control-len" }
+ { control-data void* }
+ { control-len long }
- { "FT_Pos" "lsb-delta" }
- { "FT_Pos" "rsb-delta" }
+ { lsb-delta FT_Pos }
+ { rsb-delta FT_Pos }
- { "void*" "other" } ;
+ { other void* } ;
-C-STRUCT: face-size
- { "face*" "face" }
- { "void*" "generic" }
- { "void*" "generic" }
+STRUCT: face-size
+ { face face* }
+ { generic void* }
+ { generic2 void* }
- { "FT_UShort" "x-ppem" }
- { "FT_UShort" "y-ppem" }
+ { x-ppem FT_UShort }
+ { y-ppem FT_UShort }
- { "FT_Fixed" "x-scale" }
- { "FT_Fixed" "y-scale" }
+ { x-scale FT_Fixed }
+ { y-scale FT_Fixed }
- { "FT_Pos" "ascender" }
- { "FT_Pos" "descender" }
- { "FT_Pos" "height" }
- { "FT_Pos" "max-advance" } ;
+ { ascender FT_Pos }
+ { descender FT_Pos }
+ { height FT_Pos }
+ { max-advance FT_Pos } ;
-C-STRUCT: face
- { "FT_Long" "num-faces" }
- { "FT_Long" "index" }
+STRUCT: face
+ { num-faces FT_Long }
+ { index FT_Long }
- { "FT_Long" "flags" }
- { "FT_Long" "style-flags" }
+ { flags FT_Long }
+ { style-flags FT_Long }
- { "FT_Long" "num-glyphs" }
+ { num-glyphs FT_Long }
- { "FT_Char*" "family-name" }
- { "FT_Char*" "style-name" }
+ { family-name FT_Char* }
+ { style-name FT_Char* }
- { "FT_Int" "num-fixed-sizes" }
- { "void*" "available-sizes" }
+ { num-fixed-sizes FT_Int }
+ { available-sizes void* }
- { "FT_Int" "num-charmaps" }
- { "void*" "charmaps" }
+ { num-charmaps FT_Int }
+ { charmaps void* }
- { "void*" "generic" }
- { "void*" "generic" }
+ { generic void* }
+ { generic2 void* }
- { "FT_Pos" "x-min" }
- { "FT_Pos" "y-min" }
- { "FT_Pos" "x-max" }
- { "FT_Pos" "y-max" }
+ { x-min FT_Pos }
+ { y-min FT_Pos }
+ { x-max FT_Pos }
+ { y-max FT_Pos }
- { "FT_UShort" "units-per-em" }
- { "FT_Short" "ascender" }
- { "FT_Short" "descender" }
- { "FT_Short" "height" }
+ { units-per-em FT_UShort }
+ { ascender FT_Short }
+ { descender FT_Short }
+ { height FT_Short }
- { "FT_Short" "max-advance-width" }
- { "FT_Short" "max-advance-height" }
+ { max-advance-width FT_Short }
+ { max-advance-height FT_Short }
- { "FT_Short" "underline-position" }
- { "FT_Short" "underline-thickness" }
+ { underline-position FT_Short }
+ { underline-thickness FT_Short }
- { "glyph*" "glyph" }
- { "face-size*" "size" }
- { "void*" "charmap" } ;
+ { glyph glyph* }
+ { size face-size* }
+ { charmap void* } ;
-C-STRUCT: FT_Bitmap
- { "int" "rows" }
- { "int" "width" }
- { "int" "pitch" }
- { "void*" "buffer" }
- { "short" "num_grays" }
- { "char" "pixel_mode" }
- { "char" "palette_mode" }
- { "void*" "palette" } ;
+STRUCT: FT_Bitmap
+ { rows int }
+ { width int }
+ { pitch int }
+ { buffer void* }
+ { num_grays short }
+ { pixel_mode char }
+ { palette_mode char }
+ { palette void* } ;
+
+TYPEDEF: void* FT_Face*
FUNCTION: FT_Error FT_New_Face ( void* library, FT_Char* font, FT_Long index, face* face ) ;
ARTICLE: "gpu.buffers" "Buffer objects"
"The " { $vocab-link "gpu.buffers" } " vocabulary provides words for creating, allocating, updating, and reading GPU data buffers."
-{ $subsection buffer }
-{ $subsection <buffer> }
-{ $subsection byte-array>buffer }
+{ $subsections
+ buffer
+ <buffer>
+ byte-array>buffer
+}
"Declaring buffer usage:"
-{ $subsection buffer-kind }
-{ $subsection buffer-upload-pattern }
-{ $subsection buffer-usage-pattern }
+{ $subsections
+ buffer-kind
+ buffer-upload-pattern
+ buffer-usage-pattern
+}
"Referencing buffer data:"
-{ $subsection buffer-ptr }
-{ $subsection buffer-range }
+{ $subsections
+ buffer-ptr
+ buffer-range
+}
"Manipulating buffer data:"
-{ $subsection allocate-buffer }
-{ $subsection update-buffer }
-{ $subsection read-buffer }
-{ $subsection copy-buffer }
-{ $subsection with-mapped-buffer }
+{ $subsections
+ allocate-buffer
+ update-buffer
+ read-buffer
+ copy-buffer
+ with-mapped-buffer
+}
;
ABOUT: "gpu.buffers"
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types arrays combinators combinators.short-circuit
-game-worlds gpu gpu.buffers gpu.util.wasd gpu.framebuffers gpu.render
-gpu.shaders gpu.state gpu.textures gpu.util grouping http.client images
-images.loader io io.encodings.ascii io.files io.files.temp
-kernel math math.matrices math.parser math.vectors
-method-chains sequences specialized-arrays.float specialized-vectors.uint splitting
-struct-vectors threads ui ui.gadgets ui.gadgets.worlds
-ui.pixel-formats ;
+USING: accessors alien.c-types arrays classes.struct combinators
+combinators.short-circuit game-worlds gpu gpu.buffers
+gpu.util.wasd gpu.framebuffers gpu.render gpu.shaders gpu.state
+gpu.textures gpu.util grouping http.client images images.loader
+io io.encodings.ascii io.files io.files.temp kernel math
+math.matrices math.parser math.vectors method-chains sequences
+splitting threads ui ui.gadgets ui.gadgets.worlds
+ui.pixel-formats specialized-arrays specialized-vectors ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
+SPECIALIZED-VECTOR: uint
IN: gpu.demos.bunny
GLSL-SHADER-FILE: bunny-vertex-shader vertex-shader "bunny.v.glsl"
{ f float-components 1 f } ;
VERTEX-STRUCT: bunny-vertex-struct bunny-vertex
+SPECIALIZED-VECTOR: bunny-vertex-struct
+
UNIFORM-TUPLE: bunny-uniforms < mvp-uniforms
{ "light-position" vec3-uniform f }
{ "color" vec4-uniform f }
" " split [ string>number ] map sift ;
: <bunny-vertex> ( vertex -- struct )
- >float-array
- "bunny-vertex-struct" <c-object>
- [ set-bunny-vertex-struct-vertex ] keep ;
+ bunny-vertex-struct <struct>
+ swap >float-array >>vertex ; inline
: (parse-bunny-model) ( vs is -- vs is )
readln [
] when* ;
: parse-bunny-model ( -- vertexes indexes )
- 100000 "bunny-vertex-struct" <struct-vector>
+ 100000 <bunny-vertex-struct-vector>
100000 <uint-vector>
(parse-bunny-model) ;
: calc-bunny-normal ( vertexes indexes -- )
swap
- [ [ nth bunny-vertex-struct-vertex ] curry { } map-as normal ]
- [
- [
- nth [ bunny-vertex-struct-normal v+ ] keep
- set-bunny-vertex-struct-normal
- ] curry with each
- ] 2bi ;
+ [ [ nth vertex>> ] curry { } map-as normal ]
+ [ [ nth [ v+ ] change-normal drop ] curry with each ] 2bi ;
: calc-bunny-normals ( vertexes indexes -- )
3 <groups>
[ calc-bunny-normal ] with each ;
: normalize-bunny-normals ( vertexes -- )
- [
- [ bunny-vertex-struct-normal normalize ] keep
- set-bunny-vertex-struct-normal
- ] each ;
+ [ [ normalize ] change-normal drop ] each ;
: bunny-data ( filename -- vertexes indexes )
ascii [ parse-bunny-model ] with-file-reader
--- /dev/null
+USING: tools.deploy.config ;
+H{
+ { deploy-name "gpu.demos.bunny" }
+ { deploy-word-defs? f }
+ { deploy-io 3 }
+ { "stop-after-last-window?" t }
+ { deploy-math? t }
+ { deploy-word-props? f }
+ { deploy-threads? t }
+ { deploy-c-types? f }
+ { deploy-reflection 2 }
+ { deploy-unicode? f }
+ { deploy-ui? t }
+}
ARTICLE: "gpu.framebuffers" "Framebuffer objects"
"The " { $vocab-link "gpu.framebuffers" } " vocabulary provides words for creating, allocating, and reading from framebuffer objects. Framebuffer objects are used as rendering targets; the " { $link system-framebuffer } " is supplied by the window system and contains the contents of the window on screen. User-created " { $link framebuffer } " objects can also be created to direct rendering output to offscreen " { $link texture } "s or " { $link renderbuffer } "s."
-{ $subsection system-framebuffer }
-{ $subsection framebuffer }
-{ $subsection renderbuffer }
+{ $subsections
+ system-framebuffer
+ framebuffer
+ renderbuffer
+}
"The contents of a framebuffer can be cleared to known values before rendering a scene:"
-{ $subsection clear-framebuffer }
-{ $subsection clear-framebuffer-attachment }
+{ $subsections
+ clear-framebuffer
+ clear-framebuffer-attachment
+}
"The image memory for a renderbuffer can be resized, or the full set of textures and renderbuffers attached to a framebuffer can be resized to the same dimensions together:"
-{ $subsection allocate-renderbuffer }
-{ $subsection resize-framebuffer }
+{ $subsections
+ allocate-renderbuffer
+ resize-framebuffer
+}
"Rectangular regions of framebuffers can be read into memory, read into GPU " { $link buffer } "s, and copied between framebuffers:"
-{ $subsection framebuffer-rect }
-{ $subsection attachment-ref }
-{ $subsection read-framebuffer }
-{ $subsection read-framebuffer-to }
-{ $subsection read-framebuffer-image }
-{ $subsection copy-framebuffer } ;
+{ $subsections
+ framebuffer-rect
+ attachment-ref
+ read-framebuffer
+ read-framebuffer-to
+ read-framebuffer-image
+ copy-framebuffer
+} ;
ABOUT: "gpu.framebuffers"
destructors gpu gpu.buffers gpu.private gpu.textures
gpu.textures.private images kernel locals math math.rectangles opengl
opengl.framebuffers opengl.gl opengl.textures sequences
-specialized-arrays.int specialized-arrays.uint
-ui.gadgets.worlds variants ;
+specialized-arrays ui.gadgets.worlds variants ;
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: uint
IN: gpu.framebuffers
SINGLETON: system-framebuffer
ARTICLE: "gpu" "Graphics context management"
"Preparing the GPU library:"
-{ $subsection init-gpu }
+{ $subsections init-gpu }
"Forcing execution of queued commands:"
-{ $subsection flush-gpu }
-{ $subsection finish-gpu }
+{ $subsections
+ flush-gpu
+ finish-gpu
+}
"Resetting OpenGL state:"
-{ $subsection reset-gpu } ;
+{ $subsections reset-gpu } ;
ARTICLE: "gpu-summary" "GPU-accelerated rendering"
"The " { $vocab-link "gpu" } " library is a set of vocabularies that work together to provide a convenient interface to creating, managing, and using GPU resources."
-{ $subsection "gpu" }
-{ $subsection "gpu.state" }
-{ $subsection "gpu.buffers" }
-{ $subsection "gpu.textures" }
-{ $subsection "gpu.framebuffers" }
-{ $subsection "gpu.shaders" }
-{ $subsection "gpu.render" }
+{ $subsections
+ "gpu"
+ "gpu.state"
+ "gpu.buffers"
+ "gpu.textures"
+ "gpu.framebuffers"
+ "gpu.shaders"
+ "gpu.render"
+}
"The library is built on top of the OpenGL API, but it aims to be complete enough that raw OpenGL calls are never needed. OpenGL 2.0 with the vertex array object extension (" { $snippet "GL_APPLE_vertex_array_object" } " or " { $snippet "GL_ARB_vertex_array_object" } ") is required. Some features require later OpenGL versions or additional extensions; these requirements are documented alongside individual words. To make full use of the library, an OpenGL 3.1 or later implementation is recommended." ;
ABOUT: "gpu-summary"
! (c)2009 Joe Groff bsd license
-USING: alien alien.syntax byte-arrays classes gpu.buffers
-gpu.framebuffers gpu.shaders gpu.textures help.markup
-help.syntax images kernel math multiline sequences
-specialized-arrays.alien specialized-arrays.uint
-specialized-arrays.ulong strings ;
+USING: alien alien.c-types alien.syntax byte-arrays classes
+gpu.buffers gpu.framebuffers gpu.shaders gpu.textures help.markup
+help.syntax images kernel math sequences
+specialized-arrays strings ;
+QUALIFIED-WITH: alien.c-types c
+QUALIFIED-WITH: math m
+SPECIALIZED-ARRAY: c:float
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ulong
+SPECIALIZED-ARRAY: void*
IN: gpu.render
HELP: <index-elements>
{ $description "Constructs a " { $link multi-index-range } " tuple." } ;
HELP: UNIFORM-TUPLE:
-{ $syntax <" UNIFORM-TUPLE: class-name
+{ $syntax """UNIFORM-TUPLE: class-name
{ "slot" uniform-type dimension }
{ "slot" uniform-type dimension }
...
- { "slot" uniform-type dimension } ; "> }
+ { "slot" uniform-type dimension } ;""" }
{ $description "Defines a new " { $link uniform-tuple } " class. Tuples of the new class can be used as the " { $snippet "uniforms" } " slot of a " { $link render-set } " in order to set the uniform parameters of the active shader program. The " { $link uniform-type } " of each slot defines the component type, and the " { $snippet "dimension" } " specifies an array length if not " { $link f } "."
$nl
"Uniform parameters are passed from Factor to the shader program through the uniform tuple as follows:"
{ $list
{ { $link int-uniform } "s and " { $link uint-uniform } "s take their values from Factor " { $link integer } "s." }
-{ { $link float-uniform } "s take their values from Factor " { $link float } "s." }
+{ { $link float-uniform } "s take their values from Factor " { $link m:float } "s." }
{ { $link bool-uniform } "s take their values from Factor " { $link boolean } "s." }
{ { $link texture-uniform } "s take their values from " { $link texture } " objects." }
{ "Vector uniforms take their values from Factor " { $link sequence } "s of the corresponding component type."
ARTICLE: "gpu.render" "Rendering"
"The " { $vocab-link "gpu.render" } " vocabulary contains words for organizing and submitting data to the GPU for rendering."
-{ $subsection render }
-{ $subsection render-set }
+{ $subsections
+ render
+ render-set
+}
{ $link uniform-tuple } "s provide Factor types for containing and submitting shader uniform parameters:"
-{ $subsection POSTPONE: UNIFORM-TUPLE: }
+{ $subsections POSTPONE: UNIFORM-TUPLE: }
;
ABOUT: "gpu.render"
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types alien.structs arrays
+USING: accessors alien alien.c-types alien.data arrays
assocs classes classes.mixin classes.parser classes.singleton
classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
generic generic.parser gpu gpu.buffers gpu.framebuffers
gpu.textures gpu.textures.private half-floats images kernel
lexer locals math math.order math.parser namespaces opengl
opengl.gl parser quotations sequences slots sorting
-specialized-arrays.alien specialized-arrays.float specialized-arrays.int
-specialized-arrays.uint strings ui.gadgets.worlds variants
+specialized-arrays strings ui.gadgets.worlds variants
vocabs.parser words ;
+FROM: math => float ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: void*
IN: gpu.render
UNION: ?integer integer POSTPONE: f ;
! (c)2009 Joe Groff bsd license
-USING: alien.syntax classes gpu.buffers help.markup help.syntax
-images kernel math multiline quotations sequences strings ;
+USING: classes classes.struct gpu.buffers help.markup help.syntax
+images kernel math multiline quotations sequences strings words ;
IN: gpu.shaders
HELP: <program-instance>
{ $description "Defines a new " { $link shader } " of kind " { $link shader-kind } " named " { $snippet "shader-name" } ". The shader will read its source code from " { $snippet "filename" } " in the current Factor source file's directory." } ;
HELP: GLSL-SHADER:
-{ $syntax <" GLSL-SHADER-FILE: shader-name shader-kind
+{ $syntax """GLSL-SHADER-FILE: shader-name shader-kind
shader source
-; "> }
+;""" }
{ $description "Defines a new " { $link shader } " of kind " { $link shader-kind } " named " { $snippet "shader-name" } ". The shader will read its source code from the current Factor source file between the " { $snippet "GLSL-SHADER:" } " line and the first subsequent line with a single semicolon on it." } ;
HELP: VERTEX-FORMAT:
-{ $syntax <" VERTEX-FORMAT: format-name
+{ $syntax """VERTEX-FORMAT: format-name
{ "attribute"/f component-type dimension normalize? }
{ "attribute"/f component-type dimension normalize? }
...
- { "attribute"/f component-type dimension normalize? } ; "> }
+ { "attribute"/f component-type dimension normalize? } ;""" }
{ $description "Defines a new binary " { $link vertex-format } " for structuring vertex data stored in " { $link buffer } "s. Each " { $snippet "attribute" } " name either corresponds to an input parameter of a vertex shader, or is " { $link f } " to include padding in the vertex format. The " { $link component-type } " determines the format of the components, and the " { $snippet "dimension" } " determines the number of components. If the " { $snippet "component-type" } " is an integer type and " { $snippet "normalize?" } " is true, the component values will be scaled to the range 0.0 to 1.0 when fed to the vertex shader; otherwise, they will be cast to floats retaining their integral values." } ;
HELP: VERTEX-STRUCT:
-{ $syntax <" VERTEX-STRUCT: struct-name format-name "> }
-{ $description "Defines a struct C type (like " { $link POSTPONE: C-STRUCT: } ") with the same binary format and component types as the given " { $link vertex-format } "." } ;
+{ $syntax """VERTEX-STRUCT: struct-name format-name""" }
+{ $description "Defines a struct class (like " { $link POSTPONE: STRUCT: } ") with the same binary format and component types as the given " { $link vertex-format } "." } ;
{ POSTPONE: GLSL-PROGRAM: POSTPONE: GLSL-SHADER-FILE: POSTPONE: GLSL-SHADER: } related-words
HELP: define-vertex-struct
{ $values
- { "struct-name" string } { "vertex-format" vertex-format }
+ { "class" word } { "vertex-format" vertex-format }
}
{ $description "Defines a new struct C type from a " { $link vertex-format } ". The runtime equivalent of " { $link POSTPONE: VERTEX-STRUCT: } ". This word must be called inside a compilation unit." } ;
ARTICLE: "gpu.shaders" "Shader objects"
"The " { $vocab-link "gpu.shaders" } " vocabulary supports defining, compiling, and linking " { $link shader } "s into " { $link program } "s that run on the GPU and control rendering."
-{ $subsection POSTPONE: GLSL-PROGRAM: }
-{ $subsection POSTPONE: GLSL-SHADER: }
-{ $subsection POSTPONE: GLSL-SHADER-FILE: }
+{ $subsections
+ POSTPONE: GLSL-PROGRAM:
+ POSTPONE: GLSL-SHADER:
+ POSTPONE: GLSL-SHADER-FILE:
+}
"A program must be instantiated for each graphics context it is used in:"
-{ $subsection <program-instance> }
+{ $subsection
s <program-instance> }
"Program instances can be updated on the fly, allowing for interactive development of shaders:"
-{ $subsection refresh-program }
+{ $subsections refresh-program }
"Render data inside GPU " { $link buffer } "s is organized into " { $link vertex-array } "s for consumption by shader code:"
-{ $subsection vertex-array }
-{ $subsection <vertex-array> }
-{ $subsection buffer>vertex-array }
-{ $subsection POSTPONE: VERTEX-FORMAT: } ;
+{ $subsections
+ vertex-array
+ <vertex-array>
+ buffer>vertex-array
+ POSTPONE: VERTEX-FORMAT:
+} ;
ABOUT: "gpu.shaders"
USING: multiline gpu.shaders gpu.shaders.private tools.test ;
IN: gpu.shaders.tests
-[ <" ERROR: foo.factor:20: Bad command or filename
+[ """ERROR: foo.factor:20: Bad command or filename
INFO: foo.factor:30: The operation completed successfully
-NOT:A:LOG:LINE "> ]
+NOT:A:LOG:LINE""" ]
[ T{ shader { filename "foo.factor" } { line 19 } }
-<" ERROR: 0:1: Bad command or filename
+"""ERROR: 0:1: Bad command or filename
INFO: 0:11: The operation completed successfully
-NOT:A:LOG:LINE "> replace-log-line-numbers ] unit-test
+NOT:A:LOG:LINE""" replace-log-line-numbers ] unit-test
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types alien.strings
-alien.structs arrays assocs byte-arrays classes.mixin
-classes.parser classes.singleton combinators
-combinators.short-circuit definitions destructors
-generic.parser gpu gpu.buffers hashtables images
-io.encodings.ascii io.files io.pathnames kernel lexer literals
-locals math math.parser memoize multiline namespaces opengl
-opengl.gl opengl.shaders parser quotations sequences
-specialized-arrays.alien specialized-arrays.int splitting
-strings tr ui.gadgets.worlds variants vectors vocabs vocabs.loader
-vocabs.parser words words.constant ;
+USING: accessors alien alien.c-types alien.data alien.strings
+arrays assocs byte-arrays classes.mixin classes.parser
+classes.singleton classes.struct combinators combinators.short-circuit
+definitions destructors generic.parser gpu gpu.buffers hashtables
+images io.encodings.ascii io.files io.pathnames kernel lexer
+literals locals math math.parser memoize multiline namespaces
+opengl opengl.gl opengl.shaders parser quotations sequences
+specialized-arrays splitting strings tr ui.gadgets.worlds
+variants vectors vocabs vocabs.loader vocabs.parser words
+words.constant half-floats ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: void*
IN: gpu.shaders
VARIANT: shader-kind
: component-type>c-type ( component-type -- c-type )
{
- { ubyte-components [ "uchar" ] }
- { ushort-components [ "ushort" ] }
- { uint-components [ "uint" ] }
- { half-components [ "half" ] }
- { float-components [ "float" ] }
- { byte-integer-components [ "char" ] }
- { ubyte-integer-components [ "uchar" ] }
- { short-integer-components [ "short" ] }
- { ushort-integer-components [ "ushort" ] }
- { int-integer-components [ "int" ] }
- { uint-integer-components [ "uint" ] }
+ { ubyte-components [ c:uchar ] }
+ { ushort-components [ c:ushort ] }
+ { uint-components [ c:uint ] }
+ { half-components [ half ] }
+ { float-components [ c:float ] }
+ { byte-integer-components [ c:char ] }
+ { ubyte-integer-components [ c:uchar ] }
+ { short-integer-components [ c:short ] }
+ { ushort-integer-components [ c:ushort ] }
+ { int-integer-components [ c:int ] }
+ { uint-integer-components [ c:uint ] }
} case ;
-: c-array-dim ( dim -- string )
- dup 1 = [ drop "" ] [ number>string "[" "]" surround ] if ;
+: c-array-dim ( type dim -- type' )
+ dup 1 = [ drop ] [ 2array ] if ;
SYMBOL: padding-no
padding-no [ 0 ] initialize
"(" ")" surround
padding-no inc ;
-: vertex-attribute>c-type ( vertex-attribute -- {type,name} )
- [
- [ component-type>> component-type>c-type ]
- [ dim>> c-array-dim ] bi append
- ] [ name>> [ padding-name ] unless* ] bi 2array ;
+: vertex-attribute>struct-slot ( vertex-attribute -- struct-slot-spec )
+ [ name>> [ padding-name ] unless* ]
+ [ [ component-type>> component-type>c-type ] [ dim>> c-array-dim ] bi ] bi
+ { } <struct-slot-spec> ;
: shader-filename ( shader/program -- filename )
dup filename>> [ nip ] [ name>> where first ] if* file-name ;
[ first4 vertex-attribute boa ] map
define-vertex-format ;
-: define-vertex-struct ( struct-name vertex-format -- )
- [ current-vocab ] dip
- "vertex-format-attributes" word-prop [ vertex-attribute>c-type ] map
- define-struct ;
+: define-vertex-struct ( class vertex-format -- )
+ "vertex-format-attributes" word-prop [ vertex-attribute>struct-slot ] map
+ define-struct-class ;
SYNTAX: VERTEX-STRUCT:
- scan scan-word define-vertex-struct ;
+ CREATE-CLASS scan-word define-vertex-struct ;
TUPLE: vertex-array < gpu-object
{ program-instance program-instance read-only }
! (c)2009 Joe Groff bsd license
-USING: help.markup help.syntax kernel math math.rectangles multiline sequences ;
+USING: help.markup help.syntax kernel math math.rectangles
+sequences ;
IN: gpu.state
HELP: <blend-mode>
{ { $link func-one-minus-constant-alpha } " returns one minus the alpha component of the current " { $link blend-state } "'s " { $snippet "constant-color" } " for every result component." }
}
"A typical transparency effect will use the values:"
-{ $code <" T{ blend-mode
+{ $code """T{ blend-mode
{ equation eq-add }
{ source-function func-source-alpha }
{ dest-function func-one-minus-source-alpha }
-} "> }
+}""" }
} } ;
HELP: blend-state
ARTICLE: "gpu.state" "GPU state"
"The " { $vocab-link "gpu.state" } " vocabulary provides words for querying and setting GPU state."
-{ $subsection set-gpu-state }
+{ $subsections set-gpu-state }
"The following state tuples are available:"
-{ $subsection viewport-state }
-{ $subsection scissor-state }
-{ $subsection multisample-state }
-{ $subsection stencil-state }
-{ $subsection depth-range-state }
-{ $subsection depth-state }
-{ $subsection blend-state }
-{ $subsection mask-state }
-{ $subsection triangle-cull-state }
-{ $subsection triangle-state }
-{ $subsection point-state }
-{ $subsection line-state } ;
+{ $subsections
+ viewport-state
+ scissor-state
+ multisample-state
+ stencil-state
+ depth-range-state
+ depth-state
+ blend-state
+ mask-state
+ triangle-cull-state
+ triangle-state
+ point-state
+ line-state
+} ;
ABOUT: "gpu.state"
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types arrays byte-arrays combinators gpu
-kernel literals math math.rectangles opengl opengl.gl sequences
-variants specialized-arrays.int specialized-arrays.float ;
+USING: accessors alien.c-types alien.data arrays byte-arrays
+combinators gpu kernel literals math math.rectangles opengl
+opengl.gl sequences variants specialized-arrays ;
+QUALIFIED-WITH: alien.c-types c
+FROM: math => float ;
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: c:float
IN: gpu.state
UNION: ?rect rect POSTPONE: f ;
HELP: texture
{ $class-description "Textures are typed, multidimensional arrays of GPU memory used for storing image data, lookup tables, and other kinds of multidimensional data for use with shader programs. They come in different types depending on dimensionality and intended usage:"
-{ $subsection texture-1d }
-{ $subsection texture-2d }
-{ $subsection texture-3d }
-{ $subsection texture-cube-map }
-{ $subsection texture-rectangle }
-{ $subsection texture-1d-array }
-{ $subsection texture-2d-array }
+{ $subsections
+ texture-1d
+ texture-2d
+ texture-3d
+ texture-cube-map
+ texture-rectangle
+ texture-1d-array
+ texture-2d-array
+}
"Textures are constructed using the corresponding " { $snippet "<constructor word>" } " for their type. The constructor sets the texture's " { $link component-order } ", " { $link component-type } ", and " { $link texture-parameters } ". Once created, memory for a texture can be allocated with " { $link allocate-texture } ", updated with " { $link update-texture } ", or retrieved with " { $link read-texture } "." } ;
HELP: texture-1d
ARTICLE: "gpu.textures" "Texture objects"
"The " { $vocab-link "gpu.textures" } " vocabulary provides words for creating, allocating, updating, and reading GPU texture objects."
-{ $subsection texture }
-{ $subsection allocate-texture }
-{ $subsection update-texture }
-{ $subsection read-texture }
+{ $subsections
+ texture
+ allocate-texture
+ update-texture
+ read-texture
+}
"Words are also provided to interface textures with the " { $vocab-link "images" } " library:"
-{ $subsection allocate-texture-image }
-{ $subsection update-texture-image }
-{ $subsection read-texture-image }
+{ $subsections
+ allocate-texture-image
+ update-texture-image
+ read-texture-image
+}
;
ABOUT: "gpu.textures"
USING: accessors alien.c-types arrays byte-arrays combinators
destructors fry gpu gpu.buffers images kernel locals math
opengl opengl.gl opengl.textures sequences
-specialized-arrays.float ui.gadgets.worlds variants ;
+specialized-arrays ui.gadgets.worlds variants ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: gpu.textures
TUPLE: texture < gpu-object
! (c)2009 Joe Groff bsd license
USING: gpu.buffers gpu.render gpu.shaders gpu.textures images kernel
-specialized-arrays.float ;
+specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: gpu.util
CONSTANT: environment-cube-map-mv-matrices
gpu.render gpu.state kernel literals
locals math math.constants math.functions math.matrices
math.order math.vectors opengl.gl sequences
-specialized-arrays.float ui ui.gadgets.worlds ;
+ui ui.gadgets.worlds specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: gpu.util.wasd
UNIFORM-TUPLE: mvp-uniforms
! (c)2009 Joe Groff bsd license
USING: accessors arrays destructors kernel math opengl
-opengl.gl sequences sequences.product specialized-arrays.float ;
+opengl.gl sequences sequences.product specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: grid-meshes
TUPLE: grid-mesh dim buffer row-length ;
-USING: alien.c-types alien.syntax half-floats kernel math tools.test ;
+USING: accessors alien.c-types alien.syntax half-floats kernel
+math tools.test specialized-arrays alien.data classes.struct ;
+SPECIALIZED-ARRAY: half
IN: half-floats.tests
[ HEX: 0000 ] [ 0.0 half>bits ] unit-test
[ HEX: be00 ] [ -1.5 half>bits ] unit-test
[ HEX: 7c00 ] [ 1/0. half>bits ] unit-test
[ HEX: fc00 ] [ -1/0. half>bits ] unit-test
-[ HEX: 7eaa ] [ HEX: aaaaaaaaaaaaa <fp-nan> half>bits ] unit-test
+[ HEX: 7eaa ] [ NAN: aaaaaaaaaaaaa half>bits ] unit-test
! too-big floats overflow to infinity
[ HEX: 7c00 ] [ 65536.0 half>bits ] unit-test
[ 3.0 ] [ HEX: 4200 bits>half ] unit-test
[ t ] [ HEX: 7e00 bits>half fp-nan? ] unit-test
-C-STRUCT: halves
- { "half" "tom" }
- { "half" "dick" }
- { "half" "harry" }
- { "half" "harry-jr" } ;
+STRUCT: halves
+ { tom half }
+ { dick half }
+ { harry half }
+ { harry-jr half } ;
-[ 8 ] [ "halves" heap-size ] unit-test
+[ 8 ] [ halves heap-size ] unit-test
[ 3.0 ] [
- "halves" <c-object>
- 3.0 over set-halves-dick
- halves-dick
+ halves <struct>
+ 3.0 >>dick
+ dick>>
] unit-test
[ half-array{ 1.0 2.0 3.0 1/0. -1/0. } ]
! (c)2009 Joe Groff bsd license
-USING: accessors alien.c-types alien.syntax kernel math math.order
-specialized-arrays.direct.functor specialized-arrays.functor ;
+USING: accessors alien.accessors alien.c-types alien.data
+alien.syntax kernel math math.order ;
+FROM: math => float ;
IN: half-floats
: half>bits ( float -- bits )
] unless
] bi bitor bits>float ;
-C-STRUCT: half { "ushort" "(bits)" } ;
+SYMBOL: half
<<
-"half" c-type
- [ half>bits <ushort> ] >>unboxer-quot
- [ *ushort bits>half ] >>boxer-quot
- drop
-
-"half" define-array
-"half" define-direct-array
+<c-type>
+ float >>class
+ float >>boxed-class
+ [ alien-unsigned-2 bits>half ] >>getter
+ [ [ >float half>bits ] 2dip set-alien-unsigned-2 ] >>setter
+ 2 >>size
+ 2 >>align
+ [ >float ] >>unboxer-quot
+\ half define-primitive-type
>>
"This library provide basic utilities for hashcash creation and validation."
$nl
"Creating stamps:"
-{ $subsection mint }
-{ $subsection mint* }
+{ $subsections
+ mint
+ mint*
+}
"Validation:"
-{ $subsection check-stamp }
+{ $subsections check-stamp }
"Hashcash tuple and constructor:"
-{ $subsection hashcash }
-{ $subsection <hashcash> }
+{ $subsections
+ hashcash
+ <hashcash>
+}
"Utilities:"
-{ $subsection salt } ;
+{ $subsections salt } ;
{ mint mint* <hashcash> check-stamp salt } related-words
\r
ARTICLE: "histogram" "Computing histograms"\r
"Counting elements in a sequence:"\r
-{ $subsection histogram }\r
-{ $subsection histogram* }\r
+{ $subsections\r
+ histogram\r
+ histogram*\r
+}\r
"Combinators for implementing histogram:"\r
-{ $subsection sequence>assoc }\r
-{ $subsection sequence>assoc* }\r
-{ $subsection sequence>hashtable } ;\r
+{ $subsections\r
+ sequence>assoc\r
+ sequence>assoc*\r
+ sequence>hashtable\r
+} ;\r
\r
ABOUT: "histogram"\r
"For the full list of HTML tags and attributes, consult the word list for the " { $vocab-link "html.elements" } " vocabulary. In addition to HTML tag and attribute words, a few utilities are provided."
$nl
"Writing unescaped HTML to " { $vocab-link "html.streams" } ":"
-{ $subsection write-html }
-{ $subsection print-html } ;
+{ $subsections
+ write-html
+ print-html
+} ;
ABOUT: "html.elements"
ARTICLE: "id3" "ID3 tags"
"The " { $vocab-link "id3" } " vocabulary contains words for parsing " { $emphasis "ID3" } " tags, which are textual fields storing an MP3's title, artist, and other metadata." $nl
"Parsing ID3 tags for a directory of MP3s, recursively:"
-{ $subsection parse-mp3-directory }
+{ $subsections parse-mp3-directory }
"Finding MP3 files recursively:"
-{ $subsection find-mp3s }
+{ $subsections find-mp3s }
"Parsing a sequence of MP3 pathnames:"
-{ $subsection mp3-paths>id3s }
+{ $subsections mp3-paths>id3s }
"Parsing an MP3 file's ID3 tags:"
-{ $subsection mp3>id3 }
+{ $subsections mp3>id3 }
"ID3v1 frame tag accessors:"
-{ $subsection album }
-{ $subsection artist }
-{ $subsection comment }
-{ $subsection genre }
-{ $subsection title }
-{ $subsection year }
+{ $subsections
+ album
+ artist
+ comment
+ genre
+ title
+ year
+}
"Access any frame tag:"
-{ $subsection find-id3-frame } ;
+{ $subsections find-id3-frame } ;
ABOUT: "id3"
! Copyright (C) 2009 Tim Wawrzynczak, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences io io.encodings.binary io.files io.pathnames
-strings kernel math io.mmap io.mmap.uchar accessors
-combinators math.ranges unicode.categories byte-arrays
-io.encodings.string io.encodings.utf16 assocs math.parser
-combinators.short-circuit fry namespaces combinators.smart
-splitting io.encodings.ascii arrays io.files.info unicode.case
-io.directories.search literals math.functions continuations ;
+strings kernel math io.mmap accessors combinators math.ranges
+unicode.categories byte-arrays io.encodings.string
+io.encodings.utf16 assocs math.parser combinators.short-circuit
+fry namespaces combinators.smart splitting io.encodings.ascii
+arrays io.files.info unicode.case io.directories.search literals
+math.functions continuations ;
+FROM: alien.c-types => uchar ;
IN: id3
<PRIVATE
CONSTANT: id3v1-length 128
CONSTANT: id3v1-offset 128
CONSTANT: id3v1+-length 227
-CONSTANT: id3v1+-offset $[ 128 227 + ]
+: id3v1+-offset ( -- n ) id3v1-length id3v1+-length + ; inline
: id3v1? ( seq -- ? )
{
: mp3>id3 ( path -- id3/f )
[
- [ <id3> ] dip
- {
- [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
- [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
- [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
- } cleave
- ] with-mapped-uchar-file-reader ;
+ [ <id3> ] dip uchar <mapped-array>
+ [ dup id3v1? [ read-v1-tags merge-id3v1 ] [ drop ] if ]
+ [ dup id3v1+? [ read-v1+-tags merge-id3v1 ] [ drop ] if ]
+ [ dup id3v2? [ read-v2-tags ] [ drop ] if ]
+ tri
+ ] with-mapped-file-reader ;
: find-id3-frame ( id3 name -- obj/f )
swap frames>> at* [ data>> ] when ;
--- /dev/null
+Doug Coleman
+Keith Lazuka
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel sequences ;
+IN: images.gif
+
+ARTICLE: "images.gif" "GIF Image Loader"
+{ $vocab-link "images.gif" }
+$nl
+{ $notes "Currently multi-frame GIF images are not supported." }
+;
+
+ABOUT: "images.gif"
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors bitstreams compression.lzw fry images.gif
+images.loader images.testing images.viewer io
+io.encodings.binary io.files io.pathnames kernel math
+math.bitwise math.parser namespaces prettyprint quotations
+sequences tools.test tools.test.private ;
+QUALIFIED-WITH: bitstreams bs
+IN: images.gif.tests
+
+verbose-tests? off
+"vocab:images/testing/gif/circle.gif" decode-test
+"vocab:images/testing/gif/checkmark.gif" decode-test
+"vocab:images/testing/gif/monochrome.gif" decode-test
+"vocab:images/testing/gif/alpha.gif" decode-test
+"vocab:images/testing/gif/noise.gif" decode-test
+"vocab:images/testing/gif/astronaut_animation.gif" decode-test
+verbose-tests? on
+
+: path>gif ( path -- gif )
+ binary [ input-stream get load-gif ] with-file-reader ;
+
+: circle.gif ( -- gif )
+ "vocab:images/testing/gif/circle.gif" path>gif ;
+
+: checkmark.gif ( -- gif )
+ "vocab:images/testing/gif/checkmark.gif" path>gif ;
+
+: monochrome.gif ( -- gif )
+ "vocab:images/testing/gif/monochrome.gif" path>gif ;
+
+: alpha.gif ( -- gif )
+ "vocab:images/testing/gif/alpha.gif" path>gif ;
+
+: declared-num-colors ( gif -- n ) flags>> 3 bits 1 + 2^ ;
+: actual-num-colors ( gif -- n ) global-color-table>> length ;
+
+[ 2 ] [ monochrome.gif actual-num-colors ] unit-test
+[ 2 ] [ monochrome.gif declared-num-colors ] unit-test
+
+[ 16 ] [ circle.gif actual-num-colors ] unit-test
+[ 16 ] [ circle.gif declared-num-colors ] unit-test
+
+[ 256 ] [ checkmark.gif actual-num-colors ] unit-test
+[ 256 ] [ checkmark.gif declared-num-colors ] unit-test
+
+: >index-stream ( gif -- seq )
+ [ compressed-bytes>> ]
+ [ image-descriptor>> first-code-size>> ] bi
+ gif-lzw-uncompress ;
+
+[
+ BV{
+ 0 0 0 0 0 0
+ 1 0 0 0 0 1
+ 1 1 0 0 1 1
+ 1 1 1 1 1 1
+ 1 0 1 1 0 1
+ 1 0 0 0 0 1
+ }
+] [ monochrome.gif >index-stream ] unit-test
+
+[
+ BV{
+ 0 1
+ 1 0
+ }
+] [ alpha.gif >index-stream ] unit-test
-! Copyrigt (C) 2009 Doug Coleman.
+! Copyrigt (C) 2009 Doug Coleman, Keith Lazuka
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators constructors destructors
-images images.loader io io.binary io.buffers
-io.encodings.binary io.encodings.string io.encodings.utf8
-io.files io.files.info io.ports io.streams.limited kernel make
-math math.bitwise math.functions multiline namespaces
-prettyprint sequences ;
+USING: accessors arrays assocs combinators compression.lzw
+constructors destructors grouping images images.loader io
+io.binary io.buffers io.encodings.binary io.encodings.string
+io.encodings.utf8 io.files io.files.info io.ports
+io.streams.limited kernel make math math.bitwise math.functions
+multiline namespaces prettyprint sequences ;
IN: images.gif
SINGLETON: gif-image
ERROR: gif-unexpected-eof ;
TUPLE: graphics-control-extension
-label block-size raw-data
-packed delay-time color-index
-block-terminator ;
+flags delay-time transparent-color-index ;
TUPLE: image-descriptor
-separator left top width height flags ;
+left top width height flags first-code-size ;
TUPLE: plain-text-extension
introducer label block-size text-grid-left text-grid-top text-grid-width
CONSTANT: comment-extension HEX: fe
CONSTANT: application-extension HEX: ff
CONSTANT: trailer HEX: 3b
+CONSTANT: graphic-control-extension-block-size HEX: 04
+CONSTANT: block-terminator HEX: 00
: <loading-gif> ( -- loading-gif )
\ loading-gif new
: read-image-descriptor ( -- image-descriptor )
\ image-descriptor new
- 1 read le> >>separator
2 read le> >>left
2 read le> >>top
2 read le> >>width
2 read le> >>height
- 1 read le> >>flags ;
+ 1 read le> >>flags
+ 1 read le> 1 + >>first-code-size ;
: read-graphic-control-extension ( -- graphic-control-extension )
\ graphics-control-extension new
- 1 read le> [ >>block-size ] [ read ] bi
- >>raw-data
- 1 read le> >>block-terminator ;
+ 1 read le> graphic-control-extension-block-size assert=
+ 1 read le> >>flags
+ 2 read le> >>delay-time
+ 1 read le> >>transparent-color-index
+ 1 read le> block-terminator assert= ;
: read-plain-text-extension ( -- plain-text-extension )
\ plain-text-extension new
: interlaced? ( image -- ? ) flags>> 6 bit? ; inline
: sort? ( image -- ? ) flags>> 5 bit? ; inline
: color-table-size ( image -- ? ) flags>> 3 bits 1 + 2^ 3 * ; inline
+: transparency? ( image -- ? )
+ graphic-control-extensions>> first flags>> 0 bit? ; inline
: color-resolution ( image -- ? ) flags>> -4 shift 3 bits ; inline
: read-global-color-table ( loading-gif -- loading-gif )
dup color-table? [
- dup color-table-size read >>global-color-table
+ dup color-table-size read 3 group >>global-color-table
] when ;
: maybe-read-local-color-table ( loading-gif -- loading-gif )
} case
] with-input-stream ;
-: loading-gif>image ( loading-gif -- image )
- ;
+: decompress ( loading-gif -- indexes )
+ [ compressed-bytes>> ]
+ [ image-descriptor>> first-code-size>> ] bi
+ gif-lzw-uncompress ;
+
+: colorize ( index palette transparent-index/f -- seq )
+ pick = [ 2drop B{ 0 0 0 0 } ] [ nth 255 suffix ] if ;
+
+: apply-palette ( indexes palette transparent-index/f -- bitmap )
+ [ colorize ] 2curry V{ } map-as concat ;
+
+: dimensions ( loading-gif -- dim )
+ [ image-descriptor>> width>> ] [ image-descriptor>> height>> ] bi 2array ;
+
+: ?transparent-color-index ( loading-gif -- index/f )
+ dup transparency?
+ [ graphic-control-extensions>> first transparent-color-index>> ]
+ [ drop f ] if ;
+
+: gif>image ( loading-gif -- image )
+ [ <image> ] dip
+ [ dimensions >>dim ]
+ [ drop RGBA >>component-order ubyte-components >>component-type ]
+ [
+ [ decompress ] [ global-color-table>> ] [ ?transparent-color-index ] tri
+ apply-palette >>bitmap
+ ] tri ;
ERROR: loading-gif-error gif-image ;
dup loading?>> [ loading-gif-error ] when ;
M: gif-image stream>image ( path gif-image -- image )
- drop load-gif ensure-loaded loading-gif>image ;
+ drop load-gif ensure-loaded gif>image ;
--- /dev/null
+GIF image file format
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: http.client images.loader images.loader.private kernel
+images.viewer ;
+IN: images.http
+
+: load-http-image ( path -- image )
+ [ http-get nip ] [ image-class ] bi load-image* ;
+
+: http-image. ( path -- )
+ load-http-image image. ;
! Copyright (C) 2009 Doug Coleman
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors grouping sequences combinators
-math specialized-arrays.direct.uint byte-arrays fry
-specialized-arrays.direct.ushort specialized-arrays.uint
-specialized-arrays.ushort specialized-arrays.float images
-half-floats ;
+USING: alien.c-types kernel accessors grouping sequences
+combinators math byte-arrays fry images half-floats
+specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: half
IN: images.normalization
<PRIVATE
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors byte-arrays images.loader images.pam
+images.testing io io.encodings.binary io.files
+io.streams.byte-array kernel quotations tools.test ;
+IN: images.pam.tests
+
+! ----------- Encoder Tests ------------------------------
+
+"vocab:images/testing/pam/rgb1x1.pam" pam-image encode-test
+"vocab:images/testing/pam/rgba1x1.pam" pam-image encode-test
+"vocab:images/testing/pam/rgb2x2.pam" pam-image encode-test
+"vocab:images/testing/pam/rgba2x2.pam" pam-image encode-test
+"vocab:images/testing/pam/rgb3x3.pam" pam-image encode-test
+"vocab:images/testing/pam/rgba3x3.pam" pam-image encode-test
+
+! ----------- Decoder Tests ------------------------------
+
+! 1x1
+
+[ { 1 1 } ] [ "vocab:images/testing/pam/rgb1x1.pam" load-image dim>> ] unit-test
+
+[ B{ 0 0 0 } ]
+[ "vocab:images/testing/pam/rgb1x1.pam" load-image bitmap>> ] unit-test
+
+[ B{ 0 0 0 0 } ]
+[ "vocab:images/testing/pam/rgba1x1.pam" load-image bitmap>> ] unit-test
+
+! 2x2
+
+[ { 2 2 } ] [ "vocab:images/testing/pam/rgb2x2.pam" load-image dim>> ] unit-test
+
+[ B{ 0 0 0 255 255 255 255 255 255 0 0 0 } ]
+[ "vocab:images/testing/pam/rgb2x2.pam" load-image bitmap>> ] unit-test
+
+[ B{ 0 0 0 255 255 255 255 0 255 255 255 0 0 0 0 255 } ]
+[ "vocab:images/testing/pam/rgba2x2.pam" load-image bitmap>> ] unit-test
+
+! 3x3
+
+[
+ B{
+ 255 0 0 0 255 0 0 0 255
+ 4 252 253 254 1 127 252 253 2
+ 255 255 255 0 0 0 255 255 255
+ }
+]
+[ "vocab:images/testing/pam/rgb3x3.pam" load-image bitmap>> ] unit-test
+
+[
+ B{
+ 255 0 0 255 0 255 0 255 0 0 255 255
+ 4 252 253 255 254 1 127 255 252 253 2 255
+ 255 255 255 255 0 0 0 255 255 255 255 0
+ }
+]
+[ "vocab:images/testing/pam/rgba3x3.pam" load-image bitmap>> ] unit-test
--- /dev/null
+! Copyright (C) 2009 Keith Lazuka.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators fry grouping images
+images.loader io io.encodings io.encodings.ascii
+io.encodings.binary io.files io.files.temp kernel math
+math.parser prettyprint sequences splitting ;
+IN: images.pam
+
+SINGLETON: pam-image
+"pam" pam-image register-image-class
+
+: output-pam-header ( note num-channels width height -- )
+ ascii [
+ "P7" print
+ "HEIGHT " write pprint nl
+ "WIDTH " write pprint nl
+ "MAXVAL 255" print
+ "DEPTH " write pprint nl
+ "TUPLTYPE " prepend print
+ "ENDHDR" print
+ ] with-encoded-output ; inline
+
+: output-pam ( note num-channels width height pixels -- )
+ [ output-pam-header ] dip write ;
+
+: verify-bitmap-format ( image -- )
+ [ component-type>> ubyte-components assert= ]
+ [ component-order>> { RGB RGBA } memq? [
+ "PAM encode: component-order must be RGB or RGBA!" throw
+ ] unless ] bi ;
+
+GENERIC: TUPLTYPE ( component-order -- str )
+M: component-order TUPLTYPE name>> ;
+M: RGBA TUPLTYPE drop "RGB_ALPHA" ;
+
+M: pam-image image>stream
+ drop {
+ [ verify-bitmap-format ]
+ [ component-order>> [ TUPLTYPE ] [ component-count ] bi ]
+ [ dim>> first2 ]
+ [ bitmap>> ]
+ } cleave output-pam ;
+
+! PAM Decoder
+
+TUPLE: loading-pam width height depth maxval tupltype bitmap ;
+
+: ?glue ( seq1 seq2 seq3 -- seq )
+ pick empty? [ drop nip ] [ glue ] if ;
+
+: append-tupltype ( pam tupltype -- pam )
+ '[ _ " " ?glue ] change-tupltype ;
+
+: read-header-lines ( pam -- pam )
+ readln " " split unclip swap " " join swap {
+ { "ENDHDR" [ drop ] }
+ { "HEIGHT" [ string>number >>height read-header-lines ] }
+ { "WIDTH" [ string>number >>width read-header-lines ] }
+ { "DEPTH" [ string>number >>depth read-header-lines ] }
+ { "MAXVAL" [ string>number >>maxval read-header-lines ] }
+ { "TUPLTYPE" [ append-tupltype read-header-lines ] }
+ [ 2drop read-header-lines ]
+ } case ;
+
+: read-header ( pam -- pam )
+ ascii [
+ readln "P7" assert=
+ read-header-lines
+ ] with-decoded-input ;
+
+: bytes-per-pixel ( pam -- n )
+ [ depth>> ] [ maxval>> 256 < 1 2 ? ] bi * ;
+
+: bitmap-length ( pam -- num-bytes )
+ [ width>> ] [ height>> ] [ bytes-per-pixel ] tri * * ;
+
+: read-bitmap ( pam -- pam )
+ dup bitmap-length read >>bitmap ;
+
+: load-pam ( stream -- pam )
+ [ loading-pam new read-header read-bitmap ] with-input-stream ;
+
+: tupltype>component-order ( pam -- component-order )
+ tupltype>> dup {
+ { "RGB_ALPHA" [ drop RGBA ] }
+ { "RGBA" [ drop RGBA ] }
+ { "RGB" [ drop RGB ] }
+ [ "Cannot determine component-order from TUPLTYPE " prepend throw ]
+ } case ;
+
+: pam>image ( pam -- image )
+ [ <image> ] dip {
+ [ [ width>> ] [ height>> ] bi 2array >>dim ]
+ [ tupltype>component-order >>component-order ]
+ [ drop ubyte-components >>component-type ]
+ [ bitmap>> >>bitmap ]
+ } cleave ;
+
+M: pam-image stream>image drop load-pam pam>image ;
ARTICLE: "infix" "Infix notation"
"The " { $vocab-link "infix" } " vocabulary implements support for infix notation in Factor source code."
-{ $subsection POSTPONE: [infix }
-{ $subsection POSTPONE: [infix| }
+{ $subsections
+ POSTPONE: [infix
+ POSTPONE: [infix|
+}
$nl
"The usual infix math operators are supported:"
{ $list
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel sequences system ;
+USING: alien.syntax classes.struct kernel sequences system ;
IN: io.serial.unix.termios
CONSTANT: NCCS 20
TYPEDEF: uchar cc_t
TYPEDEF: uint speed_t
-C-STRUCT: termios
- { "tcflag_t" "iflag" } ! input mode flags
- { "tcflag_t" "oflag" } ! output mode flags
- { "tcflag_t" "cflag" } ! control mode flags
- { "tcflag_t" "lflag" } ! local mode flags
- { { "cc_t" NCCS } "cc" } ! control characters
- { "speed_t" "ispeed" } ! input speed
- { "speed_t" "ospeed" } ; ! output speed
+STRUCT: termios
+ { iflag tcflag_t }
+ { oflag tcflag_t }
+ { cflag tcflag_t }
+ { lflag tcflag_t }
+ { cc { cc_t NCCS } }
+ { ispeed speed_t }
+ { ospeed speed_t } ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel system unix ;
+USING: alien.syntax classes.struct kernel system unix ;
IN: io.serial.unix.termios
CONSTANT: NCCS 32
TYPEDEF: uint speed_t
TYPEDEF: uint tcflag_t
-C-STRUCT: termios
- { "tcflag_t" "iflag" } ! input mode flags
- { "tcflag_t" "oflag" } ! output mode flags
- { "tcflag_t" "cflag" } ! control mode flags
- { "tcflag_t" "lflag" } ! local mode flags
- { "cc_t" "line" } ! line discipline
- { { "cc_t" NCCS } "cc" } ! control characters
- { "speed_t" "ispeed" } ! input speed
- { "speed_t" "ospeed" } ; ! output speed
+STRUCT: termios
+ { iflag tcflag_t }
+ { oflag tcflag_t }
+ { cflag tcflag_t }
+ { lflag tcflag_t }
+ { line cc_t }
+ { cc { cc_t NCCS } }
+ { ispeed speed_t }
+ { ospeed speed_t } ;
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types alien.syntax combinators io.ports
-io.streams.duplex system kernel math math.bitwise
-vocabs.loader unix io.serial io.serial.unix.termios io.backend.unix ;
+USING: accessors alien.c-types alien.syntax alien.data
+classes.struct combinators io.ports io.streams.duplex
+system kernel math math.bitwise vocabs.loader unix io.serial
+io.serial.unix.termios io.backend.unix ;
IN: io.serial.unix
<< {
: get-termios ( serial -- termios )
serial-fd
- "termios" <c-object> [ tcgetattr io-error ] keep ;
+ termios <struct> [ tcgetattr io-error ] keep ;
: configure-termios ( serial -- )
dup termios>>
{
- [ [ iflag>> ] dip over [ set-termios-iflag ] [ 2drop ] if ]
- [ [ oflag>> ] dip over [ set-termios-oflag ] [ 2drop ] if ]
+ [ [ iflag>> ] dip over [ (>>iflag) ] [ 2drop ] if ]
+ [ [ oflag>> ] dip over [ (>>oflag) ] [ 2drop ] if ]
[
[
[ cflag>> 0 or ] [ baud>> lookup-baud ] bi bitor
- ] dip set-termios-cflag
+ ] dip (>>cflag)
]
- [ [ lflag>> ] dip over [ set-termios-lflag ] [ 2drop ] if ]
+ [ [ lflag>> ] dip over [ (>>lflag) ] [ 2drop ] if ]
} 2cleave ;
: tciflush ( serial -- )
! See http://factorcode.org/license.txt for BSD license.
USING: io.files.windows io.streams.duplex kernel math
math.bitwise windows.kernel32 accessors alien.c-types
-windows io.files.windows fry locals continuations ;
+windows io.files.windows fry locals continuations
+classes.struct ;
IN: io.serial.windows
: <serial-stream> ( path encoding -- duplex )
: get-comm-state ( duplex -- dcb )
in>> handle>>
- "DCB" <c-object> tuck
+ DCB <struct> tuck
GetCommState win32-error=0/f ;
: set-comm-state ( duplex dcb -- )
ARTICLE: "irc.client" "IRC Client"
"An IRC Client library"
{ $heading "IRC objects:" }
-{ $subsection irc-client }
+{ $subsections irc-client }
{ $heading "Chat objects:" }
-{ $subsection irc-server-chat }
-{ $subsection irc-channel-chat }
-{ $subsection irc-nick-chat }
+{ $subsections
+ irc-server-chat
+ irc-channel-chat
+ irc-nick-chat
+}
{ $heading "Setup objects:" }
-{ $subsection irc-profile }
+{ $subsections irc-profile }
{ $heading "Words:" }
-{ $subsection connect-irc }
-{ $subsection terminate-irc }
-{ $subsection attach-chat }
-{ $subsection detach-chat }
-{ $subsection hear }
-{ $subsection speak }
+{ $subsections
+ connect-irc
+ terminate-irc
+ attach-chat
+ detach-chat
+ hear
+ speak
+}
{ $heading "IRC messages" }
"Some of the RFC defined irc messages as objects:"
{ $table
[ (connect-irc) (do-login) spawn-irc ] with-irc ;
: attach-chat ( irc-chat irc-client -- ) [ (attach-chat) ] with-irc ;
-: detach-chat ( irc-chat -- ) dup [ client>> remove-chat ] with-irc ;
+: detach-chat ( irc-chat -- ) dup client>> [ remove-chat ] with-irc ;
: speak ( message irc-chat -- ) dup client>> [ (speak) ] with-irc ;
: hear ( irc-chat -- message ) in-messages>> mailbox-get ;
: terminate-irc ( irc-client -- ) [ (terminate-irc) ] with-irc ;
! Test join
[ { "JOIN #factortest" } [
- "#factortest" %join %pop-output-line
+ "#factortest" %join %pop-output-line
+ ] unit-test
+] spawning-irc
+
+[ { "PART #factortest" } [
+ "#factortest" %join %pop-output-line drop
+ "#factortest" chat> remove-chat %pop-output-line
] unit-test
] spawning-irc
M: irc-server-chat remove-chat drop +server-chat+ unregister-chat ;
M: irc-channel-chat remove-chat
- [ part new annotate-message irc-send ]
+ [ name>> "PART " prepend string>irc-message irc-send ]
[ name>> unregister-chat ] bi ;
: (speak) ( message irc-chat -- ) swap annotate-message irc-send ;
USING: accessors alien.c-types jamshred.game jamshred.oint
jamshred.player jamshred.tunnel kernel math math.constants
math.functions math.vectors opengl opengl.gl opengl.glu
-opengl.demo-support sequences specialized-arrays.float ;
+opengl.demo-support sequences specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: jamshred.gl
CONSTANT: min-vertices 6
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors colors.constants combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle specialized-arrays.float strings system ;
+USING: accessors colors.constants combinators jamshred.log
+jamshred.oint jamshred.sound jamshred.tunnel kernel locals math
+math.constants math.order math.ranges math.vectors math.matrices
+sequences shuffle specialized-arrays strings system ;
+QUALIFIED-WITH: alien.c-types c
+SPECIALIZED-ARRAY: c:float
IN: jamshred.player
TUPLE: player < oint
! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences specialized-arrays.float tools.test ;
+USING: accessors arrays jamshred.oint jamshred.tunnel kernel
+math.vectors sequences specialized-arrays tools.test
+alien.c-types ;
+SPECIALIZED-ARRAY: float
IN: jamshred.tunnel.tests
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
USING: accessors arrays colors combinators fry jamshred.oint
kernel literals locals math math.constants math.matrices
math.order math.quadratic math.ranges math.vectors random
-sequences specialized-arrays.float vectors ;
+sequences specialized-arrays vectors ;
FROM: jamshred.oint => distance ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: jamshred.tunnel
CONSTANT: n-segments 5000
--- /dev/null
+Slava Pestov
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: slides help.markup math math.private kernel sequences
+slots.private ;
+IN: jvm-summit-talk
+
+CONSTANT: jvm-summit-slides
+{
+ { $slide "Factor language implementation"
+ "Goals: expressiveness, metaprogramming, performance"
+ "We want a language for anything from scripting DSLs to high-performance numerics"
+ "I assume you know a bit about compiler implementation: parser -> frontend -> optimizer -> codegen"
+ { "This is " { $strong "not" } " a talk about the Factor language" }
+ { "Go to " { $url "http://factorcode.org" } " to learn the language" }
+ }
+ { $slide "Why are dynamic languages slow?"
+ "Branching and indirection!"
+ "Runtime type checks and dispatch"
+ "Integer overflow checks"
+ "Boxed integers and floats"
+ "Lots of allocation of temporary objects"
+ }
+ { $slide "Interactive development"
+ "Code can be reloaded at any time"
+ "Class hierarchy might change"
+ "Slots may be added and removed"
+ "Functions might be redefined"
+ }
+ { $slide "Factor's solution"
+ "Factor implements most of the library in Factor"
+ "Library contains very generic, high-level code"
+ "Always compiles to native code"
+ "Compiler removes unused generality from high-level code"
+ "Inlining, specialization, partial evaluation"
+ "And deoptimize when assumptions change"
+ }
+ { $slide "Introduction: SSA form"
+ "Every identifier only has one global definition"
+ {
+ "Not SSA:"
+ { $code
+ "x = 1"
+ "y = 2"
+ "x = x + y"
+ "if(z < 0)"
+ " t = x + y"
+ "else"
+ " t = x - y"
+ "print(t)"
+ }
+ }
+ }
+ { $slide "Introduction: SSA form"
+ "Rename re-definitions and subsequent usages"
+ {
+ "Still not SSA:"
+ { $code
+ "x = 1"
+ "y = 2"
+ "x1 = x + y"
+ "if(z < 0)"
+ " t = x1 + y"
+ "else"
+ " t = x1 - y"
+ "print(t)"
+ }
+ }
+ }
+ { $slide "Introduction: SSA form"
+ "Introduce “φ functions” at control-flow merge points"
+ {
+ "This is SSA:"
+ { $code
+ "x = 1"
+ "y = 2"
+ "x1 = x + y"
+ "if(z < 0)"
+ " t1 = x1 + y"
+ "else"
+ " t2 = x1 - y"
+ "t3 = φ(t1,t2)"
+ "print(t3)"
+ }
+ }
+ }
+ { $slide "Why SSA form?"
+ {
+ "Def-use chains:"
+ { $list
+ "Defs-of: instructions that define a value"
+ "Uses-of: instructions that use a value"
+ }
+ "With SSA, defs-of has exactly one element"
+ }
+ }
+ { $slide "Def-use chains"
+ "Simpler def-use makes analysis more accurate."
+ {
+ "Non-SSA example:"
+ { $code
+ "if(x < 0)"
+ " s = new Circle"
+ " a = area(s1)"
+ "else"
+ " s = new Rectangle"
+ " a = area(s2)"
+ }
+ }
+ }
+ { $slide "Def-use chains"
+ {
+ "SSA example:"
+ { $code
+ "if(x < 0)"
+ " s1 = new Circle"
+ " a1 = area(s1)"
+ "else"
+ " s2 = new Rectangle"
+ " a2 = area(s2)"
+ "a = φ(a1,a2)"
+ }
+
+ }
+ }
+ { $slide "Factor compiler overview"
+ "High-level SSA IR constructed from stack code"
+ "High level optimizer transforms high-level IR"
+ "Low-level SSA IR is constructed from high-level IR"
+ "Low level optimizer transforms low-level IR"
+ "Register allocator runs on low-level IR"
+ "Machine IR is constructed from low-level IR"
+ "Code generation"
+ }
+ { $slide "High-level optimizer"
+ "Frontend: expands macros, inline higher order functions"
+ "Propagation: inline methods, constant folding"
+ "Escape analysis: unbox tuples"
+ "Dead code elimination: clean up"
+ }
+ { $slide "Higher-order functions"
+ "Almost all control flow is done with higher-order functions"
+ { { $link if } ", " { $link times } ", " { $link each } }
+ "Calling a block is an indirect jump"
+ "Solution: inline higher order functions at the call site"
+ "Inline the block body at the higher order call site in the function"
+ "Record inlining in deoptimization database"
+ }
+ { $slide "Generic functions"
+ "A generic function contains multiple method bodies"
+ "Dispatches on the class of argument(s)"
+ "In Factor, generic functions are single dispatch"
+ "Almost equivalent to message passing"
+ }
+ { $slide "Tuple slot access"
+ "Slot readers and writers are generic functions"
+ "Generated automatically when you define a tuple class"
+ { "The generated methods call " { $link slot } ", " { $link set-slot } " primitives" }
+ "These primitives are not type safe; the generic dispatch performs the type checking for us"
+ "If class of dispatch value known statically, inline method"
+ "This may result in more methods inlining from additional specialization"
+ }
+ { $slide "Generic arithmetic"
+ { { $link + } ", " { $link * } ", etc perform a double dispatch on arguments" }
+ { "Fixed-precision integers (" { $link fixnum } "s) upgrade to " { $link bignum } "s automatically" }
+ "Floats and complex numbers are boxed, heap-allocated"
+ "Propagation of classes helps for floats"
+ "But not for fixnums, because of overflow checks"
+ "So we also propagate integer intervals"
+ "Interval arithmetic: etc, [a,b] + [c,d] = [a+c,b+d]"
+ }
+ { $slide "Slot value propagation"
+ "Complex numbers are even trickier"
+ "We can have a complex number with integer components, float components"
+ "Even if we inline complex arithmetic methods, still dispatching on components"
+ "Solution: propagate slot info"
+ }
+ { $slide "Constrant propagation"
+ "Contrieved example:"
+ { $code
+ "x = •"
+ "b = isa(x,array)"
+ "if(b)"
+ " a = length(x)"
+ "else"
+ " b = length(x)"
+ "c = φ(a,b)"
+ }
+ { "We should be able to inline the call to " { $snippet "length" } " in the true branch" }
+ }
+ { $slide "Constrant propagation"
+ "We build a table:"
+ { $code
+ "b true => x is array"
+ "b false => x is ~array"
+ }
+ { "In true branch, apply all " { $snippet "b true" } " constraints" }
+ { "In false branch, apply all " { $snippet "b false" } " constraints" }
+ }
+ { $slide "Going further"
+ "High-level optimizer eliminates some dispatch overhead and allocation"
+ {
+ { "Let's take a look at the " { $link float+ } " primitive" }
+ { $list
+ "No type checking anymore... but"
+ "Loads two tagged pointers from operand stack"
+ "Unboxes floats"
+ "Adds two floats"
+ "Boxes float result and perform a GC check"
+ }
+ }
+ }
+ { $slide "Low-level optimizer"
+ "Frontend: construct LL SSA IR from HL SSA IR"
+ "Alias analysis: remove redundant slot loads/stores"
+ "Value numbering: simplify arithmetic"
+ "Representation selection: eliminate boxing"
+ "Dead code elimination: clean up"
+ "Register allocation"
+ }
+ { $slide "Constructing low-level IR"
+ { "Low-level IR is a " { $emphasis "control flow graph" } " of " { $emphasis "basic blocks" } }
+ "A basic block is a list of instructions"
+ "Register-based IR; infinite, uniform register file"
+ { "Instructions:"
+ { $list
+ "Subroutine calls"
+ "Machine arithmetic"
+ "Load/store values on operand stack"
+ "Box/unbox values"
+ }
+ }
+ }
+ { $slide "Inline allocation and GC checks"
+ {
+ "Allocation of small objects can be done in a few instructions:"
+ { $list
+ "Bump allocation pointer"
+ "Write object header"
+ "Fill in payload"
+ }
+ }
+ "Multiple allocations in the same basic block only need a single GC check; saves on a conditional branch"
+ }
+ { $slide "Alias analysis"
+ "Factor constructors are just ordinary functions"
+ { "They call a primitive constructor: " { $link new } }
+ "When a new object is constructed, it has to be initialized"
+ "... but the user's constructor probably fills in all the slots again with actual values"
+ "Local alias analysis eliminates redundant slot loads and stores"
+ }
+ { $slide "Value numbering"
+ { "A form of " { $emphasis "redundancy elimination" } }
+ "Requires use of SSA form in order to work"
+ "Define an equivalence relation over SSA values"
+ "Assign a “value number” to each SSA value"
+ "If two values have the same number, they will always be equal at runtime"
+ }
+ { $slide "Types of value numbering"
+ "Many variations: algebraic simplifications, various rewrite rules can be tacked on"
+ "Local value numbering: in basic blocks"
+ "Global value numbering: entire procedure"
+ "Factor only does local value numbering"
+ }
+ { $slide "Value graph and expressions"
+ { $table
+ {
+ {
+ "Basic block:"
+ { $code
+ "x = •"
+ "y = •"
+ "a = x + 1"
+ "b = a + 1"
+ "c = x + 2"
+ "d = b - c"
+ "e = y + d"
+ }
+ }
+ {
+ "Value numbers:"
+ { $code
+ "V1: •"
+ "V2: •"
+ "V3: 1"
+ "V4: 2"
+ "V5: (V1 + V3)"
+ "V6: (V5 + V3)"
+ "V7: (V3 + V4)"
+ "V8: (V6 - V7)"
+ "V9: (V2 + V8)"
+ }
+ }
+ }
+ }
+ }
+ { $slide "Expression simplification"
+ {
+ "Constant folding: if V1 and V2 are constants "
+ { $snippet "(V1 op V2)" }
+ " can be evaluated at compile-time"
+ }
+ {
+ "Reassociation: if V2 and V3 are constants "
+ { $code "((V1 op V2) op V3) => (V1 op (V2 op V3))" }
+ }
+ {
+ "Algebraic identities: if V2 is constant 0, "
+ { $code "(V1 + V2) => V1" }
+ }
+ {
+ "Strength reduction: if V2 is a constant power of two, "
+ { $code "(V1 * V2) => (V1 << log2(V2))" }
+ }
+ "etc, etc, etc"
+ }
+ { $slide "Representation selection overview"
+ "Floats and SIMD vectors need to be boxed"
+ "Representation: tagged pointer, unboxed float, unboxed SIMD value..."
+ "When IR is built, no boxing or unboxing instructions inserted"
+ "Representation selection pass makes IR consistent"
+ }
+ { $slide "Representation selection algorithm"
+ {
+ "For each SSA value:"
+ { $list
+ "Compute possible representations"
+ "Compute cost of each representation"
+ "Pick representation with minimum cost"
+ }
+ }
+ {
+ "For each instruction:"
+ { $list
+ "If it expects a value to be in a different representation, insert box or unbox code"
+ }
+ }
+ }
+ { $slide "Register allocation"
+ "Linear scan algorithm used in Java HotSpot Client"
+ "Described in Christian Wimmer's masters thesis"
+ "Works fine on x86-64, not too great on x86-32"
+ "Good enough since basic blocks tend to be short, with lots of procedure calls"
+ "Might switch to graph coloring eventually"
+ }
+ { $slide "Compiler tools"
+ "Printing high level IR"
+ "Printing low level IR"
+ "Disassembly"
+ "Display call tree"
+ "Display control flow graph"
+ "Display dominator tree"
+ }
+}
+
+: jvm-summit-talk ( -- )
+ jvm-summit-slides slides-window ;
+
+MAIN: jvm-summit-talk
--- /dev/null
+Slides from Slava's talk at JVM Language Summit 2009
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien arrays assocs compiler.units effects
io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
-llvm.types make namespaces sequences specialized-arrays.alien
+llvm.types make namespaces sequences specialized-arrays
vocabs words ;
-
+SPECIALIZED-ARRAY: void*
IN: llvm.invoker
! get function name, ret type, param types and names
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays combinators kernel llvm.core
-locals math.parser math multiline
-namespaces parser peg.ebnf sequences
-sequences.deep specialized-arrays.alien strings vocabs words ;
-
+USING: accessors arrays combinators kernel llvm.core locals
+math.parser math multiline namespaces parser peg.ebnf sequences
+sequences.deep specialized-arrays strings vocabs words ;
+SPECIALIZED-ARRAY: void*
IN: llvm.types
! Type resolution strategy:
destructors fry io io.encodings.utf8 kernel managed-server
namespaces parser sequences sorting splitting strings.parser
unicode.case unicode.categories calendar calendar.format
-locals multiline io.encodings.binary io.encodings.string
-prettyprint ;
+locals io.encodings.binary io.encodings.string prettyprint ;
IN: managed-server.chat
TUPLE: chat-server < managed-server ;
docs key chat-docs get set-at ;
[ handle-help ]
-<" Syntax: /help [command]
-Displays the documentation for a command.">
+"""Syntax: /help [command]
+Displays the documentation for a command."""
"help" add-command
[ drop clients keys [ "``" "''" surround ] map ", " join send-line ]
-<" Syntax: /who
-Shows the list of connected users.">
+"""Syntax: /who
+Shows the list of connected users."""
"who" add-command
[ drop gmt timestamp>rfc822 send-line ]
-<" Syntax: /time
-Returns the current GMT time."> "time" add-command
+"""Syntax: /time
+Returns the current GMT time.""" "time" add-command
[ handle-nick ]
-<" Syntax: /nick nickname
-Changes your nickname.">
+"""Syntax: /nick nickname
+Changes your nickname."""
"nick" add-command
[ handle-me ]
-<" Syntax: /me action">
+"""Syntax: /me action"""
"me" add-command
[ handle-quit ]
-<" Syntax: /quit [message]
-Disconnects a user from the chat server."> "quit" add-command
+"""Syntax: /quit [message]
+Disconnects a user from the chat server.""" "quit" add-command
: handle-command ( string -- )
dup " " split1 swap >lower commands get at* [
target-os get "winnt" = "./factor.com" "./factor" ? ;
: boot-cmd ( -- cmd )
- factor-vm
- "-i=" boot-image-name append
- "-no-user-init"
- 3array ;
+ [
+ factor-vm ,
+ "-i=" boot-image-name append ,
+ "-no-user-init" ,
+ ] { } make ;
: boot ( -- )
"factor" [
{ $description "Divides a number by the number of weeks in a year." } ;
ARTICLE: "time-period-calculations" "Calculations over periods of time"
-{ $subsection monthly }
-{ $subsection semimonthly }
-{ $subsection biweekly }
-{ $subsection weekly }
-{ $subsection daily-360 }
-{ $subsection daily-365 } ;
+{ $subsections
+ monthly
+ semimonthly
+ biweekly
+ weekly
+ daily-360
+ daily-365
+} ;
ARTICLE: "math.finance" "Financial math"
"The " { $vocab-link "math.finance" } " vocabulary contains financial calculation words." $nl
"Calculating payroll over periods of time:"
-{ $subsection "time-period-calculations" } ;
+{ $subsections "time-period-calculations" } ;
ABOUT: "math.finance"
--- /dev/null
+! (c)Joe Groff bsd license
+USING: classes.struct math.matrices.simd math.vectors.simd math
+literals math.constants math.functions specialized-arrays tools.test ;
+QUALIFIED-WITH: alien.c-types c
+FROM: math.matrices => m~ ;
+SIMD: c:float
+SPECIALIZED-ARRAY: float-4
+IN: math.matrices.simd.tests
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 3.0 0.0 0.0 0.0 }
+ float-4{ 0.0 4.0 0.0 0.0 }
+ float-4{ 0.0 0.0 2.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+] [ float-4{ 3.0 4.0 2.0 0.0 } scale-matrix4 ] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1/8. 0.0 0.0 0.0 }
+ float-4{ 0.0 1/4. 0.0 0.0 }
+ float-4{ 0.0 0.0 1/2. 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+] [ float-4{ 8.0 4.0 2.0 0.0 } ortho-matrix4 ] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 0.0 0.0 -1.0 0.0 }
+ float-4{ 1.0 0.0 0.0 0.0 }
+ float-4{ 0.0 1.0 0.0 0.0 }
+ float-4{ 3.0 4.0 2.0 1.0 }
+ }
+ }
+] [
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 0.0 1.0 0.0 3.0 }
+ float-4{ 0.0 0.0 1.0 4.0 }
+ float-4{ -1.0 0.0 0.0 2.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ } transpose-matrix4
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 3.0 }
+ float-4{ 0.0 1.0 0.0 4.0 }
+ float-4{ 0.0 0.0 1.0 2.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+] [ float-4{ 3.0 4.0 2.0 0.0 } translation-matrix4 ] unit-test
+
+[ t ] [
+ float-4{ $[ 1/2. sqrt ] 0.0 $[ 1/2. sqrt ] 0.0 } pi rotation-matrix4
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 0.0 0.0 1.0 0.0 }
+ float-4{ 0.0 -1.0 0.0 0.0 }
+ float-4{ 1.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ 1.0e-7 m~
+] unit-test
+
+[ t ] [
+ float-4{ 0.0 1.0 0.0 1.0 } pi 1/2. * rotation-matrix4
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 0.0 0.0 1.0 0.0 }
+ float-4{ 0.0 1.0 0.0 0.0 }
+ float-4{ -1.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ 1.0e-7 m~
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 2.0 0.0 0.0 10.0 }
+ float-4{ 0.0 3.0 0.0 18.0 }
+ float-4{ 0.0 0.0 4.0 28.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+] [
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 2.0 0.0 0.0 0.0 }
+ float-4{ 0.0 3.0 0.0 0.0 }
+ float-4{ 0.0 0.0 4.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 5.0 }
+ float-4{ 0.0 1.0 0.0 6.0 }
+ float-4{ 0.0 0.0 1.0 7.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ m4.
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 3.0 0.0 0.0 5.0 }
+ float-4{ 0.0 4.0 0.0 6.0 }
+ float-4{ 0.0 0.0 5.0 7.0 }
+ float-4{ 0.0 0.0 0.0 2.0 }
+ }
+ }
+] [
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 2.0 0.0 0.0 0.0 }
+ float-4{ 0.0 3.0 0.0 0.0 }
+ float-4{ 0.0 0.0 4.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 5.0 }
+ float-4{ 0.0 1.0 0.0 6.0 }
+ float-4{ 0.0 0.0 1.0 7.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ m4+
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 -5.0 }
+ float-4{ 0.0 2.0 0.0 -6.0 }
+ float-4{ 0.0 0.0 3.0 -7.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ }
+ }
+] [
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 2.0 0.0 0.0 0.0 }
+ float-4{ 0.0 3.0 0.0 0.0 }
+ float-4{ 0.0 0.0 4.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 5.0 }
+ float-4{ 0.0 1.0 0.0 6.0 }
+ float-4{ 0.0 0.0 1.0 7.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ m4-
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 3.0 0.0 0.0 15.0 }
+ float-4{ 0.0 3.0 0.0 18.0 }
+ float-4{ 0.0 0.0 3.0 21.0 }
+ float-4{ 0.0 0.0 0.0 3.0 }
+ }
+ }
+] [
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 5.0 }
+ float-4{ 0.0 1.0 0.0 6.0 }
+ float-4{ 0.0 0.0 1.0 7.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ 3.0 m4*n
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 3.0 0.0 0.0 15.0 }
+ float-4{ 0.0 3.0 0.0 18.0 }
+ float-4{ 0.0 0.0 3.0 21.0 }
+ float-4{ 0.0 0.0 0.0 3.0 }
+ }
+ }
+] [
+ 3.0
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 5.0 }
+ float-4{ 0.0 1.0 0.0 6.0 }
+ float-4{ 0.0 0.0 1.0 7.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+ n*m4
+] unit-test
+
+[
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1/2. 0.0 0.0 0.0 }
+ float-4{ 0.0 1/2. 0.0 0.0 }
+ float-4{ 0.0 0.0 -6/4. -10/4. }
+ float-4{ 0.0 0.0 -1.0 0.0 }
+ }
+ }
+] [
+ float-4{ 2.0 2.0 0.0 0.0 } 1.0 5.0
+ frustum-matrix4
+] unit-test
--- /dev/null
+! (c)Joe Groff bsd license
+USING: accessors classes.struct fry generalizations kernel locals
+math math.combinatorics math.functions math.matrices.simd math.vectors
+math.vectors.simd sequences sequences.private specialized-arrays
+typed ;
+QUALIFIED-WITH: alien.c-types c
+SIMD: c:float
+SPECIALIZED-ARRAY: float-4
+IN: math.matrices.simd
+
+STRUCT: matrix4
+ { rows float-4[4] } ;
+
+INSTANCE: matrix4 immutable-sequence
+
+M: matrix4 length drop 4 ; inline
+M: matrix4 nth-unsafe rows>> nth-unsafe ; inline
+M: matrix4 new-sequence 2drop matrix4 (struct) ; inline
+
+<PRIVATE
+
+: rows ( a -- a1 a2 a3 a4 )
+ rows>> 4 firstn ; inline
+
+:: set-rows ( c1 c2 c3 c4 c -- c )
+ c rows>> :> rows
+ c1 rows set-first
+ c2 rows set-second
+ c3 rows set-third
+ c4 rows set-fourth
+ c ; inline
+
+: make-matrix4 ( quot: ( -- c1 c2 c3 c4 ) -- c )
+ matrix4 (struct) swap dip set-rows ; inline
+
+:: 2map-rows ( a b quot -- c )
+ [
+ a rows :> a4 :> a3 :> a2 :> a1
+ b rows :> b4 :> b3 :> b2 :> b1
+
+ a1 b1 quot call
+ a2 b2 quot call
+ a3 b3 quot call
+ a4 b4 quot call
+ ] make-matrix4 ; inline
+
+: map-rows ( a quot -- c )
+ '[ rows _ 4 napply ] make-matrix4 ; inline
+
+PRIVATE>
+
+TYPED: m4+ ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v+ ] 2map-rows ;
+TYPED: m4- ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v- ] 2map-rows ;
+TYPED: m4* ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v* ] 2map-rows ;
+TYPED: m4/ ( a: matrix4 b: matrix4 -- c: matrix4 ) [ v/ ] 2map-rows ;
+
+TYPED: m4*n ( a: matrix4 b: float -- c: matrix4 ) [ v*n ] curry map-rows ;
+TYPED: m4/n ( a: matrix4 b: float -- c: matrix4 ) [ v/n ] curry map-rows ;
+TYPED: n*m4 ( a: float b: matrix4 -- c: matrix4 ) [ n*v ] with map-rows ;
+TYPED: n/m4 ( a: float b: matrix4 -- c: matrix4 ) [ n/v ] with map-rows ;
+
+TYPED:: m4. ( a: matrix4 b: matrix4 -- c: matrix4 )
+ [
+ a rows :> a4 :> a3 :> a2 :> a1
+ b rows :> b4 :> b3 :> b2 :> b1
+
+ a1 first b1 n*v :> c1a
+ a2 first b1 n*v :> c2a
+ a3 first b1 n*v :> c3a
+ a4 first b1 n*v :> c4a
+
+ a1 second b2 n*v c1a v+ :> c1b
+ a2 second b2 n*v c2a v+ :> c2b
+ a3 second b2 n*v c3a v+ :> c3b
+ a4 second b2 n*v c4a v+ :> c4b
+
+ a1 third b3 n*v c1b v+ :> c1c
+ a2 third b3 n*v c2b v+ :> c2c
+ a3 third b3 n*v c3b v+ :> c3c
+ a4 third b3 n*v c4b v+ :> c4c
+
+ a1 fourth b4 n*v c1c v+
+ a2 fourth b4 n*v c2c v+
+ a3 fourth b4 n*v c3c v+
+ a4 fourth b4 n*v c4c v+
+ ] make-matrix4 ;
+
+TYPED:: v.m4 ( a: float-4 b: matrix4 -- c: float-4 )
+ b rows :> b4 :> b3 :> b2 :> b1
+
+ a first b1 n*v
+ a second b2 n*v v+
+ a third b3 n*v v+
+ a fourth b4 n*v v+ ;
+
+TYPED:: m4.v ( a: matrix4 b: float-4 -- c: float-4 )
+ a rows [ b v. ] 4 napply float-4-boa ;
+
+CONSTANT: identity-matrix4
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 1.0 0.0 0.0 0.0 }
+ float-4{ 0.0 1.0 0.0 0.0 }
+ float-4{ 0.0 0.0 1.0 0.0 }
+ float-4{ 0.0 0.0 0.0 1.0 }
+ }
+ }
+
+CONSTANT: zero-matrix4
+ S{ matrix4 f
+ float-4-array{
+ float-4{ 0.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ float-4{ 0.0 0.0 0.0 0.0 }
+ }
+ }
+
+TYPED:: m4^n ( m: matrix4 n: fixnum -- m^n: matrix4 )
+ identity-matrix4 n [ m m4. ] times ;
+
+: vmerge-diagonal* ( x y -- h t )
+ [ (vmerge-head) ] [ swap (vmerge-tail) ] 2bi ; inline
+: vmerge-diagonal ( x -- h t )
+ 0.0 float-4-with vmerge-diagonal* ; inline
+
+TYPED: diagonal-matrix4 ( diagonal: float-4 -- matrix: matrix4 )
+ [ vmerge-diagonal [ vmerge-diagonal ] bi@ ] make-matrix4 ;
+
+: vmerge-transpose ( a b c d -- a' b' c' d' )
+ [ (vmerge) ] bi-curry@ bi* ; inline
+
+TYPED: transpose-matrix4 ( matrix: matrix4 -- matrix: matrix4 )
+ [ rows vmerge-transpose vmerge-transpose ] make-matrix4 ;
+
+: scale-matrix4 ( factors -- matrix )
+ [ float-4{ t t t f } ] dip float-4{ 0.0 0.0 0.0 1.0 } v?
+ diagonal-matrix4 ; inline
+
+: ortho-matrix4 ( factors -- matrix )
+ float-4{ 1.0 1.0 1.0 1.0 } swap v/ scale-matrix4 ; inline
+
+TYPED:: translation-matrix4 ( offset: float-4 -- matrix: matrix4 )
+ [
+ float-4{ 1.0 1.0 1.0 1.0 } :> diagonal
+
+ offset 0 float-4-with (vmerge)
+ [ 0 float-4-with swap (vmerge) ] bi@ drop :> z :> y :> x
+
+ diagonal y vmerge-diagonal*
+ [ x vmerge-diagonal* ]
+ [ z vmerge-diagonal* ] bi*
+ ] make-matrix4 ;
+
+TYPED:: rotation-matrix4 ( axis: float-4 theta: float -- matrix: matrix4 )
+ ! x*x + c*(1.0 - x*x) x*y*(1.0 - c) - s*z x*z*(1.0 - c) + s*y 0
+ ! x*y*(1.0 - c) + s*z y*y + c*(1.0 - y*y) y*z*(1.0 - c) - s*x 0
+ ! x*z*(1.0 - c) - s*y y*z*(1.0 - c) + s*x z*z + c*(1.0 - z*z) 0
+ ! 0 0 0 1
+ matrix4 (struct) :> triangle-m
+ theta cos :> c
+ theta sin :> s
+
+ float-4{ 1.0 -1.0 1.0 0.0 } :> triangle-sign
+
+ c float-4-with :> cc
+ s float-4-with :> ss
+ 1.0 float-4-with :> ones
+ ones cc v- :> 1-c
+ axis axis v* :> axis2
+
+ axis2 cc ones axis2 v- v* v+ :> diagonal
+
+ axis { 1 0 0 3 } vshuffle axis { 2 2 1 3 } vshuffle v* 1-c v*
+ float-4{ t t t f } vbitand :> triangle-a
+ ss axis v* triangle-sign v* :> triangle-b
+ triangle-a triangle-b v+ :> triangle-lo
+ triangle-a triangle-b v- :> triangle-hi
+
+ diagonal scale-matrix4 :> diagonal-m
+
+ triangle-hi { 3 2 1 3 } vshuffle
+ triangle-hi { 3 3 0 3 } vshuffle triangle-lo { 2 3 3 3 } vshuffle v+
+ triangle-lo { 1 0 3 3 } vshuffle
+ float-4 new
+
+ triangle-m set-rows drop
+
+ diagonal-m triangle-m m4+ ;
+
+TYPED:: frustum-matrix4 ( xy: float-4 near: float far: float -- matrix: matrix4 )
+ [
+ near near near far + 2 near far * * float-4-boa ! num
+ float-4{ t t f f } xy near far - float-4-with v? ! denom
+ v/ :> fov
+
+ fov 0.0 float-4-with (vmerge-head) vmerge-diagonal
+ fov float-4{ f f t t } vand
+ float-4{ 0.0 0.0 -1.0 0.0 }
+ ] make-matrix4 ;
+
--- /dev/null
+SIMD accelerated 4x4 matrix math
ARTICLE: "memory.piles" "Piles"
"A " { $link pile } " is a block of raw memory. Portions of its memory can be allocated from the beginning of the pile in constant time, and the pile can be emptied and its pointer reset to the beginning."
-{ $subsection <pile> }
-{ $subsection pile-alloc }
-{ $subsection <pile-c-array> }
-{ $subsection <pile-c-object> }
-{ $subsection pile-align }
-{ $subsection pile-empty }
+{ $subsections
+ <pile>
+ pile-alloc
+ <pile-c-array>
+ <pile-c-object>
+ pile-align
+ pile-empty
+}
"An example of the utility of piles is in video games. For example, the game Abuse was scripted with a Lisp dialect. In order to avoid stalls from traditional GC or heap-based allocators, the Abuse Lisp VM would allocate values from a preallocated pile over the course of a frame, and release the entire pile at the end of the frame." ;
ABOUT: "memory.piles"
! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types destructors kernel libc math ;
+USING: accessors alien alien.c-types alien.data destructors kernel libc math ;
IN: memory.piles
TUPLE: pile
ARTICLE: "memory.pools" "Pools"
"The " { $vocab-link "memory.pools" } " vocabulary provides " { $link pool } " objects which manage preallocated collections of objects."
-{ $subsection pool }
-{ $subsection POSTPONE: POOL: }
-{ $subsection new-from-pool }
-{ $subsection free-to-pool } ;
+{ $subsections
+ pool
+ POSTPONE: POOL:
+ new-from-pool
+ free-to-pool
+} ;
ABOUT: "memory.pools"
\r
ARTICLE: "models-history" "History models"\r
"History models record previous values."\r
-{ $subsection history }\r
-{ $subsection <history> }\r
+{ $subsections\r
+ history\r
+ <history>\r
+}\r
"Recording history:"\r
-{ $subsection add-history }\r
+{ $subsections add-history }\r
"Navigating the history:"\r
-{ $subsection go-back }\r
-{ $subsection go-forward } ;\r
+{ $subsections\r
+ go-back\r
+ go-forward\r
+} ;\r
\r
ABOUT: "models-history"\r
USING: accessors arrays assocs bson.constants combinators
combinators.smart constructors destructors formatting fry hashtables
io io.pools io.sockets kernel linked-assocs math mongodb.connection
-mongodb.msg parser prettyprint sequences sets splitting strings
+mongodb.msg parser prettyprint prettyprint.custom prettyprint.sections
+sequences sets splitting strings
tools.continuations uuid memoize locals ;
IN: mongodb.driver
ERROR: mdb-error msg ;
+M: mdb-error pprint* ( obj -- )
+ msg>> text ;
+
: >pwd-digest ( user password -- digest )
"mongo" swap 3array ":" join md5-checksum ;
--- /dev/null
+USING: alien.c-types alien.syntax io io.encodings.utf16n
+io.encodings.utf8 io.files kernel namespaces sequences system threads
+unix.utilities ;
+IN: native-thread-test
+
+FUNCTION: void* start_standalone_factor_in_new_thread ( int argc, char** argv ) ;
+
+HOOK: native-string-encoding os ( -- encoding )
+M: windows native-string-encoding utf16n ;
+M: unix native-string-encoding utf8 ;
+
+: start-vm-in-os-thread ( args -- threadhandle )
+ \ vm get-global prefix
+ [ length ] [ native-string-encoding strings>alien ] bi
+ start_standalone_factor_in_new_thread ;
+
+: start-tetris-in-os-thread ( -- )
+ { "-run=tetris" } start-vm-in-os-thread drop ;
+
+: start-testthread-in-os-thread ( -- )
+ { "-run=native-thread-test" } start-vm-in-os-thread drop ;
+
+: testthread ( -- )
+ "/tmp/hello" utf8 [ "hello!\n" write ] with-file-appender 5000000 sleep ;
+
+MAIN: testthread
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors eval kernel lexer nested-comments tools.test ;
+IN: nested-comments.tests
+
+! Correct
+[ ] [
+ "USE: nested-comments (* comment *)" eval( -- )
+] unit-test
+
+[ ] [
+ "USE: nested-comments (* comment*)" eval( -- )
+] unit-test
+
+[ ] [
+ "USE: nested-comments (* comment
+*)" eval( -- )
+] unit-test
+
+[ ] [
+ "USE: nested-comments (* comment
+*)" eval( -- )
+] unit-test
+
+[ ] [
+ "USE: nested-comments (* comment
+*)" eval( -- )
+] unit-test
+
+[ ] [
+ "USE: nested-comments (* comment
+ (* *)
+
+*)" eval( -- )
+] unit-test
+
+! Malformed
+[
+ "USE: nested-comments (* comment
+ (* *)" eval( -- )
+] [
+ error>> T{ unexpected f "*)" f } =
+] must-fail-with
-! by blei on #concatenative\r
+! Copyright (C) 2009 blei, Doug Coleman.\r
+! See http://factorcode.org/license.txt for BSD license.\r
USING: kernel sequences math locals make multiline ;\r
IN: nested-comments\r
\r
-:: (subsequences-at) ( sseq seq n -- )\r
- sseq seq n start*\r
- [ dup , sseq length + [ sseq seq ] dip (subsequences-at) ]\r
- when* ;\r
+: (count-subsequences) ( count substring string n -- count' )\r
+ [ 2dup ] dip start* [\r
+ pick length +\r
+ [ 1 + ] 3dip (count-subsequences)\r
+ ] [\r
+ 2drop\r
+ ] if* ;\r
\r
-: subsequences-at ( sseq seq -- indices )\r
- [ 0 (subsequences-at) ] { } make ;\r
+: count-subsequences ( subseq seq -- n )\r
+ [ 0 ] 2dip 0 (count-subsequences) ;\r
\r
-: count-subsequences ( sseq seq -- i )\r
- subsequences-at length ;\r
+: parse-nestable-comment ( parsed-vector left-to-parse -- parsed-vector )\r
+ 1 - "*)" parse-multiline-string\r
+ [ "(*" ] dip\r
+ count-subsequences + dup 0 > [ parse-nestable-comment ] [ drop ] if ;\r
\r
-: parse-all-(* ( parsed-vector left-to-parse -- parsed-vector )\r
- 1 - "*)" parse-multiline-string [ "(*" ] dip\r
- count-subsequences + dup 0 > [ parse-all-(* ] [ drop ] if ;\r
-\r
-SYNTAX: (* 1 parse-all-(* ;
\ No newline at end of file
+SYNTAX: (* 1 parse-nestable-comment ;\r
USING: accessors arrays byte-arrays combinators
combinators.short-circuit fry hints images kernel locals math
-math.affine-transforms math.functions math.order
-math.polynomials math.private math.vectors random
-random.mersenne-twister sequences sequences.private
-sequences.product ;
+math.affine-transforms math.functions math.order math.polynomials
+math.vectors random random.mersenne-twister sequences
+sequences.private sequences.product ;
IN: noise
: <perlin-noise-table> ( -- table )
HINTS: grad { fixnum float float float } ;
: unit-cube ( point -- cube )
- [ floor >fixnum 256 rem ] map ;
+ [ floor 256 rem ] map ;
:: hashes ( table x y z -- aaa baa aba bba aab bab abb bbb )
- x table nth-unsafe y fixnum+fast :> a
- x 1 fixnum+fast table nth-unsafe y fixnum+fast :> b
-
- a table nth-unsafe z fixnum+fast :> aa
- b table nth-unsafe z fixnum+fast :> ba
- a 1 fixnum+fast table nth-unsafe z fixnum+fast :> ab
- b 1 fixnum+fast table nth-unsafe z fixnum+fast :> bb
-
- aa table nth-unsafe
- ba table nth-unsafe
- ab table nth-unsafe
- bb table nth-unsafe
- aa 1 fixnum+fast table nth-unsafe
- ba 1 fixnum+fast table nth-unsafe
- ab 1 fixnum+fast table nth-unsafe
- bb 1 fixnum+fast table nth-unsafe ; inline
+ x table nth-unsafe y + :> a
+ x 1 + table nth-unsafe y + :> b
+
+ a table nth-unsafe z + :> aa
+ b table nth-unsafe z + :> ba
+ a 1 + table nth-unsafe z + :> ab
+ b 1 + table nth-unsafe z + :> bb
+
+ aa table nth-unsafe
+ ba table nth-unsafe
+ ab table nth-unsafe
+ bb table nth-unsafe
+ aa 1 + table nth-unsafe
+ ba 1 + table nth-unsafe
+ ab 1 + table nth-unsafe
+ bb 1 + table nth-unsafe ; inline
HINTS: hashes { byte-array fixnum fixnum fixnum } ;
! (c)2009 Joe Groff bsd license
-USING: accessors arrays grouping kernel locals math math.order
-math.ranges math.vectors math.vectors.homogeneous sequences
-specialized-arrays.float ;
+USING: accessors alien.c-types arrays grouping kernel locals
+math math.order math.ranges math.vectors
+math.vectors.homogeneous sequences specialized-arrays ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: nurbs
TUPLE: nurbs-curve
--- /dev/null
+Chris Double
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING:
+ alien
+ alien.c-types
+ alien.libraries
+ alien.syntax
+ classes.struct
+ combinators
+ kernel
+ system
+;
+IN: ogg
+
+<<
+"ogg" {
+ { [ os winnt? ] [ "ogg.dll" ] }
+ { [ os macosx? ] [ "libogg.0.dylib" ] }
+ { [ os unix? ] [ "libogg.so" ] }
+} cond "cdecl" add-library
+>>
+
+LIBRARY: ogg
+
+STRUCT: oggpack-buffer
+ { endbyte long }
+ { endbit int }
+ { buffer uchar* }
+ { ptr uchar* }
+ { storage long } ;
+
+STRUCT: ogg-page
+ { header uchar* }
+ { header_len long }
+ { body uchar* }
+ { body_len long } ;
+
+STRUCT: ogg-stream-state
+ { body_data uchar* }
+ { body_storage long }
+ { body_fill long }
+ { body_returned long }
+ { lacing_vals int* }
+ { granule_vals longlong* }
+ { lacing_storage long }
+ { lacing_fill long }
+ { lacing_packet long }
+ { lacing_returned long }
+ { header { uchar 282 } }
+ { header_fill int }
+ { e_o_s int }
+ { b_o_s int }
+ { serialno long }
+ { pageno long }
+ { packetno longlong }
+ { granulepos longlong } ;
+
+STRUCT: ogg-packet
+ { packet uchar* }
+ { bytes long }
+ { b_o_s long }
+ { e_o_s long }
+ { granulepos longlong }
+ { packetno longlong } ;
+
+STRUCT: ogg-sync-state
+ { data uchar* }
+ { storage int }
+ { fill int }
+ { returned int }
+ { unsynced int }
+ { headerbytes int }
+ { bodybytes int } ;
+
+FUNCTION: void oggpack_writeinit ( oggpack-buffer* b ) ;
+FUNCTION: void oggpack_writetrunc ( oggpack-buffer* b, long bits ) ;
+FUNCTION: void oggpack_writealign ( oggpack-buffer* b) ;
+FUNCTION: void oggpack_writecopy ( oggpack-buffer* b, void* source, long bits ) ;
+FUNCTION: void oggpack_reset ( oggpack-buffer* b ) ;
+FUNCTION: void oggpack_writeclear ( oggpack-buffer* b ) ;
+FUNCTION: void oggpack_readinit ( oggpack-buffer* b, uchar* buf, int bytes ) ;
+FUNCTION: void oggpack_write ( oggpack-buffer* b, ulong value, int bits ) ;
+FUNCTION: long oggpack_look ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long oggpack_look1 ( oggpack-buffer* b ) ;
+FUNCTION: void oggpack_adv ( oggpack-buffer* b, int bits ) ;
+FUNCTION: void oggpack_adv1 ( oggpack-buffer* b ) ;
+FUNCTION: long oggpack_read ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long oggpack_read1 ( oggpack-buffer* b ) ;
+FUNCTION: long oggpack_bytes ( oggpack-buffer* b ) ;
+FUNCTION: long oggpack_bits ( oggpack-buffer* b ) ;
+FUNCTION: uchar* oggpack_get_buffer ( oggpack-buffer* b ) ;
+FUNCTION: void oggpackB_writeinit ( oggpack-buffer* b ) ;
+FUNCTION: void oggpackB_writetrunc ( oggpack-buffer* b, long bits ) ;
+FUNCTION: void oggpackB_writealign ( oggpack-buffer* b ) ;
+FUNCTION: void oggpackB_writecopy ( oggpack-buffer* b, void* source, long bits ) ;
+FUNCTION: void oggpackB_reset ( oggpack-buffer* b ) ;
+FUNCTION: void oggpackB_writeclear ( oggpack-buffer* b ) ;
+FUNCTION: void oggpackB_readinit ( oggpack-buffer* b, uchar* buf, int bytes ) ;
+FUNCTION: void oggpackB_write ( oggpack-buffer* b, ulong value, int bits ) ;
+FUNCTION: long oggpackB_look ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long oggpackB_look1 ( oggpack-buffer* b ) ;
+FUNCTION: void oggpackB_adv ( oggpack-buffer* b, int bits ) ;
+FUNCTION: void oggpackB_adv1 ( oggpack-buffer* b ) ;
+FUNCTION: long oggpackB_read ( oggpack-buffer* b, int bits ) ;
+FUNCTION: long oggpackB_read1 ( oggpack-buffer* b ) ;
+FUNCTION: long oggpackB_bytes ( oggpack-buffer* b ) ;
+FUNCTION: long oggpackB_bits ( oggpack-buffer* b ) ;
+FUNCTION: uchar* oggpackB_get_buffer ( oggpack-buffer* b ) ;
+FUNCTION: int ogg_stream_packetin ( ogg-stream-state* os, ogg-packet* op ) ;
+FUNCTION: int ogg_stream_pageout ( ogg-stream-state* os, ogg-page* og ) ;
+FUNCTION: int ogg_stream_flush ( ogg-stream-state* os, ogg-page* og ) ;
+FUNCTION: int ogg_sync_init ( ogg-sync-state* oy ) ;
+FUNCTION: int ogg_sync_clear ( ogg-sync-state* oy ) ;
+FUNCTION: int ogg_sync_reset ( ogg-sync-state* oy ) ;
+FUNCTION: int ogg_sync_destroy ( ogg-sync-state* oy ) ;
+
+FUNCTION: void* ogg_sync_buffer ( ogg-sync-state* oy, long size ) ;
+FUNCTION: int ogg_sync_wrote ( ogg-sync-state* oy, long bytes ) ;
+FUNCTION: long ogg_sync_pageseek ( ogg-sync-state* oy, ogg-page* og ) ;
+FUNCTION: int ogg_sync_pageout ( ogg-sync-state* oy, ogg-page* og ) ;
+FUNCTION: int ogg_stream_pagein ( ogg-stream-state* os, ogg-page* og ) ;
+FUNCTION: int ogg_stream_packetout ( ogg-stream-state* os, ogg-packet* op ) ;
+FUNCTION: int ogg_stream_packetpeek ( ogg-stream-state* os, ogg-packet* op ) ;
+FUNCTION: int ogg_stream_init ( ogg-stream-state* os, int serialno ) ;
+FUNCTION: int ogg_stream_clear ( ogg-stream-state* os ) ;
+FUNCTION: int ogg_stream_reset ( ogg-stream-state* os ) ;
+FUNCTION: int ogg_stream_reset_serialno ( ogg-stream-state* os, int serialno ) ;
+FUNCTION: int ogg_stream_destroy ( ogg-stream-state* os ) ;
+FUNCTION: int ogg_stream_eos ( ogg-stream-state* os ) ;
+FUNCTION: void ogg_page_checksum_set ( ogg-page* og ) ;
+FUNCTION: int ogg_page_version ( ogg-page* og ) ;
+FUNCTION: int ogg_page_continued ( ogg-page* og ) ;
+FUNCTION: int ogg_page_bos ( ogg-page* og ) ;
+FUNCTION: int ogg_page_eos ( ogg-page* og ) ;
+FUNCTION: longlong ogg_page_granulepos ( ogg-page* og ) ;
+FUNCTION: int ogg_page_serialno ( ogg-page* og ) ;
+FUNCTION: long ogg_page_pageno ( ogg-page* og ) ;
+FUNCTION: int ogg_page_packets ( ogg-page* og ) ;
+FUNCTION: void ogg_packet_clear ( ogg-packet* op ) ;
+
--- /dev/null
+Ogg media library binding
--- /dev/null
+bindings
+audio
+video
--- /dev/null
+Chris Double
--- /dev/null
+Ogg Theora video library binding
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING:
+ alien
+ alien.c-types
+ alien.libraries
+ alien.syntax
+ classes.struct
+ combinators
+ kernel
+ ogg
+ system
+;
+IN: ogg.theora
+
+<<
+"theoradec" {
+ { [ os winnt? ] [ "theoradec.dll" ] }
+ { [ os macosx? ] [ "libtheoradec.0.dylib" ] }
+ { [ os unix? ] [ "libtheoradec.so" ] }
+} cond "cdecl" add-library
+
+"theoraenc" {
+ { [ os winnt? ] [ "theoraenc.dll" ] }
+ { [ os macosx? ] [ "libtheoraenc.0.dylib" ] }
+ { [ os unix? ] [ "libtheoraenc.so" ] }
+} cond "cdecl" add-library
+>>
+
+CONSTANT: TH-EFAULT -1
+CONSTANT: TH-EINVAL -10
+CONSTANT: TH-EBADHEADER -20
+CONSTANT: TH-ENOTFORMAT -21
+CONSTANT: TH-EVERSION -22
+CONSTANT: TH-EIMPL -23
+CONSTANT: TH-EBADPACKET -24
+CONSTANT: TH-DUPFRAME 1
+
+TYPEDEF: int th-colorspace
+CONSTANT: TH-CS-UNSPECIFIED 0
+CONSTANT: TH-CS-ITU-REC-470M 1
+CONSTANT: TH-CS-ITU-REC-470BG 2
+CONSTANT: TH-CS-NSPACES 3
+
+TYPEDEF: int th-pixelformat
+CONSTANT: TH-PF-RSVD 0
+CONSTANT: TH-PF-422 1
+CONSTANT: TH-PF-444 2
+CONSTANT: TH-PF-NFORMATS 3
+
+STRUCT: th-img-plane
+ { width int }
+ { height int }
+ { stride int }
+ { data uchar* }
+;
+
+TYPEDEF: th-img-plane[3] th-ycbcr-buffer
+
+STRUCT: th-info
+ { version-major uchar }
+ { version-minor uchar }
+ { version-subminor uchar }
+ { frame-width uint }
+ { frame-height uint }
+ { pic-width uint }
+ { pic-height uint }
+ { pic-x uint }
+ { pic-y uint }
+ { fps-numerator uint }
+ { fps-denominator uint }
+ { aspect-numerator uint }
+ { aspect-denominator uint }
+ { colorspace th-colorspace }
+ { pixel-fmt th-pixelformat }
+ { target-bitrate int }
+ { quality int }
+ { keyframe-granule-shift int }
+;
+
+STRUCT: th-comment
+ { user-comments char** }
+ { comment-lengths int* }
+ { comments int }
+ { vendor char* }
+;
+
+TYPEDEF: uchar[64] th-quant-base
+
+STRUCT: th-quant-ranges
+ { nranges int }
+ { sizes int* }
+ { base-matrices th-quant-base* }
+;
+
+STRUCT: th-quant-info
+ { dc-scale { short 64 } }
+ { ac-scale { short 64 } }
+ { loop-filter-limits { uchar 64 } }
+ { qi-ranges { th-quant-ranges 2 3 } }
+;
+
+CONSTANT: TH-NHUFFMANE-TABLES 80
+CONSTANT: TH-NDCT-TOKENS 32
+
+STRUCT: th-huff-code
+ { pattern int }
+ { nbits int }
+;
+
+LIBRARY: theoradec
+FUNCTION: char* th_version_string ( ) ;
+FUNCTION: uint th_version_number ( ) ;
+FUNCTION: longlong th_granule_frame ( void* encdec, longlong granpos) ;
+FUNCTION: int th_packet_isheader ( ogg-packet* op ) ;
+FUNCTION: int th_packet_iskeyframe ( ogg-packet* op ) ;
+FUNCTION: void th_info_init ( th-info* info ) ;
+FUNCTION: void th_info_clear ( th-info* info ) ;
+FUNCTION: void th_comment_init ( th-comment* tc ) ;
+FUNCTION: void th_comment_add ( th-comment* tc, char* comment ) ;
+FUNCTION: void th_comment_add_tag ( th-comment* tc, char* tag, char* value ) ;
+FUNCTION: char* th_comment_query ( th-comment* tc, char* tag, int count ) ;
+FUNCTION: int th_comment_query_count ( th-comment* tc, char* tag ) ;
+FUNCTION: void th_comment_clear ( th-comment* tc ) ;
+
+CONSTANT: TH-ENCCTL-SET-HUFFMAN-CODES 0
+CONSTANT: TH-ENCCTL-SET-QUANT-PARAMS 2
+CONSTANT: TH-ENCCTL-SET-KEYFRAME-FREQUENCY-FORCE 4
+CONSTANT: TH-ENCCTL-SET-VP3-COMPATIBLE 10
+CONSTANT: TH-ENCCTL-GET-SPLEVEL-MAX 12
+CONSTANT: TH-ENCCTL-SET-SPLEVEL 14
+CONSTANT: TH-ENCCTL-SET-DUP-COUNT 18
+CONSTANT: TH-ENCCTL-SET-RATE-FLAGS 20
+CONSTANT: TH-ENCCTL-SET-RATE-BUFFER 22
+CONSTANT: TH-ENCCTL-2PASS-OUT 24
+CONSTANT: TH-ENCCTL-2PASS-IN 26
+CONSTANT: TH-ENCCTL-SET-QUALITY 28
+CONSTANT: TH-ENCCTL-SET-BITRATE 30
+
+CONSTANT: TH-RATECTL-DROP-FRAMES 1
+CONSTANT: TH-RATECTL-CAP-OVERFLOW 2
+CONSTANT: TH-RATECTL-CAP-UNDERFOW 4
+
+TYPEDEF: void* th-enc-ctx
+
+LIBRARY: theoraenc
+FUNCTION: th-enc-ctx* th_encode_alloc ( th-info* info ) ;
+FUNCTION: int th_encode_ctl ( th-enc-ctx* enc, int req, void* buf, int buf_sz ) ;
+FUNCTION: int th_encode_flushheader ( th-enc-ctx* enc, th-comment* comments, ogg-packet* op ) ;
+FUNCTION: int th_encode_ycbcr_in ( th-enc-ctx* enc, th-ycbcr-buffer ycbcr ) ;
+FUNCTION: int th_encode_packetout ( th-enc-ctx* enc, int last, ogg-packet* op ) ;
+FUNCTION: void th_encode_free ( th-enc-ctx* enc ) ;
+
+CONSTANT: TH-DECCTL-GET-PPLEVEL-MAX 1
+CONSTANT: TH-DECCTL-SET-PPLEVEL 3
+CONSTANT: TH-DECCTL-SET-GRANPOS 5
+CONSTANT: TH-DECCTL-SET-STRIPE-CB 7
+CONSTANT: TH-DECCTL-SET-TELEMETRY-MBMODE 9
+CONSTANT: TH-DECCTL-SET-TELEMETRY-MV 11
+CONSTANT: TH-DECCTL-SET-TELEMETRY-QI 13
+CONSTANT: TH-DECCTL-SET-TELEMETRY-BITS 15
+
+TYPEDEF: void* th-stripe-decoded-func
+
+STRUCT: th-stripe-callback
+ { ctx void* }
+ { stripe-decoded th-stripe-decoded-func }
+;
+
+TYPEDEF: void* th-dec-ctx
+TYPEDEF: void* th-setup-info
+
+LIBRARY: theoradec
+FUNCTION: int th_decode_headerin ( th-info* info, th-comment* tc, th-setup-info** setup, ogg-packet* op ) ;
+FUNCTION: th-dec-ctx* th_decode_alloc ( th-info* info, th-setup-info* setup ) ;
+FUNCTION: void th_setup_free ( th-setup-info* setup ) ;
+FUNCTION: int th_decode_ctl ( th-dec-ctx* dec, int req, void* buf, int buf_sz ) ;
+FUNCTION: int th_decode_packetin ( th-dec-ctx* dec, ogg-packet* op, longlong granpos ) ;
+FUNCTION: int th_decode_ycbcr_out ( th-dec-ctx* dec, th-ycbcr-buffer ycbcr ) ;
+FUNCTION: void th_decode_free ( th-dec-ctx* dec ) ;
--- /dev/null
+Chris Double
--- /dev/null
+Ogg Vorbis audio library binding
--- /dev/null
+! Copyright (C) 2007 Chris Double.
+! See http://factorcode.org/license.txt for BSD license.
+!
+USING:
+ alien
+ alien.c-types
+ alien.libraries
+ alien.syntax
+ classes.struct
+ combinators
+ kernel
+ ogg
+ system
+;
+IN: ogg.vorbis
+
+<<
+"vorbis" {
+ { [ os winnt? ] [ "vorbis.dll" ] }
+ { [ os macosx? ] [ "libvorbis.0.dylib" ] }
+ { [ os unix? ] [ "libvorbis.so" ] }
+} cond "cdecl" add-library
+>>
+
+LIBRARY: vorbis
+
+STRUCT: vorbis-info
+ { version int }
+ { channels int }
+ { rate long }
+ { bitrate_upper long }
+ { bitrate_nominal long }
+ { bitrate_lower long }
+ { bitrate_window long }
+ { codec_setup void* }
+ ;
+
+STRUCT: vorbis-dsp-state
+ { analysisp int }
+ { vi vorbis-info* }
+ { pcm float** }
+ { pcmret float** }
+ { pcm_storage int }
+ { pcm_current int }
+ { pcm_returned int }
+ { preextrapolate int }
+ { eofflag int }
+ { lW long }
+ { W long }
+ { nW long }
+ { centerW long }
+ { granulepos longlong }
+ { sequence longlong }
+ { glue_bits longlong }
+ { time_bits longlong }
+ { floor_bits longlong }
+ { res_bits longlong }
+ { backend_state void* }
+ ;
+
+STRUCT: alloc-chain
+ { ptr void* }
+ { next void* }
+ ;
+
+STRUCT: vorbis-block
+ { pcm float** }
+ { opb oggpack-buffer }
+ { lW long }
+ { W long }
+ { nW long }
+ { pcmend int }
+ { mode int }
+ { eofflag int }
+ { granulepos longlong }
+ { sequence longlong }
+ { vd vorbis-dsp-state* }
+ { localstore void* }
+ { localtop long }
+ { localalloc long }
+ { totaluse long }
+ { reap alloc-chain* }
+ { glue_bits long }
+ { time_bits long }
+ { floor_bits long }
+ { res_bits long }
+ { internal void* }
+ ;
+
+STRUCT: vorbis-comment
+ { usercomments char** }
+ { comment_lengths int* }
+ { comments int }
+ { vendor char* }
+ ;
+
+FUNCTION: void vorbis_info_init ( vorbis-info* vi ) ;
+FUNCTION: void vorbis_info_clear ( vorbis-info* vi ) ;
+FUNCTION: int vorbis_info_blocksize ( vorbis-info* vi, int zo ) ;
+FUNCTION: void vorbis_comment_init ( vorbis-comment* vc ) ;
+FUNCTION: void vorbis_comment_add ( vorbis-comment* vc, char* comment ) ;
+FUNCTION: void vorbis_comment_add_tag ( vorbis-comment* vc, char* tag, char* contents ) ;
+FUNCTION: char* vorbis_comment_query ( vorbis-comment* vc, char* tag, int count ) ;
+FUNCTION: int vorbis_comment_query_count ( vorbis-comment* vc, char* tag ) ;
+FUNCTION: void vorbis_comment_clear ( vorbis-comment* vc ) ;
+FUNCTION: int vorbis_block_init ( vorbis-dsp-state* v, vorbis-block* vb ) ;
+FUNCTION: int vorbis_block_clear ( vorbis-block* vb ) ;
+FUNCTION: void vorbis_dsp_clear ( vorbis-dsp-state* v ) ;
+FUNCTION: double vorbis_granule_time ( vorbis-dsp-state* v, longlong granulepos ) ;
+FUNCTION: int vorbis_analysis_init ( vorbis-dsp-state* v, vorbis-info* vi ) ;
+FUNCTION: int vorbis_commentheader_out ( vorbis-comment* vc, ogg-packet* op ) ;
+FUNCTION: int vorbis_analysis_headerout ( vorbis-dsp-state* v,
+ vorbis-comment* vc,
+ ogg-packet* op,
+ ogg-packet* op_comm,
+ ogg-packet* op_code ) ;
+FUNCTION: float** vorbis_analysis_buffer ( vorbis-dsp-state* v, int vals ) ;
+FUNCTION: int vorbis_analysis_wrote ( vorbis-dsp-state* v, int vals ) ;
+FUNCTION: int vorbis_analysis_blockout ( vorbis-dsp-state* v, vorbis-block* vb ) ;
+FUNCTION: int vorbis_analysis ( vorbis-block* vb, ogg-packet* op ) ;
+FUNCTION: int vorbis_bitrate_addblock ( vorbis-block* vb ) ;
+FUNCTION: int vorbis_bitrate_flushpacket ( vorbis-dsp-state* vd,
+ ogg-packet* op ) ;
+FUNCTION: int vorbis_synthesis_headerin ( vorbis-info* vi, vorbis-comment* vc,
+ ogg-packet* op ) ;
+FUNCTION: int vorbis_synthesis_init ( vorbis-dsp-state* v, vorbis-info* vi ) ;
+FUNCTION: int vorbis_synthesis_restart ( vorbis-dsp-state* v ) ;
+FUNCTION: int vorbis_synthesis ( vorbis-block* vb, ogg-packet* op ) ;
+FUNCTION: int vorbis_synthesis_trackonly ( vorbis-block* vb, ogg-packet* op ) ;
+FUNCTION: int vorbis_synthesis_blockin ( vorbis-dsp-state* v, vorbis-block* vb ) ;
+FUNCTION: int vorbis_synthesis_pcmout ( vorbis-dsp-state* v, float*** pcm ) ;
+FUNCTION: int vorbis_synthesis_lapout ( vorbis-dsp-state* v, float*** pcm ) ;
+FUNCTION: int vorbis_synthesis_read ( vorbis-dsp-state* v, int samples ) ;
+FUNCTION: long vorbis_packet_blocksize ( vorbis-info* vi, ogg-packet* op ) ;
+FUNCTION: int vorbis_synthesis_halfrate ( vorbis-info* v, int flag ) ;
+FUNCTION: int vorbis_synthesis_halfrate_p ( vorbis-info* v ) ;
+
+CONSTANT: OV_FALSE -1
+CONSTANT: OV_EOF -2
+CONSTANT: OV_HOLE -3
+CONSTANT: OV_EREAD -128
+CONSTANT: OV_EFAULT -129
+CONSTANT: OV_EIMPL -130
+CONSTANT: OV_EINVAL -131
+CONSTANT: OV_ENOTVORBIS -132
+CONSTANT: OV_EBADHEADER -133
+CONSTANT: OV_EVERSION -134
+CONSTANT: OV_ENOTAUDIO -135
+CONSTANT: OV_EBADPACKET -136
+CONSTANT: OV_EBADLINK -137
+CONSTANT: OV_ENOSEEK -138
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel alien alien.syntax shuffle
-openal.backend namespaces system generalizations ;
+openal openal.backend namespaces system generalizations ;
IN: openal.macosx
LIBRARY: alut
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors arrays alien system combinators alien.syntax namespaces
- alien.c-types sequences vocabs.loader shuffle
- openal.backend specialized-arrays.uint alien.libraries generalizations ;
+USING: kernel accessors arrays alien system combinators
+alien.syntax namespaces alien.c-types sequences vocabs.loader
+shuffle openal.backend alien.libraries generalizations
+specialized-arrays ;
+FROM: alien.c-types => float short ;
+SPECIALIZED-ARRAY: uint
IN: openal
<< "alut" {
! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types alien.syntax combinators generalizations
-kernel openal.backend ;
+kernel openal openal.backend ;
IN: openal.other
LIBRARY: alut
! Copyright (C) 2005 Alex Chapman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.libraries alien.syntax kernel sequences words system
-combinators ;
+USING: alien alien.c-types alien.libraries alien.syntax kernel
+sequences words system combinators opengl.gl ;
IN: opengl.glu
+<<
+
os {
{ [ dup macosx? ] [ drop ] }
{ [ dup windows? ] [ drop ] }
{ [ dup unix? ] [ drop "glu" "libGLU.so.1" "cdecl" add-library ] }
} cond
+>>
+
LIBRARY: glu
! These are defined as structs in glu.h, but we only ever use pointers to them
-TYPEDEF: void* GLUnurbs*
-TYPEDEF: void* GLUquadric*
-TYPEDEF: void* GLUtesselator*
-TYPEDEF: void* GLubyte*
+C-TYPE: GLUnurbs
+C-TYPE: GLUquadric
+C-TYPE: GLUtesselator
+C-TYPE: GLubyte
TYPEDEF: void* GLUfuncptr
! StringName
! FUNCTION: GLint gluUnProject4 ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble clipW, GLdouble* model, GLdouble* proj, GLint* view, GLdouble nearVal, GLdouble farVal, GLdouble* objX, GLdouble* objY, GLdouble* objZ, GLdouble* objW ) ;
: gl-look-at ( eye focus up -- )
- [ first3 ] tri@ gluLookAt ;
\ No newline at end of file
+ [ first3 ] tri@ gluLookAt ;
{ $slide "Locals example"
"Area of a triangle using Heron's formula"
{ $code
- <" :: area ( a b c -- x )
+ """:: area ( a b c -- x )
a b c + + 2 / :> p
p
p a - *
p b - *
- p c - * sqrt ;">
+ p c - * sqrt ;"""
}
}
{ $slide "Previous example without locals"
"A bit unwieldy..."
{ $code
- <" : area ( a b c -- x )
+ """: area ( a b c -- x )
[ ] [ + + 2 / ] 3bi
[ '[ _ - ] tri@ ] [ neg ] bi
- * * * sqrt ;"> }
+ * * * sqrt ;""" }
}
{ $slide "More idiomatic version"
"But there's a trick: put the points in an array"
- { $code <" : v-n ( v n -- w ) '[ _ - ] map ;
+ { $code """: v-n ( v n -- w ) '[ _ - ] map ;
: area ( points -- x )
[ 0 suffix ] [ sum 2 / ] bi
- v-n product sqrt ;"> }
+ v-n product sqrt ;""" }
}
! { $slide "The parser"
! "All data types have a literal syntax"
}
{ $slide "This is hard with mainstream syntax!"
{ $code
- <" var customer = ...;
+ """var customer = ...;
var orders = (customer == null ? null : customer.orders);
var order = (orders == null ? null : orders[0]);
-var price = (order == null ? null : order.price);"> }
+var price = (order == null ? null : order.price);""" }
}
{ $slide "An ad-hoc solution"
"Something like..."
}
{ $slide "UI example"
{ $code
{ 5 5 } >>gap
1 >>fill
"Hello world!" <label> add-gadget
"Click me!" [ drop beep ]
<bevel-button> add-gadget
<editor> <scroller> add-gadget
-"UI test" open-window "> }
+"UI test" open-window""" }
}
{ $slide "Help system"
"Help markup is just literal data"
{ $syntax "a => b" }
{ $description "Constructs a two-element array from the objects immediately before and after the " { $snippet "=>" } ". This syntax can be used inside sequence and assoc literals." }
{ $examples
-{ $unchecked-example <" USING: pair-rocket prettyprint ;
+{ $unchecked-example """USING: pair-rocket prettyprint ;
-H{ "foo" => 1 "bar" => 2 } .
-"> <" H{ { "foo" 1 } { "bar" 2 } } "> }
+H{ "foo" => 1 "bar" => 2 } ."""
+"""H{ { "foo" 1 } { "bar" 2 } }""" }
}
;
{ $url "http://groups.google.com/group/comp.lang.scheme/msg/9f0d61da01540816" } "."
" See this blog entry for more details:"
{ $url "http://www.bluishcoder.co.nz/2006/03/factor-partial-continuation-updates.html" }
-{ $subsection breset }
-{ $subsection bshift } ;
+{ $subsections
+ breset
+ bshift
+} ;
ABOUT: "partial-continuations"
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel tools.test peg peg.javascript.ast peg.javascript.parser
- accessors multiline sequences math peg.ebnf ;
+ accessors sequences math peg.ebnf ;
IN: peg.javascript.parser.tests
{
] unit-test
{ t } [
-<"
+"""
var x=5
var y=10
-"> main \ javascript rule (parse) remaining>> length zero?
+""" main \ javascript rule (parse) remaining>> length zero?
] unit-test
{ t } [
-<"
+"""
function foldl(f, initial, seq) {
for(var i=0; i< seq.length; ++i)
initial = f(initial, seq[i]);
return initial;
-}"> main \ javascript rule (parse) remaining>> length zero?
+}""" main \ javascript rule (parse) remaining>> length zero?
] unit-test
{ t } [
-<"
+"""
ParseState.prototype.from = function(index) {
var r = new ParseState(this.input, this.index + index);
r.cache = this.cache;
r.length = this.length - index;
return r;
-}"> main \ javascript rule (parse) remaining>> length zero?
+}""" main \ javascript rule (parse) remaining>> length zero?
] unit-test
! See http://factorcode.org/license.txt for BSD license.
!
USING: kernel tools.test peg peg.ebnf peg.pl0
- multiline sequences accessors ;
+ sequences accessors ;
IN: peg.pl0.tests
{ t } [
] unit-test
{ t } [
- <"
-VAR x, squ;
+"""VAR x, squ;
PROCEDURE square;
BEGIN
CALL square;
x := x + 1;
END
-END."> main \ pl0 rule (parse) remaining>> empty?
+END.""" main \ pl0 rule (parse) remaining>> empty?
] unit-test
{ f } [
- <"
+"""
CONST
m = 7,
n = 85;
y := 36;
CALL gcd;
END.
- "> main \ pl0 rule (parse) remaining>> empty?
-] unit-test
\ No newline at end of file
+""" main \ pl0 rule (parse) remaining>> empty?
+] unit-test
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math math.functions math.ranges math.order
-project-euler.common sequences ;
+project-euler.common sequences layouts ;
IN: project-euler.044
! http://projecteuler.net/index.php?section=problems&id=44
<PRIVATE
: nth-pentagonal ( n -- seq )
- dup 3 * 1 - * 2 / ;
+ dup 3 * 1 - * 2 /i ; inline
: sum-and-diff? ( m n -- ? )
- [ + ] [ - ] 2bi [ pentagonal? ] bi@ and ;
+ [ + ] [ - ] 2bi [ pentagonal? ] bi@ and ; inline
+
+: euler044-step ( min m n -- min' )
+ [ nth-pentagonal ] bi@
+ 2dup sum-and-diff? [ - abs min ] [ 2drop ] if ; inline
PRIVATE>
: euler044 ( -- answer )
- 2500 [1,b] [ nth-pentagonal ] map dup cartesian-product
- [ first2 sum-and-diff? ] filter [ first2 - abs ] [ min ] map-reduce ;
+ most-positive-fixnum
+ 2500 [1,b] [
+ dup [1,b] [
+ euler044-step
+ ] with each
+ ] each ;
! [ euler044 ] 10 ave-time
-! 4996 ms ave run time - 87.46 SD (10 trials)
-
-! TODO: this solution is ugly and not very efficient...find a better algorithm
+! 289 ms ave run time - 0.27 SD (10 trials)
SOLUTION: euler044
--- /dev/null
+USING: project-euler.072 tools.test ;
+IN: project-euler.072.tests
+
+[ 303963552391 ] [ euler072 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math math.primes.factors math.ranges
+project-euler.common sequences ;
+IN: project-euler.072
+
+! http://projecteuler.net/index.php?section=problems&id=072
+
+! DESCRIPTION
+! -----------
+
+! Consider the fraction, n/d, where n and d are positive integers.
+! If n<d and HCF(n,d)=1, it is called a reduced proper fraction.
+
+! If we list the set of reduced proper fractions for d ≤ 8 in ascending order
+! of size, we get:
+
+! 1/8, 1/7, 1/6, 1/5, 1/4, 2/7, 1/3, 3/8, 2/5, 3/7, 1/2, 4/7, 3/5, 5/8, 2/3,
+! 5/7, 3/4, 4/5, 5/6, 6/7, 7/8
+
+! It can be seen that there are 21 elements in this set.
+
+! How many elements would be contained in the set of reduced proper fractions
+! for d ≤ 1,000,000?
+
+
+! SOLUTION
+! --------
+
+! The answer can be found by adding totient(n) for 2 ≤ n ≤ 1e6
+
+: euler072 ( -- answer )
+ 2 1000000 [a,b] [ totient ] [ + ] map-reduce ;
+
+! [ euler072 ] 100 ave-time
+! 5274 ms ave run time - 102.7 SD (100 trials)
+
+SOLUTION: euler072
! Copyright (c) 2008 Aaron Schaefer.
! See http://factorcode.org/license.txt for BSD license.
-USING: kernel locals make math project-euler.common sequences ;
+USING: kernel locals math project-euler.common sequences ;
IN: project-euler.073
! http://projecteuler.net/index.php?section=problems&id=73
<PRIVATE
-:: (euler073) ( limit lo hi -- )
+:: (euler073) ( counter limit lo hi -- counter' )
[let | m [ lo hi mediant ] |
m denominator limit <= [
- m ,
+ counter 1 +
limit lo m (euler073)
limit m hi (euler073)
- ] when
+ ] [ counter ] if
] ;
PRIVATE>
: euler073 ( -- answer )
- [ 10000 1/3 1/2 (euler073) ] { } make length ;
+ 0 10000 1/3 1/2 (euler073) ;
! [ euler073 ] 10 ave-time
! 20506 ms ave run time - 937.07 SD (10 trials)
--- /dev/null
+USING: project-euler.074 tools.test ;
+IN: project-euler.074.tests
+
+[ 402 ] [ euler074 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs hashtables kernel math math.ranges
+project-euler.common sequences sets ;
+IN: project-euler.074
+
+! http://projecteuler.net/index.php?section=problems&id=074
+
+! DESCRIPTION
+! -----------
+
+! The number 145 is well known for the property that the sum of the factorial
+! of its digits is equal to 145:
+
+! 1! + 4! + 5! = 1 + 24 + 120 = 145
+
+! Perhaps less well known is 169, in that it produces the longest chain of
+! numbers that link back to 169; it turns out that there are only three such
+! loops that exist:
+
+! 169 → 363601 → 1454 → 169
+! 871 → 45361 → 871
+! 872 → 45362 → 872
+
+! It is not difficult to prove that EVERY starting number will eventually get
+! stuck in a loop. For example,
+
+! 69 → 363600 → 1454 → 169 → 363601 (→ 1454)
+! 78 → 45360 → 871 → 45361 (→ 871)
+! 540 → 145 (→ 145)
+
+! Starting with 69 produces a chain of five non-repeating terms, but the
+! longest non-repeating chain with a starting number below one million is sixty
+! terms.
+
+! How many chains, with a starting number below one million, contain exactly
+! sixty non-repeating terms?
+
+
+! SOLUTION
+! --------
+
+! Brute force
+
+<PRIVATE
+
+: digit-factorial ( n -- n! )
+ { 1 1 2 6 24 120 720 5040 40320 362880 } nth ;
+
+: digits-factorial-sum ( n -- n )
+ number>digits [ digit-factorial ] sigma ;
+
+: chain-length ( n -- n )
+ 61 <hashtable>
+ [ 2dup key? not ]
+ [ [ conjoin ] [ [ digits-factorial-sum ] dip ] 2bi ]
+ while nip assoc-size ;
+
+PRIVATE>
+
+: euler074 ( -- answer )
+ 1000000 [1,b] [ chain-length 60 = ] count ;
+
+! [ euler074 ] 10 ave-time
+! 25134 ms ave run time - 31.96 SD (10 trials)
+
+SOLUTION: euler074
+
--- /dev/null
+USING: project-euler.085 tools.test ;
+IN: project-euler.085.tests
+
+[ 2772 ] [ euler085 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel math math.ranges project-euler.common
+sequences locals ;
+IN: project-euler.085
+
+! http://projecteuler.net/index.php?section=problems&id=85
+
+! DESCRIPTION
+! -----------
+
+! By counting carefully it can be seen that a rectangular grid measuring
+! 3 by 2 contains eighteen rectangles.
+
+! Although there exists no rectangular grid that contains exactly two million
+! rectangles, find the area of the grid with the nearest solution.
+
+
+! SOLUTION
+! --------
+
+! A grid measuring x by y contains x * (x + 1) * y * (x + 1) / 4 rectangles.
+
+<PRIVATE
+
+: distance ( m -- n )
+ 2000000 - abs ; inline
+
+: rectangles-count ( a b -- n )
+ 2dup [ 1 + ] bi@ * * * 4 /i ; inline
+
+:: each-unique-product ( a b quot: ( i j -- ) -- )
+ a b [a,b] [| i |
+ i b [a,b] [| j |
+ i j quot call
+ ] each
+ ] each ; inline
+
+TUPLE: result { area read-only } { distance read-only } ;
+
+C: <result> result
+
+: min-by-distance ( seq seq -- seq )
+ [ [ distance>> ] bi@ < ] most ; inline
+
+: compute-result ( i j -- pair )
+ [ * ] [ rectangles-count distance ] 2bi <result> ; inline
+
+: area-of-nearest ( -- n )
+ T{ result f 0 2000000 } 1 2000
+ [ compute-result min-by-distance ] each-unique-product area>> ;
+
+PRIVATE>
+
+: euler085 ( -- answer )
+ area-of-nearest ;
+
+! [ euler085 ] 100 ave-time
+! 791 ms ave run time - 17.15 SD (100 trials)
+
+SOLUTION: euler085
--- /dev/null
+USING: project-euler.102 tools.test ;
+IN: project-euler.102.tests
+
+[ 228 ] [ euler102 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays grouping io.encodings.ascii io.files kernel math
+math.parser sequences splitting project-euler.common ;
+IN: project-euler.102
+
+! http://projecteuler.net/index.php?section=problems&id=102
+
+! DESCRIPTION
+! -----------
+
+! Three distinct points are plotted at random on a Cartesian plane, for which
+! -1000 ≤ x, y ≤ 1000, such that a triangle is formed.
+
+! Consider the following two triangles:
+
+! A(-340,495), B(-153,-910), C(835,-947)
+! X(-175,41), Y(-421,-714), Z(574,-645)
+
+! It can be verified that triangle ABC contains the origin, whereas triangle
+! XYZ does not.
+
+! Using triangles.txt (right click and 'Save Link/Target As...'), a 27K text
+! file containing the co-ordinates of one thousand "random" triangles, find the
+! number of triangles for which the interior contains the origin.
+
+! NOTE: The first two examples in the file represent the triangles in the
+! example given above.
+
+
+! SOLUTION
+! --------
+
+! A triangle of coordinates (x1, y1) (x2, y2) (x3, y3) contains
+! the origin when (ab * bc > 0) and (bc * ca > 0) where:
+! ab = x1 * (y2 - y1) - y1 * (x2 - x1)
+! bc = x2 * (y3 - y2) - y2 * (x3 - x2)
+! ca = x3 * (y1 - y3) - y3 * (x1 - x3)
+
+<PRIVATE
+
+: source-102 ( -- seq )
+ "resource:extra/project-euler/102/triangles.txt"
+ ascii file-lines [
+ "," split [ string>number ] map 2 group
+ ] map ;
+
+: det ( coord coord -- n )
+ dupd [ [ last ] bi@ - ] [ [ first ] bi@ - ] 2bi 2array
+ [ [ first ] bi@ * ] [ [ last ] bi@ * ] 2bi - ;
+
+: include-origin? ( coord-seq -- ? )
+ dup first suffix 2 clump [ [ first ] [ last ] bi det ] map
+ 2 clump [ product 0 > ] all? ;
+
+PRIVATE>
+
+: euler102 ( -- answer )
+ source-102 [ include-origin? ] count ;
+
+! [ euler102 ] 100 ave-time
+! 12 ms ave run time - 0.92 SD (100 trials)
+
+SOLUTION: euler102
--- /dev/null
+-340,495,-153,-910,835,-947\r
+-175,41,-421,-714,574,-645\r
+-547,712,-352,579,951,-786\r
+419,-864,-83,650,-399,171\r
+-429,-89,-357,-930,296,-29\r
+-734,-702,823,-745,-684,-62\r
+-971,762,925,-776,-663,-157\r
+162,570,628,485,-807,-896\r
+641,91,-65,700,887,759\r
+215,-496,46,-931,422,-30\r
+-119,359,668,-609,-358,-494\r
+440,929,968,214,760,-857\r
+-700,785,838,29,-216,411\r
+-770,-458,-325,-53,-505,633\r
+-752,-805,349,776,-799,687\r
+323,5,561,-36,919,-560\r
+-907,358,264,320,204,274\r
+-728,-466,350,969,292,-345\r
+940,836,272,-533,748,185\r
+411,998,813,520,316,-949\r
+-152,326,658,-762,148,-651\r
+330,507,-9,-628,101,174\r
+551,-496,772,-541,-702,-45\r
+-164,-489,-90,322,631,-59\r
+673,366,-4,-143,-606,-704\r
+428,-609,801,-449,740,-269\r
+453,-924,-785,-346,-853,111\r
+-738,555,-181,467,-426,-20\r
+958,-692,784,-343,505,-569\r
+620,27,263,54,-439,-726\r
+804,87,998,859,871,-78\r
+-119,-453,-709,-292,-115,-56\r
+-626,138,-940,-476,-177,-274\r
+-11,160,142,588,446,158\r
+538,727,550,787,330,810\r
+420,-689,854,-546,337,516\r
+872,-998,-607,748,473,-192\r
+653,440,-516,-985,808,-857\r
+374,-158,331,-940,-338,-641\r
+137,-925,-179,771,734,-715\r
+-314,198,-115,29,-641,-39\r
+759,-574,-385,355,590,-603\r
+-189,-63,-168,204,289,305\r
+-182,-524,-715,-621,911,-255\r
+331,-816,-833,471,168,126\r
+-514,581,-855,-220,-731,-507\r
+129,169,576,651,-87,-458\r
+783,-444,-881,658,-266,298\r
+603,-430,-598,585,368,899\r
+43,-724,962,-376,851,409\r
+-610,-646,-883,-261,-482,-881\r
+-117,-237,978,641,101,-747\r
+579,125,-715,-712,208,534\r
+672,-214,-762,372,874,533\r
+-564,965,38,715,367,242\r
+500,951,-700,-981,-61,-178\r
+-382,-224,-959,903,-282,-60\r
+-355,295,426,-331,-591,655\r
+892,128,958,-271,-993,274\r
+-454,-619,302,138,-790,-874\r
+-642,601,-574,159,-290,-318\r
+266,-109,257,-686,54,975\r
+162,628,-478,840,264,-266\r
+466,-280,982,1,904,-810\r
+721,839,730,-807,777,981\r
+-129,-430,748,263,943,96\r
+434,-94,410,-990,249,-704\r
+237,42,122,-732,44,-51\r
+909,-116,-229,545,292,717\r
+824,-768,-807,-370,-262,30\r
+675,58,332,-890,-651,791\r
+363,825,-717,254,684,240\r
+405,-715,900,166,-589,422\r
+-476,686,-830,-319,634,-807\r
+633,837,-971,917,-764,207\r
+-116,-44,-193,-70,908,809\r
+-26,-252,998,408,70,-713\r
+-601,645,-462,842,-644,-591\r
+-160,653,274,113,-138,687\r
+369,-273,-181,925,-167,-693\r
+-338,135,480,-967,-13,-840\r
+-90,-270,-564,695,161,907\r
+607,-430,869,-713,461,-469\r
+919,-165,-776,522,606,-708\r
+-203,465,288,207,-339,-458\r
+-453,-534,-715,975,838,-677\r
+-973,310,-350,934,546,-805\r
+-835,385,708,-337,-594,-772\r
+-14,914,900,-495,-627,594\r
+833,-713,-213,578,-296,699\r
+-27,-748,484,455,915,291\r
+270,889,739,-57,442,-516\r
+119,811,-679,905,184,130\r
+-678,-469,925,553,612,482\r
+101,-571,-732,-842,644,588\r
+-71,-737,566,616,957,-663\r
+-634,-356,90,-207,936,622\r
+598,443,964,-895,-58,529\r
+847,-467,929,-742,91,10\r
+-633,829,-780,-408,222,-30\r
+-818,57,275,-38,-746,198\r
+-722,-825,-549,597,-391,99\r
+-570,908,430,873,-103,-360\r
+342,-681,512,434,542,-528\r
+297,850,479,609,543,-357\r
+9,784,212,548,56,859\r
+-152,560,-240,-969,-18,713\r
+140,-133,34,-635,250,-163\r
+-272,-22,-169,-662,989,-604\r
+471,-765,355,633,-742,-118\r
+-118,146,942,663,547,-376\r
+583,16,162,264,715,-33\r
+-230,-446,997,-838,561,555\r
+372,397,-729,-318,-276,649\r
+92,982,-970,-390,-922,922\r
+-981,713,-951,-337,-669,670\r
+-999,846,-831,-504,7,-128\r
+455,-954,-370,682,-510,45\r
+822,-960,-892,-385,-662,314\r
+-668,-686,-367,-246,530,-341\r
+-723,-720,-926,-836,-142,757\r
+-509,-134,384,-221,-873,-639\r
+-803,-52,-706,-669,373,-339\r
+933,578,631,-616,770,555\r
+741,-564,-33,-605,-576,275\r
+-715,445,-233,-730,734,-704\r
+120,-10,-266,-685,-490,-17\r
+-232,-326,-457,-946,-457,-116\r
+811,52,639,826,-200,147\r
+-329,279,293,612,943,955\r
+-721,-894,-393,-969,-642,453\r
+-688,-826,-352,-75,371,79\r
+-809,-979,407,497,858,-248\r
+-485,-232,-242,-582,-81,849\r
+141,-106,123,-152,806,-596\r
+-428,57,-992,811,-192,478\r
+864,393,122,858,255,-876\r
+-284,-780,240,457,354,-107\r
+956,605,-477,44,26,-678\r
+86,710,-533,-815,439,327\r
+-906,-626,-834,763,426,-48\r
+201,-150,-904,652,475,412\r
+-247,149,81,-199,-531,-148\r
+923,-76,-353,175,-121,-223\r
+427,-674,453,472,-410,585\r
+931,776,-33,85,-962,-865\r
+-655,-908,-902,208,869,792\r
+-316,-102,-45,-436,-222,885\r
+-309,768,-574,653,745,-975\r
+896,27,-226,993,332,198\r
+323,655,-89,260,240,-902\r
+501,-763,-424,793,813,616\r
+993,375,-938,-621,672,-70\r
+-880,-466,-283,770,-824,143\r
+63,-283,886,-142,879,-116\r
+-964,-50,-521,-42,-306,-161\r
+724,-22,866,-871,933,-383\r
+-344,135,282,966,-80,917\r
+-281,-189,420,810,362,-582\r
+-515,455,-588,814,162,332\r
+555,-436,-123,-210,869,-943\r
+589,577,232,286,-554,876\r
+-773,127,-58,-171,-452,125\r
+-428,575,906,-232,-10,-224\r
+437,276,-335,-348,605,878\r
+-964,511,-386,-407,168,-220\r
+307,513,912,-463,-423,-416\r
+-445,539,273,886,-18,760\r
+-396,-585,-670,414,47,364\r
+143,-506,754,906,-971,-203\r
+-544,472,-180,-541,869,-465\r
+-779,-15,-396,890,972,-220\r
+-430,-564,503,182,-119,456\r
+89,-10,-739,399,506,499\r
+954,162,-810,-973,127,870\r
+890,952,-225,158,828,237\r
+-868,952,349,465,574,750\r
+-915,369,-975,-596,-395,-134\r
+-135,-601,575,582,-667,640\r
+413,890,-560,-276,-555,-562\r
+-633,-269,561,-820,-624,499\r
+371,-92,-784,-593,864,-717\r
+-971,655,-439,367,754,-951\r
+172,-347,36,279,-247,-402\r
+633,-301,364,-349,-683,-387\r
+-780,-211,-713,-948,-648,543\r
+72,58,762,-465,-66,462\r
+78,502,781,-832,713,836\r
+-431,-64,-484,-392,208,-343\r
+-64,101,-29,-860,-329,844\r
+398,391,828,-858,700,395\r
+578,-896,-326,-604,314,180\r
+97,-321,-695,185,-357,852\r
+854,839,283,-375,951,-209\r
+194,96,-564,-847,162,524\r
+-354,532,494,621,580,560\r
+419,-678,-450,926,-5,-924\r
+-661,905,519,621,-143,394\r
+-573,268,296,-562,-291,-319\r
+-211,266,-196,158,564,-183\r
+18,-585,-398,777,-581,864\r
+790,-894,-745,-604,-418,70\r
+848,-339,150,773,11,851\r
+-954,-809,-53,-20,-648,-304\r
+658,-336,-658,-905,853,407\r
+-365,-844,350,-625,852,-358\r
+986,-315,-230,-159,21,180\r
+-15,599,45,-286,-941,847\r
+-613,-68,184,639,-987,550\r
+334,675,-56,-861,923,340\r
+-848,-596,960,231,-28,-34\r
+707,-811,-994,-356,-167,-171\r
+-470,-764,72,576,-600,-204\r
+379,189,-542,-576,585,800\r
+440,540,-445,-563,379,-334\r
+-155,64,514,-288,853,106\r
+-304,751,481,-520,-708,-694\r
+-709,132,594,126,-844,63\r
+723,471,421,-138,-962,892\r
+-440,-263,39,513,-672,-954\r
+775,809,-581,330,752,-107\r
+-376,-158,335,-708,-514,578\r
+-343,-769,456,-187,25,413\r
+548,-877,-172,300,-500,928\r
+938,-102,423,-488,-378,-969\r
+-36,564,-55,131,958,-800\r
+-322,511,-413,503,700,-847\r
+-966,547,-88,-17,-359,-67\r
+637,-341,-437,-181,527,-153\r
+-74,449,-28,3,485,189\r
+-997,658,-224,-948,702,-807\r
+-224,736,-896,127,-945,-850\r
+-395,-106,439,-553,-128,124\r
+-841,-445,-758,-572,-489,212\r
+633,-327,13,-512,952,771\r
+-940,-171,-6,-46,-923,-425\r
+-142,-442,-817,-998,843,-695\r
+340,847,-137,-920,-988,-658\r
+-653,217,-679,-257,651,-719\r
+-294,365,-41,342,74,-892\r
+690,-236,-541,494,408,-516\r
+180,-807,225,790,494,59\r
+707,605,-246,656,284,271\r
+65,294,152,824,442,-442\r
+-321,781,-540,341,316,415\r
+420,371,-2,545,995,248\r
+56,-191,-604,971,615,449\r
+-981,-31,510,592,-390,-362\r
+-317,-968,913,365,97,508\r
+832,63,-864,-510,86,202\r
+-483,456,-636,340,-310,676\r
+981,-847,751,-508,-962,-31\r
+-157,99,73,797,63,-172\r
+220,858,872,924,866,-381\r
+996,-169,805,321,-164,971\r
+896,11,-625,-973,-782,76\r
+578,-280,730,-729,307,-905\r
+-580,-749,719,-698,967,603\r
+-821,874,-103,-623,662,-491\r
+-763,117,661,-644,672,-607\r
+592,787,-798,-169,-298,690\r
+296,644,-526,-762,-447,665\r
+534,-818,852,-120,57,-379\r
+-986,-549,-329,294,954,258\r
+-133,352,-660,-77,904,-356\r
+748,343,215,500,317,-277\r
+311,7,910,-896,-809,795\r
+763,-602,-753,313,-352,917\r
+668,619,-474,-597,-650,650\r
+-297,563,-701,-987,486,-902\r
+-461,-740,-657,233,-482,-328\r
+-446,-250,-986,-458,-629,520\r
+542,-49,-327,-469,257,-947\r
+121,-575,-634,-143,-184,521\r
+30,504,455,-645,-229,-945\r
+-12,-295,377,764,771,125\r
+-686,-133,225,-25,-376,-143\r
+-6,-46,338,270,-405,-872\r
+-623,-37,582,467,963,898\r
+-804,869,-477,420,-475,-303\r
+94,41,-842,-193,-768,720\r
+-656,-918,415,645,-357,460\r
+-47,-486,-911,468,-608,-686\r
+-158,251,419,-394,-655,-895\r
+272,-695,979,508,-358,959\r
+-776,650,-918,-467,-690,-534\r
+-85,-309,-626,167,-366,-429\r
+-880,-732,-186,-924,970,-875\r
+517,645,-274,962,-804,544\r
+721,402,104,640,478,-499\r
+198,684,-134,-723,-452,-905\r
+-245,745,239,238,-826,441\r
+-217,206,-32,462,-981,-895\r
+-51,989,526,-173,560,-676\r
+-480,-659,-976,-580,-727,466\r
+-996,-90,-995,158,-239,642\r
+302,288,-194,-294,17,924\r
+-943,969,-326,114,-500,103\r
+-619,163,339,-880,230,421\r
+-344,-601,-795,557,565,-779\r
+590,345,-129,-202,-125,-58\r
+-777,-195,159,674,775,411\r
+-939,312,-665,810,121,855\r
+-971,254,712,815,452,581\r
+442,-9,327,-750,61,757\r
+-342,869,869,-160,390,-772\r
+620,601,565,-169,-69,-183\r
+-25,924,-817,964,321,-970\r
+-64,-6,-133,978,825,-379\r
+601,436,-24,98,-115,940\r
+-97,502,614,-574,922,513\r
+-125,262,-946,695,99,-220\r
+429,-721,719,-694,197,-558\r
+326,689,-70,-908,-673,338\r
+-468,-856,-902,-254,-358,305\r
+-358,530,542,355,-253,-47\r
+-438,-74,-362,963,988,788\r
+137,717,467,622,319,-380\r
+-86,310,-336,851,918,-288\r
+721,395,646,-53,255,-425\r
+255,175,912,84,-209,878\r
+-632,-485,-400,-357,991,-608\r
+235,-559,992,-297,857,-591\r
+87,-71,148,130,647,578\r
+-290,-584,-639,-788,-21,592\r
+386,984,625,-731,-993,-336\r
+-538,634,-209,-828,-150,-774\r
+-754,-387,607,-781,976,-199\r
+412,-798,-664,295,709,-537\r
+-412,932,-880,-232,561,852\r
+-656,-358,-198,-964,-433,-848\r
+-762,-668,-632,186,-673,-11\r
+-876,237,-282,-312,-83,682\r
+403,73,-57,-436,-622,781\r
+-587,873,798,976,-39,329\r
+-369,-622,553,-341,817,794\r
+-108,-616,920,-849,-679,96\r
+290,-974,234,239,-284,-321\r
+-22,394,-417,-419,264,58\r
+-473,-551,69,923,591,-228\r
+-956,662,-113,851,-581,-794\r
+-258,-681,413,-471,-637,-817\r
+-866,926,992,-653,-7,794\r
+556,-350,602,917,831,-610\r
+188,245,-906,361,492,174\r
+-720,384,-818,329,638,-666\r
+-246,846,890,-325,-59,-850\r
+-118,-509,620,-762,-256,15\r
+-787,-536,-452,-338,-399,813\r
+458,560,525,-311,-608,-419\r
+494,-811,-825,-127,-812,894\r
+-801,890,-629,-860,574,925\r
+-709,-193,-213,138,-410,-403\r
+861,91,708,-187,5,-222\r
+789,646,777,154,90,-49\r
+-267,-830,-114,531,591,-698\r
+-126,-82,881,-418,82,652\r
+-894,130,-726,-935,393,-815\r
+-142,563,654,638,-712,-597\r
+-759,60,-23,977,100,-765\r
+-305,595,-570,-809,482,762\r
+-161,-267,53,963,998,-529\r
+-300,-57,798,353,703,486\r
+-990,696,-764,699,-565,719\r
+-232,-205,566,571,977,369\r
+740,865,151,-817,-204,-293\r
+94,445,-768,229,537,-406\r
+861,620,37,-424,-36,656\r
+390,-369,952,733,-464,569\r
+-482,-604,959,554,-705,-626\r
+-396,-615,-991,108,272,-723\r
+143,780,535,142,-917,-147\r
+138,-629,-217,-908,905,115\r
+915,103,-852,64,-468,-642\r
+570,734,-785,-268,-326,-759\r
+738,531,-332,586,-779,24\r
+870,440,-217,473,-383,415\r
+-296,-333,-330,-142,-924,950\r
+118,120,-35,-245,-211,-652\r
+61,634,153,-243,838,789\r
+726,-582,210,105,983,537\r
+-313,-323,758,234,29,848\r
+-847,-172,-593,733,-56,617\r
+54,255,-512,156,-575,675\r
+-873,-956,-148,623,95,200\r
+700,-370,926,649,-978,157\r
+-639,-202,719,130,747,222\r
+194,-33,955,943,505,114\r
+-226,-790,28,-930,827,783\r
+-392,-74,-28,714,218,-612\r
+209,626,-888,-683,-912,495\r
+487,751,614,933,631,445\r
+-348,-34,-411,-106,835,321\r
+-689,872,-29,-800,312,-542\r
+-52,566,827,570,-862,-77\r
+471,992,309,-402,389,912\r
+24,520,-83,-51,555,503\r
+-265,-317,283,-970,-472,690\r
+606,526,137,71,-651,150\r
+217,-518,663,66,-605,-331\r
+-562,232,-76,-503,205,-323\r
+842,-521,546,285,625,-186\r
+997,-927,344,909,-546,974\r
+-677,419,81,121,-705,771\r
+719,-379,-944,-797,784,-155\r
+-378,286,-317,-797,-111,964\r
+-288,-573,784,80,-532,-646\r
+-77,407,-248,-797,769,-816\r
+-24,-637,287,-858,-927,-333\r
+-902,37,894,-823,141,684\r
+125,467,-177,-516,686,399\r
+-321,-542,641,-590,527,-224\r
+-400,-712,-876,-208,632,-543\r
+-676,-429,664,-242,-269,922\r
+-608,-273,-141,930,687,380\r
+786,-12,498,494,310,326\r
+-739,-617,606,-960,804,188\r
+384,-368,-243,-350,-459,31\r
+-550,397,320,-868,328,-279\r
+969,-179,853,864,-110,514\r
+910,793,302,-822,-285,488\r
+-605,-128,218,-283,-17,-227\r
+16,324,667,708,750,3\r
+485,-813,19,585,71,930\r
+-218,816,-687,-97,-732,-360\r
+-497,-151,376,-23,3,315\r
+-412,-989,-610,-813,372,964\r
+-878,-280,87,381,-311,69\r
+-609,-90,-731,-679,150,585\r
+889,27,-162,605,75,-770\r
+448,617,-988,0,-103,-504\r
+-800,-537,-69,627,608,-668\r
+534,686,-664,942,830,920\r
+-238,775,495,932,-793,497\r
+-343,958,-914,-514,-691,651\r
+568,-136,208,359,728,28\r
+286,912,-794,683,556,-102\r
+-638,-629,-484,445,-64,-497\r
+58,505,-801,-110,872,632\r
+-390,777,353,267,976,369\r
+-993,515,105,-133,358,-572\r
+964,996,355,-212,-667,38\r
+-725,-614,-35,365,132,-196\r
+237,-536,-416,-302,312,477\r
+-664,574,-210,224,48,-925\r
+869,-261,-256,-240,-3,-698\r
+712,385,32,-34,916,-315\r
+895,-409,-100,-346,728,-624\r
+-806,327,-450,889,-781,-939\r
+-586,-403,698,318,-939,899\r
+557,-57,-920,659,333,-51\r
+-441,232,-918,-205,246,1\r
+783,167,-797,-595,245,-736\r
+-36,-531,-486,-426,-813,-160\r
+777,-843,817,313,-228,-572\r
+735,866,-309,-564,-81,190\r
+-413,645,101,719,-719,218\r
+-83,164,767,796,-430,-459\r
+122,779,-15,-295,-96,-892\r
+462,379,70,548,834,-312\r
+-630,-534,124,187,-737,114\r
+-299,-604,318,-591,936,826\r
+-879,218,-642,-483,-318,-866\r
+-691,62,-658,761,-895,-854\r
+-822,493,687,569,910,-202\r
+-223,784,304,-5,541,925\r
+-914,541,737,-662,-662,-195\r
+-622,615,414,358,881,-878\r
+339,745,-268,-968,-280,-227\r
+-364,855,148,-709,-827,472\r
+-890,-532,-41,664,-612,577\r
+-702,-859,971,-722,-660,-920\r
+-539,-605,737,149,973,-802\r
+800,42,-448,-811,152,511\r
+-933,377,-110,-105,-374,-937\r
+-766,152,482,120,-308,390\r
+-568,775,-292,899,732,890\r
+-177,-317,-502,-259,328,-511\r
+612,-696,-574,-660,132,31\r
+-119,563,-805,-864,179,-672\r
+425,-627,183,-331,839,318\r
+-711,-976,-749,152,-916,261\r
+181,-63,497,211,262,406\r
+-537,700,-859,-765,-928,77\r
+892,832,231,-749,-82,613\r
+816,216,-642,-216,-669,-912\r
+-6,624,-937,-370,-344,268\r
+737,-710,-869,983,-324,-274\r
+565,952,-547,-158,374,-444\r
+51,-683,645,-845,515,636\r
+-953,-631,114,-377,-764,-144\r
+-8,470,-242,-399,-675,-730\r
+-540,689,-20,47,-607,590\r
+-329,-710,-779,942,-388,979\r
+123,829,674,122,203,563\r
+46,782,396,-33,386,610\r
+872,-846,-523,-122,-55,-190\r
+388,-994,-525,974,127,596\r
+781,-680,796,-34,-959,-62\r
+-749,173,200,-384,-745,-446\r
+379,618,136,-250,-224,970\r
+-58,240,-921,-760,-901,-626\r
+366,-185,565,-100,515,688\r
+489,999,-893,-263,-637,816\r
+838,-496,-316,-513,419,479\r
+107,676,-15,882,98,-397\r
+-999,941,-903,-424,670,-325\r
+171,-979,835,178,169,-984\r
+-609,-607,378,-681,184,402\r
+-316,903,-575,-800,224,983\r
+591,-18,-460,551,-167,918\r
+-756,405,-117,441,163,-320\r
+456,24,6,881,-836,-539\r
+-489,-585,915,651,-892,-382\r
+-177,-122,73,-711,-386,591\r
+181,724,530,686,-131,241\r
+737,288,886,216,233,33\r
+-548,-386,-749,-153,-85,-982\r
+-835,227,904,160,-99,25\r
+-9,-42,-162,728,840,-963\r
+217,-763,870,771,47,-846\r
+-595,808,-491,556,337,-900\r
+-134,281,-724,441,-134,708\r
+-789,-508,651,-962,661,315\r
+-839,-923,339,402,41,-487\r
+300,-790,48,703,-398,-811\r
+955,-51,462,-685,960,-717\r
+910,-880,592,-255,-51,-776\r
+-885,169,-793,368,-565,458\r
+-905,940,-492,-630,-535,-988\r
+245,797,763,869,-82,550\r
+-310,38,-933,-367,-650,824\r
+-95,32,-83,337,226,990\r
+-218,-975,-191,-208,-785,-293\r
+-672,-953,517,-901,-247,465\r
+681,-148,261,-857,544,-923\r
+640,341,446,-618,195,769\r
+384,398,-846,365,671,815\r
+578,576,-911,907,762,-859\r
+548,-428,144,-630,-759,-146\r
+710,-73,-700,983,-97,-889\r
+-46,898,-973,-362,-817,-717\r
+151,-81,-125,-900,-478,-154\r
+483,615,-537,-932,181,-68\r
+786,-223,518,25,-306,-12\r
+-422,268,-809,-683,635,468\r
+983,-734,-694,-608,-110,4\r
+-786,-196,749,-354,137,-8\r
+-181,36,668,-200,691,-973\r
+-629,-838,692,-736,437,-871\r
+-208,-536,-159,-596,8,197\r
+-3,370,-686,170,913,-376\r
+44,-998,-149,-993,-200,512\r
+-519,136,859,497,536,434\r
+77,-985,972,-340,-705,-837\r
+-381,947,250,360,344,322\r
+-26,131,699,750,707,384\r
+-914,655,299,193,406,955\r
+-883,-921,220,595,-546,794\r
+-599,577,-569,-404,-704,489\r
+-594,-963,-624,-460,880,-760\r
+-603,88,-99,681,55,-328\r
+976,472,139,-453,-531,-860\r
+192,-290,513,-89,666,432\r
+417,487,575,293,567,-668\r
+655,711,-162,449,-980,972\r
+-505,664,-685,-239,603,-592\r
+-625,-802,-67,996,384,-636\r
+365,-593,522,-666,-200,-431\r
+-868,708,560,-860,-630,-355\r
+-702,785,-637,-611,-597,960\r
+-137,-696,-93,-803,408,406\r
+891,-123,-26,-609,-610,518\r
+133,-832,-198,555,708,-110\r
+791,617,-69,487,696,315\r
+-900,694,-565,517,-269,-416\r
+914,135,-781,600,-71,-600\r
+991,-915,-422,-351,-837,313\r
+-840,-398,-302,21,590,146\r
+62,-558,-702,-384,-625,831\r
+-363,-426,-924,-496,792,-908\r
+73,361,-817,-466,400,922\r
+-626,-164,-626,860,-524,286\r
+255,26,-944,809,-606,986\r
+-457,-256,-103,50,-867,-871\r
+-223,803,196,480,612,136\r
+-820,-928,700,780,-977,721\r
+717,332,53,-933,-128,793\r
+-602,-648,562,593,890,702\r
+-469,-875,-527,911,-475,-222\r
+110,-281,-552,-536,-816,596\r
+-981,654,413,-981,-75,-95\r
+-754,-742,-515,894,-220,-344\r
+795,-52,156,408,-603,76\r
+474,-157,423,-499,-807,-791\r
+260,688,40,-52,702,-122\r
+-584,-517,-390,-881,302,-504\r
+61,797,665,708,14,668\r
+366,166,458,-614,564,-983\r
+72,539,-378,796,381,-824\r
+-485,201,-588,842,736,379\r
+-149,-894,-298,705,-303,-406\r
+660,-935,-580,521,93,633\r
+-382,-282,-375,-841,-828,171\r
+-567,743,-100,43,144,122\r
+-281,-786,-749,-551,296,304\r
+11,-426,-792,212,857,-175\r
+594,143,-699,289,315,137\r
+341,596,-390,107,-631,-804\r
+-751,-636,-424,-854,193,651\r
+-145,384,749,675,-786,517\r
+224,-865,-323,96,-916,258\r
+-309,403,-388,826,35,-270\r
+-942,709,222,158,-699,-103\r
+-589,842,-997,29,-195,-210\r
+264,426,566,145,-217,623\r
+217,965,507,-601,-453,507\r
+-206,307,-982,4,64,-292\r
+676,-49,-38,-701,550,883\r
+5,-850,-438,659,745,-773\r
+933,238,-574,-570,91,-33\r
+-866,121,-928,358,459,-843\r
+-568,-631,-352,-580,-349,189\r
+-737,849,-963,-486,-662,970\r
+135,334,-967,-71,-365,-792\r
+789,21,-227,51,990,-275\r
+240,412,-886,230,591,256\r
+-609,472,-853,-754,959,661\r
+401,521,521,314,929,982\r
+-499,784,-208,71,-302,296\r
+-557,-948,-553,-526,-864,793\r
+270,-626,828,44,37,14\r
+-412,224,617,-593,502,699\r
+41,-908,81,562,-849,163\r
+165,917,761,-197,331,-341\r
+-687,314,799,755,-969,648\r
+-164,25,578,439,-334,-576\r
+213,535,874,-177,-551,24\r
+-689,291,-795,-225,-496,-125\r
+465,461,558,-118,-568,-909\r
+567,660,-810,46,-485,878\r
+-147,606,685,-690,-774,984\r
+568,-886,-43,854,-738,616\r
+-800,386,-614,585,764,-226\r
+-518,23,-225,-732,-79,440\r
+-173,-291,-689,636,642,-447\r
+-598,-16,227,410,496,211\r
+-474,-930,-656,-321,-420,36\r
+-435,165,-819,555,540,144\r
+-969,149,828,568,394,648\r
+65,-848,257,720,-625,-851\r
+981,899,275,635,465,-877\r
+80,290,792,760,-191,-321\r
+-605,-858,594,33,706,593\r
+585,-472,318,-35,354,-927\r
+-365,664,803,581,-965,-814\r
+-427,-238,-480,146,-55,-606\r
+879,-193,250,-890,336,117\r
+-226,-322,-286,-765,-836,-218\r
+-913,564,-667,-698,937,283\r
+872,-901,810,-623,-52,-709\r
+473,171,717,38,-429,-644\r
+225,824,-219,-475,-180,234\r
+-530,-797,-948,238,851,-623\r
+85,975,-363,529,598,28\r
+-799,166,-804,210,-769,851\r
+-687,-158,885,736,-381,-461\r
+447,592,928,-514,-515,-661\r
+-399,-777,-493,80,-544,-78\r
+-884,631,171,-825,-333,551\r
+191,268,-577,676,137,-33\r
+212,-853,709,798,583,-56\r
+-908,-172,-540,-84,-135,-56\r
+303,311,406,-360,-240,811\r
+798,-708,824,59,234,-57\r
+491,693,-74,585,-85,877\r
+509,-65,-936,329,-51,722\r
+-122,858,-52,467,-77,-609\r
+850,760,547,-495,-953,-952\r
+-460,-541,890,910,286,724\r
+-914,843,-579,-983,-387,-460\r
+989,-171,-877,-326,-899,458\r
+846,175,-915,540,-1000,-982\r
+-852,-920,-306,496,530,-18\r
+338,-991,160,85,-455,-661\r
+-186,-311,-460,-563,-231,-414\r
+-932,-302,959,597,793,748\r
+-366,-402,-788,-279,514,53\r
+-940,-956,447,-956,211,-285\r
+564,806,-911,-914,934,754\r
+575,-858,-277,15,409,-714\r
+848,462,100,-381,135,242\r
+330,718,-24,-190,860,-78\r
+479,458,941,108,-866,-653\r
+212,980,962,-962,115,841\r
+-827,-474,-206,881,323,765\r
+506,-45,-30,-293,524,-133\r
+832,-173,547,-852,-561,-842\r
+-397,-661,-708,819,-545,-228\r
+521,51,-489,852,36,-258\r
+227,-164,189,465,-987,-882\r
+-73,-997,641,-995,449,-615\r
+151,-995,-638,415,257,-400\r
+-663,-297,-748,537,-734,198\r
+-585,-401,-81,-782,-80,-105\r
+99,-21,238,-365,-704,-368\r
+45,416,849,-211,-371,-1\r
+-404,-443,795,-406,36,-933\r
+272,-363,981,-491,-380,77\r
+713,-342,-366,-849,643,911\r
+-748,671,-537,813,961,-200\r
+-194,-909,703,-662,-601,188\r
+281,500,724,286,267,197\r
+-832,847,-595,820,-316,637\r
+520,521,-54,261,923,-10\r
+4,-808,-682,-258,441,-695\r
+-793,-107,-969,905,798,446\r
+-108,-739,-590,69,-855,-365\r
+380,-623,-930,817,468,713\r
+759,-849,-236,433,-723,-931\r
+95,-320,-686,124,-69,-329\r
+-655,518,-210,-523,284,-866\r
+144,303,639,70,-171,269\r
+173,-333,947,-304,55,40\r
+274,878,-482,-888,-835,375\r
+-982,-854,-36,-218,-114,-230\r
+905,-979,488,-485,-479,114\r
+877,-157,553,-530,-47,-321\r
+350,664,-881,442,-220,-284\r
+434,-423,-365,878,-726,584\r
+535,909,-517,-447,-660,-141\r
+-966,191,50,353,182,-642\r
+-785,-634,123,-907,-162,511\r
+146,-850,-214,814,-704,25\r
+692,1,521,492,-637,274\r
+-662,-372,-313,597,983,-647\r
+-962,-526,68,-549,-819,231\r
+740,-890,-318,797,-666,948\r
+-190,-12,-468,-455,948,284\r
+16,478,-506,-888,628,-154\r
+272,630,-976,308,433,3\r
+-169,-391,-132,189,302,-388\r
+109,-784,474,-167,-265,-31\r
+-177,-532,283,464,421,-73\r
+650,635,592,-138,1,-387\r
+-932,703,-827,-492,-355,686\r
+586,-311,340,-618,645,-434\r
+-951,736,647,-127,-303,590\r
+188,444,903,718,-931,500\r
+-872,-642,-296,-571,337,241\r
+23,65,152,125,880,470\r
+512,823,-42,217,823,-263\r
+180,-831,-380,886,607,762\r
+722,443,-149,-216,-115,759\r
+-19,660,-36,901,923,231\r
+562,-322,-626,-968,194,-825\r
+204,-920,938,784,362,150\r
+-410,-266,-715,559,-672,124\r
+-198,446,-140,454,-461,-447\r
+83,-346,830,-493,-759,-382\r
+-881,601,581,234,-134,-925\r
+-494,914,-42,899,235,629\r
+-390,50,956,437,774,-700\r
+-514,514,44,-512,-576,-313\r
+63,-688,808,-534,-570,-399\r
+-726,572,-896,102,-294,-28\r
+-688,757,401,406,955,-511\r
+-283,423,-485,480,-767,908\r
+-541,952,-594,116,-854,451\r
+-273,-796,236,625,-626,257\r
+-407,-493,373,826,-309,297\r
+-750,955,-476,641,-809,713\r
+8,415,695,226,-111,2\r
+733,209,152,-920,401,995\r
+921,-103,-919,66,871,-947\r
+-907,89,-869,-214,851,-559\r
+-307,748,524,-755,314,-711\r
+188,897,-72,-763,482,103\r
+545,-821,-232,-596,-334,-754\r
+-217,-788,-820,388,-200,-662\r
+779,160,-723,-975,-142,-998\r
+-978,-519,-78,-981,842,904\r
+-504,-736,-295,21,-472,-482\r
+391,115,-705,574,652,-446\r
+813,-988,865,830,-263,487\r
+194,80,774,-493,-761,-872\r
+-415,-284,-803,7,-810,670\r
+-484,-4,881,-872,55,-852\r
+-379,822,-266,324,-48,748\r
+-304,-278,406,-60,959,-89\r
+404,756,577,-643,-332,658\r
+291,460,125,491,-312,83\r
+311,-734,-141,582,282,-557\r
+-450,-661,-981,710,-177,794\r
+328,264,-787,971,-743,-407\r
+-622,518,993,-241,-738,229\r
+273,-826,-254,-917,-710,-111\r
+809,770,96,368,-818,725\r
+-488,773,502,-342,534,745\r
+-28,-414,236,-315,-484,363\r
+179,-466,-566,713,-683,56\r
+560,-240,-597,619,916,-940\r
+893,473,872,-868,-642,-461\r
+799,489,383,-321,-776,-833\r
+980,490,-508,764,-512,-426\r
+917,961,-16,-675,440,559\r
+-812,212,784,-987,-132,554\r
+-886,454,747,806,190,231\r
+910,341,21,-66,708,725\r
+29,929,-831,-494,-303,389\r
+-103,492,-271,-174,-515,529\r
+-292,119,419,788,247,-951\r
+483,543,-347,-673,664,-549\r
+-926,-871,-437,337,162,-877\r
+299,472,-771,5,-88,-643\r
+-103,525,-725,-998,264,22\r
+-505,708,550,-545,823,347\r
+-738,931,59,147,-156,-259\r
+456,968,-162,889,132,-911\r
+535,120,968,-517,-864,-541\r
+24,-395,-593,-766,-565,-332\r
+834,611,825,-576,280,629\r
+211,-548,140,-278,-592,929\r
+-999,-240,-63,-78,793,573\r
+-573,160,450,987,529,322\r
+63,353,315,-187,-461,577\r
+189,-950,-247,656,289,241\r
+209,-297,397,664,-805,484\r
+-655,452,435,-556,917,874\r
+253,-756,262,-888,-778,-214\r
+793,-451,323,-251,-401,-458\r
+-396,619,-651,-287,-668,-781\r
+698,720,-349,742,-807,546\r
+738,280,680,279,-540,858\r
+-789,387,530,-36,-551,-491\r
+162,579,-427,-272,228,710\r
+689,356,917,-580,729,217\r
+-115,-638,866,424,-82,-194\r
+411,-338,-917,172,227,-29\r
+-612,63,630,-976,-64,-204\r
+-200,911,583,-571,682,-579\r
+91,298,396,-183,788,-955\r
+141,-873,-277,149,-396,916\r
+321,958,-136,573,541,-777\r
+797,-909,-469,-877,988,-653\r
+784,-198,129,883,-203,399\r
+-68,-810,223,-423,-467,-512\r
+531,-445,-603,-997,-841,641\r
+-274,-242,174,261,-636,-158\r
+-574,494,-796,-798,-798,99\r
+95,-82,-613,-954,-753,986\r
+-883,-448,-864,-401,938,-392\r
+913,930,-542,-988,310,410\r
+506,-99,43,512,790,-222\r
+724,31,49,-950,260,-134\r
+-287,-947,-234,-700,56,588\r
+-33,782,-144,948,105,-791\r
+548,-546,-652,-293,881,-520\r
+691,-91,76,991,-631,742\r
+-520,-429,-244,-296,724,-48\r
+778,646,377,50,-188,56\r
+-895,-507,-898,-165,-674,652\r
+654,584,-634,177,-349,-620\r
+114,-980,355,62,182,975\r
+516,9,-442,-298,274,-579\r
+-238,262,-431,-896,506,-850\r
+47,748,846,821,-537,-293\r
+839,726,593,285,-297,840\r
+634,-486,468,-304,-887,-567\r
+-864,914,296,-124,335,233\r
+88,-253,-523,-956,-554,803\r
+-587,417,281,-62,-409,-363\r
+-136,-39,-292,-768,-264,876\r
+-127,506,-891,-331,-744,-430\r
+778,584,-750,-129,-479,-94\r
+-876,-771,-987,-757,180,-641\r
+-777,-694,411,-87,329,190\r
+-347,-999,-882,158,-754,232\r
+-105,918,188,237,-110,-591\r
+-209,703,-838,77,838,909\r
+-995,-339,-762,750,860,472\r
+185,271,-289,173,811,-300\r
+2,65,-656,-22,36,-139\r
+765,-210,883,974,961,-905\r
+-212,295,-615,-840,77,474\r
+211,-910,-440,703,-11,859\r
+-559,-4,-196,841,-277,969\r
+-73,-159,-887,126,978,-371\r
+-569,633,-423,-33,512,-393\r
+503,143,-383,-109,-649,-998\r
+-663,339,-317,-523,-2,596\r
+690,-380,570,378,-652,132\r
+72,-744,-930,399,-525,935\r
+865,-983,115,37,995,826\r
+594,-621,-872,443,188,-241\r
+-1000,291,754,234,-435,-869\r
+-868,901,654,-907,59,181\r
+-868,-793,-431,596,-446,-564\r
+900,-944,-680,-796,902,-366\r
+331,430,943,853,-851,-942\r
+315,-538,-354,-909,139,721\r
+170,-884,-225,-818,-808,-657\r
+-279,-34,-533,-871,-972,552\r
+691,-986,-800,-950,654,-747\r
+603,988,899,841,-630,591\r
+876,-949,809,562,602,-536\r
+-693,363,-189,495,738,-1000\r
+-383,431,-633,297,665,959\r
+-740,686,-207,-803,188,-520\r
+-820,226,31,-339,10,121\r
+-312,-844,624,-516,483,621\r
+-822,-529,69,-278,800,328\r
+834,-82,-759,420,811,-264\r
+-960,-240,-921,561,173,46\r
+-324,909,-790,-814,-2,-785\r
+976,334,-290,-891,704,-581\r
+150,-798,689,-823,237,-639\r
+-551,-320,876,-502,-622,-628\r
+-136,845,904,595,-702,-261\r
+-857,-377,-522,-101,-943,-805\r
+-682,-787,-888,-459,-752,-985\r
+-571,-81,623,-133,447,643\r
+-375,-158,72,-387,-324,-696\r
+-660,-650,340,188,569,526\r
+727,-218,16,-7,-595,-988\r
+-966,-684,802,-783,-272,-194\r
+115,-566,-888,47,712,180\r
+-237,-69,45,-272,981,-812\r
+48,897,439,417,50,325\r
+348,616,180,254,104,-784\r
+-730,811,-548,612,-736,790\r
+138,-810,123,930,65,865\r
+-768,-299,-49,-895,-692,-418\r
+487,-531,802,-159,-12,634\r
+808,-179,552,-73,470,717\r
+720,-644,886,-141,625,144\r
+-485,-505,-347,-244,-916,66\r
+600,-565,995,-5,324,227\r
+-771,-35,904,-482,753,-303\r
+-701,65,426,-763,-504,-479\r
+409,733,-823,475,64,718\r
+865,975,368,893,-413,-433\r
+812,-597,-970,819,813,624\r
+193,-642,-381,-560,545,398\r
+711,28,-316,771,717,-865\r
+-509,462,809,-136,786,635\r
+618,-49,484,169,635,547\r
+-747,685,-882,-496,-332,82\r
+-501,-851,870,563,290,570\r
+-279,-829,-509,397,457,816\r
+-508,80,850,-188,483,-326\r
+860,-100,360,119,-205,787\r
+-870,21,-39,-827,-185,932\r
+826,284,-136,-866,-330,-97\r
+-944,-82,745,899,-97,365\r
+929,262,564,632,-115,632\r
+244,-276,713,330,-897,-214\r
+-890,-109,664,876,-974,-907\r
+716,249,816,489,723,141\r
+-96,-560,-272,45,-70,645\r
+762,-503,414,-828,-254,-646\r
+909,-13,903,-422,-344,-10\r
+658,-486,743,545,50,674\r
+-241,507,-367,18,-48,-241\r
+886,-268,884,-762,120,-486\r
+-412,-528,879,-647,223,-393\r
+851,810,234,937,-726,797\r
+-999,942,839,-134,-996,-189\r
+100,979,-527,-521,378,800\r
+544,-844,-832,-530,-77,-641\r
+43,889,31,442,-934,-503\r
+-330,-370,-309,-439,173,547\r
+169,945,62,-753,-542,-597\r
+208,751,-372,-647,-520,70\r
+765,-840,907,-257,379,918\r
+334,-135,-689,730,-427,618\r
+137,-508,66,-695,78,169\r
+-962,-123,400,-417,151,969\r
+328,689,666,427,-555,-642\r
+-907,343,605,-341,-647,582\r
+-667,-363,-571,818,-265,-399\r
+525,-938,904,898,725,692\r
+-176,-802,-858,-9,780,275\r
+580,170,-740,287,691,-97\r
+365,557,-375,361,-288,859\r
+193,737,842,-808,520,282\r
+-871,65,-799,836,179,-720\r
+958,-144,744,-789,797,-48\r
+122,582,662,912,68,757\r
+595,241,-801,513,388,186\r
+-103,-677,-259,-731,-281,-857\r
+921,319,-696,683,-88,-997\r
+775,200,78,858,648,768\r
+316,821,-763,68,-290,-741\r
+564,664,691,504,760,787\r
+694,-119,973,-385,309,-760\r
+777,-947,-57,990,74,19\r
+971,626,-496,-781,-602,-239\r
+-651,433,11,-339,939,294\r
+-965,-728,560,569,-708,-247\r
--- /dev/null
+USING: project-euler.112 tools.test ;
+IN: project-euler.112.tests
+
+[ 1587000 ] [ euler112 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math project-euler.common sequences sorting ;
+IN: project-euler.112
+
+! http://projecteuler.net/index.php?section=problems&id=112
+
+! DESCRIPTION
+! -----------
+
+! Working from left-to-right if no digit is exceeded by the digit to its left
+! it is called an increasing number; for example, 134468.
+
+! Similarly if no digit is exceeded by the digit to its right it is called a
+! decreasing number; for example, 66420.
+
+! We shall call a positive integer that is neither increasing nor decreasing a
+! "bouncy" number; for example, 155349.
+
+! Clearly there cannot be any bouncy numbers below one-hundred, but just over
+! half of the numbers below one-thousand (525) are bouncy. In fact, the least
+! number for which the proportion of bouncy numbers first reaches 50% is 538.
+
+! Surprisingly, bouncy numbers become more and more common and by the time we
+! reach 21780 the proportion of bouncy numbers is equal to 90%.
+
+! Find the least number for which the proportion of bouncy numbers is exactly
+! 99%.
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: bouncy? ( n -- ? )
+ number>digits dup natural-sort
+ [ = not ] [ reverse = not ] 2bi and ;
+
+PRIVATE>
+
+: euler112 ( -- answer )
+ 0 0 0 [
+ 2dup swap 99 * = not
+ ] [
+ [ 1 + ] 2dip pick bouncy? [ 1 + ] [ [ 1 + ] dip ] if
+ ] do while 2drop ;
+
+! [ euler112 ] 100 ave-time
+! 2749 ms ave run time - 33.76 SD (100 trials)
+
+SOLUTION: euler112
--- /dev/null
+USING: project-euler.124 tools.test ;
+IN: project-euler.124.tests
+
+[ 21417 ] [ euler124 ] unit-test
--- /dev/null
+! Copyright (c) 2009 Guillaume Nargeot.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel math.primes.factors
+math.ranges project-euler.common sequences sorting ;
+IN: project-euler.124
+
+! http://projecteuler.net/index.php?section=problems&id=124
+
+! DESCRIPTION
+! -----------
+
+! The radical of n, rad(n), is the product of distinct prime factors of n.
+! For example, 504 = 2^3 × 3^2 × 7, so rad(504) = 2 × 3 × 7 = 42.
+
+! If we calculate rad(n) for 1 ≤ n ≤ 10, then sort them on rad(n),
+! and sorting on n if the radical values are equal, we get:
+
+! Unsorted Sorted
+! n rad(n) n rad(n) k
+! 1 1 1 1 1
+! 2 2 2 2 2
+! 3 3 4 2 3
+! 4 2 8 2 4
+! 5 5 3 3 5
+! 6 6 9 3 6
+! 7 7 5 5 7
+! 8 2 6 6 8
+! 9 3 7 7 9
+! 10 10 10 10 10
+
+! Let E(k) be the kth element in the sorted n column; for example,
+! E(4) = 8 and E(6) = 9.
+
+! If rad(n) is sorted for 1 ≤ n ≤ 100000, find E(10000).
+
+
+! SOLUTION
+! --------
+
+<PRIVATE
+
+: rad ( n -- n )
+ unique-factors product ; inline
+
+: rads-upto ( n -- seq )
+ [0,b] [ dup rad 2array ] map ;
+
+: (euler124) ( -- seq )
+ 100000 rads-upto sort-values ;
+
+PRIVATE>
+
+: euler124 ( -- answer )
+ 10000 (euler124) nth first ;
+
+! [ euler124 ] 100 ave-time
+! 373 ms ave run time - 17.61 SD (100 trials)
+
+! TODO: instead of the brute-force method, making the rad
+! array in the way of the sieve of eratosthene would scale
+! better on bigger values.
+
+SOLUTION: euler124
USING: project-euler.186 tools.test ;
IN: project-euler.186.tests
-[ 2325629 ] [ euler186 ] unit-test
+! Uses too much memory; don't want to run on build machines
+! [ 2325629 ] [ euler186 ] unit-test
Aaron Schaefer
Eric Mertens
+Guillaume Nargeot
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test project-euler.common ;
+IN: project-euler.common.tests
+
+[ 4 ] [ -1000 number-length ] unit-test
+[ 3 ] [ -999 number-length ] unit-test
+[ 3 ] [ -100 number-length ] unit-test
+[ 2 ] [ -99 number-length ] unit-test
+[ 1 ] [ -9 number-length ] unit-test
+[ 1 ] [ -1 number-length ] unit-test
+[ 1 ] [ 0 number-length ] unit-test
+[ 1 ] [ 9 number-length ] unit-test
+[ 2 ] [ 99 number-length ] unit-test
+[ 3 ] [ 100 number-length ] unit-test
+[ 3 ] [ 999 number-length ] unit-test
+[ 4 ] [ 1000 number-length ] unit-test
[ dup 0 = not ] [ 10 /mod ] produce reverse nip ;
: number-length ( n -- m )
- log10 floor 1 + >integer ;
+ abs [
+ 1
+ ] [
+ 1 0 [ 2over >= ]
+ [ [ 10 * ] [ 1 + ] bi* ] while 2nip
+ ] if-zero ;
: nth-prime ( n -- n )
1 - lprimes lnth ;
number>string natural-sort >string "123456789" = ;
: pentagonal? ( n -- ? )
- dup 0 > [ 24 * 1 + sqrt 1 + 6 / 1 mod zero? ] [ drop f ] if ;
+ dup 0 > [ 24 * 1 + sqrt 1 + 6 / 1 mod zero? ] [ drop f ] if ; inline
: penultimate ( seq -- elt )
dup length 2 - swap nth ;
project-euler.049 project-euler.052 project-euler.053 project-euler.054
project-euler.055 project-euler.056 project-euler.057 project-euler.058
project-euler.059 project-euler.063 project-euler.067 project-euler.069
- project-euler.071 project-euler.073 project-euler.075 project-euler.076
- project-euler.079 project-euler.092 project-euler.097 project-euler.099
- project-euler.100 project-euler.116 project-euler.117 project-euler.134
- project-euler.148 project-euler.150 project-euler.151 project-euler.164
- project-euler.169 project-euler.173 project-euler.175 project-euler.186
- project-euler.190 project-euler.203 project-euler.215 ;
+ project-euler.071 project-euler.072 project-euler.073 project-euler.074
+ project-euler.075 project-euler.076 project-euler.079 project-euler.085
+ project-euler.092 project-euler.097 project-euler.099 project-euler.100
+ project-euler.102 project-euler.112 project-euler.116 project-euler.117
+ project-euler.124 project-euler.134 project-euler.148 project-euler.150
+ project-euler.151 project-euler.164 project-euler.169 project-euler.173
+ project-euler.175 project-euler.186 project-euler.190 project-euler.203
+ project-euler.215 ;
IN: project-euler
<PRIVATE
--- /dev/null
+USING: classes.struct cocoa cocoa.application cocoa.classes
+cocoa.enumeration cocoa.plists core-foundation.strings kernel ;
+IN: qtkit
+
+STRUCT: QTTime
+ { timeValue longlong }
+ { timeScale long }
+ { flags long } ;
+
+STRUCT: QTTimeRange
+ { time QTTime }
+ { duration QTTime } ;
+
+STRUCT: SMPTETime
+ { mSubframes SInt16 }
+ { mSubframeDivisor SInt16 }
+ { mCounter UInt32 }
+ { mType UInt32 }
+ { mFlags UInt32 }
+ { mHours SInt16 }
+ { mMinutes SInt16 }
+ { mSeconds SInt16 }
+ { mFrames SInt16 } ;
+
+CFSTRING: QTKitErrorDomain "QTKitErrorDomain"
+CFSTRING: QTErrorCaptureInputKey "QTErrorCaptureInputKey"
+CFSTRING: QTErrorCaptureOutputKey "QTErrorCaptureOutputKey"
+CFSTRING: QTErrorDeviceKey "QTErrorDeviceKey"
+CFSTRING: QTErrorExcludingDeviceKey "QTErrorExcludingDeviceKey"
+CFSTRING: QTErrorTimeKey "QTErrorTimeKey"
+CFSTRING: QTErrorFileSizeKey "QTErrorFileSizeKey"
+CFSTRING: QTErrorRecordingSuccesfullyFinishedKey "QTErrorRecordingSuccesfullyFinishedKey"
+
+CONSTANT: QTErrorUnknown -1
+CONSTANT: QTErrorIncompatibleInput 1002
+CONSTANT: QTErrorIncompatibleOutput 1003
+CONSTANT: QTErrorInvalidInputsOrOutputs 1100
+CONSTANT: QTErrorDeviceAlreadyUsedbyAnotherSession 1101
+CONSTANT: QTErrorNoDataCaptured 1200
+CONSTANT: QTErrorSessionConfigurationChanged 1201
+CONSTANT: QTErrorDiskFull 1202
+CONSTANT: QTErrorDeviceWasDisconnected 1203
+CONSTANT: QTErrorMediaChanged 1204
+CONSTANT: QTErrorMaximumDurationReached 1205
+CONSTANT: QTErrorMaximumFileSizeReached 1206
+CONSTANT: QTErrorMediaDiscontinuity 1207
+CONSTANT: QTErrorMaximumNumberOfSamplesForFileFormatReached 1208
+CONSTANT: QTErrorDeviceNotConnected 1300
+CONSTANT: QTErrorDeviceInUseByAnotherApplication 1301
+CONSTANT: QTErrorDeviceExcludedByAnotherDevice 1302
+
+FRAMEWORK: /System/Library/Frameworks/QTKit.framework
+
+IMPORT: QTCaptureAudioPreviewOutput
+IMPORT: QTCaptureConnection
+IMPORT: QTCaptureDecompressedAudioOutput
+IMPORT: QTCaptureDecompressedVideoOutput
+IMPORT: QTCaptureDevice
+IMPORT: QTCaptureDeviceInput
+IMPORT: QTCaptureFileOutput
+IMPORT: QTCaptureInput
+IMPORT: QTCaptureLayer
+IMPORT: QTCaptureMovieFileOutput
+IMPORT: QTCaptureOutput
+IMPORT: QTCaptureSession
+IMPORT: QTCaptureVideoPreviewOutput
+IMPORT: QTCaptureView
+IMPORT: QTCompressionOptions
+IMPORT: QTDataReference
+IMPORT: QTFormatDescription
+IMPORT: QTMedia
+IMPORT: QTMovie
+IMPORT: QTMovieLayer
+IMPORT: QTMovieView
+IMPORT: QTSampleBuffer
+IMPORT: QTTrack
+
+: <movie> ( filename -- movie )
+ QTMovie swap <NSString> f -> movieWithFile:error: -> retain ;
+
+: movie-attributes ( movie -- attributes )
+ -> movieAttributes plist> ;
+
+: play ( movie -- )
+ -> play ;
+: stop ( movie -- )
+ -> stop ;
+
+: movie-tracks ( movie -- tracks )
+ -> tracks NSFastEnumeration>vector ;
+
+: track-attributes ( track -- attributes )
+ -> trackAttributes plist> ;
--- /dev/null
+unportable
ARTICLE: "quadtrees" "Quadtrees"
"The " { $snippet "quadtrees" } " vocabulary implements the quadtree data structure in Factor."
-{ $subsection <quadtree> }
+{ $subsections <quadtree> }
"Quadtrees follow the " { $link "assocs-protocol" } " for insertion, deletion, and querying of exact points, using two-dimensional vectors as keys. Additional words are provided for spatial queries and pruning the tree structure:"
-{ $subsection in-rect }
-{ $subsection prune-quadtree }
+{ $subsections
+ in-rect
+ prune-quadtree
+}
"The following words are provided to help write quadtree algorithms:"
-{ $subsection descend }
-{ $subsection each-quadrant }
-{ $subsection map-quadrant }
+{ $subsections
+ descend
+ each-quadrant
+ map-quadrant
+}
"Quadtrees can be used to \"swizzle\" a sequence to improve the locality of spatial data in memory:"
-{ $subsection swizzle } ;
+{ $subsections swizzle } ;
ABOUT: "quadtrees"
{ $syntax "qw{ lorem ipsum }" }
{ $description "Marks the beginning of a literal array of strings. Component strings are delimited by whitespace." }
{ $examples
-{ $unchecked-example <" USING: prettyprint qw ;
-qw{ pop quiz my hive of big wild ex tranny jocks } . ">
-<" { "pop" "quiz" "my" "hive" "of" "big" "wild" "ex" "tranny" "jocks" } "> }
+{ $unchecked-example """USING: prettyprint qw ;
+qw{ pop quiz my hive of big wild ex tranny jocks } ."""
+"""{ "pop" "quiz" "my" "hive" "of" "big" "wild" "ex" "tranny" "jocks" }""" }
} ;
+
+ARTICLE: "qw" "Quoted words"
+"The " { $vocab-link "qw" } " vocabulary offers a shorthand syntax for arrays-of-strings literals." $nl
+"Construct an array of strings:"
+{ $subsections POSTPONE: qw{ } ;
+
+ABOUT: "qw"
IN: roles
HELP: ROLE:
-{ $syntax <" ROLE: name slots... ;
+{ $syntax """ROLE: name slots... ;
ROLE: name < role slots... ;
-ROLE: name <{ roles... } slots... ; "> }
+ROLE: name <{ roles... } slots... ;""" }
{ $description "Defines a new " { $link role } ". " { $link tuple } " classes which inherit this role will contain the specified " { $snippet "slots" } " as well as the slots associated with the optional inherited " { $snippet "roles" } "."
$nl
"Slot specifiers take one of the following three forms:"
"Slot attributes are lists of slot attribute specifiers followed by values; a slot attribute specifier is one of " { $link initial: } " or " { $link read-only } ". See " { $link "tuple-declarations" } " for details." } ;
HELP: TUPLE:
-{ $syntax <" TUPLE: name slots ;
+{ $syntax """TUPLE: name slots ;
TUPLE: name < estate slots ;
-TUPLE: name <{ estates... } slots... ; "> }
+TUPLE: name <{ estates... } slots... ;""" }
{ $description "Defines a new " { $link tuple } " class."
$nl
"The list of inherited " { $snippet "estates" } " is optional; a single tuple superclass and/or a set of " { $link role } "s can be specified. If no superclass is provided, it defaults to " { $link tuple } "."
--- /dev/null
+IN: rpn.tests
+USING: rpn lists tools.test ;
+
+[ { 2 } ] [ "4 2 -" rpn-parse rpn-eval list>array ] unit-test
\ No newline at end of file
GENERIC: eval-insn ( stack insn -- stack )
: binary-op ( stack quot: ( x y -- z ) -- stack )
- [ uncons uncons ] dip dip cons ; inline
+ [ uncons uncons [ swap ] dip ] dip dip cons ; inline
M: add-insn eval-insn drop [ + ] binary-op ;
M: sub-insn eval-insn drop [ - ] binary-op ;
: print-stack ( list -- )
[ number>string print ] leach ;
-: rpn-eval ( tokens -- )
- nil [ eval-insn ] foldl print-stack ;
+: rpn-eval ( tokens -- stack )
+ nil [ eval-insn ] foldl ;
: rpn ( -- )
"RPN> " write flush
- readln [ rpn-parse rpn-eval rpn ] when* ;
+ readln [ rpn-parse rpn-eval print-stack rpn ] when* ;
MAIN: rpn
ARTICLE: "sequences-merge" "Merging sequences"
"When multiple sequences are merged into one sequence, the new sequence takes an element from each input sequence in turn. For example, if we merge " { $code "{ 1 2 3 }" } "and" { $code "{ \"a\" \"b\" \"c\" }" } "we get:" { $code "{ 1 \"a\" 2 \"b\" 3 \"c\" }" } "."
-{ $subsection merge }
-{ $subsection 2merge }
-{ $subsection 3merge }
-{ $subsection <merged> }
-{ $subsection <2merged> }
-{ $subsection <3merged> } ;
+{ $subsections
+ merge
+ 2merge
+ 3merge
+ <merged>
+ <2merged>
+ <3merged>
+} ;
ABOUT: "sequences-merge"
! (c)2008 Joe Groff, see BSD license etc.
-USING: help.markup help.syntax kernel math multiline sequences ;
+USING: help.markup help.syntax kernel math sequences ;
IN: sequences.n-based
HELP: <n-based-assoc>
{ $values { "seq" sequence } { "base" integer } { "n-based-assoc" n-based-assoc } }
{ $description "Wraps " { $snippet "seq" } " in an " { $link n-based-assoc } " wrapper." }
{ $examples
-{ $example <"
+{ $example """
USING: assocs prettyprint kernel sequences.n-based ;
IN: scratchpad
} 1 <n-based-assoc> ;
10 months at .
-"> "\"October\"" } } ;
+""" "\"October\"" } } ;
HELP: n-based-assoc
{ $class-description "An adaptor class that allows a sequence to be treated as an assoc with non-zero-based keys." }
{ $examples
-{ $example <"
+{ $example """
USING: assocs prettyprint kernel sequences.n-based ;
IN: scratchpad
} 1 <n-based-assoc> ;
10 months at .
-"> "\"October\"" } } ;
+""" "\"October\"" } } ;
{ n-based-assoc <n-based-assoc> } related-words
ARTICLE: "sequences.n-based" "N-based sequences"
"The " { $vocab-link "sequences.n-based" } " vocabulary provides a sequence adaptor that allows a sequence to be treated as an assoc with non-zero-based keys."
-{ $subsection n-based-assoc }
-{ $subsection <n-based-assoc> }
+{ $subsections
+ n-based-assoc
+ <n-based-assoc>
+}
;
ABOUT: "sequences.n-based"
! (c)2009 Joe Groff bsd license
-USING: help.markup help.syntax multiline quotations sequences ;
+USING: help.markup help.syntax quotations sequences ;
IN: sequences.product
HELP: product-sequence
{ $class-description "A class of virtual sequences that present the cartesian product of their underlying set of sequences. Product sequences are constructed with the " { $link <product-sequence> } " word." }
{ $examples
-{ $example <" USING: arrays prettyprint sequences.product ;
+{ $example """USING: arrays prettyprint sequences.product ;
{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array .
-"> <" {
+""" """{
{ 1 "a" }
{ 2 "a" }
{ 3 "a" }
{ 1 "c" }
{ 2 "c" }
{ 3 "c" }
-}"> } } ;
+}""" } } ;
HELP: <product-sequence>
{ $values { "sequences" sequence } { "product-sequence" product-sequence } }
{ $description "Constructs a " { $link product-sequence } " over " { $snippet "sequences" } "." }
{ $examples
-{ $example <" USING: arrays prettyprint sequences.product ;
-{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array .
-"> <" {
+{ $example """USING: arrays prettyprint sequences.product ;
+{ { 1 2 3 } { "a" "b" "c" } } <product-sequence> >array ."""
+"""{
{ 1 "a" }
{ 2 "a" }
{ 3 "a" }
{ 1 "c" }
{ 2 "c" }
{ 3 "c" }
-}"> } } ;
+}""" } } ;
{ product-sequence <product-sequence> } related-words
ARTICLE: "sequences.product" "Product sequences"
"The " { $vocab-link "sequences.product" } " vocabulary provides a virtual sequence and combinators for manipulating the cartesian product of a set of sequences."
-{ $subsection product-sequence }
-{ $subsection <product-sequence> }
-{ $subsection product-map }
-{ $subsection product-each } ;
+{ $subsections
+ product-sequence
+ <product-sequence>
+ product-map
+ product-each
+} ;
ABOUT: "sequences.product"
[ [ % ] each ] product-each
] "" make
] unit-test
+
+[ { } ] [ { { } { 1 } } [ ] product-map ] unit-test
+[ ] [ { { } { 1 } } [ drop ] product-each ] unit-test
: product-iter ( ns lengths -- )
[ 0 over [ 1 + ] change-nth ] dip carry-ns ;
-: start-product-iter ( sequence-product -- ns lengths )
+: start-product-iter ( sequences -- ns lengths )
[ [ drop 0 ] map ] [ [ length ] map ] bi ;
: end-product-iter? ( ns lengths -- ? )
:: product-each ( sequences quot -- )
sequences start-product-iter :> lengths :> ns
- [ ns lengths end-product-iter? ]
- [ ns sequences nths quot call ns lengths product-iter ] until ; inline
+ lengths [ 0 = ] any? [
+ [ ns lengths end-product-iter? ]
+ [ ns sequences nths quot call ns lengths product-iter ] until
+ ] unless ; inline
:: product-map ( sequences quot -- sequence )
0 :> i!
! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
-USING: smtp namespaces accessors kernel arrays ;
+USING: smtp namespaces accessors kernel arrays site-watcher.db ;
IN: site-watcher.email
SYMBOL: site-watcher-from
pick [
[ <email> site-watcher-from get >>from ] 3dip
[ 1array >>to ] [ >>body ] [ >>subject ] tri* send-email
- ] [ 3drop ] if ;
\ No newline at end of file
+ ] [ 3drop ] if ;
{ wrap-margin 1100 }
}
}
- { code-style
+ { code-char-style
H{
{ font-name "monospace" }
{ font-size 36 }
+ }
+ }
+ { code-style
+ H{
{ page-color T{ rgba f 0.4 0.4 0.4 0.3 } }
}
}
{ T{ button-down } [ request-focus ] }
{ T{ key-down f f "DOWN" } [ next-page ] }
{ T{ key-down f f "UP" } [ prev-page ] }
+ { T{ key-down f f "f" } [ dup fullscreen? not set-fullscreen ] }
} set-gestures
: slides-window ( slides -- )
ARTICLE: "spider-tutorial" "Spider tutorial"
"To create a new spider, call the " { $link <spider> } " word with a link to the site you wish to spider."
-{ $code <" "http://concatenative.org" <spider> "> }
+{ $code """"http://concatenative.org" <spider>""" }
"The max-depth is initialized to 0, which retrieves just the initial page. Let's initialize it to something more fun:"
-{ $code <" 1 >>max-depth "> }
+{ $code """1 >>max-depth""" }
"Now the spider will retrieve the first page and all the pages it links to in the same domain." $nl
"But suppose the front page contains thousands of links. To avoid grabbing them all, we can set " { $slot "max-count" } " to a reasonable limit."
-{ $code <" 10 >>max-count "> }
+{ $code """10 >>max-count""" }
"A timeout might keep the spider from hitting the server too hard:"
-{ $code <" USE: calendar 1.5 seconds >>sleep "> }
+{ $code """USE: calendar 1.5 seconds >>sleep""" }
"Since we happen to know that not all pages of a wiki are suitable for spidering, we will spider only the wiki view pages, not the edit or revisions pages. To do this, we add a filter through which new links are tested; links that pass the filter are added to the todo queue, while links that do not are discarded. You can add several filters to the filter array, but we'll just add a single one for now."
-{ $code <" { [ path>> "/wiki/view" head? ] } >>filters "> }
+{ $code """{ [ path>> "/wiki/view" head? ] } >>filters""" }
"Finally, to start the spider, call the " { $link run-spider } " word."
{ $code "run-spider" }
"The full code from the tutorial."
-{ $code <" USING: spider calendar sequences accessors ;
+{ $code """USING: spider calendar sequences accessors ;
: spider-concatenative ( -- spider )
"http://concatenative.org" <spider>
1 >>max-depth
10 >>max-count
1.5 seconds >>sleep
{ [ path>> "/wiki/view" head? ] } >>filters
- run-spider ;"> } ;
+ run-spider ;""" } ;
ARTICLE: "spider" "Spider"
"The " { $vocab-link "spider" } " vocabulary implements a simple web spider for retrieving sets of webpages."
-{ $subsection "spider-tutorial" }
+{ $subsections "spider-tutorial" }
"Creating a new spider:"
-{ $subsection <spider> }
+{ $subsections <spider> }
"Running the spider:"
-{ $subsection run-spider } ;
+{ $subsections run-spider } ;
ABOUT: "spider"
! (c)2009 Joe Groff, see BSD license
USING: accessors arrays literals math math.affine-transforms
-math.functions multiline sequences svg tools.test xml xml.traversal ;
+math.functions sequences svg tools.test xml xml.traversal multiline ;
IN: svg.tests
{ 1.0 2.25 } { -3.0 4.0 } { 5.5 0.5 } <affine-transform> 1array [
T{ elliptical-arc f { 5.0 6.0 } 7.0 t f { 8.0 9.0 } f }
} ] [
- <"
+ """
M 1.0,+1 3,-10e-1 l 2 2, 2 -2, 2 2 v -9 1 H 9 8 z
M 0 0 C -4.0 0.0 -8.0 4.0 -8.0 8.0 -8.0 4.0 -12.0 8.0 -16.0 8.0
s 0.0,2.0 2.0,0.0
Q -2 0 0 -2 -3. 0 0 3
t 1 2 3 4
A 5 6 7 1 0 8 9
- "> svg-path>array
+ """ svg-path>array
] unit-test
STRING: test-svg-string
! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged specialized-arrays.uchar specialized-arrays.short ;
+USING: accessors alien.c-types combinators kernel locals math
+math.ranges openal sequences sequences.merged specialized-arrays ;
+FROM: alien.c-types => short ;
+SPECIALIZED-ARRAY: uchar
+SPECIALIZED-ARRAY: short
IN: synth.buffers
TUPLE: buffer sample-freq 8bit? id ;
+++ /dev/null
-Doug Coleman
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: system ;
-IN: system-info.backend
-
-HOOK: cpus os ( -- n )
-HOOK: cpu-mhz os ( -- n )
-HOOK: memory-load os ( -- n )
-HOOK: physical-mem os ( -- n )
-HOOK: available-mem os ( -- n )
-HOOK: total-page-file os ( -- n )
-HOOK: available-page-file os ( -- n )
-HOOK: total-virtual-mem os ( -- n )
-HOOK: available-virtual-mem os ( -- n )
-HOOK: available-virtual-extended-mem os ( -- n )
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: unix alien alien.c-types kernel math sequences strings
-io.backend.unix splitting io.encodings.utf8 io.encodings.string ;
-IN: system-info.linux
-
-: (uname) ( buf -- int )
- "int" f "uname" { "char*" } alien-invoke ;
-
-: uname ( -- seq )
- 65536 "char" <c-array> [ (uname) io-error ] keep
- "\0" split harvest [ utf8 decode ] map
- 6 "" pad-tail ;
-
-: sysname ( -- string ) uname first ;
-: nodename ( -- string ) uname second ;
-: release ( -- string ) uname third ;
-: version ( -- string ) uname fourth ;
-: machine ( -- string ) uname 4 swap nth ;
-: domainname ( -- string ) uname 5 swap nth ;
-
-: kernel-version ( -- seq )
- release ".-" split harvest 5 "" pad-tail ;
+++ /dev/null
-unportable
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings alien.syntax
-byte-arrays kernel namespaces sequences unix
-system-info.backend system io.encodings.utf8 ;
-IN: system-info.macosx
-
-! See /usr/include/sys/sysctl.h for constants
-
-LIBRARY: libc
-FUNCTION: int sysctl ( int* name, uint namelen, void* oldp, size_t* oldlenp, void* newp, size_t newlen ) ;
-
-: make-int-array ( seq -- byte-array )
- [ <int> ] map concat ;
-
-: (sysctl-query) ( name namelen oldp oldlenp -- oldp )
- over [ f 0 sysctl io-error ] dip ;
-
-: sysctl-query ( seq n -- byte-array )
- [ [ make-int-array ] [ length ] bi ] dip
- [ <byte-array> ] [ <uint> ] bi (sysctl-query) ;
-
-: sysctl-query-string ( seq -- n )
- 4096 sysctl-query utf8 alien>string ;
-
-: sysctl-query-uint ( seq -- n )
- 4 sysctl-query *uint ;
-
-: sysctl-query-ulonglong ( seq -- n )
- 8 sysctl-query *ulonglong ;
-
-: machine ( -- str ) { 6 1 } sysctl-query-string ;
-: model ( -- str ) { 6 2 } sysctl-query-string ;
-M: macosx cpus ( -- n ) { 6 3 } sysctl-query-uint ;
-: byte-order ( -- n ) { 6 4 } sysctl-query-uint ;
-M: macosx physical-mem ( -- n ) { 6 5 } sysctl-query-uint ;
-: user-mem ( -- n ) { 6 6 } sysctl-query-uint ;
-: page-size ( -- n ) { 6 7 } sysctl-query-uint ;
-: disknames ( -- n ) { 6 8 } 8 sysctl-query ;
-: diskstats ( -- n ) { 6 9 } 8 sysctl-query ;
-: epoch ( -- n ) { 6 10 } sysctl-query-uint ;
-: floating-point ( -- n ) { 6 11 } sysctl-query-uint ;
-: machine-arch ( -- n ) { 6 12 } sysctl-query-string ;
-: vector-unit ( -- n ) { 6 13 } sysctl-query-uint ;
-: bus-frequency ( -- n ) { 6 14 } sysctl-query-uint ;
-M: macosx cpu-mhz ( -- n ) { 6 15 } sysctl-query-uint ;
-: cacheline-size ( -- n ) { 6 16 } sysctl-query-uint ;
-: l1-icache-size ( -- n ) { 6 17 } sysctl-query-uint ;
-: l1-dcache-size ( -- n ) { 6 18 } sysctl-query-uint ;
-: l2-cache-settings ( -- n ) { 6 19 } sysctl-query-uint ;
-: l2-cache-size ( -- n ) { 6 20 } sysctl-query-uint ;
-: l3-cache-settings ( -- n ) { 6 21 } sysctl-query-uint ;
-: l3-cache-size ( -- n ) { 6 22 } sysctl-query-uint ;
-: tb-frequency ( -- n ) { 6 23 } sysctl-query-uint ;
-: mem-size ( -- n ) { 6 24 } sysctl-query-ulonglong ;
-: available-cpus ( -- n ) { 6 25 } sysctl-query-uint ;
+++ /dev/null
-unportable
+++ /dev/null
-Query the operating system for hardware information in a platform-independent way
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.syntax kernel math prettyprint io math.parser
-combinators vocabs.loader system-info.backend system ;
-IN: system-info
-
-: write-unit ( x n str -- )
- [ 2^ /f number>string write bl ] [ write ] bi* ;
-
-: kb ( x -- ) 10 "kB" write-unit ;
-: megs ( x -- ) 20 "MB" write-unit ;
-: gigs ( x -- ) 30 "GB" write-unit ;
-: ghz ( x -- ) 1000000000 /f number>string write bl "GHz" write ;
-
-<< {
- { [ os windows? ] [ "system-info.windows" ] }
- { [ os linux? ] [ "system-info.linux" ] }
- { [ os macosx? ] [ "system-info.macosx" ] }
- [ f ]
-} cond [ require ] when* >>
-
-: system-report. ( -- )
- "CPUs: " write cpus number>string write nl
- "CPU Speed: " write cpu-mhz ghz nl
- "Physical RAM: " write physical-mem megs nl ;
+++ /dev/null
-Doug Coleman
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types system-info kernel math namespaces
-windows windows.kernel32 system-info.backend system ;
-IN: system-info.windows.ce
-
-: memory-status ( -- MEMORYSTATUS )
- "MEMORYSTATUS" <c-object>
- "MEMORYSTATUS" heap-size over set-MEMORYSTATUS-dwLength
- dup GlobalMemoryStatus ;
-
-M: wince cpus ( -- n ) 1 ;
-
-M: wince memory-load ( -- n )
- memory-status MEMORYSTATUS-dwMemoryLoad ;
-
-M: wince physical-mem ( -- n )
- memory-status MEMORYSTATUS-dwTotalPhys ;
-
-M: wince available-mem ( -- n )
- memory-status MEMORYSTATUS-dwAvailPhys ;
-
-M: wince total-page-file ( -- n )
- memory-status MEMORYSTATUS-dwTotalPageFile ;
-
-M: wince available-page-file ( -- n )
- memory-status MEMORYSTATUS-dwAvailPageFile ;
-
-M: wince total-virtual-mem ( -- n )
- memory-status MEMORYSTATUS-dwTotalVirtual ;
-
-M: wince available-virtual-mem ( -- n )
- memory-status MEMORYSTATUS-dwAvailVirtual ;
+++ /dev/null
-unportable
+++ /dev/null
-Doug Coleman
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings
-kernel libc math namespaces system-info.backend
-system-info.windows windows windows.advapi32
-windows.kernel32 system byte-arrays windows.errors
-classes classes.struct accessors ;
-IN: system-info.windows.nt
-
-M: winnt cpus ( -- n )
- system-info dwNumberOfProcessors>> ;
-
-: memory-status ( -- MEMORYSTATUSEX )
- "MEMORYSTATUSEX" <struct>
- dup class heap-size >>dwLength
- dup GlobalMemoryStatusEx win32-error=0/f ;
-
-M: winnt memory-load ( -- n )
- memory-status dwMemoryLoad>> ;
-
-M: winnt physical-mem ( -- n )
- memory-status ullTotalPhys>> ;
-
-M: winnt available-mem ( -- n )
- memory-status ullAvailPhys>> ;
-
-M: winnt total-page-file ( -- n )
- memory-status ullTotalPageFile>> ;
-
-M: winnt available-page-file ( -- n )
- memory-status ullAvailPageFile>> ;
-
-M: winnt total-virtual-mem ( -- n )
- memory-status ullTotalVirtual>> ;
-
-M: winnt available-virtual-mem ( -- n )
- memory-status ullAvailVirtual>> ;
-
-: computer-name ( -- string )
- MAX_COMPUTERNAME_LENGTH 1 +
- [ <byte-array> dup ] keep <uint>
- GetComputerName win32-error=0/f alien>native-string ;
-
-: username ( -- string )
- UNLEN 1 +
- [ <byte-array> dup ] keep <uint>
- GetUserName win32-error=0/f alien>native-string ;
+++ /dev/null
-unportable
+++ /dev/null
-unportable
+++ /dev/null
-! Copyright (C) 2008 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types classes.struct accessors kernel
-math namespaces windows windows.kernel32 windows.advapi32 words
-combinators vocabs.loader system-info.backend system
-alien.strings windows.errors ;
-IN: system-info.windows
-
-: system-info ( -- SYSTEM_INFO )
- SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
-
-: page-size ( -- n )
- system-info dwPageSize>> ;
-
-! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
-: processor-type ( -- n )
- system-info dwProcessorType>> ;
-
-! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
-: processor-architecture ( -- n )
- system-info dwOemId>> HEX: ffff0000 bitand ;
-
-: os-version ( -- os-version )
- "OSVERSIONINFO" <c-object>
- "OSVERSIONINFO" heap-size over set-OSVERSIONINFO-dwOSVersionInfoSize
- dup GetVersionEx win32-error=0/f ;
-
-: windows-major ( -- n )
- os-version OSVERSIONINFO-dwMajorVersion ;
-
-: windows-minor ( -- n )
- os-version OSVERSIONINFO-dwMinorVersion ;
-
-: windows-build# ( -- n )
- os-version OSVERSIONINFO-dwBuildNumber ;
-
-: windows-platform-id ( -- n )
- os-version OSVERSIONINFO-dwPlatformId ;
-
-: windows-service-pack ( -- string )
- os-version OSVERSIONINFO-szCSDVersion alien>native-string ;
-
-: feature-present? ( n -- ? )
- IsProcessorFeaturePresent zero? not ;
-
-: sse2? ( -- ? )
- PF_XMMI64_INSTRUCTIONS_AVAILABLE feature-present? ;
-
-: sse3? ( -- ? )
- PF_SSE3_INSTRUCTIONS_AVAILABLE feature-present? ;
-
-: <u16-string-object> ( n -- obj )
- "ushort" <c-array> ;
-
-: get-directory ( word -- str )
- [ MAX_UNICODE_PATH [ <u16-string-object> ] keep dupd ] dip
- execute win32-error=0/f alien>native-string ; inline
-
-: windows-directory ( -- str )
- \ GetWindowsDirectory get-directory ;
-
-: system-directory ( -- str )
- \ GetSystemDirectory get-directory ;
-
-: system-windows-directory ( -- str )
- \ GetSystemWindowsDirectory get-directory ;
-
-<<
-{
- { [ os wince? ] [ "system-info.windows.ce" ] }
- { [ os winnt? ] [ "system-info.windows.nt" ] }
-} cond require >>
--- /dev/null
+Doug Coleman
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: assocs combinators constructors eval help.markup kernel
+multiline namespaces parser sequences sequences.private slides
+vocabs.refresh words fry ;
+IN: tc-lisp-talk
+
+CONSTANT: tc-lisp-slides
+{
+ { $slide "Factor!"
+ { $url "http://factorcode.org" }
+ "Development started in 2003"
+ "Open source (BSD license)"
+ "Influenced by Forth, Lisp, and Smalltalk"
+ "Blurs the line between language and library"
+ "Interactive development"
+ }
+ { $slide "First, some examples"
+ { $code "3 weeks ago noon monday ." }
+ { $code "USE: roman 2009 >roman ." }
+ { $code """: average ( seq -- x )
+ [ sum ] [ length ] bi / ;""" }
+ { $code "1 miles [ km ] undo >float ." }
+ { $code "[ readln eval>string print t ] loop" }
+ }
+ { $slide "XML Literals"
+ { $code
+ """USING: splitting xml.writer xml.syntax ;
+{ "one" "two" "three" }
+[ [XML <item><-></item> XML] ] map
+<XML <doc><-></doc> XML> pprint-xml"""
+ }
+ }
+ { $slide "Differences between Factor and Lisp"
+ "Single-implementation language"
+ "Less nesting, shorter word length"
+ { "Dynamic reloading of code from files with " { $link refresh-all } }
+ "More generic protocols -- sequences, assocs, streams"
+ "More cross-platform"
+ "No standard for the language"
+ "Evaluates left to right"
+ }
+ { $slide "Terminology"
+ { "Words - functions" }
+ { "Vocabularies - collections of code in the same namespace" }
+ { "Quotations - blocks of code" { $code "[ dup reverse append ]" } }
+ { "Combinators - higher order functions" }
+ { "Static stack effect - known stack effect at compile-time" }
+ }
+ { $slide "Defining a word"
+ "Defined at parse time"
+ "Parts: name, stack effect, definition"
+ "Composed of tokens separated by whitespace"
+ { $code ": palindrome? ( string -- ? ) dup reverse = ;" }
+ }
+ { $slide "Non-static stack effect"
+ "Not a good practice, nor useful"
+ "Not compiled by the optimizing compiler"
+ { $code "100 iota [ ] each" }
+ }
+ { $slide "Module system"
+ "Code divided up into vocabulary roots"
+ "core/ -- just enough code to bootstrap Factor"
+ "basis/ -- optimizing compiler, the UI, tools, libraries"
+ "extra/ -- demos, unpolished code, experiments"
+ "work/ -- your works in progress"
+ }
+ { $slide "Module system (part 2)"
+ "Each vocabulary corresponds to a directory on disk, with documentation and test files"
+ { "Code for the " { $snippet "math" } " vocabulary: " { $snippet "~/factor/core/math/math.factor" } }
+ { "Documentation for the " { $snippet "math" } " vocabulary: " { $snippet "~/factor/core/math/math-docs.factor" } }
+ { "Unit tests for the " { $snippet "math" } " vocabulary: " { $snippet " ~/factor/core/math/math-tests.factor" } }
+ }
+ { $slide "Using a library"
+ "Each file starts with a USING: list"
+ "To use a library, simply include it in this list"
+ "Refreshing code loads dependencies correctly"
+ }
+ { $slide "Object system"
+ "Based on CLOS"
+ { "We define generic words that operate on the top of the stack with " { $link POSTPONE: GENERIC: } " or on an implicit parameter with " { $link POSTPONE: HOOK: } }
+ }
+ { $slide "Object system example: shape protocol"
+ "In ~/factor/work/shapes/shapes.factor"
+ { $code """IN: shapes
+
+GENERIC: area ( shape -- x )
+GENERIC: perimeter ( shape -- x )"""
+ }
+ }
+ { $slide "Implementing the shape protocol: circles"
+ "In ~/factor/work/shapes/circle/circle.factor"
+ { $code """USING: shapes constructors math
+math.constants ;
+IN: shapes.circle
+
+TUPLE: circle radius ;
+CONSTRUCTOR: circle ( radius -- obj ) ;
+M: circle area radius>> sq pi * ;
+M: circle perimeter radius>> pi * 2 * ;"""
+ }
+ }
+ { $slide "Dynamic variables"
+ "Implemented as a stack of hashtables"
+ { "Useful words are " { $link get } ", " { $link set } }
+ "Input, output, error streams are stored in dynamic variables"
+ { $code """"Today is the first day of the rest of your life."
+[
+ readln print
+] with-string-reader"""
+ }
+ }
+ { $slide "The global namespace"
+ "The global namespace is just the namespace at the bottom of the namespace stack"
+ { "Useful words are " { $link get-global } ", " { $link set-global } }
+ "Factor idiom for changing a particular namespace"
+ { $code """SYMBOL: king
+global [ "Henry VIII" king set ] bind"""
+ }
+ { $code "with-scope" }
+ { $code "namestack" }
+ }
+ { $slide "Hooks"
+ "Dispatch on a dynamic variable"
+ { $code """HOOK: computer-name os ( -- string )
+M: macosx computer-name uname first ;
+macosx \ os set-global
+computer-name"""
+ }
+ }
+ { $slide "Interpolate"
+ "Replaces variables in a string"
+ { $code
+""""Dawg" "name" set
+"rims" "noun" set
+"bling" "verb1" set
+"roll" "verb2" set
+[
+ "Sup ${name}, we heard you liked ${noun}, so we put ${noun} on your car so you can ${verb1} while you ${verb2}."
+ interpolate
+] with-string-writer print """
+ }
+ }
+ { $slide "Sequence protocol"
+ "All sequences obey a protocol of generics"
+ { "Is an object a " { $link sequence? } }
+ { "Getting the " { $link length } }
+ { "Accessing the " { $link nth } " element" }
+ { "Setting an element - " { $link set-nth } }
+ }
+ { $slide "Examples of sequences in Factor"
+ "Arrays are mutable"
+ "Vectors are mutable and growable"
+ { "Arrays " { $code "{ \"abc\" \"def\" 50 }" } }
+ { "Vectors " { $code "V{ \"abc\" \"def\" 50 }" } }
+ { "Byte-arrays " { $code "B{ 1 2 3 }" } }
+ { "Byte-vectors " { $code "BV{ 11 22 33 }" } }
+ }
+ { $slide "Specialized arrays and vectors"
+ { "Specialized int arrays " { $code "int-array{ -20 -30 40 }" } }
+ { "Specialized uint arrays " { $code "uint-array{ 20 30 40 }" } }
+ { "Specialized float vectors " { $code "float-vector{ 20 30 40 }" } }
+ "35 others C-type arrays"
+ }
+ { $slide "Specialized arrays code"
+ "One line per array/vector"
+ { "In ~/factor/basis/specialized-arrays/float/float.factor"
+ { $code """<< "float" define-array >>""" }
+ }
+ { "In ~/factor/basis/specialized-vectors/float/float.factor"
+ { $code """<< "float" define-vector >>""" }
+ }
+ }
+
+ { $slide "Speciailzied arrays are implemented using functors"
+ "Like C++ templates"
+ "Eliminate boilerplate in ways other abstractions don't"
+ "Contains a definition section and a functor body"
+ "Uses the interpolate vocabulary"
+ }
+ { $slide "Functor for sorting"
+ { $code
+ """FUNCTOR: define-sorting ( NAME QUOT -- )
+
+NAME<=> DEFINES ${NAME}<=>
+NAME>=< DEFINES ${NAME}>=<
+
+WHERE
+
+: NAME<=> ( obj1 obj2 -- <=> ) QUOT compare ;
+: NAME>=< ( obj1 obj2 -- >=< )
+ NAME<=> invert-comparison ;
+
+;FUNCTOR"""
+ }
+ }
+ { $slide "Example of sorting functor"
+ { $code """USING: sorting.functor ;
+<< "length" [ length ] define-sorting >>"""
+ }
+ { $code
+ """{ { 1 2 3 } { 1 2 } { 1 } }
+[ length<=> ] sort"""
+ }
+ }
+ { $slide "Combinators"
+ "Used to implement higher order functions (dataflow and control flow)"
+ "Compiler optimizes away quotations completely"
+ "Optimized code is just tight loops in registers"
+ "Most loops can be expressed with combinators or tail-recursion"
+ }
+ { $slide "Combinators that act on one value"
+ { $link bi }
+ { $code "10 [ 1 - ] [ 1 + ] bi" }
+ { $link tri }
+ { $code "10 [ 1 - ] [ 1 + ] [ 2 * ] tri" }
+ }
+ { $slide "Combinators that act on two values"
+ { $link 2bi }
+ { $code "10 1 [ - ] [ + ] 2bi" }
+ { $link bi* }
+ { $code "10 20 [ 1 - ] [ 1 + ] bi*" }
+ { $link bi@ }
+ { $code "5 9 [ sq ] bi@" }
+ }
+ { $slide "Sequence combinators"
+
+ { $link each }
+ { $code "{ 1 2 3 4 5 } [ sq . ] each" }
+ { $link map }
+ { $code "{ 1 2 3 4 5 } [ sq ] map" }
+ { $link filter }
+ { $code "{ 1 2 3 4 5 } [ even? ] filter" }
+ }
+ { $slide "Multiple sequence combinators"
+
+ { $link 2each }
+ { $code "{ 1 2 3 } { 10 20 30 } [ + . ] 2each" }
+ { $link 2map }
+ { $code "{ 1 2 3 } { 10 20 30 } [ + ] 2map" }
+ }
+ { $slide "Control flow: if"
+ { $link if }
+ { $code """10 random dup even? [ 2 / ] [ 1 - ] if""" }
+ { $link when }
+ { $code """10 random dup even? [ 2 / ] when""" }
+ { $link unless }
+ { $code """10 random dup even? [ 1 - ] unless""" }
+ }
+ { $slide "Control flow: case"
+ { $link case }
+ { $code """ERROR: not-possible obj ;
+10 random 5 <=> {
+ { +lt+ [ "Less" ] }
+ { +gt+ [ "More" ] }
+ { +eq+ [ "Equal" ] }
+ [ not-possible ]
+} case"""
+ }
+ }
+ { $slide "Fry"
+ "Used to construct quotations"
+ { "'Holes', represented by " { $snippet "_" } " are filled left to right" }
+ { $code "10 4 '[ _ + ] call" }
+ { $code "3 4 '[ _ sq _ + ] call" }
+ }
+ { $slide "Locals"
+ "When data flow combinators and shuffle words are not enough"
+ "Name your input parameters"
+ "Used in about 1% of all words"
+ }
+ { $slide "Locals example"
+ "Area of a triangle using Heron's formula"
+ { $code
+ """:: area ( a b c -- x )
+ a b c + + 2 / :> p
+ p
+ p a - *
+ p b - *
+ p c - * sqrt ;"""
+ }
+ }
+ { $slide "Previous example without locals"
+ "A bit unwieldy..."
+ { $code
+ """: area ( a b c -- x )
+ [ ] [ + + 2 / ] 3bi
+ [ '[ _ - ] tri@ ] [ neg ] bi
+ * * * sqrt ;""" }
+ }
+ { $slide "More idiomatic version"
+ "But there's a trick: put the lengths in an array"
+ { $code """: v-n ( v n -- w ) '[ _ - ] map ;
+
+: area ( seq -- x )
+ [ 0 suffix ] [ sum 2 / ] bi
+ v-n product sqrt ;""" }
+ }
+ { $slide "Implementing an abstraction"
+ { "Suppose we want to get the price of the customer's first order, but any one of the steps along the way could be a nil value (" { $link f } " in Factor):" }
+ { $code
+ "dup [ orders>> ] when"
+ "dup [ first ] when"
+ "dup [ price>> ] when"
+ }
+ }
+ { $slide "This is hard with mainstream syntax!"
+ { $code
+ """var customer = ...;
+var orders = (customer == null ? null : customer.orders);
+var order = (orders == null ? null : orders[0]);
+var price = (order == null ? null : order.price);""" }
+ }
+ { $slide "An ad-hoc solution"
+ "Something like..."
+ { $code "var price = customer.?orders.?[0].?price;" }
+ }
+ { $slide "Macros in Factor"
+ "Expand at compile-time"
+ "Return a quotation to be compiled"
+ "Can express non-static stack effects"
+ "Not as widely used as combinators, 60 macros so far"
+ { $code "{ 1 2 3 4 5 } 5 firstn" }
+ }
+ { $slide "A macro solution"
+ "Returns a quotation to the compiler"
+ "Constructed using map, fry, and concat"
+ { $code """MACRO: plox ( seq -- quot )
+ [
+ '[ dup _ when ]
+ ] map [ ] concat-as ;"""
+ }
+ }
+ { $slide "Macro example"
+ "Return the caaar of a sequence"
+ { "Return " { $snippet f } " on failure" }
+ { $code """: caaar ( seq/f -- x/f )
+ {
+ [ first ]
+ [ first ]
+ [ first ]
+ } plox ;"""
+ }
+ { $code """{ { f } } caaar""" }
+ { $code """{ { { 1 2 3 } } } caaar""" }
+ }
+ { $slide "Smart combinators"
+ "Use stack checker to infer inputs and outputs"
+ "Even fewer uses than macros"
+ { $code "{ 1 10 20 34 } sum" }
+ { $code "[ 1 10 20 34 ] sum-outputs" }
+ { $code "[ 2 2 [ even? ] both? ] [ + ] [ - ] smart-if" }
+ }
+ { $slide "Fibonacci"
+ "Not tail recursive"
+ "Call tree is huge"
+ { $code """: fib ( n -- x )
+ dup 1 <= [
+ [ 1 - fib ] [ 2 - fib ] bi +
+ ] unless ;"""
+ }
+ { $code "36 iota [ fib ] map ." }
+ }
+ { $slide "Memoized Fibonacci"
+ "Change one word and it's efficient"
+ { $code """MEMO: fib ( n -- x )
+ dup 1 <= [
+ [ 1 - fib ] [ 2 - fib ] bi +
+ ] unless ;"""
+ }
+ { $code "36 iota [ fib ] map ." }
+ }
+ { $slide "Destructors"
+ "Deterministic resource disposal"
+ "Any step can fail and we don't want to leak resources"
+ "We want to conditionally clean up sometimes -- if everything succeeds, we might wish to retain the buffer"
+ }
+
+ { $slide "Example in C"
+ { $code
+"""void do_stuff()
+{
+ void *obj1, *obj2;
+ if(!(*obj1 = malloc(256))) goto end;
+ if(!(*obj2 = malloc(256))) goto cleanup1;
+ ... work goes here...
+cleanup2: free(*obj2);
+cleanup1: free(*obj1);
+end: return;
+}"""
+ }
+ }
+ { $slide "Example: allocating and disposing two buffers"
+ { $code """: do-stuff ( -- )
+ [
+ 256 malloc &free
+ 256 malloc &free
+ ... work goes here ...
+ ] with-destructors ;"""
+ }
+ }
+ { $slide "Example: allocating two buffers for later"
+ { $code """: do-stuff ( -- )
+ [
+ 256 malloc |free
+ 256 malloc |free
+ ... work goes here ...
+ ] with-destructors ;"""
+ }
+ }
+ { $slide "Example: disposing of an output port"
+ { $code """M: output-port dispose*
+ [
+ {
+ [ handle>> &dispose drop ]
+ [ buffer>> &dispose drop ]
+ [ port-flush ]
+ [ handle>> shutdown ]
+ } cleave
+ ] with-destructors ;"""
+ }
+ }
+ { $slide "Rapid application development"
+ "We lost the dice to Settlers of Catan: Cities and Knights"
+ "Two regular dice, one special die"
+ { $vocab-link "dice" }
+ }
+ { $slide "The essence of Factor"
+ "Nicely named words abstract away the stack, leaving readable code"
+ { $code """: surround ( seq left right -- seq' )
+ swapd 3append ;"""
+ }
+ { $code """: glue ( left right middle -- seq' )
+ swap 3append ;"""
+ }
+ { $code HEREDOC: xyz
+"a" "b" "c" 3append
+"a" """""""" surround
+"a" "b" ", " glue
+xyz
+ }
+ }
+ { $slide "C FFI demo"
+ "Easy to call C functions from Factor"
+ "Handles C structures, C types, callbacks"
+ "Used extensively in the Windows and Unix backends"
+ { $code
+ """FUNCTION: double pow ( double x, double y ) ;
+2 5.0 pow ."""
+ }
+ }
+ { $slide "Windows win32 example"
+ { $code
+"""M: windows gmt-offset
+ ( -- hours minutes seconds )
+ "TIME_ZONE_INFORMATION" <c-object>
+ dup GetTimeZoneInformation {
+ { TIME_ZONE_ID_INVALID [
+ win32-error-string throw
+ ] }
+ { TIME_ZONE_ID_STANDARD [
+ TIME_ZONE_INFORMATION-Bias
+ ] }
+ } case neg 60 /mod 0 ;"""
+ }
+ }
+ { $slide "Struct and function"
+ { $code """C-STRUCT: TIME_ZONE_INFORMATION
+ { "LONG" "Bias" }
+ { { "WCHAR" 32 } "StandardName" }
+ { "SYSTEMTIME" "StandardDate" }
+ { "LONG" "StandardBias" }
+ { { "WCHAR" 32 } "DaylightName" }
+ { "SYSTEMTIME" "DaylightDate" }
+ { "LONG" "DaylightBias" } ;"""
+ }
+ { $code """FUNCTION: DWORD GetTimeZoneInformation (
+ LPTIME_ZONE_INFORMATION
+ lpTimeZoneInformation
+) ;"""
+ }
+
+ }
+ { $slide "Cocoa FFI"
+ { $code """IMPORT: NSAlert [
+ NSAlert -> new
+ [ -> retain ] [
+ "Raptor" <CFString> &CFRelease
+ -> setMessageText:
+ ] [
+ "Look out!" <CFString> &CFRelease
+ -> setInformativeText:
+ ] tri -> runModal drop
+] with-destructors"""
+ }
+ }
+ { $slide "Deployment demo"
+ "Vocabularies can be deployed"
+ "Standalone .app on Mac"
+ "An executable and dll on Windows"
+ { $vocab-link "webkit-demo" }
+ }
+ { $slide "Interesting programs"
+ { $vocab-link "terrain" }
+ { $vocab-link "gpu.demos.raytrace" }
+ { $vocab-link "gpu.demos.bunny" }
+ }
+ { $slide "Factor's source tree"
+ "Lines of code in core/: 9,500"
+ "Lines of code in basis/: 120,000"
+ "Lines of code in extra/: 51,000"
+ "Lines of tests: 44,000"
+ "Lines of documentation: 44,500"
+ }
+ { $slide "VM trivia"
+ "Lines of C++ code: 12860"
+ "Generational garbage collection"
+ "Non-optimizing compiler"
+ "Loads an image file and runs it"
+ }
+ { $slide "Why should I use Factor?"
+ "More abstractions over time"
+ "We fix reported bugs quickly"
+ "Stackable, fluent language"
+ "Supports extreme programming"
+ "Beer-friendly programming"
+ }
+ { $slide "Questions?"
+ }
+}
+
+: tc-lisp-talk ( -- ) tc-lisp-slides slides-window ;
+
+MAIN: tc-lisp-talk
math math.constants math.functions math.matrices math.order
math.vectors opengl opengl.capabilities opengl.gl
opengl.shaders opengl.textures opengl.textures.private
-sequences sequences.product specialized-arrays.float
+sequences sequences.product specialized-arrays
terrain.generation terrain.shaders ui ui.gadgets
ui.gadgets.worlds ui.pixel-formats game-worlds method-chains
math.affine-transforms noise ui.gestures combinators.short-circuit
destructors grid-meshes ;
+FROM: alien.c-types => float ;
+SPECIALIZED-ARRAY: float
IN: terrain
CONSTANT: FOV $[ 2.0 sqrt 1 + ]
LIBRARY: tokyocabinet
-TYPEDEF: void* TCHDB*
+C-TYPE: TCXSTR
+C-TYPE: TCHDB
CONSTANT: HDBFOPEN 1
CONSTANT: HDBFFATAL 2
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.libraries alien.syntax
combinators kernel system tokyo.alien.tchdb tokyo.alien.tcutil
-tokyo.alien.tctdb ;
+tokyo.alien.tctdb classes.struct ;
IN: tokyo.alien.tcrdb
<< "tokyotyrant" {
LIBRARY: tokyotyrant
-TYPEDEF: void* TCRDB*
-! C-STRUCT: TCRDB
-! { "pthread_mutex_t" mmtx }
-! { "pthread_key_t" eckey }
-! { "char*" host }
-! { "int" port }
-! { "char*" expr }
-! { "int" fd }
-! { "TTSOCK*" sock }
-! { "double" timeout }
-! { "int" opts } ;
+C-TYPE: TCRDB
+! STRUCT: TCRDB
+! { mmtx pthread_mutex_t }
+! { eckey pthread_key_t }
+! { host char* }
+! { port int }
+! { expr char* }
+! { fd int }
+! { sock TTSOCK* }
+! { timeout double }
+! { opts int } ;
C-ENUM:
TTESUCCESS
CONSTANT: RDBITVOID TDBITVOID
CONSTANT: RDBITKEEP TDBITKEEP
-TYPEDEF: void* RDBQRY*
-! C-STRUCT: RDBQRY
-! { "TCRDB*" rdb }
-! { "TCLIST*" args } ;
+C-TYPE: RDBQRY
+! STRUCT: RDBQRY
+! { rdb TCRDB* }
+! { args TCLIST* } ;
CONSTANT: RDBQCSTREQ TDBQCSTREQ
CONSTANT: RDBQCSTRINC TDBQCSTRINC
LIBRARY: tokyocabinet
-TYPEDEF: void* TDBIDX*
-TYPEDEF: void* TCTDB*
+C-TYPE: TDBIDX
+C-TYPE: TCTDB
+C-TYPE: TCMAP
CONSTANT: TDBFOPEN HDBFOPEN
CONSTANT: TDBFFATAL HDBFFATAL
CONSTANT: TDBITVOID 9999
CONSTANT: TDBITKEEP 16777216
-TYPEDEF: void* TDBCOND*
-TYPEDEF: void* TDBQRY*
+C-TYPE: TDBCOND
+C-TYPE: TDBQRY
C-ENUM:
TDBQCSTREQ
! FIXME: on windows 64bits this isn't correct, because long is 32bits there, and time_t is int64
TYPEDEF: long tokyo_time_t
-TYPEDEF: void* TCLIST*
+C-TYPE: TCLIST
FUNCTION: TCLIST* tclistnew ( ) ;
FUNCTION: TCLIST* tclistnew2 ( int anum ) ;
ARTICLE: "trees.avl" "AVL trees"
"This is a library for AVL trees, with logarithmic time storage and retrieval operations. These trees conform to the assoc protocol."
-{ $subsection avl }
-{ $subsection <avl> }
-{ $subsection >avl }
-{ $subsection POSTPONE: AVL{ } ;
+{ $subsections
+ avl
+ <avl>
+ >avl
+ POSTPONE: AVL{
+} ;
ABOUT: "trees.avl"
ARTICLE: "trees.splay" "Splay trees"
"This is a library for splay trees. Splay trees have amortized average-case logarithmic time storage and retrieval operations, and better complexity on more skewed lookup distributions, though in bad situations they can degrade to linear time, resembling a linked list. These trees conform to the assoc protocol."
-{ $subsection splay }
-{ $subsection <splay> }
-{ $subsection >splay }
-{ $subsection POSTPONE: SPLAY{ } ;
+{ $subsections
+ splay
+ <splay>
+ >splay
+ POSTPONE: SPLAY{
+} ;
ABOUT: "trees.splay"
ARTICLE: "trees" "Binary search trees"
"This is a library for unbalanced binary search trees. It is not intended to be used directly in most situations but rather as a base class for new trees, because performance can degrade to linear time storage/retrieval by the number of keys. These binary search trees conform to the assoc protocol."
-{ $subsection tree }
-{ $subsection <tree> }
-{ $subsection >tree }
-{ $subsection POSTPONE: TREE{ } ;
+{ $subsections
+ tree
+ <tree>
+ >tree
+ POSTPONE: TREE{
+} ;
ABOUT: "trees"
--- /dev/null
+! (c)Joe Groff bsd license
+USING: typed compiler.cfg.debugger compiler.tree.debugger words ;
+IN: typed.debugger
+
+: typed-test-mr ( word -- mrs )
+ "typed-word" word-prop test-mr ; inline
+: typed-test-mr. ( word -- )
+ "typed-word" word-prop test-mr mr. ; inline
+: typed-optimized. ( word -- )
+ "typed-word" word-prop optimized. ; inline
--- /dev/null
+Strongly-typed word definitions
--- /dev/null
+USING: kernel layouts math quotations tools.test typed ;
+IN: typed.tests
+
+TYPED: f+ ( a: float b: float -- c: float )
+ + ;
+
+[ 3.5 ]
+[ 2 1+1/2 f+ ] unit-test
+
+TYPED: fix+ ( a: fixnum b: fixnum -- c: fixnum )
+ + ;
+
+most-positive-fixnum neg 1 - 1quotation
+[ most-positive-fixnum 1 fix+ ] unit-test
+
+TUPLE: tweedle-dee ;
+TUPLE: tweedle-dum ;
+
+TYPED: dee ( x: tweedle-dee -- y )
+ drop \ tweedle-dee ;
+
+TYPED: dum ( x: tweedle-dum -- y )
+ drop \ tweedle-dum ;
+
+[ \ tweedle-dum new dee ] [ input-mismatch-error? ] must-fail-with
+[ \ tweedle-dee new dum ] [ input-mismatch-error? ] must-fail-with
+
+
+TYPED: dumdum ( x -- y: tweedle-dum )
+ drop \ tweedle-dee new ;
+
+[ f dumdum ] [ output-mismatch-error? ] must-fail-with
+
+TYPED:: f+locals ( a: float b: float -- c: float )
+ a b + ;
+
+[ 3.5 ] [ 2 1+1/2 f+locals ] unit-test
--- /dev/null
+! (c)Joe Groff bsd license
+USING: accessors arrays combinators combinators.short-circuit
+definitions effects fry hints math kernel kernel.private namespaces
+parser quotations see.private sequences words
+locals locals.definitions locals.parser ;
+IN: typed
+
+ERROR: type-mismatch-error word expected-types ;
+ERROR: input-mismatch-error < type-mismatch-error ;
+ERROR: output-mismatch-error < type-mismatch-error ;
+
+! typed inputs
+
+: typed-stack-effect? ( effect -- ? )
+ [ object = ] all? not ;
+
+: input-mismatch-quot ( word types -- quot )
+ [ input-mismatch-error ] 2curry ;
+
+: make-coercer ( types -- quot )
+ [ "coercer" word-prop [ ] or ]
+ [ swap \ dip [ ] 2sequence prepend ]
+ map-reduce ;
+
+: typed-inputs ( quot word types -- quot' )
+ {
+ [ 2nip make-coercer ]
+ [ 2nip make-specializer ]
+ [ nip swap '[ _ declare @ ] ]
+ [ [ drop ] 2dip input-mismatch-quot ]
+ } 3cleave '[ @ @ _ _ if ] ;
+
+! typed outputs
+
+: output-mismatch-quot ( word types -- quot )
+ [ output-mismatch-error ] 2curry ;
+
+: typed-outputs ( quot word types -- quot' )
+ {
+ [ 2drop ]
+ [ 2nip make-coercer ]
+ [ 2nip make-specializer ]
+ [ [ drop ] 2dip output-mismatch-quot ]
+ } 3cleave '[ @ @ @ _ unless ] ;
+
+! defining typed words
+
+: typed-gensym-quot ( def word effect -- quot )
+ [ nip effect-in-types swap '[ _ declare @ ] ]
+ [ effect-out-types dup typed-stack-effect? [ typed-outputs ] [ 2drop ] if ] 2bi ;
+
+: typed-gensym ( parent-word -- word )
+ name>> "( typed " " )" surround f <word> ;
+
+: define-typed-gensym ( word def effect -- gensym )
+ [ 2drop typed-gensym dup ]
+ [ [ swap ] dip typed-gensym-quot ]
+ [ 2nip ] 3tri define-declared ;
+
+PREDICATE: typed-standard-word < word "typed-word" word-prop ;
+PREDICATE: typed-lambda-word < lambda-word "typed-word" word-prop ;
+
+UNION: typed-word typed-standard-word typed-lambda-word ;
+
+: typed-quot ( quot word effect -- quot' )
+ [ effect-in-types dup typed-stack-effect? [ typed-inputs ] [ 2drop ] if ]
+ [ nip effect-out-types dup typed-stack-effect? [ '[ @ _ declare ] ] [ drop ] if ] 2bi ;
+
+: (typed-def) ( word def effect -- quot )
+ [ define-typed-gensym ] 3keep
+ [ drop [ swap "typed-word" set-word-prop ] [ [ 1quotation ] dip ] 2bi ] dip
+ typed-quot ;
+
+: typed-def ( word def effect -- quot )
+ dup {
+ [ effect-in-types typed-stack-effect? ]
+ [ effect-out-types typed-stack-effect? ]
+ } 1|| [ (typed-def) ] [ drop nip ] if ;
+
+: define-typed ( word def effect -- )
+ [ [ 2drop ] [ typed-def ] [ 2nip ] 3tri define-inline ]
+ [ drop "typed-def" set-word-prop ]
+ [ 2drop "typed-word" word-prop \ word set-global ] 3tri ;
+
+SYNTAX: TYPED:
+ (:) define-typed ;
+SYNTAX: TYPED::
+ (::) define-typed ;
+
+M: typed-standard-word definer drop \ TYPED: \ ; ;
+M: typed-lambda-word definer drop \ TYPED:: \ ; ;
+
+M: typed-word definition "typed-def" word-prop ;
+M: typed-word declarations. "typed-word" word-prop declarations. ;
+
+M: typed-word subwords "typed-word" word-prop 1array ;
ARTICLE: "ui.gadgets.lists" "List gadgets"
"The " { $vocab-link "ui.gadgets.lists" } " vocabulary implements lists, which displays a list of presentations (see " { $link "ui.gadgets.presentations" } ")."
-{ $subsection list }
-{ $subsection <list> }
-{ $subsection list-value } ;
+{ $subsections
+ list
+ <list>
+ list-value
+} ;
ABOUT: "ui.gadgets.lists"
IN: variants
HELP: VARIANT:
-{ $syntax <"
+{ $syntax """
VARIANT: class-name
singleton
singleton
.
.
.
- ; "> }
+ ; """ }
{ $description "Defines " { $snippet "class-name" } " as a union of the following " { $link singleton-class } " and " { $link tuple-class } " definitions. Each " { $snippet "singleton" } " word is defined as a " { $snippet "singleton-class" } ", and each " { $snippet "tuple" } " word is defined aas a " { $snippet "tuple-class" } " with the given set of " { $snippet "slot" } "s, using the same syntax for slot specifiers as " { $link POSTPONE: TUPLE: } ". Typed tuple slots can recursively reference the variant " { $snippet "class-name" } " being defined. For " { $snippet "tuple" } " types, a " { $link boa } " constructor word " { $snippet "<tuple>" } " is defined as well." }
-{ $examples { $code <"
+{ $examples { $code """
USING: kernel variants ;
IN: scratchpad
nil
cons: { { first object } { rest list } }
;
-"> } } ;
+""" } } ;
HELP: match
{ $values { "branches" array } }
{ $description "Dispatches on the type of the value on the top of the stack. If the type is a " { $link singleton-class } ", the corresponding quotation is called with the underlying stack unchanged. If the type is a " { $link tuple-class } ", the tuple slots are pushed onto the stack by order of arguments." }
-{ $examples { $example <"
+{ $examples { $example """
USING: kernel math prettyprint variants ;
IN: scratchpad
} match ;
1 2 3 4 nil <cons> <cons> <cons> <cons> list-length .
-"> "4" } } ;
+""" "4" } } ;
HELP: unboa
{ $values { "class" class } }
ARTICLE: "variants" "Algebraic data types"
"The " { $vocab-link "variants" } " vocabulary provides syntax and combinators for defining and manipulating algebraic data types."
-{ $subsection POSTPONE: VARIANT: }
-{ $subsection variant-class }
-{ $subsection match } ;
+{ $subsections
+ POSTPONE: VARIANT:
+ variant-class
+ match
+} ;
ABOUT: "variants"
help-webapp new-dispatcher
<main-action> "" add-responder
over <search-action> "search" add-responder
- swap <static> "content" add-responder ;
+ swap <static> "content" add-responder
+ "resource:basis/definitions/icons/" <static> "icons" add-responder ;
: requirements ( builder -- xml )
[
os>> {
- { "winnt" "Windows XP (also tested on Vista)" }
+ { "winnt" "Windows XP, Windows Vista or Windows 7" }
{ "macosx" "Mac OS X 10.5 Leopard" }
{ "linux" "Ubuntu Linux 9.04 (other distributions may also work)" }
- { "freebsd" "FreeBSD 7.0" }
- { "netbsd" "NetBSD 4.0" }
+ { "freebsd" "FreeBSD 7.1" }
+ { "netbsd" "NetBSD 5.0" }
{ "openbsd" "OpenBSD 4.4" }
} at
] [
dup cpu>> "x86.32" = [
os>> {
- { [ dup { "winnt" "linux" "freebsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] }
- { [ dup { "netbsd" "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] }
+ { [ dup { "winnt" "linux" "freebsd" "netbsd" } member? ] [ drop "Intel Pentium 4, Core Duo, or other x86 chip with SSE2 support. Note that 32-bit Athlon XP processors do not support SSE2." ] }
+ { [ dup { "openbsd" } member? ] [ drop "Intel Pentium Pro or better" ] }
{ [ t ] [ drop f ] }
} cond
] [ drop f ] if
<tr><th class="field-label">Date: </th><td><t:label t:name="date" /></td></tr>
</table>
- <pre class="description"><t:code t:name="contents" t:mode="mode" /></pre>
-
+ <t:a t:href="$pastebin/paste.txt" t:query="id">Plain Text</t:a> |
<t:button t:action="$pastebin/delete-paste" t:for="id" class="link-button link">Delete Paste</t:button>
+ <pre class="description"><t:code t:name="contents" t:mode="mode" /></pre>
+
<t:bind-each t:name="annotations">
<h2><a name="@id">Annotation: <t:label t:name="summary" /></a></h2>
<tr><th class="field-label">Date: </th><td><t:label t:name="date" /></td></tr>
</table>
- <pre class="description"><t:code t:name="contents" t:mode="mode"/></pre>
-
+ <t:a t:href="$pastebin/annotation.txt" t:query="id">Plain Text</t:a> |
<t:button t:action="$pastebin/delete-annotation" t:for="id" class="link-button link">Delete Annotation</t:button>
+ <pre class="description"><t:code t:name="contents" t:mode="mode"/></pre>
+
</t:bind-each>
<t:bind t:name="new-annotation">
http.server
http.server.dispatchers
http.server.redirection
+http.server.responses
furnace
furnace.actions
furnace.redirection
TUPLE: annotation < entity parent ;
-annotation "ANNOTATIONS"
+\ annotation "ANNOTATIONS"
{
{ "parent" "PARENT" INTEGER +not-null+ }
} define-persistent
: <annotation> ( parent id -- annotation )
- annotation new
+ \ annotation new
swap >>id
swap >>parent ;
+: annotation ( id -- annotation )
+ [ f ] dip <annotation> select-tuple ;
+
: paste ( id -- paste )
[ <paste> select-tuple ]
[ f <annotation> select-tuples ]
{ pastebin "paste" } >>template ;
+: <raw-paste-action> ( -- action )
+ <action>
+ [ validate-integer-id "id" value paste from-object ] >>init
+ [ "contents" value "text/plain" <content> ] >>display ;
+
: <paste-feed-action> ( -- action )
<feed-action>
[ validate-integer-id ] >>init
tri
] >>submit ;
+: <raw-annotation-action> ( -- action )
+ <action>
+ [ validate-integer-id "id" value annotation from-object ] >>init
+ [ "contents" value "text/plain" <content> ] >>display ;
+
: <delete-annotation-action> ( -- action )
<action>
[ { { "id" [ v-number ] } } validate-params ] >>validate
[
- f "id" value <annotation> select-tuple
+ f "id" value annotation
[ delete-tuples ]
[ parent>> paste-url <redirect> ]
bi
<pastebin-action> "" add-responder
<pastebin-feed-action> "list.atom" add-responder
<paste-action> "paste" add-responder
+ <raw-paste-action> "paste.txt" add-responder
<paste-feed-action> "paste.atom" add-responder
<new-paste-action> "new-paste" add-responder
<delete-paste-action> "delete-paste" add-responder
<new-annotation-action> "new-annotation" add-responder
+ <raw-annotation-action> "annotation.txt" add-responder
<delete-annotation-action> "delete-annotation" add-responder
<boilerplate>
{ pastebin "pastebin-common" } >>template ;
ARTICLE: "furnace.auth.user-admin" "Furnace user administration tool"
"The " { $vocab-link "webapps.user-admin" } " vocabulary implements a web application for adding, removing and editing users in authentication realms that use " { $link "furnace.auth.providers.db" } "."
-{ $subsection <user-admin> }
+{ $subsections <user-admin> }
"Access to the web app itself is protected, and only users having an administrative capability can access it:"
-{ $subsection can-administer-users? }
+{ $subsections can-administer-users? }
"To make an existing user an administrator, call the following word in a " { $link with-db } " scope:"
-{ $subsection make-admin } ;
+{ $subsections make-admin } ;
: init-production ( -- )
common-configuration
<vhost-dispatcher>
- <factor-website> <wiki> <login-config> <factor-boilerplate> "wiki" add-responder test-db <alloy> "concatenative.org" add-responder
+ <factor-website>
+ <wiki> "wiki" add-responder
+ <user-admin> "user-admin" add-responder
+ <login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
<pastebin> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
<planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
home "docs" append-path <help-webapp> test-db <alloy> "docs.factorcode.org" add-responder
{ "Minimize button" { normal-title-bar minimize-button } }
{ "Close, minimize, and maximize buttons" { normal-title-bar close-button minimize-button maximize-button } }
{ "Resizable" { normal-title-bar close-button minimize-button maximize-button resize-handles } }
+ { "Textured background" { normal-title-bar close-button minimize-button maximize-button resize-handles textured-background } }
}
TUPLE: window-controls-demo-world < world
"adapted from lisp.vim
if exists("g:factor_norainbow")
- syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
+ syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
else
- syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
- syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
- syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
- syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
- syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
- syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
- syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
- syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
- syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
- syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
+ syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
+ syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
+ syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
+ syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
+ syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
+ syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
+ syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
+ syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
+ syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
+ syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
endif
if exists("g:factor_norainbow")
Teach Vim when to load Factor support files.
ftplugin/factor_settings.vim
Teach Vim to follow the Factor Coding Style guidelines.
+ plugin/factor.vim
+ Teach Vim some commands for navigating Factor source code. See below.
syntax/factor.vim
Syntax highlighting for Factor code.
+The "plugin/factor.vim" file implements the following commands for
+navigating Factor source:
+
+ :FactorVocab factor.vocab.name
+ Opens the source file implementing the "factor.vocab.name"
+ vocabulary.
+ :NewFactorVocab factor.vocab.name
+ Creates a new factor vocabulary under the working vocabulary root.
+ :FactorVocabImpl
+ Opens the main implementation file for the current vocabulary
+ (name.factor). The keyboard shortcut "\fi" is bound to this
+ command.
+ :FactorVocabDocs
+ Opens the documentation file for the current vocabulary
+ (name-docs.factor). The keyboard shortcut "\fd" is bound to this
+ command.
+ :FactorVocabTests
+ Opens the unit test file for the current vocabulary
+ (name-tests.factor). The keyboard shortcut "\ft" is bound to this
+ command.
+
+In order for the ":FactorVocab" command to work, you'll need to set some
+variables in your vimrc file:
+ g:FactorRoot
+ This variable should be set to the root of your Factor
+ installation. The default value is "~/factor".
+ g:FactorVocabRoots
+ This variable should be set to a list of Factor vocabulary roots.
+ The paths may be either relative to g:FactorRoot or absolute paths.
+ The default value is ["core", "basis", "extra", "work"].
+ g:FactorNewVocabRoot
+ This variable should be set to the vocabulary root in which
+ vocabularies created with NewFactorVocab should be created. The
+ default value is "work".
+
Note: The syntax-highlighting file is automatically generated to include the
names of all the vocabularies Factor knows about. To regenerate it manually,
run the following code in the listener:
"editors.vim.generate-syntax" run
-...or run it from the command-line:
+...or run it from the command line:
factor -run=editors.vim.generate-syntax
--- /dev/null
+nmap <silent> <Leader>fi :FactorVocabImpl<CR>
+nmap <silent> <Leader>fd :FactorVocabDocs<CR>
+nmap <silent> <Leader>ft :FactorVocabTests<CR>
+nmap <Leader>fv :FactorVocab<SPACE>
+nmap <Leader>fn :NewFactorVocab<SPACE>
+
+if !exists("g:FactorRoot")
+ let g:FactorRoot = "~/factor"
+endif
+
+if !exists("g:FactorVocabRoots")
+ let g:FactorVocabRoots = ["core", "basis", "extra", "work"]
+endif
+
+if !exists("g:FactorNewVocabRoot")
+ let g:FactorNewVocabRoot = "work"
+endif
+
+command! -nargs=1 -complete=customlist,FactorCompleteVocab FactorVocab :call GoToFactorVocab("<args>")
+command! -nargs=1 -complete=customlist,FactorCompleteVocab NewFactorVocab :call MakeFactorVocab("<args>")
+command! FactorVocabImpl :call GoToFactorVocabImpl()
+command! FactorVocabDocs :call GoToFactorVocabDocs()
+command! FactorVocabTests :call GoToFactorVocabTests()
+
+function! FactorVocabRoot(root)
+ let cwd = getcwd()
+ exe "lcd " fnameescape(g:FactorRoot)
+ let vocabroot = fnamemodify(a:root, ":p")
+ exe "lcd " fnameescape(cwd)
+ return vocabroot
+endfunction
+
+function! s:unique(list)
+ let dict = {}
+ for value in a:list
+ let dict[value] = 1
+ endfor
+ return sort(keys(dict))
+endfunction
+
+function! FactorCompleteVocab(arglead, cmdline, cursorpos)
+ let vocabs = []
+ let vocablead = substitute(a:arglead, "\\.", "/", "g")
+ for root in g:FactorVocabRoots
+ let vocabroot = FactorVocabRoot(root)
+ let newvocabs = globpath(vocabroot, vocablead . "*")
+ if newvocabs != ""
+ let newvocabsl = split(newvocabs, "\n")
+ let newvocabsl = filter(newvocabsl, 'getftype(v:val) == "dir"')
+ let newvocabsl = map(newvocabsl, 'substitute(v:val, "^\\V" . escape(vocabroot, "\\"), "\\1", "g")')
+ let vocabs += newvocabsl
+ endif
+ endfor
+ let vocabs = s:unique(vocabs)
+ let vocabs = map(vocabs, 'substitute(v:val, "/\\|\\\\", ".", "g")')
+ return vocabs
+endfunction
+
+function! FactorVocabFile(root, vocab, mustexist)
+ let vocabpath = substitute(a:vocab, "\\.", "/", "g")
+ let vocabfile = FactorVocabRoot(a:root) . vocabpath . "/" . fnamemodify(vocabpath, ":t") . ".factor"
+
+ if !a:mustexist || getftype(vocabfile) != ""
+ return vocabfile
+ else
+ return ""
+ endif
+endfunction
+
+function! GoToFactorVocab(vocab)
+ for root in g:FactorVocabRoots
+ let vocabfile = FactorVocabFile(root, a:vocab, 1)
+ if vocabfile != ""
+ exe "edit " fnameescape(vocabfile)
+ return
+ endif
+ endfor
+ echo "Vocabulary " vocab " not found"
+endfunction
+
+function! MakeFactorVocab(vocab)
+ let vocabfile = FactorVocabFile(g:FactorNewVocabRoot, a:vocab, 0)
+ echo vocabfile
+ let vocabdir = fnamemodify(vocabfile, ":h")
+ echo vocabdir
+ exe "!mkdir -p " shellescape(vocabdir)
+ exe "edit " fnameescape(vocabfile)
+endfunction
+
+function! FactorFileBase()
+ let filename = expand("%:r")
+ let filename = substitute(filename, "-docs", "", "")
+ let filename = substitute(filename, "-tests", "", "")
+ return filename
+endfunction
+
+function! GoToFactorVocabImpl()
+ exe "edit " fnameescape(FactorFileBase() . ".factor")
+endfunction
+
+function! GoToFactorVocabDocs()
+ exe "edit " fnameescape(FactorFileBase() . "-docs.factor")
+endfunction
+
+function! GoToFactorVocabTests()
+ exe "edit " fnameescape(FactorFileBase() . "-tests.factor")
+endfunction
set iskeyword=!,@,33-35,%,$,38-64,A-Z,91-96,a-z,123-126,128-255
endif
-syn cluster factorCluster contains=factorComment,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple
+syn cluster factorCluster contains=factorComment,factorFryDirective,factorKeyword,factorRepeat,factorConditional,factorBoolean,factorCompileDirective,factorString,factorTriString,factorSbuf,@factorNumber,@factorNumErr,factorDelimiter,factorChar,factorCharErr,factorBackslash,@factorWordOps,factorAlien,factorTuple,factorStruct
syn match factorTodo /\(TODO\|FIXME\|XXX\):\=/ contained
-syn match factorComment /\<#! .*/ contains=factorTodo
-syn match factorComment /\<! .*/ contains=factorTodo
+syn match factorComment /\<#!\>.*/ contains=factorTodo
+syn match factorComment /\<!\>.*/ contains=factorTodo
syn cluster factorDefnContents contains=@factorCluster,factorStackEffect,factorLiteralStackEffect,factorArray0,factorQuotation0
syn region None matchgroup=factorPrivate start=/\<<PRIVATE\>/ end=/\<PRIVATE>\>/ contains=@factorDefnContents,factorPrivateDefn,factorPrivateMethod,factorPGeneric,factorPGenericN
-syn keyword factorBoolean boolean f general-t t
+syn keyword factorBoolean f t
+syn match factorFryDirective /\<\(@\|_\)\>/ contained
syn keyword factorCompileDirective inline foldable recursive
+syn keyword factorKeyword boolean
syn keyword factorKeyword or tuck 2bi 2tri while wrapper nip 4dip wrapper? bi* callstack>array both? hashcode die dupd callstack callstack? 3dup tri@ pick curry build ?execute 3bi prepose >boolean ?if clone eq? tri* ? = swapd call-clear 2over 2keep 3keep clear 2dup when not tuple? dup 2bi* 2tri* call tri-curry object bi@ do unless* if* loop bi-curry* drop when* assert= retainstack assert? -rot execute 2bi@ 2tri@ boa with either? 3drop bi curry? datastack until 3dip over 3curry roll tri-curry* swap tri-curry@ 2nip and throw set-retainstack bi-curry (clone) hashcode* compose spin 2dip if 3tri unless compose? tuple keep 2curry equal? set-datastack assert tri 2drop most <wrapper> boolean? identity-tuple? null new set-callstack dip bi-curry@ rot -roll xor identity-tuple boolean
syn keyword factorKeyword ?at assoc? assoc-clone-like assoc= delete-at* assoc-partition extract-keys new-assoc value? assoc-size map>assoc push-at assoc-like key? assoc-intersect assoc-refine update assoc-union assoc-combine at* assoc-empty? at+ set-at assoc-all? assoc-subset? assoc-hashcode change-at assoc-each assoc-diff zip values value-at rename-at inc-at enum? at cache assoc>map <enum> assoc assoc-map enum value-at* remove-all assoc-map-as >alist assoc-filter-as substitute-here clear-assoc assoc-stack maybe-set-at substitute assoc-filter 2cache delete-at assoc-find keys assoc-any? unzip
syn keyword factorKeyword case execute-effect no-cond no-case? 3cleave>quot 2cleave cond>quot wrong-values? no-cond? cleave>quot no-case case>quot 3cleave wrong-values to-fixed-point alist>quot case-find cond cleave call-effect 2cleave>quot recursive-hashcode linear-case-quot spread spread>quot
syn cluster factorReal contains=factorInt,factorFloat,factorRatio,factorBinary,factorHex,factorOctal
syn cluster factorNumber contains=@factorReal,factorComplex
syn cluster factorNumErr contains=factorBinErr,factorHexErr,factorOctErr
-syn match factorInt /\<-\=\d\+\>/
-syn match factorFloat /\<-\=\d*\.\d\+\>/
-syn match factorRatio /\<-\=\d*\.*\d\+\/-\=\d*\.*\d\+\>/
+syn match factorInt /\<-\=[0-9]\([0-9,]*[0-9]\)\?\>/
+syn match factorFloat /\<-\=[0-9]\([0-9,]*[0-9]\)\?\.[0-9,]*[0-9]\+\>/
+syn match factorRatio /\<-\=[0-9]\([0-9,]*[0-9]\)\?\(+[0-9]\([0-9,]*[0-9]\+\)\?\)\?\/-\=[0-9]\([0-9,]*[0-9]\+\)\?\.\?\>/
syn region factorComplex start=/\<C{\>/ end=/\<}\>/ contains=@factorReal
-syn match factorBinErr /\<BIN:\s\+[01]*[^\s01]\S*\>/
-syn match factorBinary /\<BIN:\s\+[01]\+\>/
-syn match factorHexErr /\<HEX:\s\+\x*[^\x\s]\S*\>/
-syn match factorHex /\<HEX:\s\+\x\+\>/
-syn match factorOctErr /\<OCT:\s\+\o*[^\o\s]\S*\>/
-syn match factorOctal /\<OCT:\s\+\o\+\>/
+syn match factorBinErr /\<BIN:\s\+-\=[01,]*[^01 ]\S*\>/
+syn match factorBinary /\<BIN:\s\+-\=[01,]\+\>/
+syn match factorHexErr /\<HEX:\s\+-\=\(,\S*\|\S*,\|[-0-9a-fA-Fp,]*[^-0-9a-fA-Fp, ]\S*\)\>/
+syn match factorHex /\<HEX:\s\+-\=[0-9a-fA-F]\([0-9a-fA-F,]*[0-9a-fA-F]\)\?\(\.[0-9a-fA-F]\([0-9a-fA-F,]*[0-9a-fA-F]\)\?\)\?\(p-\=[0-9]\([0-9,]*[0-9]\)\?\)\?\>/
+syn match factorOctErr /\<OCT:\s\+-\=\(,\S*\|\S*,\|[0-7,]*[^0-7, ]\S*\)\>/
+syn match factorOctal /\<OCT:\s\+-\=[0-7,]\+\>/
+syn match factorNan /\<NAN:\s\+[0-9a-fA-F]\([0-9a-fA-F,]*[0-9a-fA-F]\)\?\>/
syn match factorIn /\<IN:\s\+\S\+\>/
syn match factorUse /\<USE:\s\+\S\+\>/
syn match factorBackslash /\<\\\>\s\+\S\+\>/
syn region factorUsing start=/\<USING:\>/ end=/;/
+syn match factorQualified /\<QUALIFIED:\s\+\S\+\>/
+syn match factorQualifiedWith /\<QUALIFIED-WITH:\s\+\S\+\s\+\S\+\>/
+syn region factorFrom start=/\<FROM:\>/ end=/;/
syn region factorSingletons start=/\<SINGLETONS:\>/ end=/;/
syn match factorSymbol /\<SYMBOL:\s\+\S\+\>/
syn region factorSymbols start=/\<SYMBOLS:\>/ end=/;/
syn region factorConstructor2 start=/\<CONSTRUCTOR:\?/ end=/;/
syn region factorTuple start=/\<TUPLE:\>/ end=/\<;\>/
+syn region factorStruct start=/\<\(UNION-STRUCT:\|STRUCT:\)\>/ end=/\<;\>/
syn match factorConstant /\<CONSTANT:\s\+\S\+\>/
+syn match factorAlias /\<ALIAS:\s\+\S\+\>/
syn match factorSingleton /\<SINGLETON:\s\+\S\+\>/
syn match factorPostpone /\<POSTPONE:\s\+\S\+\>/
syn match factorDefer /\<DEFER:\s\+\S\+\>/
syn match factorHook /\<HOOK:\s\+\S\+\s\+\S\+\>/
syn match factorMain /\<MAIN:\s\+\S\+\>/
syn match factorConstructor /\<C:\s\+\S\+\s\+\S\+\>/
-syn match factorAlien /\<ALIEN:\s\+\d\+\>/
-
-syn cluster factorWordOps contains=factorSymbol,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
+syn match factorAlien /\<ALIEN:\s\+[0-9a-fA-F]\([0-9a-fA-F,]*[0-9a-fA-F]\)\?\>/
+syn cluster factorWordOps contains=factorConstant,factorAlias,factorSingleton,factorSingletons,factorSymbol,factorSymbols,factorPostpone,factorDefer,factorForget,factorMixin,factorInstance,factorHook,factorMain,factorConstructor
"TODO:
"misc:
" PRIMITIVE:
"C interface:
-" FIELD:
-" BEGIN-STRUCT:
" C-ENUM:
" FUNCTION:
-" END-STRUCT
-" DLL"
" TYPEDEF:
" LIBRARY:
-" C-UNION:
-"QUALIFIED:
-"QUALIFIED-WITH:
-"FROM:
-"ALIAS:
-"! POSTPONE: "
"#\ "
-syn region factorString start=/"/ skip=/\\"/ end=/"/ oneline
-syn region factorSbuf start=/SBUF" / skip=/\\"/ end=/"/ oneline
+syn region factorString start=/\<"/ skip=/\\"/ end=/"/
+syn region factorTriString start=/\<"""/ skip=/\\"/ end=/"""/
+syn region factorSbuf start=/\<SBUF"\>/ skip=/\\"/ end=/"/
syn region factorMultiString matchgroup=factorMultiStringDelims start=/\<STRING:\s\+\S\+\>/ end=/^;$/ contains=factorMultiStringContents
syn match factorMultiStringContents /.*/ contained
"adapted from lisp.vim
if exists("g:factor_norainbow")
- syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
+ syn region factorQuotation matchgroup=factorDelimiter start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ matchgroup=factorDelimiter end=/\<\]\>/ contains=ALL
else
- syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
- syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
- syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
- syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
- syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
- syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
- syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
- syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
- syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
- syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\('\|\$\|\)\[\)\|\[\(let\||\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
+ syn region factorQuotation0 matchgroup=hlLevel0 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation1,factorArray1
+ syn region factorQuotation1 contained matchgroup=hlLevel1 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation2,factorArray2
+ syn region factorQuotation2 contained matchgroup=hlLevel2 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation3,factorArray3
+ syn region factorQuotation3 contained matchgroup=hlLevel3 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation4,factorArray4
+ syn region factorQuotation4 contained matchgroup=hlLevel4 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation5,factorArray5
+ syn region factorQuotation5 contained matchgroup=hlLevel5 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation6,factorArray6
+ syn region factorQuotation6 contained matchgroup=hlLevel6 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation7,factorArray7
+ syn region factorQuotation7 contained matchgroup=hlLevel7 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation8,factorArray8
+ syn region factorQuotation8 contained matchgroup=hlLevel8 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation9,factorArray9
+ syn region factorQuotation9 contained matchgroup=hlLevel9 start=/\<\(\(\('\|\$\|\)\[\)\|\[\(let\||\)\)\>/ end=/\<\]\>/ contains=@factorCluster,factorQuotation0,factorArray0
endif
if exists("g:factor_norainbow")
- syn region factorArray matchgroup=factorDelimiter start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL
+ syn region factorArray matchgroup=factorDelimiter start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ matchgroup=factorDelimiter end=/\<}\>/ contains=ALL
else
- syn region factorArray0 matchgroup=hlLevel0 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1
- syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2
- syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3
- syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4
- syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5
- syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6
- syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7
- syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8
- syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9
- syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(V\|H\|T\|W\|F\|B\|\$\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0
+ syn region factorArray0 matchgroup=hlLevel0 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray1,factorQuotation1
+ syn region factorArray1 contained matchgroup=hlLevel1 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray2,factorQuotation2
+ syn region factorArray2 contained matchgroup=hlLevel2 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray3,factorQuotation3
+ syn region factorArray3 contained matchgroup=hlLevel3 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray4,factorQuotation4
+ syn region factorArray4 contained matchgroup=hlLevel4 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray5,factorQuotation5
+ syn region factorArray5 contained matchgroup=hlLevel5 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray6,factorQuotation6
+ syn region factorArray6 contained matchgroup=hlLevel6 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray7,factorQuotation7
+ syn region factorArray7 contained matchgroup=hlLevel7 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray8,factorQuotation8
+ syn region factorArray8 contained matchgroup=hlLevel8 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray9,factorQuotation9
+ syn region factorArray9 contained matchgroup=hlLevel9 start=/\<\(\$\|[-a-zA-Z0-9]\+\)\?{\>/ end=/\<}\>/ contains=@factorCluster,factorArray0,factorQuotation0
endif
syn match factorBracketErr /\<\]\>/
HiLink factorConditional Conditional
HiLink factorKeyword Keyword
HiLink factorOperator Operator
+ HiLink factorFryDirective Operator
HiLink factorBoolean Boolean
HiLink factorDefnDelims Typedef
HiLink factorMethodDelims Typedef
HiLink factorPGenericDelims Special
HiLink factorPGenericNDelims Special
HiLink factorString String
+ HiLink factorTriString String
HiLink factorSbuf String
HiLink factorMultiStringContents String
HiLink factorMultiStringDelims Typedef
HiLink factorBinErr Error
HiLink factorHex Number
HiLink factorHexErr Error
+ HiLink factorNan Number
HiLink factorOctal Number
HiLink factorOctErr Error
HiLink factorFloat Float
HiLink factorInt Number
HiLink factorUsing Include
+ HiLink factorQualified Include
+ HiLink factorQualifiedWith Include
+ HiLink factorFrom Include
HiLink factorUse Include
HiLink factorUnuse Include
HiLink factorIn Define
HiLink factorForget Define
HiLink factorAlien Define
HiLink factorTuple Typedef
+ HiLink factorStruct Typedef
if &bg == "dark"
hi hlLevel0 ctermfg=red guifg=red1
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.cxx.parser alien.marshall
+alien.inline.types classes.mixin classes.tuple kernel namespaces
+assocs sequences parser classes.parser alien.marshall.syntax
+interpolate locals effects io strings make vocabs.parser words
+generic fry quotations ;
+IN: alien.cxx
+
+<PRIVATE
+: class-mixin ( str -- word )
+ create-class-in [ define-mixin-class ] keep ;
+
+: class-tuple-word ( word -- word' )
+ "#" append create-in ;
+
+: define-class-tuple ( word mixin -- )
+ [ drop class-wrapper { } define-tuple-class ]
+ [ add-mixin-instance ] 2bi ;
+PRIVATE>
+
+: define-c++-class ( name superclass-mixin -- )
+ [ [ class-tuple-word ] [ class-mixin ] bi dup ] dip
+ add-mixin-instance define-class-tuple ;
+
+:: define-c++-method ( class-name generic name types effect virtual -- )
+ [ name % "_" % class-name { { CHAR: : CHAR: _ } } substitute % ] "" make :> name'
+ effect [ in>> "self" suffix ] [ out>> ] bi <effect> :> effect'
+ types class-name "*" append suffix :> types'
+ effect in>> "," join :> args
+ class-name virtual [ "#" append ] unless current-vocab lookup :> class
+ SBUF" " clone dup [ I[ return self->${name}(${args});]I ] with-output-stream >string :> body
+ name' types' effect' body define-c-marshalled
+ class generic create-method name' current-vocab lookup 1quotation define ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: parser lexer alien.inline ;
+IN: alien.cxx.parser
+
+: parse-c++-class-definition ( -- class superclass-mixin )
+ scan scan-word ;
+
+: parse-c++-method-definition ( -- class-name generic name types effect )
+ scan scan-word function-types-effect ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test alien.cxx.syntax alien.inline.syntax
+alien.marshall.syntax alien.marshall accessors kernel ;
+IN: alien.cxx.syntax.tests
+
+DELETE-C-LIBRARY: test
+C-LIBRARY: test
+
+COMPILE-AS-C++
+
+C-INCLUDE: <string>
+
+C-TYPEDEF: std::string string
+
+C++-CLASS: std::string c++-root
+
+GENERIC: to-string ( obj -- str )
+
+C++-METHOD: std::string to-string const-char* c_str ( )
+
+CM-FUNCTION: std::string* new_string ( const-char* s )
+ return new std::string(s);
+;
+
+;C-LIBRARY
+
+ALIAS: <std::string> new_string
+
+{ 1 1 } [ new_string ] must-infer-as
+{ 1 1 } [ c_str_std__string ] must-infer-as
+[ t ] [ "abc" <std::string> std::string? ] unit-test
+[ "abc" ] [ "abc" <std::string> to-string ] unit-test
+
+
+DELETE-C-LIBRARY: inheritance
+C-LIBRARY: inheritance
+
+COMPILE-AS-C++
+
+C-INCLUDE: <cstring>
+
+<RAW-C
+class alpha {
+ public:
+ alpha(const char* s) {
+ str = s;
+ };
+ const char* render() {
+ return str;
+ };
+ virtual const char* chop() {
+ return str;
+ };
+ virtual int length() {
+ return strlen(str);
+ };
+ const char* str;
+};
+
+class beta : alpha {
+ public:
+ beta(const char* s) : alpha(s + 1) { };
+ const char* render() {
+ return str + 1;
+ };
+ virtual const char* chop() {
+ return str + 2;
+ };
+};
+RAW-C>
+
+C++-CLASS: alpha c++-root
+C++-CLASS: beta alpha
+
+CM-FUNCTION: alpha* new_alpha ( const-char* s )
+ return new alpha(s);
+;
+
+CM-FUNCTION: beta* new_beta ( const-char* s )
+ return new beta(s);
+;
+
+ALIAS: <alpha> new_alpha
+ALIAS: <beta> new_beta
+
+GENERIC: render ( obj -- obj )
+GENERIC: chop ( obj -- obj )
+GENERIC: length ( obj -- n )
+
+C++-METHOD: alpha render const-char* render ( )
+C++-METHOD: beta render const-char* render ( )
+C++-VIRTUAL: alpha chop const-char* chop ( )
+C++-VIRTUAL: beta chop const-char* chop ( )
+C++-VIRTUAL: alpha length int length ( )
+
+;C-LIBRARY
+
+{ 1 1 } [ render_alpha ] must-infer-as
+{ 1 1 } [ chop_beta ] must-infer-as
+{ 1 1 } [ length_alpha ] must-infer-as
+[ t ] [ "x" <alpha> alpha#? ] unit-test
+[ t ] [ "x" <alpha> alpha? ] unit-test
+[ t ] [ "x" <beta> alpha? ] unit-test
+[ f ] [ "x" <beta> alpha#? ] unit-test
+[ 5 ] [ "hello" <alpha> length ] unit-test
+[ 4 ] [ "hello" <beta> length ] unit-test
+[ "hello" ] [ "hello" <alpha> render ] unit-test
+[ "llo" ] [ "hello" <beta> render ] unit-test
+[ "ello" ] [ "hello" <beta> underlying>> \ alpha# new swap >>underlying render ] unit-test
+[ "hello" ] [ "hello" <alpha> chop ] unit-test
+[ "lo" ] [ "hello" <beta> chop ] unit-test
+[ "lo" ] [ "hello" <beta> underlying>> \ alpha# new swap >>underlying chop ] unit-test
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.cxx alien.cxx.parser ;
+IN: alien.cxx.syntax
+
+SYNTAX: C++-CLASS:
+ parse-c++-class-definition define-c++-class ;
+
+SYNTAX: C++-METHOD:
+ parse-c++-method-definition f define-c++-method ;
+
+SYNTAX: C++-VIRTUAL:
+ parse-c++-method-definition t define-c++-method ;
--- /dev/null
+Jeremy Hughes
--- /dev/null
+Jeremy Hughes
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel strings words.symbol sequences ;
+IN: alien.inline.compiler
+
+HELP: C
+{ $var-description "A symbol representing C source." } ;
+
+HELP: C++
+{ $var-description "A symbol representing C++ source." } ;
+
+HELP: compile-to-library
+{ $values
+ { "lang" symbol } { "args" sequence } { "contents" string } { "name" string }
+}
+{ $description "Compiles and links " { $snippet "contents" } " into a shared library called " { $snippet "libname.suffix" }
+ "in " { $snippet "resource:alien-inline-libs" } ". " { $snippet "suffix" } " is OS specific. "
+ { $snippet "args" } " is a sequence of arguments for the linking stage." }
+{ $notes
+ { $list
+ "C and C++ are the only supported languages."
+ { "Source and object files are placed in " { $snippet "resource:temp" } "." } }
+} ;
+
+HELP: compiler
+{ $values
+ { "lang" symbol }
+ { "str" string }
+}
+{ $description "Returns a compiler name based on OS and source language." }
+{ $see-also compiler-descr } ;
+
+HELP: compiler-descr
+{ $values
+ { "lang" symbol }
+ { "descr" "a process description" }
+}
+{ $description "Returns a compiler process description based on OS and source language." }
+{ $see-also compiler } ;
+
+HELP: inline-library-file
+{ $values
+ { "name" string }
+ { "path" "a pathname string" }
+}
+{ $description "Appends " { $snippet "name" } " to the " { $link inline-libs-directory } "." } ;
+
+HELP: inline-libs-directory
+{ $values
+ { "path" "a pathname string" }
+}
+{ $description "The directory where libraries created using " { $snippet "alien.inline" } " are stored." } ;
+
+HELP: library-path
+{ $values
+ { "str" string }
+ { "path" "a pathname string" }
+}
+{ $description "Converts " { $snippet "name" } " into a full path to the corresponding inline library." } ;
+
+HELP: library-suffix
+{ $values
+ { "str" string }
+}
+{ $description "The appropriate shared library suffix for the current OS." } ;
+
+HELP: link-descr
+{ $values
+ { "lang" "a language" }
+ { "descr" sequence }
+}
+{ $description "Returns part of a process description. OS dependent." } ;
+
+ARTICLE: "alien.inline.compiler" "Inline C compiler"
+{ $vocab-link "alien.inline.compiler" }
+;
+
+ABOUT: "alien.inline.compiler"
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators fry generalizations
+io.encodings.ascii io.files io.files.temp io.launcher kernel
+locals make sequences system vocabs.parser words io.directories
+io.pathnames ;
+IN: alien.inline.compiler
+
+SYMBOL: C
+SYMBOL: C++
+
+: inline-libs-directory ( -- path )
+ "alien-inline-libs" resource-path dup make-directories ;
+
+: inline-library-file ( name -- path )
+ inline-libs-directory prepend-path ;
+
+: library-suffix ( -- str )
+ os {
+ { [ dup macosx? ] [ drop ".dylib" ] }
+ { [ dup unix? ] [ drop ".so" ] }
+ { [ dup windows? ] [ drop ".dll" ] }
+ } cond ;
+
+: library-path ( str -- path )
+ '[ "lib" % _ % library-suffix % ] "" make inline-library-file ;
+
+HOOK: compiler os ( lang -- str )
+
+M: word compiler
+ {
+ { C [ "gcc" ] }
+ { C++ [ "g++" ] }
+ } case ;
+
+M: openbsd compiler
+ {
+ { C [ "gcc" ] }
+ { C++ [ "eg++" ] }
+ } case ;
+
+M: windows compiler
+ {
+ { C [ "gcc" ] }
+ { C++ [ "g++" ] }
+ } case ;
+
+HOOK: compiler-descr os ( lang -- descr )
+
+M: word compiler-descr compiler 1array ;
+M: macosx compiler-descr
+ call-next-method cpu x86.64?
+ [ { "-arch" "x86_64" } append ] when ;
+
+HOOK: link-descr os ( lang -- descr )
+
+M: word link-descr drop { "-shared" "-o" } ;
+M: macosx link-descr
+ drop { "-g" "-prebind" "-dynamiclib" "-o" }
+ cpu x86.64? [ { "-arch" "x86_64" } prepend ] when ;
+M: windows link-descr
+ {
+ { C [ { "-mno-cygwin" "-shared" "-o" } ] }
+ { C++ [ { "-lstdc++" "-mno-cygwin" "-shared" "-o" } ] }
+ } case ;
+
+<PRIVATE
+: src-suffix ( lang -- str )
+ {
+ { C [ ".c" ] }
+ { C++ [ ".cpp" ] }
+ } case ;
+
+: link-command ( args in out lang -- descr )
+ [ 2array ] dip [ compiler 1array ] [ link-descr ] bi
+ append prepend prepend ;
+
+:: compile-to-object ( lang contents name -- )
+ name ".o" append temp-file
+ contents name lang src-suffix append temp-file
+ [ ascii set-file-contents ] keep 2array
+ lang compiler-descr { "-fPIC" "-c" "-o" } append prepend
+ try-process ;
+
+:: link-object ( lang args name -- )
+ args name [ library-path ]
+ [ ".o" append temp-file ] bi
+ lang link-command try-process ;
+PRIVATE>
+
+:: compile-to-library ( lang args contents name -- )
+ lang contents name compile-to-object
+ lang args name link-object ;
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel strings effects quotations ;
+IN: alien.inline
+
+<PRIVATE
+: $binding-note ( x -- )
+ drop
+ { "This word requires that certain variables are correctly bound. "
+ "Call " { $link POSTPONE: define-c-library } " to set them up." } print-element ;
+PRIVATE>
+
+HELP: compile-c-library
+{ $description "Writes, compiles, and links code generated since last invocation of " { $link POSTPONE: define-c-library } ". "
+ "Also calls " { $snippet "add-library" } ". "
+ "This word does nothing if the shared library is younger than the factor source file." }
+{ $notes $binding-note } ;
+
+HELP: c-use-framework
+{ $values
+ { "str" string }
+}
+{ $description "OS X only. Adds " { $snippet "-framework name" } " to linker command." }
+{ $notes $binding-note }
+{ $see-also c-link-to c-link-to/use-framework } ;
+
+HELP: define-c-function
+{ $values
+ { "function" "function name" } { "types" "a sequence of C types" } { "effect" effect } { "body" string }
+}
+{ $description "Defines a C function and a factor word which calls it." }
+{ $notes
+ { $list
+ { "The number of " { $snippet "types" } " must match the " { $snippet "in" } " count of the " { $snippet "effect" } "." }
+ { "There must be only one " { $snippet "out" } " element. It must be a legal C return type with dashes (-) instead of spaces." }
+ $binding-note
+ }
+}
+{ $see-also POSTPONE: define-c-function' } ;
+
+HELP: define-c-function'
+{ $values
+ { "function" "function name" } { "effect" effect } { "body" string }
+}
+{ $description "Defines a C function and a factor word which calls it. See " { $link define-c-function } " for more information." }
+{ $notes
+ { $list
+ { "Each effect element must be a legal C type with dashes (-) instead of spaces. "
+ "C argument names will be generated alphabetically, starting with " { $snippet "a" } "." }
+ $binding-note
+ }
+}
+{ $see-also define-c-function } ;
+
+HELP: c-include
+{ $values
+ { "str" string }
+}
+{ $description "Appends an include line to the C library in scope." }
+{ $notes $binding-note } ;
+
+HELP: define-c-library
+{ $values
+ { "name" string }
+}
+{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " words can be used after this one." } ;
+
+HELP: c-link-to
+{ $values
+ { "str" string }
+}
+{ $description "Adds " { $snippet "-lname" } " to linker command." }
+{ $notes $binding-note }
+{ $see-also c-use-framework c-link-to/use-framework } ;
+
+HELP: c-link-to/use-framework
+{ $values
+ { "str" string }
+}
+{ $description "Equivalent to " { $link c-use-framework } " on OS X and " { $link c-link-to } " everywhere else." }
+{ $notes $binding-note }
+{ $see-also c-link-to c-use-framework } ;
+
+HELP: define-c-struct
+{ $values
+ { "name" string } { "fields" "type/name pairs" }
+}
+{ $description "Defines a C struct and factor words which operate on it." }
+{ $notes $binding-note } ;
+
+HELP: define-c-typedef
+{ $values
+ { "old" "C type" } { "new" "C type" }
+}
+{ $description "Define C and factor typedefs." }
+{ $notes $binding-note } ;
+
+HELP: delete-inline-library
+{ $values
+ { "name" string }
+}
+{ $description "Delete the shared library file corresponding to " { $snippet "name" } "." }
+{ $notes "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " } ;
+
+HELP: with-c-library
+{ $values
+ { "name" string } { "quot" quotation }
+}
+{ $description "Calls " { $link define-c-library } ", then the quotation, then " { $link compile-c-library } ", then sets all variables bound by " { $snippet "define-c-library" } " to " { $snippet "f" } "." } ;
+
+HELP: raw-c
+{ $values { "str" string } }
+{ $description "Insert a string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ;
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.inline.compiler alien.inline.types
+alien.libraries alien.parser arrays assocs effects fry
+generalizations grouping io.directories io.files
+io.files.info io.files.temp kernel lexer math math.order
+math.ranges multiline namespaces sequences source-files
+splitting strings system vocabs.loader vocabs.parser words
+alien.c-types alien.structs make parser continuations ;
+IN: alien.inline
+
+SYMBOL: c-library
+SYMBOL: library-is-c++
+SYMBOL: linker-args
+SYMBOL: c-strings
+
+<PRIVATE
+: cleanup-variables ( -- )
+ { c-library library-is-c++ linker-args c-strings }
+ [ off ] each ;
+
+: arg-list ( types -- params )
+ CHAR: a swap length CHAR: a + [a,b]
+ [ 1string ] map ;
+
+: compile-library? ( -- ? )
+ c-library get library-path dup exists? [
+ file get [
+ path>>
+ [ file-info modified>> ] bi@ <=> +lt+ =
+ ] [ drop t ] if*
+ ] [ drop t ] if ;
+
+: compile-library ( -- )
+ library-is-c++ get [ C++ ] [ C ] if
+ linker-args get
+ c-strings get "\n" join
+ c-library get compile-to-library ;
+
+: c-library-name ( name -- name' )
+ [ current-vocab name>> % "_" % % ] "" make ;
+PRIVATE>
+
+: parse-arglist ( parameters return -- types effect )
+ [ 2 group unzip [ "," ?tail drop ] map ]
+ [ [ { } ] [ 1array ] if-void ]
+ bi* <effect> ;
+
+: append-function-body ( prototype-str body -- str )
+ [ swap % " {\n" % % "\n}\n" % ] "" make ;
+
+: function-types-effect ( -- function types effect )
+ scan scan swap ")" parse-tokens
+ [ "(" subseq? not ] filter swap parse-arglist ;
+
+: prototype-string ( function types effect -- str )
+ [ [ cify-type ] map ] dip
+ types-effect>params-return cify-type -rot
+ [ " " join ] map ", " join
+ "(" prepend ")" append 3array " " join
+ library-is-c++ get [ "extern \"C\" " prepend ] when ;
+
+: prototype-string' ( function types return -- str )
+ [ dup arg-list ] <effect> prototype-string ;
+
+: factor-function ( function types effect -- word quot effect )
+ annotate-effect [ c-library get ] 3dip
+ [ [ factorize-type ] map ] dip
+ types-effect>params-return factorize-type -roll
+ concat make-function ;
+
+: define-c-library ( name -- )
+ c-library-name [ c-library set ] [ "c-library" set ] bi
+ V{ } clone c-strings set
+ V{ } clone linker-args set ;
+
+: compile-c-library ( -- )
+ compile-library? [ compile-library ] when
+ c-library get dup library-path "cdecl" add-library ;
+
+: define-c-function ( function types effect body -- )
+ [
+ [ factor-function define-declared ]
+ [ prototype-string ] 3bi
+ ] dip append-function-body c-strings get push ;
+
+: define-c-function' ( function effect body -- )
+ [
+ [ in>> ] keep
+ [ factor-function define-declared ]
+ [ out>> prototype-string' ] 3bi
+ ] dip append-function-body c-strings get push ;
+
+: c-link-to ( str -- )
+ "-l" prepend linker-args get push ;
+
+: c-use-framework ( str -- )
+ "-framework" swap linker-args get '[ _ push ] bi@ ;
+
+: c-link-to/use-framework ( str -- )
+ os macosx? [ c-use-framework ] [ c-link-to ] if ;
+
+: c-include ( str -- )
+ "#include " prepend c-strings get push ;
+
+: define-c-typedef ( old new -- )
+ [ typedef ] [
+ [ swap "typedef " % % " " % % ";" % ]
+ "" make c-strings get push
+ ] 2bi ;
+
+: define-c-struct ( name fields -- )
+ [ current-vocab swap define-struct ] [
+ over
+ [
+ "typedef struct " % "_" % % " {\n" %
+ [ first2 swap % " " % % ";\n" % ] each
+ "} " % % ";\n" %
+ ] "" make c-strings get push
+ ] 2bi ;
+
+: delete-inline-library ( name -- )
+ c-library-name [ remove-library ]
+ [ library-path dup exists? [ delete-file ] [ drop ] if ] bi ;
+
+: with-c-library ( name quot -- )
+ [ [ define-c-library ] dip call compile-c-library ]
+ [ cleanup-variables ] [ ] cleanup ; inline
+
+: raw-c ( str -- )
+ [ "\n" % % "\n" % ] "" make c-strings get push ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax alien.inline ;
+IN: alien.inline.syntax
+
+HELP: ;C-LIBRARY
+{ $syntax ";C-LIBRARY" }
+{ $description "Writes, compiles, and links code generated since previous invocation of " { $link POSTPONE: C-LIBRARY: } "." }
+{ $see-also POSTPONE: compile-c-library } ;
+
+HELP: C-FRAMEWORK:
+{ $syntax "C-FRAMEWORK: name" }
+{ $description "OS X only. Link to named framework. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
+{ $see-also POSTPONE: c-use-framework } ;
+
+HELP: C-FUNCTION:
+{ $syntax "C-FUNCTION: return name ( args ... )\nbody\n;" }
+{ $description "Appends a function to the C library in scope and defines an FFI word that calls it." }
+{ $examples
+ { $example
+ "USING: alien.inline.syntax prettyprint ;"
+ "IN: cmath.ffi"
+ ""
+ "C-LIBRARY: cmathlib"
+ ""
+ "C-FUNCTION: int add ( int a, int b )"
+ " return a + b;"
+ ";"
+ ""
+ ";C-LIBRARY"
+ ""
+ "1 2 add ."
+ "3" }
+}
+{ $see-also POSTPONE: define-c-function } ;
+
+HELP: C-INCLUDE:
+{ $syntax "C-INCLUDE: name" }
+{ $description "Appends an include line to the C library in scope." }
+{ $see-also POSTPONE: c-include } ;
+
+HELP: C-LIBRARY:
+{ $syntax "C-LIBRARY: name" }
+{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " syntax can be used after this word." }
+{ $examples
+ { $example
+ "USING: alien.inline.syntax ;"
+ "IN: rectangle.ffi"
+ ""
+ "C-LIBRARY: rectlib"
+ ""
+ "C-STRUCTURE: rectangle { \"int\" \"width\" } { \"int\" \"height\" } ;"
+ ""
+ "C-FUNCTION: int area ( rectangle c )"
+ " return c.width * c.height;"
+ ";"
+ ""
+ ";C-LIBRARY"
+ "" }
+}
+{ $see-also POSTPONE: define-c-library } ;
+
+HELP: C-LINK/FRAMEWORK:
+{ $syntax "C-LINK/FRAMEWORK: name" }
+{ $description "Equivalent to " { $link POSTPONE: C-FRAMEWORK: } " on OS X and " { $link POSTPONE: C-LINK: } " everywhere else." }
+{ $see-also POSTPONE: c-link-to/use-framework } ;
+
+HELP: C-LINK:
+{ $syntax "C-LINK: name" }
+{ $description "Link to named library. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
+{ $see-also POSTPONE: c-link-to } ;
+
+HELP: C-STRUCTURE:
+{ $syntax "C-STRUCTURE: name pairs ... ;" }
+{ $description "Like " { $snippet "C-STRUCT:" } " but also generates equivalent C code."}
+{ $see-also POSTPONE: define-c-struct } ;
+
+HELP: C-TYPEDEF:
+{ $syntax "C-TYPEDEF: old new" }
+{ $description "Like " { $snippet "TYPEDEF:" } " but generates a C typedef statement too." }
+{ $see-also POSTPONE: define-c-typedef } ;
+
+HELP: COMPILE-AS-C++
+{ $syntax "COMPILE-AS-C++" }
+{ $description "Insert this word anywhere between " { $link POSTPONE: C-LIBRARY: } " and " { $link POSTPONE: ;C-LIBRARY } " and the generated code will be treated as C++ with " { $snippet "extern \"C\"" } " prepended to each function prototype." } ;
+
+HELP: DELETE-C-LIBRARY:
+{ $syntax "DELETE-C-LIBRARY: name" }
+{ $description "Deletes the shared library file corresponding to " { $snippet "name" } " . " }
+{ $notes
+ { $list
+ { "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " }
+ "This word is mainly useful for unit tests."
+ }
+}
+{ $see-also POSTPONE: delete-inline-library } ;
+
+HELP: <RAW-C
+{ $syntax "<RAW-C code RAW-C>" }
+{ $description "Insert a (multiline) string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ;
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.inline alien.inline.syntax io.directories io.files
+kernel namespaces tools.test alien.c-types alien.data alien.structs ;
+IN: alien.inline.syntax.tests
+
+DELETE-C-LIBRARY: test
+C-LIBRARY: test
+
+C-FUNCTION: const-int add ( int a, int b )
+ return a + b;
+;
+
+C-TYPEDEF: double bigfloat
+
+C-FUNCTION: bigfloat smaller ( bigfloat a )
+ return a / 10;
+;
+
+C-STRUCTURE: rectangle
+ { "int" "width" }
+ { "int" "height" } ;
+
+C-FUNCTION: int area ( rectangle c )
+ return c.width * c.height;
+;
+
+;C-LIBRARY
+
+{ 2 1 } [ add ] must-infer-as
+[ 5 ] [ 2 3 add ] unit-test
+
+[ t ] [ "double" "bigfloat" [ resolve-typedef ] bi@ = ] unit-test
+{ 1 1 } [ smaller ] must-infer-as
+[ 1.0 ] [ 10 smaller ] unit-test
+
+[ t ] [ "rectangle" resolve-typedef struct-type? ] unit-test
+{ 1 1 } [ area ] must-infer-as
+[ 20 ] [
+ "rectangle" <c-object>
+ 4 over set-rectangle-width
+ 5 over set-rectangle-height
+ area
+] unit-test
+
+
+DELETE-C-LIBRARY: cpplib
+C-LIBRARY: cpplib
+
+COMPILE-AS-C++
+
+C-INCLUDE: <string>
+
+C-FUNCTION: const-char* hello ( )
+ std::string s("hello world");
+ return s.c_str();
+;
+
+;C-LIBRARY
+
+{ 0 1 } [ hello ] must-infer-as
+[ "hello world" ] [ hello ] unit-test
+
+
+DELETE-C-LIBRARY: compile-error
+C-LIBRARY: compile-error
+
+C-FUNCTION: char* breakme ( )
+ return not a string;
+;
+
+<< [ compile-c-library ] must-fail >>
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.inline lexer multiline namespaces parser ;
+IN: alien.inline.syntax
+
+
+SYNTAX: C-LIBRARY: scan define-c-library ;
+
+SYNTAX: COMPILE-AS-C++ t library-is-c++ set ;
+
+SYNTAX: C-LINK: scan c-link-to ;
+
+SYNTAX: C-FRAMEWORK: scan c-use-framework ;
+
+SYNTAX: C-LINK/FRAMEWORK: scan c-link-to/use-framework ;
+
+SYNTAX: C-INCLUDE: scan c-include ;
+
+SYNTAX: C-FUNCTION:
+ function-types-effect parse-here define-c-function ;
+
+SYNTAX: C-TYPEDEF: scan scan define-c-typedef ;
+
+SYNTAX: C-STRUCTURE:
+ scan parse-definition define-c-struct ;
+
+SYNTAX: ;C-LIBRARY compile-c-library ;
+
+SYNTAX: DELETE-C-LIBRARY: scan delete-inline-library ;
+
+SYNTAX: <RAW-C "RAW-C>" parse-multiline-string raw-c ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types assocs combinators.short-circuit
+continuations effects fry kernel math memoize sequences
+splitting strings peg.ebnf make words ;
+IN: alien.inline.types
+
+: cify-type ( str -- str' )
+ dup word? [ name>> ] when
+ { { CHAR: - CHAR: space } } substitute ;
+
+: factorize-type ( str -- str' )
+ cify-type
+ "const " ?head drop
+ "unsigned " ?head [ "u" prepend ] when
+ "long " ?head [ "long" prepend ] when
+ " const" ?tail drop ;
+
+: const-pointer? ( str -- ? )
+ cify-type { [ " const" tail? ] [ "&" tail? ] } 1|| ;
+
+: pointer-to-const? ( str -- ? )
+ cify-type "const " head? ;
+
+: template-class? ( str -- ? )
+ [ CHAR: < = ] any? ;
+
+MEMO: resolved-primitives ( -- seq )
+ primitive-types [ resolve-typedef ] map ;
+
+: primitive-type? ( type -- ? )
+ [
+ factorize-type resolve-typedef [ resolved-primitives ] dip
+ '[ _ = ] any?
+ ] [ 2drop f ] recover ;
+
+: pointer? ( type -- ? )
+ factorize-type [ "*" tail? ] [ "&" tail? ] bi or ;
+
+: type-sans-pointer ( type -- type' )
+ factorize-type [ '[ _ = ] "*&" swap any? ] trim-tail ;
+
+: pointer-to-primitive? ( type -- ? )
+ factorize-type
+ { [ pointer? ] [ type-sans-pointer primitive-type? ] } 1&& ;
+
+: pointer-to-non-const-primitive? ( str -- ? )
+ {
+ [ pointer-to-const? not ]
+ [ factorize-type pointer-to-primitive? ]
+ } 1&& ;
+
+: types-effect>params-return ( types effect -- params return )
+ [ in>> zip ]
+ [ nip out>> dup length 0 > [ first ] [ drop "void" ] if ]
+ 2bi ;
+
+: annotate-effect ( types effect -- types effect' )
+ [ in>> ] [ out>> ] bi [
+ zip
+ [ over pointer-to-primitive? [ ">" prepend ] when ]
+ assoc-map unzip
+ ] dip <effect> ;
+
+TUPLE: c++-type name params ptr ;
+C: <c++-type> c++-type
+
+EBNF: (parse-c++-type)
+dig = [0-9]
+alpha = [a-zA-Z]
+alphanum = [1-9a-zA-Z]
+name = [_a-zA-Z] [_a-zA-Z1-9:]* => [[ first2 swap prefix >string ]]
+ptr = [*&] => [[ empty? not ]]
+
+param = "," " "* type " "* => [[ third ]]
+
+params = "<" " "* type " "* param* ">" => [[ [ 4 swap nth ] [ third ] bi prefix ]]
+
+type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3 <c++-type> ]]
+;EBNF
+
+: parse-c++-type ( str -- c++-type )
+ factorize-type (parse-c++-type) ;
+
+DEFER: c++-type>string
+
+: params>string ( params -- str )
+ [ "<" % [ c++-type>string ] map "," join % ">" % ] "" make ;
+
+: c++-type>string ( c++-type -- str )
+ [
+ [ name>> % ]
+ [ params>> [ params>string % ] when* ]
+ [ ptr>> [ "*" % ] when ]
+ tri
+ ] "" make ;
+
+GENERIC: c++-type ( obj -- c++-type/f )
+
+M: object c++-type drop f ;
+
+M: c++-type c-type ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations sequences
+strings alien alien.c-types alien.data math byte-arrays ;
+IN: alien.marshall
+
+<PRIVATE
+: $memory-note ( arg -- )
+ drop "This word returns a pointer to unmanaged memory."
+ print-element ;
+
+: $c-ptr-note ( arg -- )
+ drop "Does nothing if its argument is a non false c-ptr."
+ print-element ;
+
+: $see-article ( arg -- )
+ drop { "See " { $vocab-link "alien.inline" } "." }
+ print-element ;
+PRIVATE>
+
+HELP: ?malloc-byte-array
+{ $values
+ { "c-type" c-type }
+ { "alien" alien }
+}
+{ $description "Does nothing if input is an alien, otherwise assumes it is a byte array and calls "
+ { $snippet "malloc-byte-array" } "."
+}
+{ $notes $memory-note } ;
+
+HELP: alien-wrapper
+{ $var-description "For wrapping C pointers in a structure factor can dispatch on." } ;
+
+HELP: unmarshall-cast
+{ $values
+ { "alien-wrapper" alien-wrapper }
+ { "alien-wrapper'" alien-wrapper }
+}
+{ $description "Called immediately after unmarshalling. Useful for automatically casting to subtypes." } ;
+
+HELP: marshall-bool
+{ $values
+ { "?" "a generalized boolean" }
+ { "n" "0 or 1" }
+}
+{ $description "Marshalls objects to bool." }
+{ $notes "Will treat " { $snippet "0" } " as " { $snippet "t" } "." } ;
+
+HELP: marshall-bool*
+{ $values
+ { "?/seq" "t/f or sequence" }
+ { "alien" alien }
+}
+{ $description "When the argument is a sequence, returns a pointer to an array of bool, "
+ "otherwise returns a pointer to a single bool value."
+}
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-bool**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description "Takes a one or two dimensional array of generalized booleans "
+ "and returns a pointer to the equivalent C structure."
+}
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-primitive
+{ $values
+ { "n" number }
+ { "n" number }
+}
+{ $description "Marshall numbers to C primitives."
+ $nl
+ "Factor marshalls numbers to primitives for FFI calls, so all "
+ "this word does is convert " { $snippet "t" } " to " { $snippet "1" }
+ ", " { $snippet "f" } " to " { $snippet "0" } ", and lets anything else "
+ "pass through untouched."
+} ;
+
+HELP: marshall-char*
+{ $values
+ { "n/seq" "number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-char**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-char**-or-strings
+{ $values
+ { "seq" "a sequence of strings" }
+ { "alien" alien }
+}
+{ $description "Marshalls an array of strings or characters to an array of C strings." }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-char*-or-string
+{ $values
+ { "n/string" "a number or string" }
+ { "alien" alien }
+}
+{ $description "Marshalls a string to a C string or a number to a pointer to " { $snippet "char" } "." }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-double*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-double**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-float*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-float**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-int*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-int**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-long*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-long**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-longlong*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-longlong**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-non-pointer
+{ $values
+ { "alien-wrapper/byte-array" "an alien-wrapper or byte-array" }
+ { "byte-array" byte-array }
+}
+{ $description "Converts argument to a byte array." }
+{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ;
+
+HELP: marshall-pointer
+{ $values
+ { "obj" object }
+ { "alien" alien }
+}
+{ $description "Converts argument to a C pointer." }
+{ $notes "Can marshall the following types: " { $snippet "alien, f, byte-array, alien-wrapper, struct-array" } "." } ;
+
+HELP: marshall-short*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-short**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-uchar*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-uchar**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-uint*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-uint**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-ulong*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-ulong**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-ulonglong*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-ulonglong**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-ushort*
+{ $values
+ { "n/seq" "a number or sequence" }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-ushort**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description $see-article }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshall-void**
+{ $values
+ { "seq" sequence }
+ { "alien" alien }
+}
+{ $description "Marshalls a sequence of objects to an array of pointers to void." }
+{ $notes { $list $c-ptr-note $memory-note } } ;
+
+HELP: marshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot" quotation }
+}
+{ $description "Given a C type, returns a quotation that will marshall its argument to that type." } ;
+
+HELP: out-arg-unmarshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot" quotation }
+}
+{ $description "Like " { $link unmarshaller } " but returns an empty quotation "
+ "for all types except pointers to non-const primitives."
+} ;
+
+HELP: class-unmarshaller
+{ $values
+ { "type" " a C type string" }
+ { "quot/f" quotation }
+}
+{ $description "If in the vocab in which this word is called, there is a subclass of " { $link alien-wrapper }
+ " named after the type argument, " { $snippet "pointer-unmarshaller" } " will return a quotation which "
+ "wraps its argument in an instance of that subclass. In any other case it returns an empty quotation."
+}
+{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ;
+
+HELP: primitive-marshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot/f" "a quotation or f" }
+}
+{ $description "Returns a quotation to marshall objects to the argument type." }
+{ $notes "Not meant to be called directly. Use the output of " { $link marshaller } " instead." } ;
+
+HELP: primitive-unmarshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot/f" "a quotation or f" }
+}
+{ $description "Returns a quotation to unmarshall objects from the argument type." }
+{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
+
+HELP: struct-field-unmarshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot" quotation }
+}
+{ $description "Like " { $link unmarshaller } " but returns a quotation that "
+ "does not call " { $snippet "free" } " on its argument."
+}
+{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
+
+HELP: struct-primitive-unmarshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot/f" "a quotation or f" }
+}
+{ $description "Like " { $link primitive-unmarshaller } " but returns a quotation that "
+ "does not call " { $snippet "free" } " on its argument." }
+{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
+
+HELP: struct-unmarshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot/f" quotation }
+}
+{ $description "Returns a quotation which wraps its argument in the subclass of "
+ { $link struct-wrapper } " which matches the " { $snippet "type" } " arg."
+}
+{ $notes "Not meant to be called directly. Use the output of " { $link unmarshaller } " instead." } ;
+
+HELP: struct-wrapper
+{ $var-description "For wrapping C structs in a structure factor can dispatch on." } ;
+
+HELP: unmarshall-bool
+{ $values
+ { "n" number }
+ { "?" "a boolean" }
+}
+{ $description "Unmarshalls a number to a boolean." } ;
+
+HELP: unmarshall-bool*
+{ $values
+ { "alien" alien }
+ { "?" "a boolean" }
+}
+{ $description "Unmarshalls a C pointer to a boolean." } ;
+
+HELP: unmarshall-bool*-free
+{ $values
+ { "alien" alien }
+ { "?" "a boolean" }
+}
+{ $description "Unmarshalls a C pointer to a boolean and frees the pointer." } ;
+
+HELP: unmarshall-char*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-char*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-char*-to-string
+{ $values
+ { "alien" alien }
+ { "string" string }
+}
+{ $description "Unmarshalls a " { $snippet "char" } " pointer to a factor string." } ;
+
+HELP: unmarshall-char*-to-string-free
+{ $values
+ { "alien" alien }
+ { "string" string }
+}
+{ $description "Unmarshalls a " { $snippet "char" } " pointer to a factor string and frees the pointer." } ;
+
+HELP: unmarshall-double*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-double*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-float*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-float*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-int*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-int*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-long*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-long*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-longlong*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-longlong*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-short*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-short*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-uchar*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-uchar*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-uint*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-uint*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-ulong*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-ulong*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-ulonglong*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-ulonglong*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-ushort*
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshall-ushort*-free
+{ $values
+ { "alien" alien }
+ { "n" number }
+}
+{ $description $see-article } ;
+
+HELP: unmarshaller
+{ $values
+ { "type" "a C type string" }
+ { "quot" quotation }
+}
+{ $description "Given a C type, returns a quotation that will unmarshall values of that type." } ;
+
+ARTICLE: "alien.marshall" "C marshalling"
+{ $vocab-link "alien.marshall" } " provides alien wrappers and marshalling words for the "
+"automatic marshalling and unmarshalling of C function arguments, return values, and output parameters."
+
+{ $subheading "Important words" }
+"Wrap an alien:" { $subsections alien-wrapper }
+"Wrap a struct:" { $subsections struct-wrapper }
+"Get the marshaller for a C type:" { $subsections marshaller }
+"Get the unmarshaller for a C type:" { $subsections unmarshaller }
+"Get the unmarshaller for an output parameter:" { $subsections out-arg-unmarshaller }
+"Get the unmarshaller for a struct field:" { $subsections struct-field-unmarshaller }
+$nl
+"Other marshalling and unmarshalling words in this vocabulary are not intended to be "
+"invoked directly."
+$nl
+"Most marshalling words allow non false c-ptrs to pass through unchanged."
+
+{ $subheading "Primitive marshallers" }
+{ $subsections marshall-primitive } "for marshalling primitive values."
+{ $subsections marshall-int* }
+ "marshalls a number or sequence of numbers. If argument is a sequence, returns a pointer "
+ "to a C array, otherwise returns a pointer to a single value."
+{ $subsections marshall-int** }
+"marshalls a 1D or 2D array of numbers. Returns an array of pointers to arrays."
+
+{ $subheading "Primitive unmarshallers" }
+{ $snippet "unmarshall-<prim>*" } " and " { $snippet "unmarshall-<prim>*-free" }
+" for all values of " { $snippet "<prim>" } " in " { $link primitive-types } "."
+{ $subsections unmarshall-int* }
+"unmarshalls a pointer to primitive. Returns a number. "
+"Assumes the pointer is not an array (if it is, only the first value is returned). "
+"C functions that return arrays are not handled correctly by " { $snippet "alien.marshall" }
+" and must be unmarshalled by hand."
+{ $subsections unmarshall-int*-free }
+"unmarshalls a pointer to primitive, and then frees the pointer."
+$nl
+"Primitive values require no unmarshalling. The factor FFI already does this."
+;
+
+ABOUT: "alien.marshall"
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.inline.types
+alien.marshall.private alien.strings byte-arrays classes
+combinators combinators.short-circuit destructors fry
+io.encodings.utf8 kernel libc sequences alien.data
+specialized-arrays strings unix.utilities vocabs.parser
+words libc.private locals generalizations math ;
+FROM: alien.c-types => float short ;
+SPECIALIZED-ARRAY: bool
+SPECIALIZED-ARRAY: char
+SPECIALIZED-ARRAY: double
+SPECIALIZED-ARRAY: float
+SPECIALIZED-ARRAY: int
+SPECIALIZED-ARRAY: long
+SPECIALIZED-ARRAY: longlong
+SPECIALIZED-ARRAY: short
+SPECIALIZED-ARRAY: uchar
+SPECIALIZED-ARRAY: uint
+SPECIALIZED-ARRAY: ulong
+SPECIALIZED-ARRAY: ulonglong
+SPECIALIZED-ARRAY: ushort
+SPECIALIZED-ARRAY: void*
+IN: alien.marshall
+
+<< primitive-types [ [ void* = ] [ bool = ] bi or not ]
+filter [ define-primitive-marshallers ] each >>
+
+TUPLE: alien-wrapper { underlying alien } ;
+TUPLE: struct-wrapper < alien-wrapper disposed ;
+TUPLE: class-wrapper < alien-wrapper disposed ;
+
+MIXIN: c++-root
+
+GENERIC: unmarshall-cast ( alien-wrapper -- alien-wrapper' )
+
+M: alien-wrapper unmarshall-cast ;
+M: struct-wrapper unmarshall-cast ;
+
+M: struct-wrapper dispose* underlying>> free ;
+
+M: class-wrapper c++-type class name>> parse-c++-type ;
+
+: marshall-pointer ( obj -- alien )
+ {
+ { [ dup alien? ] [ ] }
+ { [ dup not ] [ ] }
+ { [ dup byte-array? ] [ malloc-byte-array ] }
+ { [ dup alien-wrapper? ] [ underlying>> ] }
+ } cond ;
+
+: marshall-primitive ( n -- n )
+ [ bool>arg ] ptr-pass-through ;
+
+ALIAS: marshall-void* marshall-pointer
+
+: marshall-void** ( seq -- alien )
+ [ marshall-void* ] void*-array{ } map-as malloc-underlying ;
+
+: (marshall-char*-or-string) ( n/string -- alien )
+ dup string?
+ [ utf8 string>alien malloc-byte-array ]
+ [ (marshall-char*) ] if ;
+
+: marshall-char*-or-string ( n/string -- alien )
+ [ (marshall-char*-or-string) ] ptr-pass-through ;
+
+: (marshall-char**-or-strings) ( seq -- alien )
+ [ marshall-char*-or-string ] void*-array{ } map-as
+ malloc-underlying ;
+
+: marshall-char**-or-strings ( seq -- alien )
+ [ (marshall-char**-or-strings) ] ptr-pass-through ;
+
+: marshall-bool ( ? -- n )
+ >boolean [ 1 ] [ 0 ] if ;
+
+: (marshall-bool*) ( ?/seq -- alien )
+ [ marshall-bool <bool> malloc-byte-array ]
+ [ >bool-array malloc-underlying ]
+ marshall-x* ;
+
+: marshall-bool* ( ?/seq -- alien )
+ [ (marshall-bool*) ] ptr-pass-through ;
+
+: (marshall-bool**) ( seq -- alien )
+ [ marshall-bool* ] map >void*-array malloc-underlying ;
+
+: marshall-bool** ( seq -- alien )
+ [ (marshall-bool**) ] ptr-pass-through ;
+
+: unmarshall-bool ( n -- ? )
+ 0 = not ;
+
+: unmarshall-bool* ( alien -- ? )
+ *bool unmarshall-bool ;
+
+: unmarshall-bool*-free ( alien -- ? )
+ [ *bool unmarshall-bool ] keep add-malloc free ;
+
+: primitive-marshaller ( type -- quot/f )
+ {
+ { "bool" [ [ ] ] }
+ { "boolean" [ [ marshall-bool ] ] }
+ { "char" [ [ marshall-primitive ] ] }
+ { "uchar" [ [ marshall-primitive ] ] }
+ { "short" [ [ marshall-primitive ] ] }
+ { "ushort" [ [ marshall-primitive ] ] }
+ { "int" [ [ marshall-primitive ] ] }
+ { "uint" [ [ marshall-primitive ] ] }
+ { "long" [ [ marshall-primitive ] ] }
+ { "ulong" [ [ marshall-primitive ] ] }
+ { "long" [ [ marshall-primitive ] ] }
+ { "ulong" [ [ marshall-primitive ] ] }
+ { "float" [ [ marshall-primitive ] ] }
+ { "double" [ [ marshall-primitive ] ] }
+ { "bool*" [ [ marshall-bool* ] ] }
+ { "boolean*" [ [ marshall-bool* ] ] }
+ { "char*" [ [ marshall-char*-or-string ] ] }
+ { "uchar*" [ [ marshall-uchar* ] ] }
+ { "short*" [ [ marshall-short* ] ] }
+ { "ushort*" [ [ marshall-ushort* ] ] }
+ { "int*" [ [ marshall-int* ] ] }
+ { "uint*" [ [ marshall-uint* ] ] }
+ { "long*" [ [ marshall-long* ] ] }
+ { "ulong*" [ [ marshall-ulong* ] ] }
+ { "longlong*" [ [ marshall-longlong* ] ] }
+ { "ulonglong*" [ [ marshall-ulonglong* ] ] }
+ { "float*" [ [ marshall-float* ] ] }
+ { "double*" [ [ marshall-double* ] ] }
+ { "bool&" [ [ marshall-bool* ] ] }
+ { "boolean&" [ [ marshall-bool* ] ] }
+ { "char&" [ [ marshall-char* ] ] }
+ { "uchar&" [ [ marshall-uchar* ] ] }
+ { "short&" [ [ marshall-short* ] ] }
+ { "ushort&" [ [ marshall-ushort* ] ] }
+ { "int&" [ [ marshall-int* ] ] }
+ { "uint&" [ [ marshall-uint* ] ] }
+ { "long&" [ [ marshall-long* ] ] }
+ { "ulong&" [ [ marshall-ulong* ] ] }
+ { "longlong&" [ [ marshall-longlong* ] ] }
+ { "ulonglong&" [ [ marshall-ulonglong* ] ] }
+ { "float&" [ [ marshall-float* ] ] }
+ { "double&" [ [ marshall-double* ] ] }
+ { "void*" [ [ marshall-void* ] ] }
+ { "bool**" [ [ marshall-bool** ] ] }
+ { "boolean**" [ [ marshall-bool** ] ] }
+ { "char**" [ [ marshall-char**-or-strings ] ] }
+ { "uchar**" [ [ marshall-uchar** ] ] }
+ { "short**" [ [ marshall-short** ] ] }
+ { "ushort**" [ [ marshall-ushort** ] ] }
+ { "int**" [ [ marshall-int** ] ] }
+ { "uint**" [ [ marshall-uint** ] ] }
+ { "long**" [ [ marshall-long** ] ] }
+ { "ulong**" [ [ marshall-ulong** ] ] }
+ { "longlong**" [ [ marshall-longlong** ] ] }
+ { "ulonglong**" [ [ marshall-ulonglong** ] ] }
+ { "float**" [ [ marshall-float** ] ] }
+ { "double**" [ [ marshall-double** ] ] }
+ { "void**" [ [ marshall-void** ] ] }
+ [ drop f ]
+ } case ;
+
+: marshall-non-pointer ( alien-wrapper/byte-array -- byte-array )
+ {
+ { [ dup byte-array? ] [ ] }
+ { [ dup alien-wrapper? ]
+ [ [ underlying>> ] [ class name>> heap-size ] bi
+ memory>byte-array ] }
+ } cond ;
+
+
+: marshaller ( type -- quot )
+ factorize-type dup primitive-marshaller [ nip ] [
+ pointer?
+ [ [ marshall-pointer ] ]
+ [ [ marshall-non-pointer ] ] if
+ ] if* ;
+
+
+: unmarshall-char*-to-string ( alien -- string )
+ utf8 alien>string ;
+
+: unmarshall-char*-to-string-free ( alien -- string )
+ [ unmarshall-char*-to-string ] keep add-malloc free ;
+
+: primitive-unmarshaller ( type -- quot/f )
+ {
+ { "bool" [ [ ] ] }
+ { "boolean" [ [ unmarshall-bool ] ] }
+ { "char" [ [ ] ] }
+ { "uchar" [ [ ] ] }
+ { "short" [ [ ] ] }
+ { "ushort" [ [ ] ] }
+ { "int" [ [ ] ] }
+ { "uint" [ [ ] ] }
+ { "long" [ [ ] ] }
+ { "ulong" [ [ ] ] }
+ { "longlong" [ [ ] ] }
+ { "ulonglong" [ [ ] ] }
+ { "float" [ [ ] ] }
+ { "double" [ [ ] ] }
+ { "bool*" [ [ unmarshall-bool*-free ] ] }
+ { "boolean*" [ [ unmarshall-bool*-free ] ] }
+ { "char*" [ [ ] ] }
+ { "uchar*" [ [ unmarshall-uchar*-free ] ] }
+ { "short*" [ [ unmarshall-short*-free ] ] }
+ { "ushort*" [ [ unmarshall-ushort*-free ] ] }
+ { "int*" [ [ unmarshall-int*-free ] ] }
+ { "uint*" [ [ unmarshall-uint*-free ] ] }
+ { "long*" [ [ unmarshall-long*-free ] ] }
+ { "ulong*" [ [ unmarshall-ulong*-free ] ] }
+ { "longlong*" [ [ unmarshall-long*-free ] ] }
+ { "ulonglong*" [ [ unmarshall-ulong*-free ] ] }
+ { "float*" [ [ unmarshall-float*-free ] ] }
+ { "double*" [ [ unmarshall-double*-free ] ] }
+ { "bool&" [ [ unmarshall-bool*-free ] ] }
+ { "boolean&" [ [ unmarshall-bool*-free ] ] }
+ { "char&" [ [ ] ] }
+ { "uchar&" [ [ unmarshall-uchar*-free ] ] }
+ { "short&" [ [ unmarshall-short*-free ] ] }
+ { "ushort&" [ [ unmarshall-ushort*-free ] ] }
+ { "int&" [ [ unmarshall-int*-free ] ] }
+ { "uint&" [ [ unmarshall-uint*-free ] ] }
+ { "long&" [ [ unmarshall-long*-free ] ] }
+ { "ulong&" [ [ unmarshall-ulong*-free ] ] }
+ { "longlong&" [ [ unmarshall-longlong*-free ] ] }
+ { "ulonglong&" [ [ unmarshall-ulonglong*-free ] ] }
+ { "float&" [ [ unmarshall-float*-free ] ] }
+ { "double&" [ [ unmarshall-double*-free ] ] }
+ [ drop f ]
+ } case ;
+
+: struct-primitive-unmarshaller ( type -- quot/f )
+ {
+ { "bool" [ [ unmarshall-bool ] ] }
+ { "boolean" [ [ unmarshall-bool ] ] }
+ { "char" [ [ ] ] }
+ { "uchar" [ [ ] ] }
+ { "short" [ [ ] ] }
+ { "ushort" [ [ ] ] }
+ { "int" [ [ ] ] }
+ { "uint" [ [ ] ] }
+ { "long" [ [ ] ] }
+ { "ulong" [ [ ] ] }
+ { "longlong" [ [ ] ] }
+ { "ulonglong" [ [ ] ] }
+ { "float" [ [ ] ] }
+ { "double" [ [ ] ] }
+ { "bool*" [ [ unmarshall-bool* ] ] }
+ { "boolean*" [ [ unmarshall-bool* ] ] }
+ { "char*" [ [ ] ] }
+ { "uchar*" [ [ unmarshall-uchar* ] ] }
+ { "short*" [ [ unmarshall-short* ] ] }
+ { "ushort*" [ [ unmarshall-ushort* ] ] }
+ { "int*" [ [ unmarshall-int* ] ] }
+ { "uint*" [ [ unmarshall-uint* ] ] }
+ { "long*" [ [ unmarshall-long* ] ] }
+ { "ulong*" [ [ unmarshall-ulong* ] ] }
+ { "longlong*" [ [ unmarshall-long* ] ] }
+ { "ulonglong*" [ [ unmarshall-ulong* ] ] }
+ { "float*" [ [ unmarshall-float* ] ] }
+ { "double*" [ [ unmarshall-double* ] ] }
+ { "bool&" [ [ unmarshall-bool* ] ] }
+ { "boolean&" [ [ unmarshall-bool* ] ] }
+ { "char&" [ [ unmarshall-char* ] ] }
+ { "uchar&" [ [ unmarshall-uchar* ] ] }
+ { "short&" [ [ unmarshall-short* ] ] }
+ { "ushort&" [ [ unmarshall-ushort* ] ] }
+ { "int&" [ [ unmarshall-int* ] ] }
+ { "uint&" [ [ unmarshall-uint* ] ] }
+ { "long&" [ [ unmarshall-long* ] ] }
+ { "ulong&" [ [ unmarshall-ulong* ] ] }
+ { "longlong&" [ [ unmarshall-longlong* ] ] }
+ { "ulonglong&" [ [ unmarshall-ulonglong* ] ] }
+ { "float&" [ [ unmarshall-float* ] ] }
+ { "double&" [ [ unmarshall-double* ] ] }
+ [ drop f ]
+ } case ;
+
+
+: ?malloc-byte-array ( c-type -- alien )
+ dup alien? [ malloc-byte-array ] unless ;
+
+:: x-unmarshaller ( type type-quot superclass def clean -- quot/f )
+ type type-quot call current-vocab lookup [
+ dup superclasses superclass swap member?
+ [ def call ] [ drop clean call f ] if
+ ] [ clean call f ] if* ; inline
+
+: struct-unmarshaller ( type -- quot/f )
+ [ ] \ struct-wrapper
+ [ '[ ?malloc-byte-array _ new swap >>underlying ] ]
+ [ ]
+ x-unmarshaller ;
+
+: class-unmarshaller ( type -- quot/f )
+ [ type-sans-pointer "#" append ] \ class-wrapper
+ [ '[ _ new swap >>underlying ] ]
+ [ ]
+ x-unmarshaller ;
+
+: non-primitive-unmarshaller ( type -- quot/f )
+ {
+ { [ dup pointer? ] [ class-unmarshaller ] }
+ [ struct-unmarshaller ]
+ } cond ;
+
+: unmarshaller ( type -- quot )
+ factorize-type {
+ [ primitive-unmarshaller ]
+ [ non-primitive-unmarshaller ]
+ [ drop [ ] ]
+ } 1|| ;
+
+: struct-field-unmarshaller ( type -- quot )
+ factorize-type {
+ [ struct-primitive-unmarshaller ]
+ [ non-primitive-unmarshaller ]
+ [ drop [ ] ]
+ } 1|| ;
+
+: out-arg-unmarshaller ( type -- quot )
+ dup pointer-to-non-const-primitive?
+ [ factorize-type primitive-unmarshaller ]
+ [ drop [ drop ] ] if ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.inline arrays
+combinators fry functors kernel lexer libc macros math
+sequences specialized-arrays libc.private
+combinators.short-circuit alien.data ;
+SPECIALIZED-ARRAY: void*
+IN: alien.marshall.private
+
+: bool>arg ( ? -- 1/0/obj )
+ {
+ { t [ 1 ] }
+ { f [ 0 ] }
+ [ ]
+ } case ;
+
+MACRO: marshall-x* ( num-quot seq-quot -- alien )
+ '[ bool>arg dup number? _ _ if ] ;
+
+: ptr-pass-through ( obj quot -- alien )
+ over { [ c-ptr? ] [ ] } 1&& [ drop ] [ call ] if ; inline
+
+: malloc-underlying ( obj -- alien )
+ underlying>> malloc-byte-array ;
+
+FUNCTOR: define-primitive-marshallers ( TYPE -- )
+<TYPE> IS <${TYPE}>
+*TYPE IS *${TYPE}
+>TYPE-array IS >${TYPE}-array
+marshall-TYPE DEFINES marshall-${TYPE}
+(marshall-TYPE*) DEFINES (marshall-${TYPE}*)
+(marshall-TYPE**) DEFINES (marshall-${TYPE}**)
+marshall-TYPE* DEFINES marshall-${TYPE}*
+marshall-TYPE** DEFINES marshall-${TYPE}**
+marshall-TYPE*-free DEFINES marshall-${TYPE}*-free
+marshall-TYPE**-free DEFINES marshall-${TYPE}**-free
+unmarshall-TYPE* DEFINES unmarshall-${TYPE}*
+unmarshall-TYPE*-free DEFINES unmarshall-${TYPE}*-free
+WHERE
+<PRIVATE
+: (marshall-TYPE*) ( n/seq -- alien )
+ [ <TYPE> malloc-byte-array ]
+ [ >TYPE-array malloc-underlying ]
+ marshall-x* ;
+PRIVATE>
+: marshall-TYPE* ( n/seq -- alien )
+ [ (marshall-TYPE*) ] ptr-pass-through ;
+<PRIVATE
+: (marshall-TYPE**) ( seq -- alien )
+ [ marshall-TYPE* ] void*-array{ } map-as malloc-underlying ;
+PRIVATE>
+: marshall-TYPE** ( seq -- alien )
+ [ (marshall-TYPE**) ] ptr-pass-through ;
+: unmarshall-TYPE* ( alien -- n )
+ *TYPE ; inline
+: unmarshall-TYPE*-free ( alien -- n )
+ [ unmarshall-TYPE* ] keep add-malloc free ;
+;FUNCTOR
+
+SYNTAX: PRIMITIVE-MARSHALLERS:
+";" parse-tokens [ define-primitive-marshallers ] each ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: classes help.markup help.syntax kernel quotations words
+alien.marshall.structs strings alien.structs alien.marshall ;
+IN: alien.marshall.structs
+
+HELP: define-marshalled-struct
+{ $values
+ { "name" string } { "vocab" "a vocabulary specifier" } { "fields" "an alist" }
+}
+{ $description "Calls " { $link define-struct } " and " { $link define-struct-tuple } "." } ;
+
+HELP: define-struct-tuple
+{ $values
+ { "name" string }
+}
+{ $description "Defines a subclass of " { $link struct-wrapper } ", a constructor, "
+ "and accessor words."
+} ;
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types alien.marshall arrays assocs
+classes.tuple combinators destructors generalizations generic
+kernel libc locals parser quotations sequences slots words
+alien.structs lexer vocabs.parser fry effects alien.data ;
+IN: alien.marshall.structs
+
+<PRIVATE
+: define-struct-accessor ( class name quot -- )
+ [ "accessors" create create-method dup make-inline ] dip define ;
+
+: define-struct-getter ( class name word type -- )
+ [ ">>" append \ underlying>> ] 2dip
+ struct-field-unmarshaller \ call 4array >quotation
+ define-struct-accessor ;
+
+: define-struct-setter ( class name word type -- )
+ [ "(>>" prepend ")" append ] 2dip
+ marshaller [ underlying>> ] \ bi* roll 4array >quotation
+ define-struct-accessor ;
+
+: define-struct-accessors ( class name type reader writer -- )
+ [ dup define-protocol-slot ] 3dip
+ [ drop swap define-struct-getter ]
+ [ nip swap define-struct-setter ] 5 nbi ;
+
+: define-struct-constructor ( class -- )
+ {
+ [ name>> "<" prepend ">" append create-in ]
+ [ '[ _ new ] ]
+ [ name>> '[ _ malloc-object >>underlying ] append ]
+ [ name>> 1array ]
+ } cleave { } swap <effect> define-declared ;
+PRIVATE>
+
+:: define-struct-tuple ( name -- )
+ name create-in :> class
+ class struct-wrapper { } define-tuple-class
+ class define-struct-constructor
+ name c-type fields>> [
+ class swap
+ {
+ [ name>> { { CHAR: space CHAR: - } } substitute ]
+ [ type>> ] [ reader>> ] [ writer>> ]
+ } cleave define-struct-accessors
+ ] each ;
+
+: define-marshalled-struct ( name vocab fields -- )
+ [ define-struct ] [ 2drop define-struct-tuple ] 3bi ;
--- /dev/null
+Jeremy Hughes
\ No newline at end of file
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.markup help.syntax kernel quotations words
+alien.inline alien.syntax effects alien.marshall
+alien.marshall.structs strings sequences alien.inline.syntax ;
+IN: alien.marshall.syntax
+
+HELP: CM-FUNCTION:
+{ $syntax "CM-FUNCTION: return name args\n body\n;" }
+{ $description "Like " { $link POSTPONE: C-FUNCTION: } " but with marshalling "
+ "of arguments and return values."
+}
+{ $examples
+ { $example
+ "USING: alien.inline.syntax alien.marshall.syntax prettyprint ;"
+ "IN: example"
+ ""
+ "C-LIBRARY: exlib"
+ ""
+ "C-INCLUDE: <stdio.h>"
+ "C-INCLUDE: <stdlib.h>"
+ "CM-FUNCTION: char* sum_diff ( const-int a, const-int b, int* x, int* y )"
+ " *x = a + b;"
+ " *y = a - b;"
+ " char* s = (char*) malloc(sizeof(char) * 64);"
+ " sprintf(s, \"sum %i, diff %i\", *x, *y);"
+ " return s;"
+ ";"
+ ""
+ ";C-LIBRARY"
+ ""
+ "8 5 0 0 sum_diff . . ."
+ "3\n13\n\"sum 13, diff 3\""
+ }
+}
+{ $see-also define-c-marshalled POSTPONE: C-FUNCTION: POSTPONE: M-FUNCTION: } ;
+
+HELP: CM-STRUCTURE:
+{ $syntax "CM-STRUCTURE: name fields ... ;" }
+{ $description "Like " { $link POSTPONE: C-STRUCTURE: } " but with marshalling of fields. "
+ "Defines a subclass of " { $link struct-wrapper } " a constructor, and slot-like accessor words."
+}
+{ $see-also POSTPONE: C-STRUCTURE: POSTPONE: M-STRUCTURE: } ;
+
+HELP: M-FUNCTION:
+{ $syntax "M-FUNCTION: return name args ;" }
+{ $description "Like " { $link POSTPONE: FUNCTION: } " but with marshalling "
+ "of arguments and return values."
+}
+{ $see-also marshalled-function POSTPONE: C-FUNCTION: POSTPONE: CM-FUNCTION: } ;
+
+HELP: M-STRUCTURE:
+{ $syntax "M-STRUCTURE: name fields ... ;" }
+{ $description "Like " { $link POSTPONE: C-STRUCT: } " but with marshalling of fields. "
+ "Defines a subclass of " { $link struct-wrapper } " a constructor, and slot-like accessor words."
+}
+{ $see-also define-marshalled-struct POSTPONE: C-STRUCTURE: POSTPONE: CM-STRUCTURE: } ;
+
+HELP: define-c-marshalled
+{ $values
+ { "name" string } { "types" sequence } { "effect" effect } { "body" string }
+}
+{ $description "Defines a C function and a factor word which calls it with marshalling of "
+ "args and return values."
+}
+{ $see-also define-c-marshalled' } ;
+
+HELP: define-c-marshalled'
+{ $values
+ { "name" string } { "effect" effect } { "body" string }
+}
+{ $description "Like " { $link define-c-marshalled } ". "
+ "The effect elements must be C type strings."
+} ;
+
+HELP: marshalled-function
+{ $values
+ { "name" string } { "types" sequence } { "effect" effect }
+ { "word" word } { "quot" quotation } { "effect" effect }
+}
+{ $description "Defines a word which calls the named C function. Arguments, "
+ "return value, and output parameters are marshalled and unmarshalled."
+} ;
+
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: alien.inline.syntax alien.marshall.syntax destructors
+tools.test accessors kernel ;
+IN: alien.marshall.syntax.tests
+
+DELETE-C-LIBRARY: test
+C-LIBRARY: test
+
+C-INCLUDE: <stdlib.h>
+C-INCLUDE: <string.h>
+C-INCLUDE: <stdbool.h>
+
+CM-FUNCTION: void outarg1 ( int* a )
+ *a += 2;
+;
+
+CM-FUNCTION: unsigned-long* outarg2 ( unsigned-long a, unsigned-long* b )
+ unsigned long* x = malloc(sizeof(unsigned long*));
+ *b = 10 + *b;
+ *x = a + *b;
+ return x;
+;
+
+CM-STRUCTURE: wedge
+ { "double" "degrees" } ;
+
+CM-STRUCTURE: sundial
+ { "double" "radius" }
+ { "wedge" "wedge" } ;
+
+CM-FUNCTION: double hours ( sundial* d )
+ return d->wedge.degrees / 30;
+;
+
+CM-FUNCTION: void change_time ( double hours, sundial* d )
+ d->wedge.degrees = hours * 30;
+;
+
+CM-FUNCTION: bool c_not ( bool p )
+ return !p;
+;
+
+CM-FUNCTION: char* upcase ( const-char* s )
+ int len = strlen(s);
+ char* t = malloc(sizeof(char) * len);
+ int i;
+ for (i = 0; i < len; i++)
+ t[i] = toupper(s[i]);
+ t[i] = '\0';
+ return t;
+;
+
+;C-LIBRARY
+
+{ 1 1 } [ outarg1 ] must-infer-as
+[ 3 ] [ 1 outarg1 ] unit-test
+[ 3 ] [ t outarg1 ] unit-test
+[ 2 ] [ f outarg1 ] unit-test
+
+{ 2 2 } [ outarg2 ] must-infer-as
+[ 18 15 ] [ 3 5 outarg2 ] unit-test
+
+{ 1 1 } [ hours ] must-infer-as
+[ 5.0 ] [ <sundial> <wedge> 150 >>degrees >>wedge hours ] unit-test
+
+{ 2 0 } [ change_time ] must-infer-as
+[ 150.0 ] [ 5 <sundial> <wedge> 11 >>degrees >>wedge [ change_time ] keep wedge>> degrees>> ] unit-test
+
+{ 1 1 } [ c_not ] must-infer-as
+[ f ] [ "x" c_not ] unit-test
+[ f ] [ 0 c_not ] unit-test
+
+{ 1 1 } [ upcase ] must-infer-as
+[ "ABC" ] [ "abc" upcase ] unit-test
--- /dev/null
+! Copyright (C) 2009 Jeremy Hughes.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.inline alien.inline.types alien.marshall
+combinators effects generalizations kernel locals make namespaces
+quotations sequences words alien.marshall.structs lexer parser
+vocabs.parser multiline ;
+IN: alien.marshall.syntax
+
+:: marshalled-function ( name types effect -- word quot effect )
+ name types effect factor-function
+ [ in>> ]
+ [ out>> types [ pointer-to-non-const-primitive? ] filter append ]
+ bi <effect>
+ [
+ [
+ types [ marshaller ] map , \ spread , ,
+ types length , \ nkeep ,
+ types [ out-arg-unmarshaller ] map
+ effect out>> dup empty?
+ [ drop ] [ first unmarshaller prefix ] if
+ , \ spread ,
+ ] [ ] make
+ ] dip ;
+
+: define-c-marshalled ( name types effect body -- )
+ [
+ [ marshalled-function define-declared ]
+ [ prototype-string ] 3bi
+ ] dip append-function-body c-strings get push ;
+
+: define-c-marshalled' ( name effect body -- )
+ [
+ [ in>> ] keep
+ [ marshalled-function define-declared ]
+ [ out>> prototype-string' ] 3bi
+ ] dip append-function-body c-strings get push ;
+
+SYNTAX: CM-FUNCTION:
+ function-types-effect parse-here define-c-marshalled ;
+
+SYNTAX: M-FUNCTION:
+ function-types-effect marshalled-function define-declared ;
+
+SYNTAX: M-STRUCTURE:
+ scan current-vocab parse-definition
+ define-marshalled-struct ;
+
+SYNTAX: CM-STRUCTURE:
+ scan current-vocab parse-definition
+ [ define-marshalled-struct ] [ nip define-c-struct ] 3bi ;
+++ /dev/null
-IN: cpu.arm.assembler.tests
-USING: assembler-arm math test namespaces sequences kernel
-quotations ;
-
-: test-opcode [ { } make first ] curry unit-test ;
-
-[ HEX: ea000000 ] [ 0 B ] test-opcode
-[ HEX: eb000000 ] [ 0 BL ] test-opcode
-! [ HEX: e12fff30 ] [ R0 BLX ] test-opcode
-
-[ HEX: e24cc004 ] [ IP IP 4 SUB ] test-opcode
-[ HEX: e24cb004 ] [ FP IP 4 SUB ] test-opcode
-[ HEX: e087e3ac ] [ LR R7 IP 7 <LSR> ADD ] test-opcode
-[ HEX: e08c0109 ] [ R0 IP R9 2 <LSL> ADD ] test-opcode
-[ HEX: 02850004 ] [ R0 R5 4 EQ ADD ] test-opcode
-[ HEX: 00000000 ] [ R0 R0 R0 EQ AND ] test-opcode
-
-[ HEX: e1a0c00c ] [ IP IP MOV ] test-opcode
-[ HEX: e1a0c00d ] [ IP SP MOV ] test-opcode
-[ HEX: e3a03003 ] [ R3 3 MOV ] test-opcode
-[ HEX: e1a00003 ] [ R0 R3 MOV ] test-opcode
-[ HEX: e1e01c80 ] [ R1 R0 25 <LSL> MVN ] test-opcode
-[ HEX: e1e00ca1 ] [ R0 R1 25 <LSR> MVN ] test-opcode
-[ HEX: 11a021ac ] [ R2 IP 3 <LSR> NE MOV ] test-opcode
-
-[ HEX: e3530007 ] [ R3 7 CMP ] test-opcode
-
-[ HEX: e008049a ] [ R8 SL R4 MUL ] test-opcode
-
-[ HEX: e5151004 ] [ R1 R5 4 <-> LDR ] test-opcode
-[ HEX: e41c2004 ] [ R2 IP 4 <-!> LDR ] test-opcode
-[ HEX: e50e2004 ] [ R2 LR 4 <-> STR ] test-opcode
-
-[ HEX: e7910002 ] [ R0 R1 R2 <+> LDR ] test-opcode
-[ HEX: e7910102 ] [ R0 R1 R2 2 <LSL> <+> LDR ] test-opcode
-
-[ HEX: e1d310bc ] [ R1 R3 12 <+> LDRH ] test-opcode
-[ HEX: e1d310fc ] [ R1 R3 12 <+> LDRSH ] test-opcode
-[ HEX: e1d310dc ] [ R1 R3 12 <+> LDRSB ] test-opcode
-[ HEX: e1c310bc ] [ R1 R3 12 <+> STRH ] test-opcode
-[ HEX: e19310b4 ] [ R1 R3 R4 <+> LDRH ] test-opcode
-[ HEX: e1f310fc ] [ R1 R3 12 <!+> LDRSH ] test-opcode
-[ HEX: e1b310d4 ] [ R1 R3 R4 <!+> LDRSB ] test-opcode
-[ HEX: e0c317bb ] [ R1 R3 123 <+!> STRH ] test-opcode
-[ HEX: e08310b4 ] [ R1 R3 R4 <+!> STRH ] test-opcode
+++ /dev/null
-! Copyright (C) 2007 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generator generator.fixup kernel sequences words
-namespaces math math.bitfields ;
-IN: cpu.arm.assembler
-
-: define-registers ( seq -- )
- dup length [ "register" set-word-prop ] 2each ;
-
-SYMBOL: R0
-SYMBOL: R1
-SYMBOL: R2
-SYMBOL: R3
-SYMBOL: R4
-SYMBOL: R5
-SYMBOL: R6
-SYMBOL: R7
-SYMBOL: R8
-SYMBOL: R9
-SYMBOL: R10
-SYMBOL: R11
-SYMBOL: R12
-SYMBOL: R13
-SYMBOL: R14
-SYMBOL: R15
-
-{ R0 R1 R2 R3 R4 R5 R6 R7 R8 R9 R10 R11 R12 R13 R14 R15 }
-define-registers
-
-PREDICATE: register < word register >boolean ;
-
-GENERIC: register ( register -- n )
-M: word register "register" word-prop ;
-M: f register drop 0 ;
-
-: SL R10 ; inline : FP R11 ; inline : IP R12 ; inline
-: SP R13 ; inline : LR R14 ; inline : PC R15 ; inline
-
-! Condition codes
-SYMBOL: cond-code
-
-: >CC ( n -- )
- cond-code set ;
-
-: CC> ( -- n )
- #! Default value is BIN: 1110 AL (= always)
- cond-code [ f ] change BIN: 1110 or ;
-
-: EQ BIN: 0000 >CC ;
-: NE BIN: 0001 >CC ;
-: CS BIN: 0010 >CC ;
-: CC BIN: 0011 >CC ;
-: LO BIN: 0100 >CC ;
-: PL BIN: 0101 >CC ;
-: VS BIN: 0110 >CC ;
-: VC BIN: 0111 >CC ;
-: HI BIN: 1000 >CC ;
-: LS BIN: 1001 >CC ;
-: GE BIN: 1010 >CC ;
-: LT BIN: 1011 >CC ;
-: GT BIN: 1100 >CC ;
-: LE BIN: 1101 >CC ;
-: AL BIN: 1110 >CC ;
-: NV BIN: 1111 >CC ;
-
-: (insn) ( n -- ) CC> 28 shift bitor , ;
-
-: insn ( bitspec -- ) bitfield (insn) ; inline
-
-! Branching instructions
-GENERIC# (B) 1 ( signed-imm-24 l -- )
-
-M: integer (B) { 24 { 1 25 } { 0 26 } { 1 27 } 0 } insn ;
-M: word (B) 0 swap (B) rc-relative-arm-3 rel-word ;
-M: label (B) 0 swap (B) rc-relative-arm-3 label-fixup ;
-
-: B 0 (B) ; : BL 1 (B) ;
-
-! Data processing instructions
-SYMBOL: updates-cond-code
-
-: S ( -- ) updates-cond-code on ;
-
-: S> ( -- ? ) updates-cond-code [ f ] change ;
-
-: sinsn ( bitspec -- )
- bitfield S> [ 20 2^ bitor ] when (insn) ; inline
-
-GENERIC# shift-imm/reg 2 ( shift-imm/Rs Rm shift -- n )
-
-M: integer shift-imm/reg ( shift-imm Rm shift -- n )
- { { 0 4 } 5 { register 0 } 7 } bitfield ;
-
-M: register shift-imm/reg ( Rs Rm shift -- n )
- {
- { 1 4 }
- { 0 7 }
- 5
- { register 8 }
- { register 0 }
- } bitfield ;
-
-GENERIC: shifter-op ( shifter-op -- n )
-
-TUPLE: IMM immed rotate ;
-C: <IMM> IMM
-
-M: IMM shifter-op
- dup IMM-immed swap IMM-rotate
- { { 1 25 } 8 0 } bitfield ;
-
-TUPLE: shifter Rm by shift ;
-C: <shifter> shifter
-
-M: shifter shifter-op
- dup shifter-by over shifter-Rm rot shifter-shift
- shift-imm/reg ;
-
-: <LSL> ( Rm shift-imm/Rs -- shifter-op ) BIN: 00 <shifter> ;
-: <LSR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 01 <shifter> ;
-: <ASR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 10 <shifter> ;
-: <ROR> ( Rm shift-imm/Rs -- shifter-op ) BIN: 11 <shifter> ;
-: <RRX> ( Rm -- shifter-op ) 0 <ROR> ;
-
-M: register shifter-op 0 <LSL> shifter-op ;
-
-M: integer shifter-op 0 <IMM> shifter-op ;
-
-: addr1 ( Rd Rn shifter-op opcode -- )
- {
- 21 ! opcode
- { shifter-op 0 }
- { register 16 } ! Rn
- { register 12 } ! Rd
- } sinsn ;
-
-: AND BIN: 0000 addr1 ;
-: EOR BIN: 0001 addr1 ;
-: SUB BIN: 0010 addr1 ;
-: RSB BIN: 0011 addr1 ;
-: ADD BIN: 0100 addr1 ;
-: ADC BIN: 0101 addr1 ;
-: SBC BIN: 0110 addr1 ;
-: RSC BIN: 0111 addr1 ;
-: ORR BIN: 1100 addr1 ;
-: BIC BIN: 1110 addr1 ;
-
-: MOV f swap BIN: 1101 addr1 ;
-: MVN f swap BIN: 1111 addr1 ;
-
-! These always update the condition code flags
-: (CMP) >r f -rot r> S addr1 ;
-
-: TST BIN: 1000 (CMP) ;
-: TEQ BIN: 1001 (CMP) ;
-: CMP BIN: 1010 (CMP) ;
-: CMN BIN: 1011 (CMP) ;
-
-! Multiply instructions
-: (MLA) ( Rd Rm Rs Rn a -- )
- {
- 21
- { register 12 }
- { register 8 }
- { register 0 }
- { register 16 }
- { 1 7 }
- { 1 4 }
- } sinsn ;
-
-: MUL ( Rd Rm Rs -- ) f 0 (MLA) ;
-: MLA ( Rd Rm Rs Rn -- ) 1 (MLA) ;
-
-: (S/UMLAL) ( RdLo RdHi Rm Rs s a -- )
- {
- { 1 23 }
- 22
- 21
- { register 8 }
- { register 0 }
- { register 16 }
- { register 12 }
- { 1 7 }
- { 1 4 }
- } sinsn ;
-
-: SMLAL 1 1 (S/UMLAL) ; : SMULL 1 0 (S/UMLAL) ;
-: UMLAL 0 1 (S/UMLAL) ; : UMULL 0 0 (S/UMLAL) ;
-
-! Miscellaneous arithmetic instructions
-: CLZ ( Rd Rm -- )
- {
- { 1 24 }
- { 1 22 }
- { 1 21 }
- { BIN: 111 16 }
- { BIN: 1111 8 }
- { 1 4 }
- { register 0 }
- { register 12 }
- } sinsn ;
-
-! Status register acess instructions
-
-! Load and store instructions
-GENERIC: addressing-mode-2 ( addressing-mode -- n )
-
-TUPLE: addressing p u w ;
-: <addressing> ( delegate p u w -- addressing )
- {
- set-delegate
- set-addressing-p
- set-addressing-u
- set-addressing-w
- } addressing construct ;
-
-M: addressing addressing-mode-2
- {
- addressing-p addressing-u addressing-w delegate
- } get-slots addressing-mode-2
- { 0 21 23 24 } bitfield ;
-
-M: integer addressing-mode-2 ;
-
-M: object addressing-mode-2 shifter-op { { 1 25 } 0 } bitfield ;
-
-! Offset
-: <+> 1 1 0 <addressing> ;
-: <-> 1 0 0 <addressing> ;
-
-! Pre-indexed
-: <!+> 1 1 1 <addressing> ;
-: <!-> 1 0 1 <addressing> ;
-
-! Post-indexed
-: <+!> 0 1 0 <addressing> ;
-: <-!> 0 0 0 <addressing> ;
-
-: addr2 ( Rd Rn addressing-mode b l -- )
- {
- { 1 26 }
- 20
- 22
- { addressing-mode-2 0 }
- { register 16 }
- { register 12 }
- } insn ;
-
-: LDR 0 1 addr2 ;
-: LDRB 1 1 addr2 ;
-: STR 0 0 addr2 ;
-: STRB 1 0 addr2 ;
-
-! We might have to simulate these instructions since older ARM
-! chips don't have them.
-SYMBOL: have-BX?
-SYMBOL: have-BLX?
-
-GENERIC# (BX) 1 ( Rm l -- )
-
-M: register (BX) ( Rm l -- )
- {
- { 1 24 }
- { 1 21 }
- { BIN: 1111 16 }
- { BIN: 1111 12 }
- { BIN: 1111 8 }
- 5
- { 1 4 }
- { register 0 }
- } insn ;
-
-M: word (BX) 0 swap (BX) rc-relative-arm-3 rel-word ;
-
-M: label (BX) 0 swap (BX) rc-relative-arm-3 label-fixup ;
-
-: BX have-BX? get [ 0 (BX) ] [ PC swap MOV ] if ;
-
-: BLX have-BLX? get [ 1 (BX) ] [ LR PC MOV BX ] if ;
-
-! More load and store instructions
-GENERIC: addressing-mode-3 ( addressing-mode -- n )
-
-: b>n/n ( b -- n n ) dup -4 shift swap HEX: f bitand ;
-
-M: addressing addressing-mode-3
- [ addressing-p ] keep
- [ addressing-u ] keep
- [ addressing-w ] keep
- delegate addressing-mode-3
- { 0 21 23 24 } bitfield ;
-
-M: integer addressing-mode-3
- b>n/n {
- ! { 1 24 }
- { 1 22 }
- { 1 7 }
- { 1 4 }
- 0
- 8
- } bitfield ;
-
-M: object addressing-mode-3
- shifter-op {
- ! { 1 24 }
- { 1 7 }
- { 1 4 }
- 0
- } bitfield ;
-
-: addr3 ( Rn Rd addressing-mode h l s -- )
- {
- 6
- 20
- 5
- { addressing-mode-3 0 }
- { register 16 }
- { register 12 }
- } insn ;
-
-: LDRH 1 1 0 addr3 ;
-: LDRSB 0 1 1 addr3 ;
-: LDRSH 1 1 1 addr3 ;
-: STRH 1 0 0 addr3 ;
-
-! Load and store multiple instructions
-
-! Semaphore instructions
-
-! Exception-generating instructions
+++ /dev/null
-Slava Pestov
ARTICLE: "graph-protocol" "Graph protocol"
"All graphs must be instances of the graph mixin:"
-{ $subsection graph }
+{ $subsections graph }
"All graphs must implement a method on the following generic word:"
-{ $subsection vertices }
+{ $subsections vertices }
"At least one of the following two generic words must have a method; the " { $link graph } " mixin has default definitions which are mutually recursive:"
-{ $subsection adjlist }
-{ $subsection adj? }
+{ $subsections
+ adjlist
+ adj?
+}
"All mutable graphs must implement a method on the following generic word:"
-{ $subsection add-blank-vertex }
+{ $subsections add-blank-vertex }
"All mutable undirected graphs must implement a method on the following generic word:"
-{ $subsection add-edge }
+{ $subsections add-edge }
"Mutable directed graphs should not implement the above word, as it has a default definition defined in terms of the following generic word:"
-{ $subsection add-edge* }
+{ $subsections add-edge* }
"The following two words have default definitions, but are available as generics to allow implementations to optimize them:"
-{ $subsection num-vertices }
-{ $subsection num-edges } ;
+{ $subsections
+ num-vertices
+ num-edges
+} ;
HELP: graph
{ $class-description "A mixin class whose instances are graphs. Custom implementations of the graph protocol should be declared as instances of this mixin for all graph functionality to work correctly:"
ARTICLE: "derivatives" "The Derivative Toolkit"
"A toolkit for computing the derivative of functions."
-{ $subsection derivative }
-{ $subsection derivative-func }
-{ $subsection (derivative) } ;
+{ $subsections
+ derivative
+ derivative-func
+ (derivative)
+} ;
ABOUT: "derivatives"
TYPEDEF: char SQLCHAR
TYPEDEF: char* SQLCHAR*
TYPEDEF: void* SQLHANDLE
-TYPEDEF: void* SQLHANDLE*
+C-TYPE: SQLHANDLE
TYPEDEF: void* SQLHENV
TYPEDEF: void* SQLHDBC
TYPEDEF: void* SQLHSTMT
+++ /dev/null
-Chris Double
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel system combinators alien alien.syntax ;
-IN: ogg
-
-<<
-"ogg" {
- { [ os winnt? ] [ "ogg.dll" ] }
- { [ os macosx? ] [ "libogg.0.dylib" ] }
- { [ os unix? ] [ "libogg.so" ] }
-} cond "cdecl" add-library
->>
-
-LIBRARY: ogg
-
-C-STRUCT: oggpack_buffer
- { "long" "endbyte" }
- { "int" "endbit" }
- { "uchar*" "buffer" }
- { "uchar*" "ptr" }
- { "long" "storage" } ;
-
-C-STRUCT: ogg_page
- { "uchar*" "header" }
- { "long" "header_len" }
- { "uchar*" "body" }
- { "long" "body_len" } ;
-
-C-STRUCT: ogg_stream_state
- { "uchar*" "body_data" }
- { "long" "body_storage" }
- { "long" "body_fill" }
- { "long" "body_returned" }
- { "int*" "lacing_vals" }
- { "longlong*" "granule_vals" }
- { "long" "lacing_storage" }
- { "long" "lacing_fill" }
- { "long" "lacing_packet" }
- { "long" "lacing_returned" }
- { { "uchar" 282 } "header" }
- { "int" "header_fill" }
- { "int" "e_o_s" }
- { "int" "b_o_s" }
- { "long" "serialno" }
- { "long" "pageno" }
- { "longlong" "packetno" }
- { "longlong" "granulepos" } ;
-
-C-STRUCT: ogg_packet
- { "uchar*" "packet" }
- { "long" "bytes" }
- { "long" "b_o_s" }
- { "long" "e_o_s" }
- { "longlong" "granulepos" }
- { "longlong" "packetno" } ;
-
-C-STRUCT: ogg_sync_state
- { "uchar*" "data" }
- { "int" "storage" }
- { "int" "fill" }
- { "int" "returned" }
- { "int" "unsynced" }
- { "int" "headerbytes" }
- { "int" "bodybytes" } ;
-
-FUNCTION: void oggpack_writeinit ( oggpack_buffer* b ) ;
-FUNCTION: void oggpack_writetrunc ( oggpack_buffer* b, long bits ) ;
-FUNCTION: void oggpack_writealign ( oggpack_buffer* b) ;
-FUNCTION: void oggpack_writecopy ( oggpack_buffer* b, void* source, long bits ) ;
-FUNCTION: void oggpack_reset ( oggpack_buffer* b ) ;
-FUNCTION: void oggpack_writeclear ( oggpack_buffer* b ) ;
-FUNCTION: void oggpack_readinit ( oggpack_buffer* b, uchar* buf, int bytes ) ;
-FUNCTION: void oggpack_write ( oggpack_buffer* b, ulong value, int bits ) ;
-FUNCTION: long oggpack_look ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long oggpack_look1 ( oggpack_buffer* b ) ;
-FUNCTION: void oggpack_adv ( oggpack_buffer* b, int bits ) ;
-FUNCTION: void oggpack_adv1 ( oggpack_buffer* b ) ;
-FUNCTION: long oggpack_read ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long oggpack_read1 ( oggpack_buffer* b ) ;
-FUNCTION: long oggpack_bytes ( oggpack_buffer* b ) ;
-FUNCTION: long oggpack_bits ( oggpack_buffer* b ) ;
-FUNCTION: uchar* oggpack_get_buffer ( oggpack_buffer* b ) ;
-FUNCTION: void oggpackB_writeinit ( oggpack_buffer* b ) ;
-FUNCTION: void oggpackB_writetrunc ( oggpack_buffer* b, long bits ) ;
-FUNCTION: void oggpackB_writealign ( oggpack_buffer* b ) ;
-FUNCTION: void oggpackB_writecopy ( oggpack_buffer* b, void* source, long bits ) ;
-FUNCTION: void oggpackB_reset ( oggpack_buffer* b ) ;
-FUNCTION: void oggpackB_writeclear ( oggpack_buffer* b ) ;
-FUNCTION: void oggpackB_readinit ( oggpack_buffer* b, uchar* buf, int bytes ) ;
-FUNCTION: void oggpackB_write ( oggpack_buffer* b, ulong value, int bits ) ;
-FUNCTION: long oggpackB_look ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long oggpackB_look1 ( oggpack_buffer* b ) ;
-FUNCTION: void oggpackB_adv ( oggpack_buffer* b, int bits ) ;
-FUNCTION: void oggpackB_adv1 ( oggpack_buffer* b ) ;
-FUNCTION: long oggpackB_read ( oggpack_buffer* b, int bits ) ;
-FUNCTION: long oggpackB_read1 ( oggpack_buffer* b ) ;
-FUNCTION: long oggpackB_bytes ( oggpack_buffer* b ) ;
-FUNCTION: long oggpackB_bits ( oggpack_buffer* b ) ;
-FUNCTION: uchar* oggpackB_get_buffer ( oggpack_buffer* b ) ;
-FUNCTION: int ogg_stream_packetin ( ogg_stream_state* os, ogg_packet* op ) ;
-FUNCTION: int ogg_stream_pageout ( ogg_stream_state* os, ogg_page* og ) ;
-FUNCTION: int ogg_stream_flush ( ogg_stream_state* os, ogg_page* og ) ;
-FUNCTION: int ogg_sync_init ( ogg_sync_state* oy ) ;
-FUNCTION: int ogg_sync_clear ( ogg_sync_state* oy ) ;
-FUNCTION: int ogg_sync_reset ( ogg_sync_state* oy ) ;
-FUNCTION: int ogg_sync_destroy ( ogg_sync_state* oy ) ;
-
-FUNCTION: void* ogg_sync_buffer ( ogg_sync_state* oy, long size ) ;
-FUNCTION: int ogg_sync_wrote ( ogg_sync_state* oy, long bytes ) ;
-FUNCTION: long ogg_sync_pageseek ( ogg_sync_state* oy, ogg_page* og ) ;
-FUNCTION: int ogg_sync_pageout ( ogg_sync_state* oy, ogg_page* og ) ;
-FUNCTION: int ogg_stream_pagein ( ogg_stream_state* os, ogg_page* og ) ;
-FUNCTION: int ogg_stream_packetout ( ogg_stream_state* os, ogg_packet* op ) ;
-FUNCTION: int ogg_stream_packetpeek ( ogg_stream_state* os, ogg_packet* op ) ;
-FUNCTION: int ogg_stream_init (ogg_stream_state* os, int serialno ) ;
-FUNCTION: int ogg_stream_clear ( ogg_stream_state* os ) ;
-FUNCTION: int ogg_stream_reset ( ogg_stream_state* os ) ;
-FUNCTION: int ogg_stream_reset_serialno ( ogg_stream_state* os, int serialno ) ;
-FUNCTION: int ogg_stream_destroy ( ogg_stream_state* os ) ;
-FUNCTION: int ogg_stream_eos ( ogg_stream_state* os ) ;
-FUNCTION: void ogg_page_checksum_set ( ogg_page* og ) ;
-FUNCTION: int ogg_page_version ( ogg_page* og ) ;
-FUNCTION: int ogg_page_continued ( ogg_page* og ) ;
-FUNCTION: int ogg_page_bos ( ogg_page* og ) ;
-FUNCTION: int ogg_page_eos ( ogg_page* og ) ;
-FUNCTION: longlong ogg_page_granulepos ( ogg_page* og ) ;
-FUNCTION: int ogg_page_serialno ( ogg_page* og ) ;
-FUNCTION: long ogg_page_pageno ( ogg_page* og ) ;
-FUNCTION: int ogg_page_packets ( ogg_page* og ) ;
-FUNCTION: void ogg_packet_clear ( ogg_packet* op ) ;
-
+++ /dev/null
-Ogg media library binding
+++ /dev/null
-bindings
-audio
-video
+++ /dev/null
-Chris Double
+++ /dev/null
-Ogg Theora video library binding
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel system combinators alien alien.syntax ;
-IN: ogg.theora
-
-<<
-"theora" {
- { [ os winnt? ] [ "theora.dll" ] }
- { [ os macosx? ] [ "libtheora.0.dylib" ] }
- { [ os unix? ] [ "libtheora.so" ] }
-} cond "cdecl" add-library
->>
-
-LIBRARY: theora
-
-C-STRUCT: yuv_buffer
- { "int" "y_width" }
- { "int" "y_height" }
- { "int" "y_stride" }
- { "int" "uv_width" }
- { "int" "uv_height" }
- { "int" "uv_stride" }
- { "void*" "y" }
- { "void*" "u" }
- { "void*" "v" } ;
-
-: OC_CS_UNSPECIFIED ( -- number ) 0 ; inline
-: OC_CS_ITU_REC_470M ( -- number ) 1 ; inline
-: OC_CS_ITU_REC_470BG ( -- number ) 2 ; inline
-: OC_CS_NSPACES ( -- number ) 3 ; inline
-
-TYPEDEF: int theora_colorspace
-
-: OC_PF_420 ( -- number ) 0 ; inline
-: OC_PF_RSVD ( -- number ) 1 ; inline
-: OC_PF_422 ( -- number ) 2 ; inline
-: OC_PF_444 ( -- number ) 3 ; inline
-
-TYPEDEF: int theora_pixelformat
-
-C-STRUCT: theora_info
- { "uint" "width" }
- { "uint" "height" }
- { "uint" "frame_width" }
- { "uint" "frame_height" }
- { "uint" "offset_x" }
- { "uint" "offset_y" }
- { "uint" "fps_numerator" }
- { "uint" "fps_denominator" }
- { "uint" "aspect_numerator" }
- { "uint" "aspect_denominator" }
- { "theora_colorspace" "colorspace" }
- { "int" "target_bitrate" }
- { "int" "quality" }
- { "int" "quick_p" }
- { "uchar" "version_major" }
- { "uchar" "version_minor" }
- { "uchar" "version_subminor" }
- { "void*" "codec_setup" }
- { "int" "dropframes_p" }
- { "int" "keyframe_auto_p" }
- { "uint" "keyframe_frequency" }
- { "uint" "keyframe_frequency_force" }
- { "uint" "keyframe_data_target_bitrate" }
- { "int" "keyframe_auto_threshold" }
- { "uint" "keyframe_mindistance" }
- { "int" "noise_sensitivity" }
- { "int" "sharpness" }
- { "theora_pixelformat" "pixelformat" } ;
-
-C-STRUCT: theora_state
- { "theora_info*" "i" }
- { "longlong" "granulepos" }
- { "void*" "internal_encode" }
- { "void*" "internal_decode" } ;
-
-C-STRUCT: theora_comment
- { "char**" "user_comments" }
- { "int*" "comment_lengths" }
- { "int" "comments" }
- { "char*" "vendor" } ;
-
-: OC_FAULT ( -- number ) -1 ; inline
-: OC_EINVAL ( -- number ) -10 ; inline
-: OC_DISABLED ( -- number ) -11 ; inline
-: OC_BADHEADER ( -- number ) -20 ; inline
-: OC_NOTFORMAT ( -- number ) -21 ; inline
-: OC_VERSION ( -- number ) -22 ; inline
-: OC_IMPL ( -- number ) -23 ; inline
-: OC_BADPACKET ( -- number ) -24 ; inline
-: OC_NEWPACKET ( -- number ) -25 ; inline
-: OC_DUPFRAME ( -- number ) 1 ; inline
-
-FUNCTION: char* theora_version_string ( ) ;
-FUNCTION: uint theora_version_number ( ) ;
-FUNCTION: int theora_encode_init ( theora_state* th, theora_info* ti ) ;
-FUNCTION: int theora_encode_YUVin ( theora_state* t, yuv_buffer* yuv ) ;
-FUNCTION: int theora_encode_packetout ( theora_state* t, int last_p, ogg_packet* op ) ;
-FUNCTION: int theora_encode_header ( theora_state* t, ogg_packet* op ) ;
-FUNCTION: int theora_encode_comment ( theora_comment* tc, ogg_packet* op ) ;
-FUNCTION: int theora_encode_tables ( theora_state* t, ogg_packet* op ) ;
-FUNCTION: int theora_decode_header ( theora_info* ci, theora_comment* cc, ogg_packet* op ) ;
-FUNCTION: int theora_decode_init ( theora_state* th, theora_info* c ) ;
-FUNCTION: int theora_decode_packetin ( theora_state* th, ogg_packet* op ) ;
-FUNCTION: int theora_decode_YUVout ( theora_state* th, yuv_buffer* yuv ) ;
-FUNCTION: int theora_packet_isheader ( ogg_packet* op ) ;
-FUNCTION: int theora_packet_iskeyframe ( ogg_packet* op ) ;
-FUNCTION: int theora_granule_shift ( theora_info* ti ) ;
-FUNCTION: longlong theora_granule_frame ( theora_state* th, longlong granulepos ) ;
-FUNCTION: double theora_granule_time ( theora_state* th, longlong granulepos ) ;
-FUNCTION: void theora_info_init ( theora_info* c ) ;
-FUNCTION: void theora_info_clear ( theora_info* c ) ;
-FUNCTION: void theora_clear ( theora_state* t ) ;
-FUNCTION: void theora_comment_init ( theora_comment* tc ) ;
-FUNCTION: void theora_comment_add ( theora_comment* tc, char* comment ) ;
-FUNCTION: void theora_comment_add_tag ( theora_comment* tc, char* tag, char* value ) ;
-FUNCTION: char* theora_comment_query ( theora_comment* tc, char* tag, int count ) ;
-FUNCTION: int theora_comment_query_count ( theora_comment* tc, char* tag ) ;
-FUNCTION: void theora_comment_clear ( theora_comment* tc ) ;
+++ /dev/null
-Chris Double
+++ /dev/null
-Ogg Vorbis audio library binding
+++ /dev/null
-! Copyright (C) 2007 Chris Double.
-! See http://factorcode.org/license.txt for BSD license.
-!
-USING: kernel system combinators alien alien.syntax ogg ;
-IN: ogg.vorbis
-
-<<
-"vorbis" {
- { [ os winnt? ] [ "vorbis.dll" ] }
- { [ os macosx? ] [ "libvorbis.0.dylib" ] }
- { [ os unix? ] [ "libvorbis.so" ] }
-} cond "cdecl" add-library
->>
-
-LIBRARY: vorbis
-
-C-STRUCT: vorbis_info
- { "int" "version" }
- { "int" "channels" }
- { "long" "rate" }
- { "long" "bitrate_upper" }
- { "long" "bitrate_nominal" }
- { "long" "bitrate_lower" }
- { "long" "bitrate_window" }
- { "void*" "codec_setup"}
- ;
-
-C-STRUCT: vorbis_dsp_state
- { "int" "analysisp" }
- { "vorbis_info*" "vi" }
- { "float**" "pcm" }
- { "float**" "pcmret" }
- { "int" "pcm_storage" }
- { "int" "pcm_current" }
- { "int" "pcm_returned" }
- { "int" "preextrapolate" }
- { "int" "eofflag" }
- { "long" "lW" }
- { "long" "W" }
- { "long" "nW" }
- { "long" "centerW" }
- { "longlong" "granulepos" }
- { "longlong" "sequence" }
- { "longlong" "glue_bits" }
- { "longlong" "time_bits" }
- { "longlong" "floor_bits" }
- { "longlong" "res_bits" }
- { "void*" "backend_state" }
- ;
-
-C-STRUCT: alloc_chain
- { "void*" "ptr" }
- { "void*" "next" }
- ;
-
-C-STRUCT: vorbis_block
- { "float**" "pcm" }
- { "oggpack_buffer" "opb" }
- { "long" "lW" }
- { "long" "W" }
- { "long" "nW" }
- { "int" "pcmend" }
- { "int" "mode" }
- { "int" "eofflag" }
- { "longlong" "granulepos" }
- { "longlong" "sequence" }
- { "vorbis_dsp_state*" "vd" }
- { "void*" "localstore" }
- { "long" "localtop" }
- { "long" "localalloc" }
- { "long" "totaluse" }
- { "alloc_chain*" "reap" }
- { "long" "glue_bits" }
- { "long" "time_bits" }
- { "long" "floor_bits" }
- { "long" "res_bits" }
- { "void*" "internal" }
- ;
-
-C-STRUCT: vorbis_comment
- { "char**" "usercomments" }
- { "int*" "comment_lengths" }
- { "int" "comments" }
- { "char*" "vendor" }
- ;
-
-FUNCTION: void vorbis_info_init ( vorbis_info* vi ) ;
-FUNCTION: void vorbis_info_clear ( vorbis_info* vi ) ;
-FUNCTION: int vorbis_info_blocksize ( vorbis_info* vi, int zo ) ;
-FUNCTION: void vorbis_comment_init ( vorbis_comment* vc ) ;
-FUNCTION: void vorbis_comment_add ( vorbis_comment* vc, char* comment ) ;
-FUNCTION: void vorbis_comment_add_tag ( vorbis_comment* vc, char* tag, char* contents ) ;
-FUNCTION: char* vorbis_comment_query ( vorbis_comment* vc, char* tag, int count ) ;
-FUNCTION: int vorbis_comment_query_count ( vorbis_comment* vc, char* tag ) ;
-FUNCTION: void vorbis_comment_clear ( vorbis_comment* vc ) ;
-FUNCTION: int vorbis_block_init ( vorbis_dsp_state* v, vorbis_block* vb ) ;
-FUNCTION: int vorbis_block_clear ( vorbis_block* vb ) ;
-FUNCTION: void vorbis_dsp_clear ( vorbis_dsp_state* v ) ;
-FUNCTION: double vorbis_granule_time ( vorbis_dsp_state* v, longlong granulepos ) ;
-FUNCTION: int vorbis_analysis_init ( vorbis_dsp_state* v, vorbis_info* vi ) ;
-FUNCTION: int vorbis_commentheader_out ( vorbis_comment* vc, ogg_packet* op ) ;
-FUNCTION: int vorbis_analysis_headerout ( vorbis_dsp_state* v,
- vorbis_comment* vc,
- ogg_packet* op,
- ogg_packet* op_comm,
- ogg_packet* op_code ) ;
-FUNCTION: float** vorbis_analysis_buffer ( vorbis_dsp_state* v, int vals ) ;
-FUNCTION: int vorbis_analysis_wrote ( vorbis_dsp_state* v, int vals ) ;
-FUNCTION: int vorbis_analysis_blockout ( vorbis_dsp_state* v, vorbis_block* vb ) ;
-FUNCTION: int vorbis_analysis ( vorbis_block* vb, ogg_packet* op ) ;
-FUNCTION: int vorbis_bitrate_addblock ( vorbis_block* vb ) ;
-FUNCTION: int vorbis_bitrate_flushpacket ( vorbis_dsp_state* vd,
- ogg_packet* op ) ;
-FUNCTION: int vorbis_synthesis_headerin ( vorbis_info* vi, vorbis_comment* vc,
- ogg_packet* op ) ;
-FUNCTION: int vorbis_synthesis_init ( vorbis_dsp_state* v, vorbis_info* vi ) ;
-FUNCTION: int vorbis_synthesis_restart ( vorbis_dsp_state* v ) ;
-FUNCTION: int vorbis_synthesis ( vorbis_block* vb, ogg_packet* op ) ;
-FUNCTION: int vorbis_synthesis_trackonly ( vorbis_block* vb, ogg_packet* op ) ;
-FUNCTION: int vorbis_synthesis_blockin ( vorbis_dsp_state* v, vorbis_block* vb ) ;
-FUNCTION: int vorbis_synthesis_pcmout ( vorbis_dsp_state* v, float*** pcm ) ;
-FUNCTION: int vorbis_synthesis_lapout ( vorbis_dsp_state* v, float*** pcm ) ;
-FUNCTION: int vorbis_synthesis_read ( vorbis_dsp_state* v, int samples ) ;
-FUNCTION: long vorbis_packet_blocksize ( vorbis_info* vi, ogg_packet* op ) ;
-FUNCTION: int vorbis_synthesis_halfrate ( vorbis_info* v, int flag ) ;
-FUNCTION: int vorbis_synthesis_halfrate_p ( vorbis_info* v ) ;
-
-: OV_FALSE ( -- number ) -1 ; inline
-: OV_EOF ( -- number ) -2 ; inline
-: OV_HOLE ( -- number ) -3 ; inline
-: OV_EREAD ( -- number ) -128 ; inline
-: OV_EFAULT ( -- number ) -129 ; inline
-: OV_EIMPL ( -- number ) -130 ; inline
-: OV_EINVAL ( -- number ) -131 ; inline
-: OV_ENOTVORBIS ( -- number ) -132 ; inline
-: OV_EBADHEADER ( -- number ) -133 ; inline
-: OV_EVERSION ( -- number ) -134 ; inline
-: OV_ENOTAUDIO ( -- number ) -135 ; inline
-: OV_EBADPACKET ( -- number ) -136 ; inline
-: OV_EBADLINK ( -- number ) -137 ; inline
-: OV_ENOSEEK ( -- number ) -138 ; inline
ARTICLE: "ui.offscreen" "Offscreen UI rendering"
"The " { $vocab-link "ui.offscreen" } " provides words for rendering gadgets to an offscreen buffer so that bitmaps can be made from their contents."
-{ $subsection offscreen-world }
+{ $subsections offscreen-world }
"Opening gadgets offscreen:"
-{ $subsection open-offscreen }
-{ $subsection close-offscreen }
-{ $subsection do-offscreen }
+{ $subsections
+ open-offscreen
+ close-offscreen
+ do-offscreen
+}
"Creating bitmaps from offscreen buffers:"
-{ $subsection offscreen-world>bitmap }
-{ $subsection gadget>bitmap } ;
+{ $subsections
+ offscreen-world>bitmap
+ gadget>bitmap
+} ;
ABOUT: "ui.offscreen"
include vm/Config.macosx
include vm/Config.ppc
-CFLAGS += -arch ppc
+CFLAGS += -arch ppc -force_cpusubtype_ALL
include vm/Config.unix
PLAF_DLL_OBJS += vm/os-genunix.o vm/os-netbsd.o
CFLAGS += -export-dynamic
-LIBPATH = -L/usr/X11R6/lib -Wl,-rpath,/usr/X11R6/lib -L/usr/pkg/lib -Wl,-rpath,/usr/pkg/lib
+LIBPATH = -L/usr/X11R7/lib -Wl,-rpath,/usr/X11R7/lib -L/usr/pkg/lib -Wl,-rpath,/usr/pkg/lib
LIBS = -lm -lssl -lcrypto $(X11_UI_LIBS)
/* gets the address of an object representing a C pointer, with the
intention of storing the pointer across code which may potentially GC. */
-char *pinned_alien_offset(cell obj)
+char *factor_vm::pinned_alien_offset(cell obj)
{
switch(tagged<object>(obj).type())
{
}
/* make an alien */
-cell allot_alien(cell delegate_, cell displacement)
+cell factor_vm::allot_alien(cell delegate_, cell displacement)
{
- gc_root<object> delegate(delegate_);
- gc_root<alien> new_alien(allot<alien>(sizeof(alien)));
+ gc_root<object> delegate(delegate_,this);
+ gc_root<alien> new_alien(allot<alien>(sizeof(alien)),this);
if(delegate.type_p(ALIEN_TYPE))
{
}
/* make an alien pointing at an offset of another alien */
-PRIMITIVE(displaced_alien)
+void factor_vm::primitive_displaced_alien()
{
cell alien = dpop();
cell displacement = to_cell(dpop());
/* address of an object representing a C pointer. Explicitly throw an error
if the object is a byte array, as a sanity check. */
-PRIMITIVE(alien_address)
+void factor_vm::primitive_alien_address()
{
box_unsigned_cell((cell)pinned_alien_offset(dpop()));
}
/* pop ( alien n ) from datastack, return alien's address plus n */
-static void *alien_pointer()
+void *factor_vm::alien_pointer()
{
fixnum offset = to_fixnum(dpop());
return unbox_alien() + offset;
#define DEFINE_ALIEN_ACCESSOR(name,type,boxer,to) \
PRIMITIVE(alien_##name) \
{ \
- boxer(*(type*)alien_pointer()); \
+ PRIMITIVE_GETVM()->boxer(*(type*)PRIMITIVE_GETVM()->alien_pointer()); \
} \
PRIMITIVE(set_alien_##name) \
{ \
- type *ptr = (type *)alien_pointer(); \
- type value = to(dpop()); \
+ type *ptr = (type *)PRIMITIVE_GETVM()->alien_pointer(); \
+ type value = PRIMITIVE_GETVM()->to(dpop()); \
*ptr = value; \
}
DEFINE_ALIEN_ACCESSOR(cell,void *,box_alien,pinned_alien_offset)
/* open a native library and push a handle */
-PRIMITIVE(dlopen)
+void factor_vm::primitive_dlopen()
{
- gc_root<byte_array> path(dpop());
- path.untag_check();
- gc_root<dll> library(allot<dll>(sizeof(dll)));
+ gc_root<byte_array> path(dpop(),this);
+ path.untag_check(this);
+ gc_root<dll> library(allot<dll>(sizeof(dll)),this);
library->path = path.value();
ffi_dlopen(library.untagged());
dpush(library.value());
}
/* look up a symbol in a native library */
-PRIMITIVE(dlsym)
+void factor_vm::primitive_dlsym()
{
- gc_root<object> library(dpop());
- gc_root<byte_array> name(dpop());
- name.untag_check();
+ gc_root<object> library(dpop(),this);
+ gc_root<byte_array> name(dpop(),this);
+ name.untag_check(this);
symbol_char *sym = name->data<symbol_char>();
}
/* close a native library handle */
-PRIMITIVE(dlclose)
+void factor_vm::primitive_dlclose()
{
dll *d = untag_check<dll>(dpop());
if(d->dll != NULL)
ffi_dlclose(d);
}
-PRIMITIVE(dll_validp)
+void factor_vm::primitive_dll_validp()
{
cell library = dpop();
if(library == F)
}
/* gets the address of an object representing a C pointer */
-VM_C_API char *alien_offset(cell obj)
+char *factor_vm::alien_offset(cell obj)
{
switch(tagged<object>(obj).type())
{
}
}
+VM_C_API char *alien_offset(cell obj, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->alien_offset(obj);
+}
+
/* pop an object representing a C pointer */
-VM_C_API char *unbox_alien()
+char *factor_vm::unbox_alien()
{
return alien_offset(dpop());
}
+VM_C_API char *unbox_alien(factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->unbox_alien();
+}
+
/* make an alien and push */
-VM_C_API void box_alien(void *ptr)
+void factor_vm::box_alien(void *ptr)
{
if(ptr == NULL)
dpush(F);
dpush(allot_alien(F,(cell)ptr));
}
+VM_C_API void box_alien(void *ptr, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_alien(ptr);
+}
+
/* for FFI calls passing structs by value */
-VM_C_API void to_value_struct(cell src, void *dest, cell size)
+void factor_vm::to_value_struct(cell src, void *dest, cell size)
{
memcpy(dest,alien_offset(src),size);
}
+VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_value_struct(src,dest,size);
+}
+
/* for FFI callbacks receiving structs by value */
-VM_C_API void box_value_struct(void *src, cell size)
+void factor_vm::box_value_struct(void *src, cell size)
{
byte_array *bytes = allot_byte_array(size);
memcpy(bytes->data<void>(),src,size);
dpush(tag<byte_array>(bytes));
}
+VM_C_API void box_value_struct(void *src, cell size,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_value_struct(src,size);
+}
+
/* On some x86 OSes, structs <= 8 bytes are returned in registers. */
-VM_C_API void box_small_struct(cell x, cell y, cell size)
+void factor_vm::box_small_struct(cell x, cell y, cell size)
{
cell data[2];
data[0] = x;
box_value_struct(data,size);
}
+VM_C_API void box_small_struct(cell x, cell y, cell size, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_small_struct(x,y,size);
+}
+
/* On OS X/PPC, complex numbers are returned in registers. */
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
+void factor_vm::box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size)
{
cell data[4];
data[0] = x1;
box_value_struct(data,size);
}
+VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_medium_struct(x1, x2, x3, x4, size);
+}
+
+void factor_vm::primitive_vm_ptr()
+{
+ box_alien(this);
+}
+
}
namespace factor
{
-cell allot_alien(cell delegate, cell displacement);
-
-PRIMITIVE(displaced_alien);
-PRIMITIVE(alien_address);
-
-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(dlopen);
-PRIMITIVE(dlsym);
-PRIMITIVE(dlclose);
-PRIMITIVE(dll_validp);
-
-VM_C_API char *alien_offset(cell object);
-VM_C_API char *unbox_alien();
-VM_C_API void box_alien(void *ptr);
-VM_C_API void to_value_struct(cell src, void *dest, cell size);
-VM_C_API void box_value_struct(void *src, cell size);
-VM_C_API void box_small_struct(cell x, cell y, cell size);
-VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
+VM_C_API char *alien_offset(cell object, factor_vm *vm);
+VM_C_API char *unbox_alien(factor_vm *vm);
+VM_C_API void box_alien(void *ptr, factor_vm *vm);
+VM_C_API void to_value_struct(cell src, void *dest, cell size, factor_vm *vm);
+VM_C_API void box_value_struct(void *src, cell size,factor_vm *vm);
+VM_C_API void box_small_struct(cell x, cell y, cell size,factor_vm *vm);
+VM_C_API void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size,factor_vm *vm);
}
{
/* make a new array with an initial element */
-array *allot_array(cell capacity, cell fill_)
+array *factor_vm::allot_array(cell capacity, cell fill_)
{
- gc_root<object> fill(fill_);
- gc_root<array> new_array(allot_array_internal<array>(capacity));
+ gc_root<object> fill(fill_,this);
+ gc_root<array> new_array(allot_array_internal<array>(capacity),this);
if(fill.value() == tag_fixnum(0))
memset(new_array->data(),'\0',capacity * sizeof(cell));
}
/* push a new array on the stack */
-PRIMITIVE(array)
+void factor_vm::primitive_array()
{
cell initial = dpop();
cell size = unbox_array_size();
dpush(tag<array>(allot_array(size,initial)));
}
-cell allot_array_1(cell obj_)
+cell factor_vm::allot_array_1(cell obj_)
{
- gc_root<object> obj(obj_);
- gc_root<array> a(allot_array_internal<array>(1));
+ gc_root<object> obj(obj_,this);
+ gc_root<array> a(allot_array_internal<array>(1),this);
set_array_nth(a.untagged(),0,obj.value());
return a.value();
}
-cell allot_array_2(cell v1_, cell v2_)
+cell factor_vm::allot_array_2(cell v1_, cell v2_)
{
- gc_root<object> v1(v1_);
- gc_root<object> v2(v2_);
- gc_root<array> a(allot_array_internal<array>(2));
+ gc_root<object> v1(v1_,this);
+ gc_root<object> v2(v2_,this);
+ gc_root<array> a(allot_array_internal<array>(2),this);
set_array_nth(a.untagged(),0,v1.value());
set_array_nth(a.untagged(),1,v2.value());
return a.value();
}
-cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
+cell factor_vm::allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_)
{
- gc_root<object> v1(v1_);
- gc_root<object> v2(v2_);
- gc_root<object> v3(v3_);
- gc_root<object> v4(v4_);
- gc_root<array> a(allot_array_internal<array>(4));
+ gc_root<object> v1(v1_,this);
+ gc_root<object> v2(v2_,this);
+ gc_root<object> v3(v3_,this);
+ gc_root<object> v4(v4_,this);
+ gc_root<array> a(allot_array_internal<array>(4),this);
set_array_nth(a.untagged(),0,v1.value());
set_array_nth(a.untagged(),1,v2.value());
set_array_nth(a.untagged(),2,v3.value());
return a.value();
}
-PRIMITIVE(resize_array)
+void factor_vm::primitive_resize_array()
{
array* a = untag_check<array>(dpop());
cell capacity = unbox_array_size();
void growable_array::add(cell elt_)
{
- gc_root<object> elt(elt_);
+ factor_vm* parent_vm = elements.parent_vm;
+ gc_root<object> elt(elt_,parent_vm);
if(count == array_capacity(elements.untagged()))
- elements = reallot_array(elements.untagged(),count * 2);
+ elements = parent_vm->reallot_array(elements.untagged(),count * 2);
- set_array_nth(elements.untagged(),count++,elt.value());
+ parent_vm->set_array_nth(elements.untagged(),count++,elt.value());
}
void growable_array::trim()
{
- elements = reallot_array(elements.untagged(),count);
+ factor_vm *parent_vm = elements.parent_vm;
+ elements = parent_vm->reallot_array(elements.untagged(),count);
}
}
namespace factor
{
-inline static cell array_nth(array *array, cell slot)
+inline cell array_nth(array *array, cell slot)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
return array->data()[slot];
}
-inline static void set_array_nth(array *array, cell slot, cell value)
+inline void factor_vm::set_array_nth(array *array, cell slot, cell value)
{
#ifdef FACTOR_DEBUG
assert(slot < array_capacity(array));
write_barrier(array);
}
-array *allot_array(cell capacity, cell fill);
-
-cell allot_array_1(cell obj);
-cell allot_array_2(cell v1, cell v2);
-cell allot_array_4(cell v1, cell v2, cell v3, cell v4);
-
-PRIMITIVE(array);
-PRIMITIVE(resize_array);
-
struct growable_array {
cell count;
gc_root<array> elements;
- growable_array(cell capacity = 10) : count(0), elements(allot_array(capacity,F)) {}
+ explicit growable_array(factor_vm *myvm, cell capacity = 10) : count(0), elements(myvm->allot_array(capacity,F),myvm) {}
void add(cell elt);
void trim();
-/* :tabSize=2:indentSize=2:noTabs=true:
-
-Copyright (C) 1989-94 Massachusetts Institute of Technology
-Portions copyright (C) 2004-2008 Slava Pestov
-
-This material was developed by the Scheme project at the Massachusetts
-Institute of Technology, Department of Electrical Engineering and
-Computer Science. Permission to copy and modify this software, to
-redistribute either the original software or a modified version, and
-to use this software for any purpose is granted, subject to the
-following restrictions and understandings.
-
-1. Any copy made of this software must include this copyright notice
-in full.
-
-2. Users of this software agree to make their best efforts (a) to
-return to the MIT Scheme project any improvements or extensions that
-they make, so that these may be included in future releases; and (b)
-to inform MIT of noteworthy uses of this software.
-
-3. All materials developed as a consequence of the use of this
-software shall duly acknowledge such use, in accordance with the usual
-standards of acknowledging credit in academic research.
-
-4. MIT has made no warrantee or representation that the operation of
-this software will be error-free, and MIT is under no obligation to
-provide any services, by way of maintenance, update, or otherwise.
-
-5. In conjunction with products arising from the use of this material,
-there shall be no use of the name of the Massachusetts Institute of
-Technology nor of any adaptation thereof in any advertising,
-promotional, or sales literature without prior written consent from
-MIT in each case. */
+/*
+ Copyright (C) 1989-94 Massachusetts Institute of Technology
+ Portions copyright (C) 2004-2008 Slava Pestov
+
+ This material was developed by the Scheme project at the Massachusetts
+ Institute of Technology, Department of Electrical Engineering and
+ Computer Science. Permission to copy and modify this software, to
+ redistribute either the original software or a modified version, and
+ to use this software for any purpose is granted, subject to the
+ following restrictions and understandings.
+
+ 1. Any copy made of this software must include this copyright notice
+ in full.
+
+ 2. Users of this software agree to make their best efforts (a) to
+ return to the MIT Scheme project any improvements or extensions that
+ they make, so that these may be included in future releases; and (b)
+ to inform MIT of noteworthy uses of this software.
+
+ 3. All materials developed as a consequence of the use of this
+ software shall duly acknowledge such use, in accordance with the usual
+ standards of acknowledging credit in academic research.
+
+ 4. MIT has made no warrantee or representation that the operation of
+ this software will be error-free, and MIT is under no obligation to
+ provide any services, by way of maintenance, update, or otherwise.
+
+ 5. In conjunction with products arising from the use of this material,
+ there shall be no use of the name of the Massachusetts Institute of
+ Technology nor of any adaptation thereof in any advertising,
+ promotional, or sales literature without prior written consent from
+ MIT in each case. */
/* Changes for Scheme 48:
* - Converted to ANSI.
/* Exports */
-int
-bignum_equal_p(bignum * x, bignum * y)
+int factor_vm::bignum_equal_p(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? (BIGNUM_ZERO_P (y))
- : ((! (BIGNUM_ZERO_P (y)))
- && ((BIGNUM_NEGATIVE_P (x))
- ? (BIGNUM_NEGATIVE_P (y))
- : (! (BIGNUM_NEGATIVE_P (y))))
- && (bignum_equal_p_unsigned (x, y))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? (BIGNUM_ZERO_P (y))
+ : ((! (BIGNUM_ZERO_P (y)))
+ && ((BIGNUM_NEGATIVE_P (x))
+ ? (BIGNUM_NEGATIVE_P (y))
+ : (! (BIGNUM_NEGATIVE_P (y))))
+ && (bignum_equal_p_unsigned (x, y))));
}
-enum bignum_comparison
-bignum_compare(bignum * x, bignum * y)
+enum bignum_comparison factor_vm::bignum_compare(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? ((BIGNUM_ZERO_P (y))
- ? bignum_comparison_equal
- : (BIGNUM_NEGATIVE_P (y))
- ? bignum_comparison_greater
- : bignum_comparison_less)
- : (BIGNUM_ZERO_P (y))
- ? ((BIGNUM_NEGATIVE_P (x))
- ? bignum_comparison_less
- : bignum_comparison_greater)
- : (BIGNUM_NEGATIVE_P (x))
- ? ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_compare_unsigned (y, x))
- : (bignum_comparison_less))
- : ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_comparison_greater)
- : (bignum_compare_unsigned (x, y))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? ((BIGNUM_ZERO_P (y))
+ ? bignum_comparison_equal
+ : (BIGNUM_NEGATIVE_P (y))
+ ? bignum_comparison_greater
+ : bignum_comparison_less)
+ : (BIGNUM_ZERO_P (y))
+ ? ((BIGNUM_NEGATIVE_P (x))
+ ? bignum_comparison_less
+ : bignum_comparison_greater)
+ : (BIGNUM_NEGATIVE_P (x))
+ ? ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_compare_unsigned (y, x))
+ : (bignum_comparison_less))
+ : ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_comparison_greater)
+ : (bignum_compare_unsigned (x, y))));
}
/* allocates memory */
-bignum *
-bignum_add(bignum * x, bignum * y)
+bignum *factor_vm::bignum_add(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? (y)
- : (BIGNUM_ZERO_P (y))
- ? (x)
- : ((BIGNUM_NEGATIVE_P (x))
- ? ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_add_unsigned (x, y, 1))
- : (bignum_subtract_unsigned (y, x)))
- : ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_subtract_unsigned (x, y))
- : (bignum_add_unsigned (x, y, 0)))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? (y)
+ : (BIGNUM_ZERO_P (y))
+ ? (x)
+ : ((BIGNUM_NEGATIVE_P (x))
+ ? ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_add_unsigned (x, y, 1))
+ : (bignum_subtract_unsigned (y, x)))
+ : ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_subtract_unsigned (x, y))
+ : (bignum_add_unsigned (x, y, 0)))));
}
/* allocates memory */
-bignum *
-bignum_subtract(bignum * x, bignum * y)
+bignum *factor_vm::bignum_subtract(bignum * x, bignum * y)
{
- return
- ((BIGNUM_ZERO_P (x))
- ? ((BIGNUM_ZERO_P (y))
- ? (y)
- : (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
- : ((BIGNUM_ZERO_P (y))
- ? (x)
- : ((BIGNUM_NEGATIVE_P (x))
- ? ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_subtract_unsigned (y, x))
- : (bignum_add_unsigned (x, y, 1)))
- : ((BIGNUM_NEGATIVE_P (y))
- ? (bignum_add_unsigned (x, y, 0))
- : (bignum_subtract_unsigned (x, y))))));
+ return
+ ((BIGNUM_ZERO_P (x))
+ ? ((BIGNUM_ZERO_P (y))
+ ? (y)
+ : (bignum_new_sign (y, (! (BIGNUM_NEGATIVE_P (y))))))
+ : ((BIGNUM_ZERO_P (y))
+ ? (x)
+ : ((BIGNUM_NEGATIVE_P (x))
+ ? ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_subtract_unsigned (y, x))
+ : (bignum_add_unsigned (x, y, 1)))
+ : ((BIGNUM_NEGATIVE_P (y))
+ ? (bignum_add_unsigned (x, y, 0))
+ : (bignum_subtract_unsigned (x, y))))));
}
/* allocates memory */
-bignum *
-bignum_multiply(bignum * x, bignum * y)
+bignum *factor_vm::bignum_multiply(bignum * x, bignum * y)
{
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum_length_type y_length = (BIGNUM_LENGTH (y));
- int negative_p =
- ((BIGNUM_NEGATIVE_P (x))
- ? (! (BIGNUM_NEGATIVE_P (y)))
- : (BIGNUM_NEGATIVE_P (y)));
- if (BIGNUM_ZERO_P (x))
- return (x);
- if (BIGNUM_ZERO_P (y))
- return (y);
- if (x_length == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (x, 0));
- if (digit == 1)
- return (bignum_maybe_new_sign (y, negative_p));
- if (digit < BIGNUM_RADIX_ROOT)
- return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
- }
- if (y_length == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (y, 0));
- if (digit == 1)
- return (bignum_maybe_new_sign (x, negative_p));
- if (digit < BIGNUM_RADIX_ROOT)
- return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
- }
- return (bignum_multiply_unsigned (x, y, negative_p));
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ bignum_length_type y_length = (BIGNUM_LENGTH (y));
+ int negative_p =
+ ((BIGNUM_NEGATIVE_P (x))
+ ? (! (BIGNUM_NEGATIVE_P (y)))
+ : (BIGNUM_NEGATIVE_P (y)));
+ if (BIGNUM_ZERO_P (x))
+ return (x);
+ if (BIGNUM_ZERO_P (y))
+ return (y);
+ if (x_length == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (x, 0));
+ if (digit == 1)
+ return (bignum_maybe_new_sign (y, negative_p));
+ if (digit < BIGNUM_RADIX_ROOT)
+ return (bignum_multiply_unsigned_small_factor (y, digit, negative_p));
+ }
+ if (y_length == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (y, 0));
+ if (digit == 1)
+ return (bignum_maybe_new_sign (x, negative_p));
+ if (digit < BIGNUM_RADIX_ROOT)
+ return (bignum_multiply_unsigned_small_factor (x, digit, negative_p));
+ }
+ return (bignum_multiply_unsigned (x, y, negative_p));
}
/* allocates memory */
-void
-bignum_divide(bignum * numerator, bignum * denominator,
- bignum * * quotient, bignum * * remainder)
+void factor_vm::bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder)
{
- if (BIGNUM_ZERO_P (denominator))
- {
- divide_by_zero_error();
- return;
- }
- if (BIGNUM_ZERO_P (numerator))
- {
- (*quotient) = numerator;
- (*remainder) = numerator;
- }
- else
- {
- int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
- int q_negative_p =
- ((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
- switch (bignum_compare_unsigned (numerator, denominator))
- {
- case bignum_comparison_equal:
- {
- (*quotient) = (BIGNUM_ONE (q_negative_p));
- (*remainder) = (BIGNUM_ZERO ());
- break;
- }
- case bignum_comparison_less:
- {
- (*quotient) = (BIGNUM_ZERO ());
- (*remainder) = numerator;
- break;
- }
- case bignum_comparison_greater:
- {
- if ((BIGNUM_LENGTH (denominator)) == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
- if (digit == 1)
- {
- (*quotient) =
- (bignum_maybe_new_sign (numerator, q_negative_p));
- (*remainder) = (BIGNUM_ZERO ());
- break;
- }
- else if (digit < BIGNUM_RADIX_ROOT)
- {
- bignum_divide_unsigned_small_denominator
- (numerator, digit,
- quotient, remainder,
- q_negative_p, r_negative_p);
- break;
- }
- else
- {
- bignum_divide_unsigned_medium_denominator
- (numerator, digit,
- quotient, remainder,
- q_negative_p, r_negative_p);
- break;
- }
- }
- bignum_divide_unsigned_large_denominator
- (numerator, denominator,
- quotient, remainder,
- q_negative_p, r_negative_p);
- break;
- }
- }
- }
+ if (BIGNUM_ZERO_P (denominator))
+ {
+ divide_by_zero_error();
+ return;
+ }
+ if (BIGNUM_ZERO_P (numerator))
+ {
+ (*quotient) = numerator;
+ (*remainder) = numerator;
+ }
+ else
+ {
+ int r_negative_p = (BIGNUM_NEGATIVE_P (numerator));
+ int q_negative_p =
+ ((BIGNUM_NEGATIVE_P (denominator)) ? (! r_negative_p) : r_negative_p);
+ switch (bignum_compare_unsigned (numerator, denominator))
+ {
+ case bignum_comparison_equal:
+ {
+ (*quotient) = (BIGNUM_ONE (q_negative_p));
+ (*remainder) = (BIGNUM_ZERO ());
+ break;
+ }
+ case bignum_comparison_less:
+ {
+ (*quotient) = (BIGNUM_ZERO ());
+ (*remainder) = numerator;
+ break;
+ }
+ case bignum_comparison_greater:
+ {
+ if ((BIGNUM_LENGTH (denominator)) == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
+ if (digit == 1)
+ {
+ (*quotient) =
+ (bignum_maybe_new_sign (numerator, q_negative_p));
+ (*remainder) = (BIGNUM_ZERO ());
+ break;
+ }
+ else if (digit < BIGNUM_RADIX_ROOT)
+ {
+ bignum_divide_unsigned_small_denominator
+ (numerator, digit,
+ quotient, remainder,
+ q_negative_p, r_negative_p);
+ break;
+ }
+ else
+ {
+ bignum_divide_unsigned_medium_denominator
+ (numerator, digit,
+ quotient, remainder,
+ q_negative_p, r_negative_p);
+ break;
+ }
+ }
+ bignum_divide_unsigned_large_denominator
+ (numerator, denominator,
+ quotient, remainder,
+ q_negative_p, r_negative_p);
+ break;
+ }
+ }
+ }
}
/* allocates memory */
-bignum *
-bignum_quotient(bignum * numerator, bignum * denominator)
+bignum *factor_vm::bignum_quotient(bignum * numerator, bignum * denominator)
{
- if (BIGNUM_ZERO_P (denominator))
- {
- divide_by_zero_error();
- return (BIGNUM_OUT_OF_BAND);
- }
- if (BIGNUM_ZERO_P (numerator))
- return numerator;
- {
- int q_negative_p =
- ((BIGNUM_NEGATIVE_P (denominator))
- ? (! (BIGNUM_NEGATIVE_P (numerator)))
- : (BIGNUM_NEGATIVE_P (numerator)));
- switch (bignum_compare_unsigned (numerator, denominator))
- {
- case bignum_comparison_equal:
- return (BIGNUM_ONE (q_negative_p));
- case bignum_comparison_less:
- return (BIGNUM_ZERO ());
- case bignum_comparison_greater:
- default: /* to appease gcc -Wall */
- {
- bignum * quotient;
- if ((BIGNUM_LENGTH (denominator)) == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
- if (digit == 1)
- return (bignum_maybe_new_sign (numerator, q_negative_p));
- if (digit < BIGNUM_RADIX_ROOT)
- bignum_divide_unsigned_small_denominator
- (numerator, digit,
- ("ient), ((bignum * *) 0),
- q_negative_p, 0);
- else
- bignum_divide_unsigned_medium_denominator
- (numerator, digit,
- ("ient), ((bignum * *) 0),
- q_negative_p, 0);
- }
- else
- bignum_divide_unsigned_large_denominator
- (numerator, denominator,
- ("ient), ((bignum * *) 0),
- q_negative_p, 0);
- return (quotient);
- }
- }
- }
+ if (BIGNUM_ZERO_P (denominator))
+ {
+ divide_by_zero_error();
+ return (BIGNUM_OUT_OF_BAND);
+ }
+ if (BIGNUM_ZERO_P (numerator))
+ return numerator;
+ {
+ int q_negative_p =
+ ((BIGNUM_NEGATIVE_P (denominator))
+ ? (! (BIGNUM_NEGATIVE_P (numerator)))
+ : (BIGNUM_NEGATIVE_P (numerator)));
+ switch (bignum_compare_unsigned (numerator, denominator))
+ {
+ case bignum_comparison_equal:
+ return (BIGNUM_ONE (q_negative_p));
+ case bignum_comparison_less:
+ return (BIGNUM_ZERO ());
+ case bignum_comparison_greater:
+ default: /* to appease gcc -Wall */
+ {
+ bignum * quotient;
+ if ((BIGNUM_LENGTH (denominator)) == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
+ if (digit == 1)
+ return (bignum_maybe_new_sign (numerator, q_negative_p));
+ if (digit < BIGNUM_RADIX_ROOT)
+ bignum_divide_unsigned_small_denominator
+ (numerator, digit,
+ ("ient), ((bignum * *) 0),
+ q_negative_p, 0);
+ else
+ bignum_divide_unsigned_medium_denominator
+ (numerator, digit,
+ ("ient), ((bignum * *) 0),
+ q_negative_p, 0);
+ }
+ else
+ bignum_divide_unsigned_large_denominator
+ (numerator, denominator,
+ ("ient), ((bignum * *) 0),
+ q_negative_p, 0);
+ return (quotient);
+ }
+ }
+ }
}
/* allocates memory */
-bignum *
-bignum_remainder(bignum * numerator, bignum * denominator)
+bignum *factor_vm::bignum_remainder(bignum * numerator, bignum * denominator)
{
- if (BIGNUM_ZERO_P (denominator))
- {
- divide_by_zero_error();
- return (BIGNUM_OUT_OF_BAND);
- }
- if (BIGNUM_ZERO_P (numerator))
- return numerator;
- switch (bignum_compare_unsigned (numerator, denominator))
- {
- case bignum_comparison_equal:
- return (BIGNUM_ZERO ());
- case bignum_comparison_less:
- return numerator;
- case bignum_comparison_greater:
- default: /* to appease gcc -Wall */
- {
- bignum * remainder;
- if ((BIGNUM_LENGTH (denominator)) == 1)
- {
- bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
- if (digit == 1)
- return (BIGNUM_ZERO ());
- if (digit < BIGNUM_RADIX_ROOT)
- return
- (bignum_remainder_unsigned_small_denominator
- (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
- bignum_divide_unsigned_medium_denominator
- (numerator, digit,
- ((bignum * *) 0), (&remainder),
- 0, (BIGNUM_NEGATIVE_P (numerator)));
- }
- else
- bignum_divide_unsigned_large_denominator
- (numerator, denominator,
- ((bignum * *) 0), (&remainder),
- 0, (BIGNUM_NEGATIVE_P (numerator)));
- return (remainder);
- }
- }
+ if (BIGNUM_ZERO_P (denominator))
+ {
+ divide_by_zero_error();
+ return (BIGNUM_OUT_OF_BAND);
+ }
+ if (BIGNUM_ZERO_P (numerator))
+ return numerator;
+ switch (bignum_compare_unsigned (numerator, denominator))
+ {
+ case bignum_comparison_equal:
+ return (BIGNUM_ZERO ());
+ case bignum_comparison_less:
+ return numerator;
+ case bignum_comparison_greater:
+ default: /* to appease gcc -Wall */
+ {
+ bignum * remainder;
+ if ((BIGNUM_LENGTH (denominator)) == 1)
+ {
+ bignum_digit_type digit = (BIGNUM_REF (denominator, 0));
+ if (digit == 1)
+ return (BIGNUM_ZERO ());
+ if (digit < BIGNUM_RADIX_ROOT)
+ return
+ (bignum_remainder_unsigned_small_denominator
+ (numerator, digit, (BIGNUM_NEGATIVE_P (numerator))));
+ bignum_divide_unsigned_medium_denominator
+ (numerator, digit,
+ ((bignum * *) 0), (&remainder),
+ 0, (BIGNUM_NEGATIVE_P (numerator)));
+ }
+ else
+ bignum_divide_unsigned_large_denominator
+ (numerator, denominator,
+ ((bignum * *) 0), (&remainder),
+ 0, (BIGNUM_NEGATIVE_P (numerator)));
+ return (remainder);
+ }
+ }
}
-#define FOO_TO_BIGNUM(name,type,utype) \
- bignum * name##_to_bignum(type n) \
- { \
- int negative_p; \
- bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
- bignum_digit_type * end_digits = result_digits; \
- /* Special cases win when these small constants are cached. */ \
- if (n == 0) return (BIGNUM_ZERO ()); \
- if (n == 1) return (BIGNUM_ONE (0)); \
- if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1)); \
- { \
- utype accumulator = ((negative_p = (n < (type)0)) ? (-n) : n); \
- do \
- { \
- (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
- accumulator >>= BIGNUM_DIGIT_LENGTH; \
- } \
- while (accumulator != 0); \
- } \
- { \
- bignum * result = \
- (allot_bignum ((end_digits - result_digits), negative_p)); \
- bignum_digit_type * scan_digits = result_digits; \
- bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
- while (scan_digits < end_digits) \
- (*scan_result++) = (*scan_digits++); \
- return (result); \
- } \
- }
+#define FOO_TO_BIGNUM(name,type,utype) \
+bignum * factor_vm::name##_to_bignum(type n) \
+{ \
+ int negative_p; \
+ bignum_digit_type result_digits [BIGNUM_DIGITS_FOR(type)]; \
+ bignum_digit_type * end_digits = result_digits; \
+ /* Special cases win when these small constants are cached. */ \
+ if (n == 0) return (BIGNUM_ZERO ()); \
+ if (n == 1) return (BIGNUM_ONE (0)); \
+ if (n < (type)0 && n == (type)-1) return (BIGNUM_ONE (1)); \
+ { \
+ utype accumulator = ((negative_p = (n < (type)0)) ? (-n) : n); \
+ do \
+ { \
+ (*end_digits++) = (accumulator & BIGNUM_DIGIT_MASK); \
+ accumulator >>= BIGNUM_DIGIT_LENGTH; \
+ } \
+ while (accumulator != 0); \
+ } \
+ { \
+ bignum * result = \
+ (allot_bignum ((end_digits - result_digits), negative_p)); \
+ bignum_digit_type * scan_digits = result_digits; \
+ bignum_digit_type * scan_result = (BIGNUM_START_PTR (result)); \
+ while (scan_digits < end_digits) \
+ (*scan_result++) = (*scan_digits++); \
+ return (result); \
+ } \
+}
/* all below allocate memory */
FOO_TO_BIGNUM(cell,cell,cell)
FOO_TO_BIGNUM(long_long,s64,u64)
FOO_TO_BIGNUM(ulong_long,u64,u64)
-#define BIGNUM_TO_FOO(name,type,utype) \
- type bignum_to_##name(bignum * bignum) \
- { \
- if (BIGNUM_ZERO_P (bignum)) \
- return (0); \
- { \
- utype accumulator = 0; \
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
- while (start < scan) \
- accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
- return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \
- } \
- }
+#define BIGNUM_TO_FOO(name,type,utype) \
+ type factor_vm::bignum_to_##name(bignum * bignum) \
+ { \
+ if (BIGNUM_ZERO_P (bignum)) \
+ return (0); \
+ { \
+ utype accumulator = 0; \
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum)); \
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum))); \
+ while (start < scan) \
+ accumulator = ((accumulator << BIGNUM_DIGIT_LENGTH) + (*--scan)); \
+ return ((BIGNUM_NEGATIVE_P (bignum)) ? (-((type)accumulator)) : accumulator); \
+ } \
+ }
/* all of the below allocate memory */
BIGNUM_TO_FOO(cell,cell,cell);
BIGNUM_TO_FOO(long_long,s64,u64)
BIGNUM_TO_FOO(ulong_long,u64,u64)
-double
-bignum_to_double(bignum * bignum)
+double factor_vm::bignum_to_double(bignum * bignum)
{
- if (BIGNUM_ZERO_P (bignum))
- return (0);
- {
- double accumulator = 0;
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
- while (start < scan)
- accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
- return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
- }
+ if (BIGNUM_ZERO_P (bignum))
+ return (0);
+ {
+ double accumulator = 0;
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
+ while (start < scan)
+ accumulator = ((accumulator * BIGNUM_RADIX) + (*--scan));
+ return ((BIGNUM_NEGATIVE_P (bignum)) ? (-accumulator) : accumulator);
+ }
}
-#define DTB_WRITE_DIGIT(factor) \
-{ \
- significand *= (factor); \
- digit = ((bignum_digit_type) significand); \
- (*--scan) = digit; \
- significand -= ((double) digit); \
+#define DTB_WRITE_DIGIT(factor) \
+{ \
+ significand *= (factor); \
+ digit = ((bignum_digit_type) significand); \
+ (*--scan) = digit; \
+ significand -= ((double) digit); \
}
/* allocates memory */
#define inf std::numeric_limits<double>::infinity()
-bignum *
-double_to_bignum(double x)
+bignum *factor_vm::double_to_bignum(double x)
{
- if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
- int exponent;
- double significand = (frexp (x, (&exponent)));
- if (exponent <= 0) return (BIGNUM_ZERO ());
- if (exponent == 1) return (BIGNUM_ONE (x < 0));
- if (significand < 0) significand = (-significand);
- {
- bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
- bignum * result = (allot_bignum (length, (x < 0)));
- bignum_digit_type * start = (BIGNUM_START_PTR (result));
- bignum_digit_type * scan = (start + length);
- bignum_digit_type digit;
- int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
- if (odd_bits > 0)
- DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
- while (start < scan)
- {
- if (significand == 0)
- {
- while (start < scan)
- (*--scan) = 0;
- break;
- }
- DTB_WRITE_DIGIT (BIGNUM_RADIX);
- }
- return (result);
- }
+ if (x == inf || x == -inf || x != x) return (BIGNUM_ZERO ());
+ int exponent;
+ double significand = (frexp (x, (&exponent)));
+ if (exponent <= 0) return (BIGNUM_ZERO ());
+ if (exponent == 1) return (BIGNUM_ONE (x < 0));
+ if (significand < 0) significand = (-significand);
+ {
+ bignum_length_type length = (BIGNUM_BITS_TO_DIGITS (exponent));
+ bignum * result = (allot_bignum (length, (x < 0)));
+ bignum_digit_type * start = (BIGNUM_START_PTR (result));
+ bignum_digit_type * scan = (start + length);
+ bignum_digit_type digit;
+ int odd_bits = (exponent % BIGNUM_DIGIT_LENGTH);
+ if (odd_bits > 0)
+ DTB_WRITE_DIGIT ((fixnum)1 << odd_bits);
+ while (start < scan)
+ {
+ if (significand == 0)
+ {
+ while (start < scan)
+ (*--scan) = 0;
+ break;
+ }
+ DTB_WRITE_DIGIT (BIGNUM_RADIX);
+ }
+ return (result);
+ }
}
#undef DTB_WRITE_DIGIT
/* Comparisons */
-int
-bignum_equal_p_unsigned(bignum * x, bignum * y)
+int factor_vm::bignum_equal_p_unsigned(bignum * x, bignum * y)
{
- bignum_length_type length = (BIGNUM_LENGTH (x));
- if (length != (BIGNUM_LENGTH (y)))
- return (0);
- else
- {
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_x = (scan_x + length);
- while (scan_x < end_x)
- if ((*scan_x++) != (*scan_y++))
- return (0);
- return (1);
- }
+ bignum_length_type length = (BIGNUM_LENGTH (x));
+ if (length != (BIGNUM_LENGTH (y)))
+ return (0);
+ else
+ {
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_x = (scan_x + length);
+ while (scan_x < end_x)
+ if ((*scan_x++) != (*scan_y++))
+ return (0);
+ return (1);
+ }
}
-enum bignum_comparison
-bignum_compare_unsigned(bignum * x, bignum * y)
+enum bignum_comparison factor_vm::bignum_compare_unsigned(bignum * x, bignum * y)
{
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum_length_type y_length = (BIGNUM_LENGTH (y));
- if (x_length < y_length)
- return (bignum_comparison_less);
- if (x_length > y_length)
- return (bignum_comparison_greater);
- {
- bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_x = (start_x + x_length);
- bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
- while (start_x < scan_x)
- {
- bignum_digit_type digit_x = (*--scan_x);
- bignum_digit_type digit_y = (*--scan_y);
- if (digit_x < digit_y)
- return (bignum_comparison_less);
- if (digit_x > digit_y)
- return (bignum_comparison_greater);
- }
- }
- return (bignum_comparison_equal);
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ bignum_length_type y_length = (BIGNUM_LENGTH (y));
+ if (x_length < y_length)
+ return (bignum_comparison_less);
+ if (x_length > y_length)
+ return (bignum_comparison_greater);
+ {
+ bignum_digit_type * start_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_x = (start_x + x_length);
+ bignum_digit_type * scan_y = ((BIGNUM_START_PTR (y)) + y_length);
+ while (start_x < scan_x)
+ {
+ bignum_digit_type digit_x = (*--scan_x);
+ bignum_digit_type digit_y = (*--scan_y);
+ if (digit_x < digit_y)
+ return (bignum_comparison_less);
+ if (digit_x > digit_y)
+ return (bignum_comparison_greater);
+ }
+ }
+ return (bignum_comparison_equal);
}
/* Addition */
/* allocates memory */
-bignum *
-bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
+bignum *factor_vm::bignum_add_unsigned(bignum * x, bignum * y, int negative_p)
{
- GC_BIGNUM(x); GC_BIGNUM(y);
-
- if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
- {
- bignum * z = x;
- x = y;
- y = z;
- }
- {
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
-
- bignum * r = (allot_bignum ((x_length + 1), negative_p));
-
- bignum_digit_type sum;
- bignum_digit_type carry = 0;
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
- {
- bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
- while (scan_y < end_y)
- {
- sum = ((*scan_x++) + (*scan_y++) + carry);
- if (sum < BIGNUM_RADIX)
- {
- (*scan_r++) = sum;
- carry = 0;
- }
- else
- {
- (*scan_r++) = (sum - BIGNUM_RADIX);
- carry = 1;
- }
- }
- }
- {
- bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
- if (carry != 0)
- while (scan_x < end_x)
- {
- sum = ((*scan_x++) + 1);
- if (sum < BIGNUM_RADIX)
- {
- (*scan_r++) = sum;
- carry = 0;
- break;
- }
- else
- (*scan_r++) = (sum - BIGNUM_RADIX);
- }
- while (scan_x < end_x)
- (*scan_r++) = (*scan_x++);
- }
- if (carry != 0)
- {
- (*scan_r) = 1;
- return (r);
- }
- return (bignum_shorten_length (r, x_length));
- }
+ GC_BIGNUM(x); GC_BIGNUM(y);
+
+ if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
+ {
+ bignum * z = x;
+ x = y;
+ y = z;
+ }
+ {
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+
+ bignum * r = (allot_bignum ((x_length + 1), negative_p));
+
+ bignum_digit_type sum;
+ bignum_digit_type carry = 0;
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
+ {
+ bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
+ while (scan_y < end_y)
+ {
+ sum = ((*scan_x++) + (*scan_y++) + carry);
+ if (sum < BIGNUM_RADIX)
+ {
+ (*scan_r++) = sum;
+ carry = 0;
+ }
+ else
+ {
+ (*scan_r++) = (sum - BIGNUM_RADIX);
+ carry = 1;
+ }
+ }
+ }
+ {
+ bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
+ if (carry != 0)
+ while (scan_x < end_x)
+ {
+ sum = ((*scan_x++) + 1);
+ if (sum < BIGNUM_RADIX)
+ {
+ (*scan_r++) = sum;
+ carry = 0;
+ break;
+ }
+ else
+ (*scan_r++) = (sum - BIGNUM_RADIX);
+ }
+ while (scan_x < end_x)
+ (*scan_r++) = (*scan_x++);
+ }
+ if (carry != 0)
+ {
+ (*scan_r) = 1;
+ return (r);
+ }
+ return (bignum_shorten_length (r, x_length));
+ }
}
/* Subtraction */
/* allocates memory */
-bignum *
-bignum_subtract_unsigned(bignum * x, bignum * y)
+bignum *factor_vm::bignum_subtract_unsigned(bignum * x, bignum * y)
{
- GC_BIGNUM(x); GC_BIGNUM(y);
+ GC_BIGNUM(x); GC_BIGNUM(y);
- int negative_p = 0;
- switch (bignum_compare_unsigned (x, y))
- {
- case bignum_comparison_equal:
- return (BIGNUM_ZERO ());
- case bignum_comparison_less:
- {
- bignum * z = x;
- x = y;
- y = z;
- }
- negative_p = 1;
- break;
- case bignum_comparison_greater:
- negative_p = 0;
- break;
- }
- {
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
-
- bignum * r = (allot_bignum (x_length, negative_p));
-
- bignum_digit_type difference;
- bignum_digit_type borrow = 0;
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
- {
- bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
- while (scan_y < end_y)
- {
- difference = (((*scan_x++) - (*scan_y++)) - borrow);
- if (difference < 0)
- {
- (*scan_r++) = (difference + BIGNUM_RADIX);
- borrow = 1;
- }
- else
- {
- (*scan_r++) = difference;
- borrow = 0;
- }
- }
- }
- {
- bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
- if (borrow != 0)
- while (scan_x < end_x)
- {
- difference = ((*scan_x++) - borrow);
- if (difference < 0)
- (*scan_r++) = (difference + BIGNUM_RADIX);
- else
- {
- (*scan_r++) = difference;
- borrow = 0;
- break;
- }
- }
- BIGNUM_ASSERT (borrow == 0);
- while (scan_x < end_x)
- (*scan_r++) = (*scan_x++);
- }
- return (bignum_trim (r));
- }
+ int negative_p = 0;
+ switch (bignum_compare_unsigned (x, y))
+ {
+ case bignum_comparison_equal:
+ return (BIGNUM_ZERO ());
+ case bignum_comparison_less:
+ {
+ bignum * z = x;
+ x = y;
+ y = z;
+ }
+ negative_p = 1;
+ break;
+ case bignum_comparison_greater:
+ negative_p = 0;
+ break;
+ }
+ {
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+
+ bignum * r = (allot_bignum (x_length, negative_p));
+
+ bignum_digit_type difference;
+ bignum_digit_type borrow = 0;
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * scan_r = (BIGNUM_START_PTR (r));
+ {
+ bignum_digit_type * scan_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_y = (scan_y + (BIGNUM_LENGTH (y)));
+ while (scan_y < end_y)
+ {
+ difference = (((*scan_x++) - (*scan_y++)) - borrow);
+ if (difference < 0)
+ {
+ (*scan_r++) = (difference + BIGNUM_RADIX);
+ borrow = 1;
+ }
+ else
+ {
+ (*scan_r++) = difference;
+ borrow = 0;
+ }
+ }
+ }
+ {
+ bignum_digit_type * end_x = ((BIGNUM_START_PTR (x)) + x_length);
+ if (borrow != 0)
+ while (scan_x < end_x)
+ {
+ difference = ((*scan_x++) - borrow);
+ if (difference < 0)
+ (*scan_r++) = (difference + BIGNUM_RADIX);
+ else
+ {
+ (*scan_r++) = difference;
+ borrow = 0;
+ break;
+ }
+ }
+ BIGNUM_ASSERT (borrow == 0);
+ while (scan_x < end_x)
+ (*scan_r++) = (*scan_x++);
+ }
+ return (bignum_trim (r));
+ }
}
/* Multiplication
Maximum value for product_low or product_high:
- ((R * R) + (R * (R - 2)) + (R - 1))
+ ((R * R) + (R * (R - 2)) + (R - 1))
Maximum value for carry: ((R * (R - 1)) + (R - 1))
- where R == BIGNUM_RADIX_ROOT */
+ where R == BIGNUM_RADIX_ROOT */
/* allocates memory */
-bignum *
-bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
+bignum *factor_vm::bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p)
{
- GC_BIGNUM(x); GC_BIGNUM(y);
-
- if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
- {
- bignum * z = x;
- x = y;
- y = z;
- }
- {
- bignum_digit_type carry;
- bignum_digit_type y_digit_low;
- bignum_digit_type y_digit_high;
- bignum_digit_type x_digit_low;
- bignum_digit_type x_digit_high;
- bignum_digit_type product_low;
- bignum_digit_type * scan_r;
- bignum_digit_type * scan_y;
- bignum_length_type x_length = (BIGNUM_LENGTH (x));
- bignum_length_type y_length = (BIGNUM_LENGTH (y));
-
- bignum * r =
- (allot_bignum_zeroed ((x_length + y_length), negative_p));
-
- bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
- bignum_digit_type * end_x = (scan_x + x_length);
- bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
- bignum_digit_type * end_y = (start_y + y_length);
- bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
+ GC_BIGNUM(x); GC_BIGNUM(y);
+
+ if ((BIGNUM_LENGTH (y)) > (BIGNUM_LENGTH (x)))
+ {
+ bignum * z = x;
+ x = y;
+ y = z;
+ }
+ {
+ bignum_digit_type carry;
+ bignum_digit_type y_digit_low;
+ bignum_digit_type y_digit_high;
+ bignum_digit_type x_digit_low;
+ bignum_digit_type x_digit_high;
+ bignum_digit_type product_low;
+ bignum_digit_type * scan_r;
+ bignum_digit_type * scan_y;
+ bignum_length_type x_length = (BIGNUM_LENGTH (x));
+ bignum_length_type y_length = (BIGNUM_LENGTH (y));
+
+ bignum * r =
+ (allot_bignum_zeroed ((x_length + y_length), negative_p));
+
+ bignum_digit_type * scan_x = (BIGNUM_START_PTR (x));
+ bignum_digit_type * end_x = (scan_x + x_length);
+ bignum_digit_type * start_y = (BIGNUM_START_PTR (y));
+ bignum_digit_type * end_y = (start_y + y_length);
+ bignum_digit_type * start_r = (BIGNUM_START_PTR (r));
#define x_digit x_digit_high
#define y_digit y_digit_high
#define product_high carry
- while (scan_x < end_x)
- {
- x_digit = (*scan_x++);
- x_digit_low = (HD_LOW (x_digit));
- x_digit_high = (HD_HIGH (x_digit));
- carry = 0;
- scan_y = start_y;
- scan_r = (start_r++);
- while (scan_y < end_y)
- {
- y_digit = (*scan_y++);
- y_digit_low = (HD_LOW (y_digit));
- y_digit_high = (HD_HIGH (y_digit));
- product_low =
- ((*scan_r) +
- (x_digit_low * y_digit_low) +
- (HD_LOW (carry)));
- product_high =
- ((x_digit_high * y_digit_low) +
- (x_digit_low * y_digit_high) +
- (HD_HIGH (product_low)) +
- (HD_HIGH (carry)));
- (*scan_r++) =
- (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
- carry =
- ((x_digit_high * y_digit_high) +
- (HD_HIGH (product_high)));
- }
- (*scan_r) += carry;
- }
- return (bignum_trim (r));
+ while (scan_x < end_x)
+ {
+ x_digit = (*scan_x++);
+ x_digit_low = (HD_LOW (x_digit));
+ x_digit_high = (HD_HIGH (x_digit));
+ carry = 0;
+ scan_y = start_y;
+ scan_r = (start_r++);
+ while (scan_y < end_y)
+ {
+ y_digit = (*scan_y++);
+ y_digit_low = (HD_LOW (y_digit));
+ y_digit_high = (HD_HIGH (y_digit));
+ product_low =
+ ((*scan_r) +
+ (x_digit_low * y_digit_low) +
+ (HD_LOW (carry)));
+ product_high =
+ ((x_digit_high * y_digit_low) +
+ (x_digit_low * y_digit_high) +
+ (HD_HIGH (product_low)) +
+ (HD_HIGH (carry)));
+ (*scan_r++) =
+ (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
+ carry =
+ ((x_digit_high * y_digit_high) +
+ (HD_HIGH (product_high)));
+ }
+ (*scan_r) += carry;
+ }
+ return (bignum_trim (r));
#undef x_digit
#undef y_digit
#undef product_high
- }
+ }
}
/* allocates memory */
-bignum *
-bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,
- int negative_p)
+bignum *factor_vm::bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y, int negative_p)
{
- GC_BIGNUM(x);
+ GC_BIGNUM(x);
- bignum_length_type length_x = (BIGNUM_LENGTH (x));
+ bignum_length_type length_x = (BIGNUM_LENGTH (x));
- bignum * p = (allot_bignum ((length_x + 1), negative_p));
+ bignum * p = (allot_bignum ((length_x + 1), negative_p));
- bignum_destructive_copy (x, p);
- (BIGNUM_REF (p, length_x)) = 0;
- bignum_destructive_scale_up (p, y);
- return (bignum_trim (p));
+ bignum_destructive_copy (x, p);
+ (BIGNUM_REF (p, length_x)) = 0;
+ bignum_destructive_scale_up (p, y);
+ return (bignum_trim (p));
}
-void
-bignum_destructive_add(bignum * bignum, bignum_digit_type n)
+void factor_vm::bignum_destructive_add(bignum * bignum, bignum_digit_type n)
{
- bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
- bignum_digit_type digit;
- digit = ((*scan) + n);
- if (digit < BIGNUM_RADIX)
- {
- (*scan) = digit;
- return;
- }
- (*scan++) = (digit - BIGNUM_RADIX);
- while (1)
- {
- digit = ((*scan) + 1);
- if (digit < BIGNUM_RADIX)
- {
- (*scan) = digit;
- return;
- }
- (*scan++) = (digit - BIGNUM_RADIX);
- }
+ bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type digit;
+ digit = ((*scan) + n);
+ if (digit < BIGNUM_RADIX)
+ {
+ (*scan) = digit;
+ return;
+ }
+ (*scan++) = (digit - BIGNUM_RADIX);
+ while (1)
+ {
+ digit = ((*scan) + 1);
+ if (digit < BIGNUM_RADIX)
+ {
+ (*scan) = digit;
+ return;
+ }
+ (*scan++) = (digit - BIGNUM_RADIX);
+ }
}
-void
-bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
+void factor_vm::bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor)
{
- bignum_digit_type carry = 0;
- bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
- bignum_digit_type two_digits;
- bignum_digit_type product_low;
+ bignum_digit_type carry = 0;
+ bignum_digit_type * scan = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type two_digits;
+ bignum_digit_type product_low;
#define product_high carry
- bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
- BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
- while (scan < end)
- {
- two_digits = (*scan);
- product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
- product_high =
- ((factor * (HD_HIGH (two_digits))) +
- (HD_HIGH (product_low)) +
- (HD_HIGH (carry)));
- (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
- carry = (HD_HIGH (product_high));
- }
- /* A carry here would be an overflow, i.e. it would not fit.
- Hopefully the callers allocate enough space that this will
- never happen.
- */
- BIGNUM_ASSERT (carry == 0);
- return;
+ bignum_digit_type * end = (scan + (BIGNUM_LENGTH (bignum)));
+ BIGNUM_ASSERT ((factor > 1) && (factor < BIGNUM_RADIX_ROOT));
+ while (scan < end)
+ {
+ two_digits = (*scan);
+ product_low = ((factor * (HD_LOW (two_digits))) + (HD_LOW (carry)));
+ product_high =
+ ((factor * (HD_HIGH (two_digits))) +
+ (HD_HIGH (product_low)) +
+ (HD_HIGH (carry)));
+ (*scan++) = (HD_CONS ((HD_LOW (product_high)), (HD_LOW (product_low))));
+ carry = (HD_HIGH (product_high));
+ }
+ /* A carry here would be an overflow, i.e. it would not fit.
+ Hopefully the callers allocate enough space that this will
+ never happen.
+ */
+ BIGNUM_ASSERT (carry == 0);
+ return;
#undef product_high
}
section 4.3.1, "Multiple-Precision Arithmetic". */
/* allocates memory */
-void
-bignum_divide_unsigned_large_denominator(bignum * numerator,
- bignum * denominator,
- bignum * * quotient,
- bignum * * remainder,
- int q_negative_p,
- int r_negative_p)
+void factor_vm::bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p)
{
- GC_BIGNUM(numerator); GC_BIGNUM(denominator);
+ GC_BIGNUM(numerator); GC_BIGNUM(denominator);
- bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
- bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
-
- bignum * q =
- ((quotient != ((bignum * *) 0))
- ? (allot_bignum ((length_n - length_d), q_negative_p))
- : BIGNUM_OUT_OF_BAND);
- GC_BIGNUM(q);
+ bignum_length_type length_n = ((BIGNUM_LENGTH (numerator)) + 1);
+ bignum_length_type length_d = (BIGNUM_LENGTH (denominator));
+
+ bignum * q =
+ ((quotient != ((bignum * *) 0))
+ ? (allot_bignum ((length_n - length_d), q_negative_p))
+ : BIGNUM_OUT_OF_BAND);
+ GC_BIGNUM(q);
- bignum * u = (allot_bignum (length_n, r_negative_p));
- GC_BIGNUM(u);
+ bignum * u = (allot_bignum (length_n, r_negative_p));
+ GC_BIGNUM(u);
- int shift = 0;
- BIGNUM_ASSERT (length_d > 1);
- {
- bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
- while (v1 < (BIGNUM_RADIX / 2))
- {
- v1 <<= 1;
- shift += 1;
- }
- }
- if (shift == 0)
- {
- bignum_destructive_copy (numerator, u);
- (BIGNUM_REF (u, (length_n - 1))) = 0;
- bignum_divide_unsigned_normalized (u, denominator, q);
- }
- else
- {
- bignum * v = (allot_bignum (length_d, 0));
-
- bignum_destructive_normalization (numerator, u, shift);
- bignum_destructive_normalization (denominator, v, shift);
- bignum_divide_unsigned_normalized (u, v, q);
- if (remainder != ((bignum * *) 0))
- bignum_destructive_unnormalization (u, shift);
- }
-
- if(q)
- q = bignum_trim (q);
-
- u = bignum_trim (u);
-
- if (quotient != ((bignum * *) 0))
- (*quotient) = q;
-
- if (remainder != ((bignum * *) 0))
- (*remainder) = u;
-
- return;
+ int shift = 0;
+ BIGNUM_ASSERT (length_d > 1);
+ {
+ bignum_digit_type v1 = (BIGNUM_REF ((denominator), (length_d - 1)));
+ while (v1 < (BIGNUM_RADIX / 2))
+ {
+ v1 <<= 1;
+ shift += 1;
+ }
+ }
+ if (shift == 0)
+ {
+ bignum_destructive_copy (numerator, u);
+ (BIGNUM_REF (u, (length_n - 1))) = 0;
+ bignum_divide_unsigned_normalized (u, denominator, q);
+ }
+ else
+ {
+ bignum * v = (allot_bignum (length_d, 0));
+
+ bignum_destructive_normalization (numerator, u, shift);
+ bignum_destructive_normalization (denominator, v, shift);
+ bignum_divide_unsigned_normalized (u, v, q);
+ if (remainder != ((bignum * *) 0))
+ bignum_destructive_unnormalization (u, shift);
+ }
+
+ if(q)
+ q = bignum_trim (q);
+
+ u = bignum_trim (u);
+
+ if (quotient != ((bignum * *) 0))
+ (*quotient) = q;
+
+ if (remainder != ((bignum * *) 0))
+ (*remainder) = u;
+
+ return;
}
-void
-bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
+void factor_vm::bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q)
{
- bignum_length_type u_length = (BIGNUM_LENGTH (u));
- bignum_length_type v_length = (BIGNUM_LENGTH (v));
- bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
- bignum_digit_type * u_scan = (u_start + u_length);
- bignum_digit_type * u_scan_limit = (u_start + v_length);
- bignum_digit_type * u_scan_start = (u_scan - v_length);
- bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
- bignum_digit_type * v_end = (v_start + v_length);
- bignum_digit_type * q_scan = NULL;
- bignum_digit_type v1 = (v_end[-1]);
- bignum_digit_type v2 = (v_end[-2]);
- bignum_digit_type ph; /* high half of double-digit product */
- bignum_digit_type pl; /* low half of double-digit product */
- bignum_digit_type guess;
- bignum_digit_type gh; /* high half-digit of guess */
- bignum_digit_type ch; /* high half of double-digit comparand */
- bignum_digit_type v2l = (HD_LOW (v2));
- bignum_digit_type v2h = (HD_HIGH (v2));
- bignum_digit_type cl; /* low half of double-digit comparand */
-#define gl ph /* low half-digit of guess */
+ bignum_length_type u_length = (BIGNUM_LENGTH (u));
+ bignum_length_type v_length = (BIGNUM_LENGTH (v));
+ bignum_digit_type * u_start = (BIGNUM_START_PTR (u));
+ bignum_digit_type * u_scan = (u_start + u_length);
+ bignum_digit_type * u_scan_limit = (u_start + v_length);
+ bignum_digit_type * u_scan_start = (u_scan - v_length);
+ bignum_digit_type * v_start = (BIGNUM_START_PTR (v));
+ bignum_digit_type * v_end = (v_start + v_length);
+ bignum_digit_type * q_scan = NULL;
+ bignum_digit_type v1 = (v_end[-1]);
+ bignum_digit_type v2 = (v_end[-2]);
+ bignum_digit_type ph; /* high half of double-digit product */
+ bignum_digit_type pl; /* low half of double-digit product */
+ bignum_digit_type guess;
+ bignum_digit_type gh; /* high half-digit of guess */
+ bignum_digit_type ch; /* high half of double-digit comparand */
+ bignum_digit_type v2l = (HD_LOW (v2));
+ bignum_digit_type v2h = (HD_HIGH (v2));
+ bignum_digit_type cl; /* low half of double-digit comparand */
+#define gl ph /* low half-digit of guess */
#define uj pl
#define qj ph
- bignum_digit_type gm; /* memory loc for reference parameter */
- if (q != BIGNUM_OUT_OF_BAND)
- q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
- while (u_scan_limit < u_scan)
- {
- uj = (*--u_scan);
- if (uj != v1)
- {
- /* comparand =
- (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
- guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
- cl = (u_scan[-2]);
- ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
- guess = gm;
- }
- else
- {
- cl = (u_scan[-2]);
- ch = ((u_scan[-1]) + v1);
- guess = (BIGNUM_RADIX - 1);
- }
- while (1)
- {
- /* product = (guess * v2); */
- gl = (HD_LOW (guess));
- gh = (HD_HIGH (guess));
- pl = (v2l * gl);
- ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
- pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
- ph = ((v2h * gh) + (HD_HIGH (ph)));
- /* if (comparand >= product) */
- if ((ch > ph) || ((ch == ph) && (cl >= pl)))
- break;
- guess -= 1;
- /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
- ch += v1;
- /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
- if (ch >= BIGNUM_RADIX)
- break;
- }
- qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
- if (q != BIGNUM_OUT_OF_BAND)
- (*--q_scan) = qj;
- }
- return;
+ bignum_digit_type gm; /* memory loc for reference parameter */
+ if (q != BIGNUM_OUT_OF_BAND)
+ q_scan = ((BIGNUM_START_PTR (q)) + (BIGNUM_LENGTH (q)));
+ while (u_scan_limit < u_scan)
+ {
+ uj = (*--u_scan);
+ if (uj != v1)
+ {
+ /* comparand =
+ (((((uj * BIGNUM_RADIX) + uj1) % v1) * BIGNUM_RADIX) + uj2);
+ guess = (((uj * BIGNUM_RADIX) + uj1) / v1); */
+ cl = (u_scan[-2]);
+ ch = (bignum_digit_divide (uj, (u_scan[-1]), v1, (&gm)));
+ guess = gm;
+ }
+ else
+ {
+ cl = (u_scan[-2]);
+ ch = ((u_scan[-1]) + v1);
+ guess = (BIGNUM_RADIX - 1);
+ }
+ while (1)
+ {
+ /* product = (guess * v2); */
+ gl = (HD_LOW (guess));
+ gh = (HD_HIGH (guess));
+ pl = (v2l * gl);
+ ph = ((v2l * gh) + (v2h * gl) + (HD_HIGH (pl)));
+ pl = (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl))));
+ ph = ((v2h * gh) + (HD_HIGH (ph)));
+ /* if (comparand >= product) */
+ if ((ch > ph) || ((ch == ph) && (cl >= pl)))
+ break;
+ guess -= 1;
+ /* comparand += (v1 << BIGNUM_DIGIT_LENGTH) */
+ ch += v1;
+ /* if (comparand >= (BIGNUM_RADIX * BIGNUM_RADIX)) */
+ if (ch >= BIGNUM_RADIX)
+ break;
+ }
+ qj = (bignum_divide_subtract (v_start, v_end, guess, (--u_scan_start)));
+ if (q != BIGNUM_OUT_OF_BAND)
+ (*--q_scan) = qj;
+ }
+ return;
#undef gl
#undef uj
#undef qj
}
-bignum_digit_type
-bignum_divide_subtract(bignum_digit_type * v_start,
- bignum_digit_type * v_end,
- bignum_digit_type guess,
- bignum_digit_type * u_start)
+bignum_digit_type factor_vm::bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end, bignum_digit_type guess, bignum_digit_type * u_start)
{
- bignum_digit_type * v_scan = v_start;
- bignum_digit_type * u_scan = u_start;
- bignum_digit_type carry = 0;
- if (guess == 0) return (0);
- {
- bignum_digit_type gl = (HD_LOW (guess));
- bignum_digit_type gh = (HD_HIGH (guess));
- bignum_digit_type v;
- bignum_digit_type pl;
- bignum_digit_type vl;
+ bignum_digit_type * v_scan = v_start;
+ bignum_digit_type * u_scan = u_start;
+ bignum_digit_type carry = 0;
+ if (guess == 0) return (0);
+ {
+ bignum_digit_type gl = (HD_LOW (guess));
+ bignum_digit_type gh = (HD_HIGH (guess));
+ bignum_digit_type v;
+ bignum_digit_type pl;
+ bignum_digit_type vl;
#define vh v
#define ph carry
#define diff pl
- while (v_scan < v_end)
- {
- v = (*v_scan++);
- vl = (HD_LOW (v));
- vh = (HD_HIGH (v));
- pl = ((vl * gl) + (HD_LOW (carry)));
- ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
- diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
- if (diff < 0)
- {
- (*u_scan++) = (diff + BIGNUM_RADIX);
- carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
- }
- else
- {
- (*u_scan++) = diff;
- carry = ((vh * gh) + (HD_HIGH (ph)));
- }
- }
- if (carry == 0)
- return (guess);
- diff = ((*u_scan) - carry);
- if (diff < 0)
- (*u_scan) = (diff + BIGNUM_RADIX);
- else
- {
- (*u_scan) = diff;
- return (guess);
- }
+ while (v_scan < v_end)
+ {
+ v = (*v_scan++);
+ vl = (HD_LOW (v));
+ vh = (HD_HIGH (v));
+ pl = ((vl * gl) + (HD_LOW (carry)));
+ ph = ((vl * gh) + (vh * gl) + (HD_HIGH (pl)) + (HD_HIGH (carry)));
+ diff = ((*u_scan) - (HD_CONS ((HD_LOW (ph)), (HD_LOW (pl)))));
+ if (diff < 0)
+ {
+ (*u_scan++) = (diff + BIGNUM_RADIX);
+ carry = ((vh * gh) + (HD_HIGH (ph)) + 1);
+ }
+ else
+ {
+ (*u_scan++) = diff;
+ carry = ((vh * gh) + (HD_HIGH (ph)));
+ }
+ }
+ if (carry == 0)
+ return (guess);
+ diff = ((*u_scan) - carry);
+ if (diff < 0)
+ (*u_scan) = (diff + BIGNUM_RADIX);
+ else
+ {
+ (*u_scan) = diff;
+ return (guess);
+ }
#undef vh
#undef ph
#undef diff
- }
- /* Subtraction generated carry, implying guess is one too large.
- Add v back in to bring it back down. */
- v_scan = v_start;
- u_scan = u_start;
- carry = 0;
- while (v_scan < v_end)
- {
- bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
- if (sum < BIGNUM_RADIX)
- {
- (*u_scan++) = sum;
- carry = 0;
- }
- else
- {
- (*u_scan++) = (sum - BIGNUM_RADIX);
- carry = 1;
- }
- }
- if (carry == 1)
- {
- bignum_digit_type sum = ((*u_scan) + carry);
- (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
- }
- return (guess - 1);
+ }
+ /* Subtraction generated carry, implying guess is one too large.
+ Add v back in to bring it back down. */
+ v_scan = v_start;
+ u_scan = u_start;
+ carry = 0;
+ while (v_scan < v_end)
+ {
+ bignum_digit_type sum = ((*v_scan++) + (*u_scan) + carry);
+ if (sum < BIGNUM_RADIX)
+ {
+ (*u_scan++) = sum;
+ carry = 0;
+ }
+ else
+ {
+ (*u_scan++) = (sum - BIGNUM_RADIX);
+ carry = 1;
+ }
+ }
+ if (carry == 1)
+ {
+ bignum_digit_type sum = ((*u_scan) + carry);
+ (*u_scan) = ((sum < BIGNUM_RADIX) ? sum : (sum - BIGNUM_RADIX));
+ }
+ return (guess - 1);
}
/* allocates memory */
-void
-bignum_divide_unsigned_medium_denominator(bignum * numerator,
- bignum_digit_type denominator,
- bignum * * quotient,
- bignum * * remainder,
- int q_negative_p,
- int r_negative_p)
+void factor_vm::bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
{
- GC_BIGNUM(numerator);
+ GC_BIGNUM(numerator);
- bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
- bignum_length_type length_q;
- bignum * q = NULL;
- GC_BIGNUM(q);
+ bignum_length_type length_n = (BIGNUM_LENGTH (numerator));
+ bignum_length_type length_q;
+ bignum * q = NULL;
+ GC_BIGNUM(q);
- int shift = 0;
- /* Because `bignum_digit_divide' requires a normalized denominator. */
- while (denominator < (BIGNUM_RADIX / 2))
- {
- denominator <<= 1;
- shift += 1;
- }
- if (shift == 0)
- {
- length_q = length_n;
-
- q = (allot_bignum (length_q, q_negative_p));
- bignum_destructive_copy (numerator, q);
- }
- else
- {
- length_q = (length_n + 1);
-
- q = (allot_bignum (length_q, q_negative_p));
- bignum_destructive_normalization (numerator, q, shift);
- }
- {
- bignum_digit_type r = 0;
- bignum_digit_type * start = (BIGNUM_START_PTR (q));
- bignum_digit_type * scan = (start + length_q);
- bignum_digit_type qj;
-
- while (start < scan)
- {
- r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
- (*scan) = qj;
- }
-
- q = bignum_trim (q);
-
- if (remainder != ((bignum * *) 0))
- {
- if (shift != 0)
- r >>= shift;
-
- (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
- }
-
- if (quotient != ((bignum * *) 0))
- (*quotient) = q;
- }
- return;
+ int shift = 0;
+ /* Because `bignum_digit_divide' requires a normalized denominator. */
+ while (denominator < (BIGNUM_RADIX / 2))
+ {
+ denominator <<= 1;
+ shift += 1;
+ }
+ if (shift == 0)
+ {
+ length_q = length_n;
+
+ q = (allot_bignum (length_q, q_negative_p));
+ bignum_destructive_copy (numerator, q);
+ }
+ else
+ {
+ length_q = (length_n + 1);
+
+ q = (allot_bignum (length_q, q_negative_p));
+ bignum_destructive_normalization (numerator, q, shift);
+ }
+ {
+ bignum_digit_type r = 0;
+ bignum_digit_type * start = (BIGNUM_START_PTR (q));
+ bignum_digit_type * scan = (start + length_q);
+ bignum_digit_type qj;
+
+ while (start < scan)
+ {
+ r = (bignum_digit_divide (r, (*--scan), denominator, (&qj)));
+ (*scan) = qj;
+ }
+
+ q = bignum_trim (q);
+
+ if (remainder != ((bignum * *) 0))
+ {
+ if (shift != 0)
+ r >>= shift;
+
+ (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
+ }
+
+ if (quotient != ((bignum * *) 0))
+ (*quotient) = q;
+ }
+ return;
}
-void
-bignum_destructive_normalization(bignum * source, bignum * target,
- int shift_left)
+void factor_vm::bignum_destructive_normalization(bignum * source, bignum * target, int shift_left)
{
- bignum_digit_type digit;
- bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
- bignum_digit_type carry = 0;
- bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
- bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
- bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
- int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
- bignum_digit_type mask = (((cell)1 << shift_right) - 1);
- while (scan_source < end_source)
- {
- digit = (*scan_source++);
- (*scan_target++) = (((digit & mask) << shift_left) | carry);
- carry = (digit >> shift_right);
- }
- if (scan_target < end_target)
- (*scan_target) = carry;
- else
- BIGNUM_ASSERT (carry == 0);
- return;
+ bignum_digit_type digit;
+ bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
+ bignum_digit_type carry = 0;
+ bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
+ bignum_digit_type * end_source = (scan_source + (BIGNUM_LENGTH (source)));
+ bignum_digit_type * end_target = (scan_target + (BIGNUM_LENGTH (target)));
+ int shift_right = (BIGNUM_DIGIT_LENGTH - shift_left);
+ bignum_digit_type mask = (((cell)1 << shift_right) - 1);
+ while (scan_source < end_source)
+ {
+ digit = (*scan_source++);
+ (*scan_target++) = (((digit & mask) << shift_left) | carry);
+ carry = (digit >> shift_right);
+ }
+ if (scan_target < end_target)
+ (*scan_target) = carry;
+ else
+ BIGNUM_ASSERT (carry == 0);
+ return;
}
-void
-bignum_destructive_unnormalization(bignum * bignum, int shift_right)
+void factor_vm::bignum_destructive_unnormalization(bignum * bignum, int shift_right)
{
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
- bignum_digit_type digit;
- bignum_digit_type carry = 0;
- int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
- bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
- while (start < scan)
- {
- digit = (*--scan);
- (*scan) = ((digit >> shift_right) | carry);
- carry = ((digit & mask) << shift_left);
- }
- BIGNUM_ASSERT (carry == 0);
- return;
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
+ bignum_digit_type digit;
+ bignum_digit_type carry = 0;
+ int shift_left = (BIGNUM_DIGIT_LENGTH - shift_right);
+ bignum_digit_type mask = (((fixnum)1 << shift_right) - 1);
+ while (start < scan)
+ {
+ digit = (*--scan);
+ (*scan) = ((digit >> shift_right) | carry);
+ carry = ((digit & mask) << shift_left);
+ }
+ BIGNUM_ASSERT (carry == 0);
+ return;
}
/* This is a reduced version of the division algorithm, applied to the
case of dividing two bignum digits by one bignum digit. It is
assumed that the numerator, denominator are normalized. */
-#define BDD_STEP(qn, j) \
-{ \
- uj = (u[j]); \
- if (uj != v1) \
- { \
- uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \
- guess = (uj_uj1 / v1); \
- comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \
- } \
- else \
- { \
- guess = (BIGNUM_RADIX_ROOT - 1); \
- comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \
- } \
- while ((guess * v2) > comparand) \
- { \
- guess -= 1; \
- comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \
- if (comparand >= BIGNUM_RADIX) \
- break; \
- } \
- qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
+#define BDD_STEP(qn, j) \
+{ \
+ uj = (u[j]); \
+ if (uj != v1) \
+ { \
+ uj_uj1 = (HD_CONS (uj, (u[j + 1]))); \
+ guess = (uj_uj1 / v1); \
+ comparand = (HD_CONS ((uj_uj1 % v1), (u[j + 2]))); \
+ } \
+ else \
+ { \
+ guess = (BIGNUM_RADIX_ROOT - 1); \
+ comparand = (HD_CONS (((u[j + 1]) + v1), (u[j + 2]))); \
+ } \
+ while ((guess * v2) > comparand) \
+ { \
+ guess -= 1; \
+ comparand += (v1 << BIGNUM_HALF_DIGIT_LENGTH); \
+ if (comparand >= BIGNUM_RADIX) \
+ break; \
+ } \
+ qn = (bignum_digit_divide_subtract (v1, v2, guess, (&u[j]))); \
}
-bignum_digit_type
-bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
- bignum_digit_type v,
- bignum_digit_type * q) /* return value */
+bignum_digit_type factor_vm::bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul, bignum_digit_type v, bignum_digit_type * q) /* return value */
{
- bignum_digit_type guess;
- bignum_digit_type comparand;
- bignum_digit_type v1 = (HD_HIGH (v));
- bignum_digit_type v2 = (HD_LOW (v));
- bignum_digit_type uj;
- bignum_digit_type uj_uj1;
- bignum_digit_type q1;
- bignum_digit_type q2;
- bignum_digit_type u [4];
- if (uh == 0)
- {
- if (ul < v)
- {
- (*q) = 0;
- return (ul);
- }
- else if (ul == v)
- {
- (*q) = 1;
- return (0);
- }
- }
- (u[0]) = (HD_HIGH (uh));
- (u[1]) = (HD_LOW (uh));
- (u[2]) = (HD_HIGH (ul));
- (u[3]) = (HD_LOW (ul));
- v1 = (HD_HIGH (v));
- v2 = (HD_LOW (v));
- BDD_STEP (q1, 0);
- BDD_STEP (q2, 1);
- (*q) = (HD_CONS (q1, q2));
- return (HD_CONS ((u[2]), (u[3])));
+ bignum_digit_type guess;
+ bignum_digit_type comparand;
+ bignum_digit_type v1 = (HD_HIGH (v));
+ bignum_digit_type v2 = (HD_LOW (v));
+ bignum_digit_type uj;
+ bignum_digit_type uj_uj1;
+ bignum_digit_type q1;
+ bignum_digit_type q2;
+ bignum_digit_type u [4];
+ if (uh == 0)
+ {
+ if (ul < v)
+ {
+ (*q) = 0;
+ return (ul);
+ }
+ else if (ul == v)
+ {
+ (*q) = 1;
+ return (0);
+ }
+ }
+ (u[0]) = (HD_HIGH (uh));
+ (u[1]) = (HD_LOW (uh));
+ (u[2]) = (HD_HIGH (ul));
+ (u[3]) = (HD_LOW (ul));
+ v1 = (HD_HIGH (v));
+ v2 = (HD_LOW (v));
+ BDD_STEP (q1, 0);
+ BDD_STEP (q2, 1);
+ (*q) = (HD_CONS (q1, q2));
+ return (HD_CONS ((u[2]), (u[3])));
}
#undef BDD_STEP
-#define BDDS_MULSUB(vn, un, carry_in) \
-{ \
- product = ((vn * guess) + carry_in); \
- diff = (un - (HD_LOW (product))); \
- if (diff < 0) \
- { \
- un = (diff + BIGNUM_RADIX_ROOT); \
- carry = ((HD_HIGH (product)) + 1); \
- } \
- else \
- { \
- un = diff; \
- carry = (HD_HIGH (product)); \
- } \
+#define BDDS_MULSUB(vn, un, carry_in) \
+{ \
+ product = ((vn * guess) + carry_in); \
+ diff = (un - (HD_LOW (product))); \
+ if (diff < 0) \
+ { \
+ un = (diff + BIGNUM_RADIX_ROOT); \
+ carry = ((HD_HIGH (product)) + 1); \
+ } \
+ else \
+ { \
+ un = diff; \
+ carry = (HD_HIGH (product)); \
+ } \
}
-#define BDDS_ADD(vn, un, carry_in) \
-{ \
- sum = (vn + un + carry_in); \
- if (sum < BIGNUM_RADIX_ROOT) \
- { \
- un = sum; \
- carry = 0; \
- } \
- else \
- { \
- un = (sum - BIGNUM_RADIX_ROOT); \
- carry = 1; \
- } \
+#define BDDS_ADD(vn, un, carry_in) \
+{ \
+ sum = (vn + un + carry_in); \
+ if (sum < BIGNUM_RADIX_ROOT) \
+ { \
+ un = sum; \
+ carry = 0; \
+ } \
+ else \
+ { \
+ un = (sum - BIGNUM_RADIX_ROOT); \
+ carry = 1; \
+ } \
}
-bignum_digit_type
-bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
- bignum_digit_type guess, bignum_digit_type * u)
+bignum_digit_type factor_vm::bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2, bignum_digit_type guess, bignum_digit_type * u)
{
- {
- bignum_digit_type product;
- bignum_digit_type diff;
- bignum_digit_type carry;
- BDDS_MULSUB (v2, (u[2]), 0);
- BDDS_MULSUB (v1, (u[1]), carry);
- if (carry == 0)
- return (guess);
- diff = ((u[0]) - carry);
- if (diff < 0)
- (u[0]) = (diff + BIGNUM_RADIX);
- else
- {
- (u[0]) = diff;
- return (guess);
- }
- }
- {
- bignum_digit_type sum;
- bignum_digit_type carry;
- BDDS_ADD(v2, (u[2]), 0);
- BDDS_ADD(v1, (u[1]), carry);
- if (carry == 1)
- (u[0]) += 1;
- }
- return (guess - 1);
+ {
+ bignum_digit_type product;
+ bignum_digit_type diff;
+ bignum_digit_type carry;
+ BDDS_MULSUB (v2, (u[2]), 0);
+ BDDS_MULSUB (v1, (u[1]), carry);
+ if (carry == 0)
+ return (guess);
+ diff = ((u[0]) - carry);
+ if (diff < 0)
+ (u[0]) = (diff + BIGNUM_RADIX);
+ else
+ {
+ (u[0]) = diff;
+ return (guess);
+ }
+ }
+ {
+ bignum_digit_type sum;
+ bignum_digit_type carry;
+ BDDS_ADD(v2, (u[2]), 0);
+ BDDS_ADD(v1, (u[1]), carry);
+ if (carry == 1)
+ (u[0]) += 1;
+ }
+ return (guess - 1);
}
#undef BDDS_MULSUB
#undef BDDS_ADD
/* allocates memory */
-void
-bignum_divide_unsigned_small_denominator(bignum * numerator,
- bignum_digit_type denominator,
- bignum * * quotient,
- bignum * * remainder,
- int q_negative_p,
- int r_negative_p)
+void factor_vm::bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator, bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p)
{
- GC_BIGNUM(numerator);
+ GC_BIGNUM(numerator);
- bignum * q = (bignum_new_sign (numerator, q_negative_p));
- GC_BIGNUM(q);
+ bignum * q = (bignum_new_sign (numerator, q_negative_p));
+ GC_BIGNUM(q);
- bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
+ bignum_digit_type r = (bignum_destructive_scale_down (q, denominator));
- q = (bignum_trim (q));
+ q = (bignum_trim (q));
- if (remainder != ((bignum * *) 0))
- (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
+ if (remainder != ((bignum * *) 0))
+ (*remainder) = (bignum_digit_to_bignum (r, r_negative_p));
- (*quotient) = q;
+ (*quotient) = q;
- return;
+ return;
}
/* Given (denominator > 1), it is fairly easy to show that
(quotient_high < BIGNUM_RADIX_ROOT), after which it is easy to see
that all digits are < BIGNUM_RADIX. */
-bignum_digit_type
-bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
+bignum_digit_type factor_vm::bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator)
{
- bignum_digit_type numerator;
- bignum_digit_type remainder = 0;
- bignum_digit_type two_digits;
+ bignum_digit_type numerator;
+ bignum_digit_type remainder = 0;
+ bignum_digit_type two_digits;
#define quotient_high remainder
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
- BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
- while (start < scan)
- {
- two_digits = (*--scan);
- numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
- quotient_high = (numerator / denominator);
- numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
- (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
- remainder = (numerator % denominator);
- }
- return (remainder);
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (bignum)));
+ BIGNUM_ASSERT ((denominator > 1) && (denominator < BIGNUM_RADIX_ROOT));
+ while (start < scan)
+ {
+ two_digits = (*--scan);
+ numerator = (HD_CONS (remainder, (HD_HIGH (two_digits))));
+ quotient_high = (numerator / denominator);
+ numerator = (HD_CONS ((numerator % denominator), (HD_LOW (two_digits))));
+ (*scan) = (HD_CONS (quotient_high, (numerator / denominator)));
+ remainder = (numerator % denominator);
+ }
+ return (remainder);
#undef quotient_high
}
/* allocates memory */
-bignum *
-bignum_remainder_unsigned_small_denominator(
- bignum * n, bignum_digit_type d, int negative_p)
+bignum * factor_vm::bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p)
{
- bignum_digit_type two_digits;
- bignum_digit_type * start = (BIGNUM_START_PTR (n));
- bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
- bignum_digit_type r = 0;
- BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
- while (start < scan)
- {
- two_digits = (*--scan);
- r =
- ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
- (HD_LOW (two_digits))))
- % d);
- }
- return (bignum_digit_to_bignum (r, negative_p));
+ bignum_digit_type two_digits;
+ bignum_digit_type * start = (BIGNUM_START_PTR (n));
+ bignum_digit_type * scan = (start + (BIGNUM_LENGTH (n)));
+ bignum_digit_type r = 0;
+ BIGNUM_ASSERT ((d > 1) && (d < BIGNUM_RADIX_ROOT));
+ while (start < scan)
+ {
+ two_digits = (*--scan);
+ r =
+ ((HD_CONS (((HD_CONS (r, (HD_HIGH (two_digits)))) % d),
+ (HD_LOW (two_digits))))
+ % d);
+ }
+ return (bignum_digit_to_bignum (r, negative_p));
}
/* allocates memory */
-bignum *
-bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
+bignum *factor_vm::bignum_digit_to_bignum(bignum_digit_type digit, int negative_p)
{
- if (digit == 0)
- return (BIGNUM_ZERO ());
- else
- {
- bignum * result = (allot_bignum (1, negative_p));
- (BIGNUM_REF (result, 0)) = digit;
- return (result);
- }
+ if (digit == 0)
+ return (BIGNUM_ZERO ());
+ else
+ {
+ bignum * result = (allot_bignum (1, negative_p));
+ (BIGNUM_REF (result, 0)) = digit;
+ return (result);
+ }
}
/* allocates memory */
-bignum *
-allot_bignum(bignum_length_type length, int negative_p)
+bignum *factor_vm::allot_bignum(bignum_length_type length, int negative_p)
{
- BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
- bignum * result = allot_array_internal<bignum>(length + 1);
- BIGNUM_SET_NEGATIVE_P (result, negative_p);
- return (result);
+ BIGNUM_ASSERT ((length >= 0) || (length < BIGNUM_RADIX));
+ bignum * result = allot_array_internal<bignum>(length + 1);
+ BIGNUM_SET_NEGATIVE_P (result, negative_p);
+ return (result);
}
/* allocates memory */
-bignum *
-allot_bignum_zeroed(bignum_length_type length, int negative_p)
+bignum * factor_vm::allot_bignum_zeroed(bignum_length_type length, int negative_p)
{
- bignum * result = allot_bignum(length,negative_p);
- bignum_digit_type * scan = (BIGNUM_START_PTR (result));
- bignum_digit_type * end = (scan + length);
- while (scan < end)
- (*scan++) = 0;
- return (result);
+ bignum * result = allot_bignum(length,negative_p);
+ bignum_digit_type * scan = (BIGNUM_START_PTR (result));
+ bignum_digit_type * end = (scan + length);
+ while (scan < end)
+ (*scan++) = 0;
+ return (result);
}
-#define BIGNUM_REDUCE_LENGTH(source, length) \
- source = reallot_array(source,length + 1)
+#define BIGNUM_REDUCE_LENGTH(source, length) \
+source = reallot_array(source,length + 1)
/* allocates memory */
-bignum *
-bignum_shorten_length(bignum * bignum, bignum_length_type length)
+bignum *factor_vm::bignum_shorten_length(bignum * bignum, bignum_length_type length)
{
- bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
- BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
- if (length < current_length)
- {
- BIGNUM_REDUCE_LENGTH (bignum, length);
- BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
- }
- return (bignum);
+ bignum_length_type current_length = (BIGNUM_LENGTH (bignum));
+ BIGNUM_ASSERT ((length >= 0) || (length <= current_length));
+ if (length < current_length)
+ {
+ BIGNUM_REDUCE_LENGTH (bignum, length);
+ BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
+ }
+ return (bignum);
}
/* allocates memory */
-bignum *
-bignum_trim(bignum * bignum)
+bignum *factor_vm::bignum_trim(bignum * bignum)
{
- bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
- bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
- bignum_digit_type * scan = end;
- while ((start <= scan) && ((*--scan) == 0))
- ;
- scan += 1;
- if (scan < end)
- {
- bignum_length_type length = (scan - start);
- BIGNUM_REDUCE_LENGTH (bignum, length);
- BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
- }
- return (bignum);
+ bignum_digit_type * start = (BIGNUM_START_PTR (bignum));
+ bignum_digit_type * end = (start + (BIGNUM_LENGTH (bignum)));
+ bignum_digit_type * scan = end;
+ while ((start <= scan) && ((*--scan) == 0))
+ ;
+ scan += 1;
+ if (scan < end)
+ {
+ bignum_length_type length = (scan - start);
+ BIGNUM_REDUCE_LENGTH (bignum, length);
+ BIGNUM_SET_NEGATIVE_P (bignum, (length != 0) && (BIGNUM_NEGATIVE_P (bignum)));
+ }
+ return (bignum);
}
/* Copying */
/* allocates memory */
-bignum *
-bignum_new_sign(bignum * x, int negative_p)
+bignum *factor_vm::bignum_new_sign(bignum * x, int negative_p)
{
- GC_BIGNUM(x);
- bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
+ GC_BIGNUM(x);
+ bignum * result = (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
- bignum_destructive_copy (x, result);
- return (result);
+ bignum_destructive_copy (x, result);
+ return (result);
}
/* allocates memory */
-bignum *
-bignum_maybe_new_sign(bignum * x, int negative_p)
+bignum *factor_vm::bignum_maybe_new_sign(bignum * x, int negative_p)
{
- if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
- return (x);
- else
- {
- bignum * result =
- (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
- bignum_destructive_copy (x, result);
- return (result);
- }
+ if ((BIGNUM_NEGATIVE_P (x)) ? negative_p : (! negative_p))
+ return (x);
+ else
+ {
+ bignum * result =
+ (allot_bignum ((BIGNUM_LENGTH (x)), negative_p));
+ bignum_destructive_copy (x, result);
+ return (result);
+ }
}
-void
-bignum_destructive_copy(bignum * source, bignum * target)
+void factor_vm::bignum_destructive_copy(bignum * source, bignum * target)
{
- bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
- bignum_digit_type * end_source =
- (scan_source + (BIGNUM_LENGTH (source)));
- bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
- while (scan_source < end_source)
- (*scan_target++) = (*scan_source++);
- return;
+ bignum_digit_type * scan_source = (BIGNUM_START_PTR (source));
+ bignum_digit_type * end_source =
+ (scan_source + (BIGNUM_LENGTH (source)));
+ bignum_digit_type * scan_target = (BIGNUM_START_PTR (target));
+ while (scan_source < end_source)
+ (*scan_target++) = (*scan_source++);
+ return;
}
/*
*/
/* allocates memory */
-bignum *
-bignum_bitwise_not(bignum * x)
+bignum *factor_vm::bignum_bitwise_not(bignum * x)
{
- return bignum_subtract(BIGNUM_ONE(1), x);
+ return bignum_subtract(BIGNUM_ONE(1), x);
}
/* allocates memory */
-bignum *
-bignum_arithmetic_shift(bignum * arg1, fixnum n)
+bignum *factor_vm::bignum_arithmetic_shift(bignum * arg1, fixnum n)
{
- if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
- return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
- else
- return bignum_magnitude_ash(arg1, n);
+ if (BIGNUM_NEGATIVE_P(arg1) && n < 0)
+ return bignum_bitwise_not(bignum_magnitude_ash(bignum_bitwise_not(arg1), n));
+ else
+ return bignum_magnitude_ash(arg1, n);
}
#define AND_OP 0
#define XOR_OP 2
/* allocates memory */
-bignum *
-bignum_bitwise_and(bignum * arg1, bignum * arg2)
+bignum *factor_vm::bignum_bitwise_and(bignum * arg1, bignum * arg2)
{
- return(
- (BIGNUM_NEGATIVE_P (arg1))
- ? (BIGNUM_NEGATIVE_P (arg2))
- ? bignum_negneg_bitwise_op(AND_OP, arg1, arg2)
- : bignum_posneg_bitwise_op(AND_OP, arg2, arg1)
- : (BIGNUM_NEGATIVE_P (arg2))
- ? bignum_posneg_bitwise_op(AND_OP, arg1, arg2)
- : bignum_pospos_bitwise_op(AND_OP, arg1, arg2)
- );
+ return(
+ (BIGNUM_NEGATIVE_P (arg1))
+ ? (BIGNUM_NEGATIVE_P (arg2))
+ ? bignum_negneg_bitwise_op(AND_OP, arg1, arg2)
+ : bignum_posneg_bitwise_op(AND_OP, arg2, arg1)
+ : (BIGNUM_NEGATIVE_P (arg2))
+ ? bignum_posneg_bitwise_op(AND_OP, arg1, arg2)
+ : bignum_pospos_bitwise_op(AND_OP, arg1, arg2)
+ );
}
/* allocates memory */
-bignum *
-bignum_bitwise_ior(bignum * arg1, bignum * arg2)
+bignum *factor_vm::bignum_bitwise_ior(bignum * arg1, bignum * arg2)
{
- return(
- (BIGNUM_NEGATIVE_P (arg1))
- ? (BIGNUM_NEGATIVE_P (arg2))
- ? bignum_negneg_bitwise_op(IOR_OP, arg1, arg2)
- : bignum_posneg_bitwise_op(IOR_OP, arg2, arg1)
- : (BIGNUM_NEGATIVE_P (arg2))
- ? bignum_posneg_bitwise_op(IOR_OP, arg1, arg2)
- : bignum_pospos_bitwise_op(IOR_OP, arg1, arg2)
- );
+ return(
+ (BIGNUM_NEGATIVE_P (arg1))
+ ? (BIGNUM_NEGATIVE_P (arg2))
+ ? bignum_negneg_bitwise_op(IOR_OP, arg1, arg2)
+ : bignum_posneg_bitwise_op(IOR_OP, arg2, arg1)
+ : (BIGNUM_NEGATIVE_P (arg2))
+ ? bignum_posneg_bitwise_op(IOR_OP, arg1, arg2)
+ : bignum_pospos_bitwise_op(IOR_OP, arg1, arg2)
+ );
}
/* allocates memory */
-bignum *
-bignum_bitwise_xor(bignum * arg1, bignum * arg2)
+bignum *factor_vm::bignum_bitwise_xor(bignum * arg1, bignum * arg2)
{
- return(
- (BIGNUM_NEGATIVE_P (arg1))
- ? (BIGNUM_NEGATIVE_P (arg2))
- ? bignum_negneg_bitwise_op(XOR_OP, arg1, arg2)
- : bignum_posneg_bitwise_op(XOR_OP, arg2, arg1)
- : (BIGNUM_NEGATIVE_P (arg2))
- ? bignum_posneg_bitwise_op(XOR_OP, arg1, arg2)
- : bignum_pospos_bitwise_op(XOR_OP, arg1, arg2)
- );
+ return(
+ (BIGNUM_NEGATIVE_P (arg1))
+ ? (BIGNUM_NEGATIVE_P (arg2))
+ ? bignum_negneg_bitwise_op(XOR_OP, arg1, arg2)
+ : bignum_posneg_bitwise_op(XOR_OP, arg2, arg1)
+ : (BIGNUM_NEGATIVE_P (arg2))
+ ? bignum_posneg_bitwise_op(XOR_OP, arg1, arg2)
+ : bignum_pospos_bitwise_op(XOR_OP, arg1, arg2)
+ );
}
/* allocates memory */
/* ash for the magnitude */
/* assume arg1 is a big number, n is a long */
-bignum *
-bignum_magnitude_ash(bignum * arg1, fixnum n)
+bignum *factor_vm::bignum_magnitude_ash(bignum * arg1, fixnum n)
{
- GC_BIGNUM(arg1);
+ GC_BIGNUM(arg1);
- bignum * result = NULL;
- bignum_digit_type *scan1;
- bignum_digit_type *scanr;
- bignum_digit_type *end;
-
- fixnum digit_offset,bit_offset;
-
- if (BIGNUM_ZERO_P (arg1)) return (arg1);
-
- if (n > 0) {
- digit_offset = n / BIGNUM_DIGIT_LENGTH;
- bit_offset = n % BIGNUM_DIGIT_LENGTH;
-
- result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
- BIGNUM_NEGATIVE_P(arg1));
-
- scanr = BIGNUM_START_PTR (result) + digit_offset;
- scan1 = BIGNUM_START_PTR (arg1);
- end = scan1 + BIGNUM_LENGTH (arg1);
-
- while (scan1 < end) {
- *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
- *scanr = *scanr & BIGNUM_DIGIT_MASK;
- scanr++;
- *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
- *scanr = *scanr & BIGNUM_DIGIT_MASK;
- }
- }
- else if (n < 0
- && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
- result = BIGNUM_ZERO ();
-
- else if (n < 0) {
- digit_offset = -n / BIGNUM_DIGIT_LENGTH;
- bit_offset = -n % BIGNUM_DIGIT_LENGTH;
-
- result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
- BIGNUM_NEGATIVE_P(arg1));
-
- scanr = BIGNUM_START_PTR (result);
- scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
- end = scanr + BIGNUM_LENGTH (result) - 1;
-
- while (scanr < end) {
- *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
- *scanr = (*scanr |
- *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
- scanr++;
- }
- *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
- }
- else if (n == 0) result = arg1;
+ bignum * result = NULL;
+ bignum_digit_type *scan1;
+ bignum_digit_type *scanr;
+ bignum_digit_type *end;
+
+ fixnum digit_offset,bit_offset;
+
+ if (BIGNUM_ZERO_P (arg1)) return (arg1);
+
+ if (n > 0) {
+ digit_offset = n / BIGNUM_DIGIT_LENGTH;
+ bit_offset = n % BIGNUM_DIGIT_LENGTH;
+
+ result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) + digit_offset + 1,
+ BIGNUM_NEGATIVE_P(arg1));
+
+ scanr = BIGNUM_START_PTR (result) + digit_offset;
+ scan1 = BIGNUM_START_PTR (arg1);
+ end = scan1 + BIGNUM_LENGTH (arg1);
+
+ while (scan1 < end) {
+ *scanr = *scanr | (*scan1 & BIGNUM_DIGIT_MASK) << bit_offset;
+ *scanr = *scanr & BIGNUM_DIGIT_MASK;
+ scanr++;
+ *scanr = *scan1++ >> (BIGNUM_DIGIT_LENGTH - bit_offset);
+ *scanr = *scanr & BIGNUM_DIGIT_MASK;
+ }
+ }
+ else if (n < 0
+ && (-n >= (BIGNUM_LENGTH (arg1) * (bignum_length_type) BIGNUM_DIGIT_LENGTH)))
+ result = BIGNUM_ZERO ();
+
+ else if (n < 0) {
+ digit_offset = -n / BIGNUM_DIGIT_LENGTH;
+ bit_offset = -n % BIGNUM_DIGIT_LENGTH;
+
+ result = allot_bignum_zeroed (BIGNUM_LENGTH (arg1) - digit_offset,
+ BIGNUM_NEGATIVE_P(arg1));
+
+ scanr = BIGNUM_START_PTR (result);
+ scan1 = BIGNUM_START_PTR (arg1) + digit_offset;
+ end = scanr + BIGNUM_LENGTH (result) - 1;
+
+ while (scanr < end) {
+ *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
+ *scanr = (*scanr |
+ *scan1 << (BIGNUM_DIGIT_LENGTH - bit_offset)) & BIGNUM_DIGIT_MASK;
+ scanr++;
+ }
+ *scanr = (*scan1++ & BIGNUM_DIGIT_MASK) >> bit_offset ;
+ }
+ else if (n == 0) result = arg1;
- return (bignum_trim (result));
+ return (bignum_trim (result));
}
/* allocates memory */
-bignum *
-bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
+bignum *factor_vm::bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
- GC_BIGNUM(arg1); GC_BIGNUM(arg2);
+ GC_BIGNUM(arg1); GC_BIGNUM(arg2);
- bignum * result;
- bignum_length_type max_length;
-
- bignum_digit_type *scan1, *end1, digit1;
- bignum_digit_type *scan2, *end2, digit2;
- bignum_digit_type *scanr, *endr;
-
- max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
- ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
-
- result = allot_bignum(max_length, 0);
-
- scanr = BIGNUM_START_PTR(result);
- scan1 = BIGNUM_START_PTR(arg1);
- scan2 = BIGNUM_START_PTR(arg2);
- endr = scanr + max_length;
- end1 = scan1 + BIGNUM_LENGTH(arg1);
- end2 = scan2 + BIGNUM_LENGTH(arg2);
-
- while (scanr < endr) {
- digit1 = (scan1 < end1) ? *scan1++ : 0;
- digit2 = (scan2 < end2) ? *scan2++ : 0;
- *scanr++ = (op == AND_OP) ? digit1 & digit2 :
- (op == IOR_OP) ? digit1 | digit2 :
- digit1 ^ digit2;
- }
- return bignum_trim(result);
+ bignum * result;
+ bignum_length_type max_length;
+
+ bignum_digit_type *scan1, *end1, digit1;
+ bignum_digit_type *scan2, *end2, digit2;
+ bignum_digit_type *scanr, *endr;
+
+ max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
+ ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2);
+
+ result = allot_bignum(max_length, 0);
+
+ scanr = BIGNUM_START_PTR(result);
+ scan1 = BIGNUM_START_PTR(arg1);
+ scan2 = BIGNUM_START_PTR(arg2);
+ endr = scanr + max_length;
+ end1 = scan1 + BIGNUM_LENGTH(arg1);
+ end2 = scan2 + BIGNUM_LENGTH(arg2);
+
+ while (scanr < endr) {
+ digit1 = (scan1 < end1) ? *scan1++ : 0;
+ digit2 = (scan2 < end2) ? *scan2++ : 0;
+ *scanr++ = (op == AND_OP) ? digit1 & digit2 :
+ (op == IOR_OP) ? digit1 | digit2 :
+ digit1 ^ digit2;
+ }
+ return bignum_trim(result);
}
/* allocates memory */
-bignum *
-bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
+bignum *factor_vm::bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
- GC_BIGNUM(arg1); GC_BIGNUM(arg2);
+ GC_BIGNUM(arg1); GC_BIGNUM(arg2);
- bignum * result;
- bignum_length_type max_length;
-
- bignum_digit_type *scan1, *end1, digit1;
- bignum_digit_type *scan2, *end2, digit2, carry2;
- bignum_digit_type *scanr, *endr;
-
- char neg_p = op == IOR_OP || op == XOR_OP;
-
- max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
- ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
-
- result = allot_bignum(max_length, neg_p);
-
- scanr = BIGNUM_START_PTR(result);
- scan1 = BIGNUM_START_PTR(arg1);
- scan2 = BIGNUM_START_PTR(arg2);
- endr = scanr + max_length;
- end1 = scan1 + BIGNUM_LENGTH(arg1);
- end2 = scan2 + BIGNUM_LENGTH(arg2);
-
- carry2 = 1;
-
- while (scanr < endr) {
- digit1 = (scan1 < end1) ? *scan1++ : 0;
- digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
- + carry2;
-
- if (digit2 < BIGNUM_RADIX)
- carry2 = 0;
- else
- {
- digit2 = (digit2 - BIGNUM_RADIX);
- carry2 = 1;
- }
-
- *scanr++ = (op == AND_OP) ? digit1 & digit2 :
- (op == IOR_OP) ? digit1 | digit2 :
- digit1 ^ digit2;
- }
+ bignum * result;
+ bignum_length_type max_length;
+
+ bignum_digit_type *scan1, *end1, digit1;
+ bignum_digit_type *scan2, *end2, digit2, carry2;
+ bignum_digit_type *scanr, *endr;
+
+ char neg_p = op == IOR_OP || op == XOR_OP;
+
+ max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2) + 1)
+ ? BIGNUM_LENGTH(arg1) : BIGNUM_LENGTH(arg2) + 1;
+
+ result = allot_bignum(max_length, neg_p);
+
+ scanr = BIGNUM_START_PTR(result);
+ scan1 = BIGNUM_START_PTR(arg1);
+ scan2 = BIGNUM_START_PTR(arg2);
+ endr = scanr + max_length;
+ end1 = scan1 + BIGNUM_LENGTH(arg1);
+ end2 = scan2 + BIGNUM_LENGTH(arg2);
+
+ carry2 = 1;
+
+ while (scanr < endr) {
+ digit1 = (scan1 < end1) ? *scan1++ : 0;
+ digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK)
+ + carry2;
+
+ if (digit2 < BIGNUM_RADIX)
+ carry2 = 0;
+ else
+ {
+ digit2 = (digit2 - BIGNUM_RADIX);
+ carry2 = 1;
+ }
+
+ *scanr++ = (op == AND_OP) ? digit1 & digit2 :
+ (op == IOR_OP) ? digit1 | digit2 :
+ digit1 ^ digit2;
+ }
- if (neg_p)
- bignum_negate_magnitude(result);
+ if (neg_p)
+ bignum_negate_magnitude(result);
- return bignum_trim(result);
+ return bignum_trim(result);
}
/* allocates memory */
-bignum *
-bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
+bignum *factor_vm::bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2)
{
- GC_BIGNUM(arg1); GC_BIGNUM(arg2);
+ GC_BIGNUM(arg1); GC_BIGNUM(arg2);
- bignum * result;
- bignum_length_type max_length;
-
- bignum_digit_type *scan1, *end1, digit1, carry1;
- bignum_digit_type *scan2, *end2, digit2, carry2;
- bignum_digit_type *scanr, *endr;
-
- char neg_p = op == AND_OP || op == IOR_OP;
-
- max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
- ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
-
- result = allot_bignum(max_length, neg_p);
-
- scanr = BIGNUM_START_PTR(result);
- scan1 = BIGNUM_START_PTR(arg1);
- scan2 = BIGNUM_START_PTR(arg2);
- endr = scanr + max_length;
- end1 = scan1 + BIGNUM_LENGTH(arg1);
- end2 = scan2 + BIGNUM_LENGTH(arg2);
-
- carry1 = 1;
- carry2 = 1;
-
- while (scanr < endr) {
- digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
- digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
-
- if (digit1 < BIGNUM_RADIX)
- carry1 = 0;
- else
- {
- digit1 = (digit1 - BIGNUM_RADIX);
- carry1 = 1;
- }
-
- if (digit2 < BIGNUM_RADIX)
- carry2 = 0;
- else
- {
- digit2 = (digit2 - BIGNUM_RADIX);
- carry2 = 1;
- }
-
- *scanr++ = (op == AND_OP) ? digit1 & digit2 :
- (op == IOR_OP) ? digit1 | digit2 :
- digit1 ^ digit2;
- }
-
- if (neg_p)
- bignum_negate_magnitude(result);
-
- return bignum_trim(result);
+ bignum * result;
+ bignum_length_type max_length;
+
+ bignum_digit_type *scan1, *end1, digit1, carry1;
+ bignum_digit_type *scan2, *end2, digit2, carry2;
+ bignum_digit_type *scanr, *endr;
+
+ char neg_p = op == AND_OP || op == IOR_OP;
+
+ max_length = (BIGNUM_LENGTH(arg1) > BIGNUM_LENGTH(arg2))
+ ? BIGNUM_LENGTH(arg1) + 1 : BIGNUM_LENGTH(arg2) + 1;
+
+ result = allot_bignum(max_length, neg_p);
+
+ scanr = BIGNUM_START_PTR(result);
+ scan1 = BIGNUM_START_PTR(arg1);
+ scan2 = BIGNUM_START_PTR(arg2);
+ endr = scanr + max_length;
+ end1 = scan1 + BIGNUM_LENGTH(arg1);
+ end2 = scan2 + BIGNUM_LENGTH(arg2);
+
+ carry1 = 1;
+ carry2 = 1;
+
+ while (scanr < endr) {
+ digit1 = (~((scan1 < end1) ? *scan1++ : 0) & BIGNUM_DIGIT_MASK) + carry1;
+ digit2 = (~((scan2 < end2) ? *scan2++ : 0) & BIGNUM_DIGIT_MASK) + carry2;
+
+ if (digit1 < BIGNUM_RADIX)
+ carry1 = 0;
+ else
+ {
+ digit1 = (digit1 - BIGNUM_RADIX);
+ carry1 = 1;
+ }
+
+ if (digit2 < BIGNUM_RADIX)
+ carry2 = 0;
+ else
+ {
+ digit2 = (digit2 - BIGNUM_RADIX);
+ carry2 = 1;
+ }
+
+ *scanr++ = (op == AND_OP) ? digit1 & digit2 :
+ (op == IOR_OP) ? digit1 | digit2 :
+ digit1 ^ digit2;
+ }
+
+ if (neg_p)
+ bignum_negate_magnitude(result);
+
+ return bignum_trim(result);
}
-void
-bignum_negate_magnitude(bignum * arg)
+void factor_vm::bignum_negate_magnitude(bignum * arg)
{
- bignum_digit_type *scan;
- bignum_digit_type *end;
- bignum_digit_type digit;
- bignum_digit_type carry;
-
- scan = BIGNUM_START_PTR(arg);
- end = scan + BIGNUM_LENGTH(arg);
-
- carry = 1;
-
- while (scan < end) {
- digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
-
- if (digit < BIGNUM_RADIX)
- carry = 0;
- else
- {
- digit = (digit - BIGNUM_RADIX);
- carry = 1;
- }
-
- *scan++ = digit;
- }
+ bignum_digit_type *scan;
+ bignum_digit_type *end;
+ bignum_digit_type digit;
+ bignum_digit_type carry;
+
+ scan = BIGNUM_START_PTR(arg);
+ end = scan + BIGNUM_LENGTH(arg);
+
+ carry = 1;
+
+ while (scan < end) {
+ digit = (~*scan & BIGNUM_DIGIT_MASK) + carry;
+
+ if (digit < BIGNUM_RADIX)
+ carry = 0;
+ else
+ {
+ digit = (digit - BIGNUM_RADIX);
+ carry = 1;
+ }
+
+ *scan++ = digit;
+ }
}
/* Allocates memory */
-bignum *
-bignum_integer_length(bignum * x)
+bignum *factor_vm::bignum_integer_length(bignum * x)
{
- GC_BIGNUM(x);
+ GC_BIGNUM(x);
- bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
- bignum_digit_type digit = (BIGNUM_REF (x, index));
+ bignum_length_type index = ((BIGNUM_LENGTH (x)) - 1);
+ bignum_digit_type digit = (BIGNUM_REF (x, index));
- bignum * result = (allot_bignum (2, 0));
+ bignum * result = (allot_bignum (2, 0));
- (BIGNUM_REF (result, 0)) = index;
- (BIGNUM_REF (result, 1)) = 0;
- bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
- while (digit > 1)
- {
- bignum_destructive_add (result, ((bignum_digit_type) 1));
- digit >>= 1;
- }
- return (bignum_trim (result));
+ (BIGNUM_REF (result, 0)) = index;
+ (BIGNUM_REF (result, 1)) = 0;
+ bignum_destructive_scale_up (result, BIGNUM_DIGIT_LENGTH);
+ while (digit > 1)
+ {
+ bignum_destructive_add (result, ((bignum_digit_type) 1));
+ digit >>= 1;
+ }
+ return (bignum_trim (result));
}
/* Allocates memory */
-int
-bignum_logbitp(int shift, bignum * arg)
+int factor_vm::bignum_logbitp(int shift, bignum * arg)
{
- return((BIGNUM_NEGATIVE_P (arg))
- ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
- : bignum_unsigned_logbitp (shift,arg));
+ return((BIGNUM_NEGATIVE_P (arg))
+ ? !bignum_unsigned_logbitp (shift, bignum_bitwise_not (arg))
+ : bignum_unsigned_logbitp (shift,arg));
}
-int
-bignum_unsigned_logbitp(int shift, bignum * bignum)
+int factor_vm::bignum_unsigned_logbitp(int shift, bignum * bignum)
{
- bignum_length_type len = (BIGNUM_LENGTH (bignum));
- int index = shift / BIGNUM_DIGIT_LENGTH;
- if (index >= len)
- return 0;
- bignum_digit_type digit = (BIGNUM_REF (bignum, index));
- int p = shift % BIGNUM_DIGIT_LENGTH;
- bignum_digit_type mask = ((fixnum)1) << p;
- return (digit & mask) ? 1 : 0;
+ bignum_length_type len = (BIGNUM_LENGTH (bignum));
+ int index = shift / BIGNUM_DIGIT_LENGTH;
+ if (index >= len)
+ return 0;
+ bignum_digit_type digit = (BIGNUM_REF (bignum, index));
+ int p = shift % BIGNUM_DIGIT_LENGTH;
+ bignum_digit_type mask = ((fixnum)1) << p;
+ return (digit & mask) ? 1 : 0;
}
/* Allocates memory */
-bignum *
-digit_stream_to_bignum(unsigned int n_digits,
- unsigned int (*producer)(unsigned int),
- unsigned int radix,
- int negative_p)
+bignum *factor_vm::digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factor_vm*), unsigned int radix, int negative_p)
{
- BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
- if (n_digits == 0)
- return (BIGNUM_ZERO ());
- if (n_digits == 1)
- {
- fixnum digit = ((fixnum) ((*producer) (0)));
- return (fixnum_to_bignum (negative_p ? (- digit) : digit));
- }
- {
- bignum_length_type length;
- {
- unsigned int radix_copy = radix;
- unsigned int log_radix = 0;
- while (radix_copy > 0)
- {
- radix_copy >>= 1;
- log_radix += 1;
- }
- /* This length will be at least as large as needed. */
- length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
- }
- {
- bignum * result = (allot_bignum_zeroed (length, negative_p));
- while ((n_digits--) > 0)
- {
- bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
- bignum_destructive_add
- (result, ((bignum_digit_type) ((*producer) (n_digits))));
- }
- return (bignum_trim (result));
- }
- }
+ BIGNUM_ASSERT ((radix > 1) && (radix <= BIGNUM_RADIX_ROOT));
+ if (n_digits == 0)
+ return (BIGNUM_ZERO ());
+ if (n_digits == 1)
+ {
+ fixnum digit = ((fixnum) ((*producer) (0,this)));
+ return (fixnum_to_bignum (negative_p ? (- digit) : digit));
+ }
+ {
+ bignum_length_type length;
+ {
+ unsigned int radix_copy = radix;
+ unsigned int log_radix = 0;
+ while (radix_copy > 0)
+ {
+ radix_copy >>= 1;
+ log_radix += 1;
+ }
+ /* This length will be at least as large as needed. */
+ length = (BIGNUM_BITS_TO_DIGITS (n_digits * log_radix));
+ }
+ {
+ bignum * result = (allot_bignum_zeroed (length, negative_p));
+ while ((n_digits--) > 0)
+ {
+ bignum_destructive_scale_up (result, ((bignum_digit_type) radix));
+ bignum_destructive_add
+ (result, ((bignum_digit_type) ((*producer) (n_digits,this))));
+ }
+ return (bignum_trim (result));
+ }
+ }
}
}
namespace factor
{
-/* :tabSize=2:indentSize=2:noTabs=true:
+/*
Copyright (C) 1989-1992 Massachusetts Institute of Technology
Portions copyright (C) 2004-2009 Slava Pestov
bignum_comparison_greater = 1
};
-int bignum_equal_p(bignum *, bignum *);
-enum bignum_comparison bignum_compare(bignum *, bignum *);
-bignum * bignum_add(bignum *, bignum *);
-bignum * bignum_subtract(bignum *, bignum *);
-bignum * bignum_negate(bignum *);
-bignum * bignum_multiply(bignum *, bignum *);
-void
-bignum_divide(bignum * numerator, bignum * denominator,
- bignum * * quotient, bignum * * remainder);
-bignum * bignum_quotient(bignum *, bignum *);
-bignum * bignum_remainder(bignum *, bignum *);
-bignum * fixnum_to_bignum(fixnum);
-bignum * cell_to_bignum(cell);
-bignum * long_long_to_bignum(s64 n);
-bignum * ulong_long_to_bignum(u64 n);
-fixnum bignum_to_fixnum(bignum *);
-cell bignum_to_cell(bignum *);
-s64 bignum_to_long_long(bignum *);
-u64 bignum_to_ulong_long(bignum *);
-bignum * double_to_bignum(double);
-double bignum_to_double(bignum *);
-
-/* Added bitwise operators. */
-
-bignum * bignum_bitwise_not(bignum *);
-bignum * bignum_arithmetic_shift(bignum *, fixnum);
-bignum * bignum_bitwise_and(bignum *, bignum *);
-bignum * bignum_bitwise_ior(bignum *, bignum *);
-bignum * bignum_bitwise_xor(bignum *, bignum *);
-
-/* Forward references */
-int bignum_equal_p_unsigned(bignum *, bignum *);
-enum bignum_comparison bignum_compare_unsigned(bignum *, bignum *);
-bignum * bignum_add_unsigned(bignum *, bignum *, int);
-bignum * bignum_subtract_unsigned(bignum *, bignum *);
-bignum * bignum_multiply_unsigned(bignum *, bignum *, int);
-bignum * bignum_multiply_unsigned_small_factor
- (bignum *, bignum_digit_type, int);
-void bignum_destructive_scale_up(bignum *, bignum_digit_type);
-void bignum_destructive_add(bignum *, bignum_digit_type);
-void bignum_divide_unsigned_large_denominator
- (bignum *, bignum *, bignum * *, bignum * *, int, int);
-void bignum_destructive_normalization(bignum *, bignum *, int);
-void bignum_destructive_unnormalization(bignum *, int);
-void bignum_divide_unsigned_normalized(bignum *, bignum *, bignum *);
-bignum_digit_type bignum_divide_subtract
- (bignum_digit_type *, bignum_digit_type *, bignum_digit_type,
- bignum_digit_type *);
-void bignum_divide_unsigned_medium_denominator
- (bignum *, bignum_digit_type, bignum * *, bignum * *, int, int);
-bignum_digit_type bignum_digit_divide
- (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
-bignum_digit_type bignum_digit_divide_subtract
- (bignum_digit_type, bignum_digit_type, bignum_digit_type, bignum_digit_type *);
-void bignum_divide_unsigned_small_denominator
- (bignum *, bignum_digit_type, bignum * *, bignum * *, int, int);
-bignum_digit_type bignum_destructive_scale_down
- (bignum *, bignum_digit_type);
-bignum * bignum_remainder_unsigned_small_denominator
- (bignum *, bignum_digit_type, int);
-bignum * bignum_digit_to_bignum(bignum_digit_type, int);
-bignum * allot_bignum(bignum_length_type, int);
-bignum * allot_bignum_zeroed(bignum_length_type, int);
-bignum * bignum_shorten_length(bignum *, bignum_length_type);
-bignum * bignum_trim(bignum *);
-bignum * bignum_new_sign(bignum *, int);
-bignum * bignum_maybe_new_sign(bignum *, int);
-void bignum_destructive_copy(bignum *, bignum *);
-
-/* Added for bitwise operations. */
-bignum * bignum_magnitude_ash(bignum * arg1, fixnum n);
-bignum * bignum_pospos_bitwise_op(int op, bignum *, bignum *);
-bignum * bignum_posneg_bitwise_op(int op, bignum *, bignum *);
-bignum * bignum_negneg_bitwise_op(int op, bignum *, bignum *);
-void bignum_negate_magnitude(bignum *);
-
-bignum * bignum_integer_length(bignum * arg1);
-int bignum_unsigned_logbitp(int shift, bignum * bignum);
-int bignum_logbitp(int shift, bignum * arg);
-bignum * digit_stream_to_bignum(unsigned int n_digits,
- unsigned int (*producer)(unsigned int),
- unsigned int radix,
- int negative_p);
+bignum * digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int,factor_vm*), unsigned int radix, int negative_p);
}
/* BIGNUM_EXCEPTION is invoked to handle assertion violations. */
#define BIGNUM_EXCEPTION abort
-
#define BIGNUM_DIGIT_LENGTH (((sizeof (bignum_digit_type)) * CHAR_BIT) - 2)
#define BIGNUM_HALF_DIGIT_LENGTH (BIGNUM_DIGIT_LENGTH / 2)
#define BIGNUM_RADIX (bignum_digit_type)(((cell) 1) << BIGNUM_DIGIT_LENGTH)
namespace factor
{
-VM_C_API void box_boolean(bool value)
+void factor_vm::box_boolean(bool value)
{
dpush(value ? T : F);
}
-VM_C_API bool to_boolean(cell value)
+VM_C_API void box_boolean(bool value, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_boolean(value);
+}
+
+bool factor_vm::to_boolean(cell value)
{
return value != F;
}
+VM_C_API bool to_boolean(cell value, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_boolean(value);
+}
+
}
namespace factor
{
-inline static cell tag_boolean(cell untagged)
+VM_C_API void box_boolean(bool value, factor_vm *vm);
+VM_C_API bool to_boolean(cell value, factor_vm *vm);
+
+inline cell factor_vm::tag_boolean(cell untagged)
{
return (untagged ? T : F);
}
-VM_C_API void box_boolean(bool value);
-VM_C_API bool to_boolean(cell value);
-
}
namespace factor
{
-byte_array *allot_byte_array(cell size)
+byte_array *factor_vm::allot_byte_array(cell size)
{
byte_array *array = allot_array_internal<byte_array>(size);
memset(array + 1,0,size);
return array;
}
-PRIMITIVE(byte_array)
+void factor_vm::primitive_byte_array()
{
cell size = unbox_array_size();
dpush(tag<byte_array>(allot_byte_array(size)));
}
-PRIMITIVE(uninitialized_byte_array)
+void factor_vm::primitive_uninitialized_byte_array()
{
cell size = unbox_array_size();
dpush(tag<byte_array>(allot_array_internal<byte_array>(size)));
}
-PRIMITIVE(resize_byte_array)
+void factor_vm::primitive_resize_byte_array()
{
byte_array *array = untag_check<byte_array>(dpop());
cell capacity = unbox_array_size();
void growable_byte_array::append_bytes(void *elts, cell len)
{
cell new_size = count + len;
-
+ factor_vm *parent_vm = elements.parent_vm;
if(new_size >= array_capacity(elements.untagged()))
- elements = reallot_array(elements.untagged(),new_size * 2);
+ elements = parent_vm->reallot_array(elements.untagged(),new_size * 2);
memcpy(&elements->data<u8>()[count],elts,len);
void growable_byte_array::append_byte_array(cell byte_array_)
{
- gc_root<byte_array> byte_array(byte_array_);
+ gc_root<byte_array> byte_array(byte_array_,elements.parent_vm);
cell len = array_capacity(byte_array.untagged());
cell new_size = count + len;
-
+ factor_vm *parent_vm = elements.parent_vm;
if(new_size >= array_capacity(elements.untagged()))
- elements = reallot_array(elements.untagged(),new_size * 2);
+ elements = parent_vm->reallot_array(elements.untagged(),new_size * 2);
memcpy(&elements->data<u8>()[count],byte_array->data<u8>(),len);
void growable_byte_array::trim()
{
- elements = reallot_array(elements.untagged(),count);
+ factor_vm *parent_vm = elements.parent_vm;
+ elements = parent_vm->reallot_array(elements.untagged(),count);
}
}
namespace factor
{
-byte_array *allot_byte_array(cell size);
-
-PRIMITIVE(byte_array);
-PRIMITIVE(uninitialized_byte_array);
-PRIMITIVE(resize_byte_array);
-
struct growable_byte_array {
cell count;
gc_root<byte_array> elements;
- growable_byte_array(cell capacity = 40) : count(0), elements(allot_byte_array(capacity)) { }
+ explicit growable_byte_array(factor_vm *myvm,cell capacity = 40) : count(0), elements(myvm->allot_byte_array(capacity),myvm) { }
void append_bytes(void *elts, cell len);
void append_byte_array(cell elts);
namespace factor
{
-static void check_frame(stack_frame *frame)
+void factor_vm::check_frame(stack_frame *frame)
{
#ifdef FACTOR_DEBUG
check_code_pointer((cell)frame->xt);
#endif
}
-callstack *allot_callstack(cell size)
+callstack *factor_vm::allot_callstack(cell size)
{
callstack *stack = allot<callstack>(callstack_size(size));
stack->length = tag_fixnum(size);
return stack;
}
-stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom)
+stack_frame *factor_vm::fix_callstack_top(stack_frame *top, stack_frame *bottom)
{
stack_frame *frame = bottom - 1;
will have popped a necessary frame... however this word is only
called by continuation implementation, and user code shouldn't
be calling it at all, so we leave it as it is for now. */
-stack_frame *capture_start()
+stack_frame *factor_vm::capture_start()
{
stack_frame *frame = stack_chain->callstack_bottom - 1;
while(frame >= stack_chain->callstack_top
return frame + 1;
}
-PRIMITIVE(callstack)
+void factor_vm::primitive_callstack()
{
stack_frame *top = capture_start();
stack_frame *bottom = stack_chain->callstack_bottom;
dpush(tag<callstack>(stack));
}
-PRIMITIVE(set_callstack)
+void factor_vm::primitive_set_callstack()
{
callstack *stack = untag_check<callstack>(dpop());
critical_error("Bug in set_callstack()",0);
}
-code_block *frame_code(stack_frame *frame)
+code_block *factor_vm::frame_code(stack_frame *frame)
{
check_frame(frame);
return (code_block *)frame->xt - 1;
}
-cell frame_type(stack_frame *frame)
+cell factor_vm::frame_type(stack_frame *frame)
{
return frame_code(frame)->type;
}
-cell frame_executing(stack_frame *frame)
+cell factor_vm::frame_executing(stack_frame *frame)
{
code_block *compiled = frame_code(frame);
if(compiled->literals == F || !stack_traces_p())
}
}
-stack_frame *frame_successor(stack_frame *frame)
+stack_frame *factor_vm::frame_successor(stack_frame *frame)
{
check_frame(frame);
return (stack_frame *)((cell)frame - frame->size);
}
/* Allocates memory */
-cell frame_scan(stack_frame *frame)
+cell factor_vm::frame_scan(stack_frame *frame)
{
switch(frame_type(frame))
{
return F;
else
{
- char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame);
+ char *return_addr = (char *)FRAME_RETURN_ADDRESS(frame,this);
char *quot_xt = (char *)(frame_code(frame) + 1);
return tag_fixnum(quot_code_offset_to_scan(
{
struct stack_frame_accumulator {
+ factor_vm *myvm;
growable_array frames;
+ explicit stack_frame_accumulator(factor_vm *myvm_) : myvm(myvm_), frames(myvm_) {}
+
void operator()(stack_frame *frame)
{
- gc_root<object> executing(frame_executing(frame));
- gc_root<object> scan(frame_scan(frame));
+ gc_root<object> executing(myvm->frame_executing(frame),myvm);
+ gc_root<object> scan(myvm->frame_scan(frame),myvm);
frames.add(executing.value());
frames.add(scan.value());
}
-PRIMITIVE(callstack_to_array)
+void factor_vm::primitive_callstack_to_array()
{
- gc_root<callstack> callstack(dpop());
+ gc_root<callstack> callstack(dpop(),this);
- stack_frame_accumulator accum;
+ stack_frame_accumulator accum(this);
iterate_callstack_object(callstack.untagged(),accum);
accum.frames.trim();
dpush(accum.frames.elements.value());
}
-stack_frame *innermost_stack_frame(callstack *stack)
+stack_frame *factor_vm::innermost_stack_frame(callstack *stack)
{
stack_frame *top = stack->top();
stack_frame *bottom = stack->bottom();
return frame;
}
-stack_frame *innermost_stack_frame_quot(callstack *callstack)
+stack_frame *factor_vm::innermost_stack_frame_quot(callstack *callstack)
{
stack_frame *inner = innermost_stack_frame(callstack);
- tagged<quotation>(frame_executing(inner)).untag_check();
+ tagged<quotation>(frame_executing(inner)).untag_check(this);
return inner;
}
/* Some primitives implementing a limited form of callstack mutation.
Used by the single stepper. */
-PRIMITIVE(innermost_stack_frame_executing)
+void factor_vm::primitive_innermost_stack_frame_executing()
{
dpush(frame_executing(innermost_stack_frame(untag_check<callstack>(dpop()))));
}
-PRIMITIVE(innermost_stack_frame_scan)
+void factor_vm::primitive_innermost_stack_frame_scan()
{
dpush(frame_scan(innermost_stack_frame_quot(untag_check<callstack>(dpop()))));
}
-PRIMITIVE(set_innermost_stack_frame_quot)
+void factor_vm::primitive_set_innermost_stack_frame_quot()
{
- gc_root<callstack> callstack(dpop());
- gc_root<quotation> quot(dpop());
+ gc_root<callstack> callstack(dpop(),this);
+ gc_root<quotation> quot(dpop(),this);
- callstack.untag_check();
- quot.untag_check();
+ callstack.untag_check(this);
+ quot.untag_check(this);
jit_compile(quot.value(),true);
stack_frame *inner = innermost_stack_frame_quot(callstack.untagged());
- cell offset = (char *)FRAME_RETURN_ADDRESS(inner) - (char *)inner->xt;
+ cell offset = (char *)FRAME_RETURN_ADDRESS(inner,this) - (char *)inner->xt;
inner->xt = quot->xt;
- FRAME_RETURN_ADDRESS(inner) = (char *)quot->xt + offset;
+ FRAME_RETURN_ADDRESS(inner,this) = (char *)quot->xt + offset;
}
/* called before entry into Factor code. */
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom)
+void factor_vm::save_callstack_bottom(stack_frame *callstack_bottom)
{
stack_chain->callstack_bottom = callstack_bottom;
}
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->save_callstack_bottom(callstack_bottom);
+}
+
}
return sizeof(callstack) + size;
}
-stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
-stack_frame *frame_successor(stack_frame *frame);
-code_block *frame_code(stack_frame *frame);
-cell frame_executing(stack_frame *frame);
-cell frame_scan(stack_frame *frame);
-cell frame_type(stack_frame *frame);
+VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom, factor_vm *vm);
-PRIMITIVE(callstack);
-PRIMITIVE(set_callstack);
-PRIMITIVE(callstack_to_array);
-PRIMITIVE(innermost_stack_frame_executing);
-PRIMITIVE(innermost_stack_frame_scan);
-PRIMITIVE(set_innermost_stack_frame_quot);
-
-VM_ASM_API void save_callstack_bottom(stack_frame *callstack_bottom);
-
-template<typename T> void iterate_callstack(cell top, cell bottom, T &iterator)
+/* This is a little tricky. The iterator may allocate memory, so we
+keep the callstack in a GC root and use relative offsets */
+template<typename Iterator> void factor_vm::iterate_callstack_object(callstack *stack_, Iterator &iterator)
{
- stack_frame *frame = (stack_frame *)bottom - 1;
+ gc_root<callstack> stack(stack_,this);
+ fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
- while((cell)frame >= top)
+ while(frame_offset >= 0)
{
+ stack_frame *frame = stack->frame_at(frame_offset);
+ frame_offset -= frame->size;
iterator(frame);
- frame = frame_successor(frame);
}
}
-/* This is a little tricky. The iterator may allocate memory, so we
-keep the callstack in a GC root and use relative offsets */
-template<typename T> void iterate_callstack_object(callstack *stack_, T &iterator)
+template<typename Iterator> void factor_vm::iterate_callstack(cell top, cell bottom, Iterator &iterator)
{
- gc_root<callstack> stack(stack_);
- fixnum frame_offset = untag_fixnum(stack->length) - sizeof(stack_frame);
+ stack_frame *frame = (stack_frame *)bottom - 1;
- while(frame_offset >= 0)
+ while((cell)frame >= top)
{
- stack_frame *frame = stack->frame_at(frame_offset);
- frame_offset -= frame->size;
iterator(frame);
+ frame = frame_successor(frame);
}
}
namespace factor
{
-static relocation_type relocation_type_of(relocation_entry r)
+relocation_type factor_vm::relocation_type_of(relocation_entry r)
{
return (relocation_type)((r & 0xf0000000) >> 28);
}
-static relocation_class relocation_class_of(relocation_entry r)
+relocation_class factor_vm::relocation_class_of(relocation_entry r)
{
return (relocation_class)((r & 0x0f000000) >> 24);
}
-static cell relocation_offset_of(relocation_entry r)
+cell factor_vm::relocation_offset_of(relocation_entry r)
{
- return (r & 0x00ffffff);
+ return (r & 0x00ffffff);
}
-void flush_icache_for(code_block *block)
+void factor_vm::flush_icache_for(code_block *block)
{
flush_icache((cell)block,block->size);
}
-static int number_of_parameters(relocation_type type)
+int factor_vm::number_of_parameters(relocation_type type)
{
switch(type)
{
case RT_THIS:
case RT_STACK_CHAIN:
case RT_MEGAMORPHIC_CACHE_HITS:
+ case RT_VM:
return 0;
default:
critical_error("Bad rel type",type);
}
}
-void *object_xt(cell obj)
+void *factor_vm::object_xt(cell obj)
{
switch(tagged<object>(obj).type())
{
}
}
-static void *xt_pic(word *w, cell tagged_quot)
+void *factor_vm::xt_pic(word *w, cell tagged_quot)
{
if(tagged_quot == F || max_pic_size == 0)
return w->xt;
}
}
-void *word_xt_pic(word *w)
+void *factor_vm::word_xt_pic(word *w)
{
return xt_pic(w,w->pic_def);
}
-void *word_xt_pic_tail(word *w)
+void *factor_vm::word_xt_pic_tail(word *w)
{
return xt_pic(w,w->pic_tail_def);
}
/* References to undefined symbols are patched up to call this function on
image load */
-void undefined_symbol()
+void factor_vm::undefined_symbol()
{
general_error(ERROR_UNDEFINED_SYMBOL,F,F,NULL);
}
+void undefined_symbol()
+{
+ return SIGNAL_VM_PTR()->undefined_symbol();
+}
+
/* Look up an external library symbol referenced by a compiled code block */
-void *get_rel_symbol(array *literals, cell index)
+void *factor_vm::get_rel_symbol(array *literals, cell index)
{
cell symbol = array_nth(literals,index);
cell library = array_nth(literals,index + 1);
dll *d = (library == F ? NULL : untag<dll>(library));
if(d != NULL && !d->dll)
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
switch(tagged<object>(symbol).type())
{
return sym;
else
{
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
}
}
case ARRAY_TYPE:
if(sym)
return sym;
}
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
}
default:
critical_error("Bad symbol specifier",symbol);
- return (void *)undefined_symbol;
+ return (void *)factor::undefined_symbol;
}
}
-cell compute_relocation(relocation_entry rel, cell index, code_block *compiled)
+cell factor_vm::compute_relocation(relocation_entry rel, cell index, code_block *compiled)
{
- array *literals = untag<array>(compiled->literals);
+ array *literals = (compiled->literals == F
+ ? NULL : untag<array>(compiled->literals));
cell offset = relocation_offset_of(rel) + (cell)compiled->xt();
#define ARG array_nth(literals,index)
return untag_fixnum(ARG);
case RT_MEGAMORPHIC_CACHE_HITS:
return (cell)&megamorphic_cache_hits;
+ case RT_VM:
+ return (cell)this;
default:
critical_error("Bad rel type",rel);
return 0; /* Can't happen */
#undef ARG
}
-void iterate_relocations(code_block *compiled, relocation_iterator iter)
+template<typename Iterator> void factor_vm::iterate_relocations(code_block *compiled, Iterator &iter)
{
if(compiled->relocation != F)
{
}
/* Store a 32-bit value into a PowerPC LIS/ORI sequence */
-static void store_address_2_2(cell *ptr, cell value)
+void factor_vm::store_address_2_2(cell *ptr, cell value)
{
ptr[-1] = ((ptr[-1] & ~0xffff) | ((value >> 16) & 0xffff));
ptr[ 0] = ((ptr[ 0] & ~0xffff) | (value & 0xffff));
}
/* Store a value into a bitfield of a PowerPC instruction */
-static void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
+void factor_vm::store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift)
{
/* This is unaccurate but good enough */
fixnum test = (fixnum)mask >> 1;
}
/* Perform a fixup on a code block */
-void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
+void factor_vm::store_address_in_code_block(cell klass, cell offset, fixnum absolute_value)
{
fixnum relative_value = absolute_value - offset;
}
}
-void update_literal_references_step(relocation_entry rel, cell index, code_block *compiled)
-{
- if(relocation_type_of(rel) == RT_IMMEDIATE)
+struct literal_references_updater {
+ factor_vm *myvm;
+
+ explicit literal_references_updater(factor_vm *myvm_) : myvm(myvm_) {}
+
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
{
- cell offset = relocation_offset_of(rel) + (cell)(compiled + 1);
- array *literals = untag<array>(compiled->literals);
- fixnum absolute_value = array_nth(literals,index);
- store_address_in_code_block(relocation_class_of(rel),offset,absolute_value);
+ if(myvm->relocation_type_of(rel) == RT_IMMEDIATE)
+ {
+ cell offset = myvm->relocation_offset_of(rel) + (cell)(compiled + 1);
+ array *literals = myvm->untag<array>(compiled->literals);
+ fixnum absolute_value = array_nth(literals,index);
+ myvm->store_address_in_code_block(myvm->relocation_class_of(rel),offset,absolute_value);
+ }
}
-}
+};
/* Update pointers to literals from compiled code. */
-void update_literal_references(code_block *compiled)
+void factor_vm::update_literal_references(code_block *compiled)
{
if(!compiled->needs_fixup)
{
- iterate_relocations(compiled,update_literal_references_step);
+ literal_references_updater updater(this);
+ iterate_relocations(compiled,updater);
flush_icache_for(compiled);
}
}
/* Copy all literals referenced from a code block to newspace. Only for
aging and nursery collections */
-void copy_literal_references(code_block *compiled)
+void factor_vm::trace_literal_references(code_block *compiled)
{
- if(collecting_gen >= compiled->last_scan)
+ if(current_gc->collecting_gen >= compiled->last_scan)
{
- if(collecting_accumulation_gen_p())
- compiled->last_scan = collecting_gen;
+ if(current_gc->collecting_accumulation_gen_p())
+ compiled->last_scan = current_gc->collecting_gen;
else
- compiled->last_scan = collecting_gen + 1;
-
- /* initialize chase pointer */
- cell scan = newspace->here;
+ compiled->last_scan = current_gc->collecting_gen + 1;
- copy_handle(&compiled->literals);
- copy_handle(&compiled->relocation);
+ trace_handle(&compiled->literals);
+ trace_handle(&compiled->relocation);
- /* do some tracing so that all reachable literals are now
- at their final address */
- copy_reachable_objects(scan,&newspace->here);
-
- update_literal_references(compiled);
+ /* once we finish tracing, re-visit this code block and update
+ literals */
+ current_gc->dirty_code_blocks.insert(compiled);
}
}
/* Compute an address to store at a relocation */
-void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
+void factor_vm::relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled)
{
#ifdef FACTOR_DEBUG
- tagged<array>(compiled->literals).untag_check();
- tagged<byte_array>(compiled->relocation).untag_check();
+ if(compiled->literals != F)
+ tagged<array>(compiled->literals).untag_check(this);
+ if(compiled->relocation != F)
+ tagged<byte_array>(compiled->relocation).untag_check(this);
#endif
store_address_in_code_block(relocation_class_of(rel),
compute_relocation(rel,index,compiled));
}
-void update_word_references_step(relocation_entry rel, cell index, code_block *compiled)
-{
- relocation_type type = relocation_type_of(rel);
- if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
- relocate_code_block_step(rel,index,compiled);
-}
+struct word_references_updater {
+ factor_vm *myvm;
+
+ explicit word_references_updater(factor_vm *myvm_) : myvm(myvm_) {}
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
+ {
+ relocation_type type = myvm->relocation_type_of(rel);
+ if(type == RT_XT || type == RT_XT_PIC || type == RT_XT_PIC_TAIL)
+ myvm->relocate_code_block_step(rel,index,compiled);
+ }
+};
/* Relocate new code blocks completely; updating references to literals,
dlsyms, and words. For all other words in the code heap, we only need
to update references to other words, without worrying about literals
or dlsyms. */
-void update_word_references(code_block *compiled)
+void factor_vm::update_word_references(code_block *compiled)
{
if(compiled->needs_fixup)
relocate_code_block(compiled);
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->type == PIC_TYPE)
- heap_free(&code,compiled);
+ code->heap_free(compiled);
else
{
- iterate_relocations(compiled,update_word_references_step);
+ word_references_updater updater(this);
+ iterate_relocations(compiled,updater);
flush_icache_for(compiled);
}
}
-void update_literal_and_word_references(code_block *compiled)
-{
- update_literal_references(compiled);
- update_word_references(compiled);
-}
-
-static void check_code_address(cell address)
+void factor_vm::check_code_address(cell address)
{
#ifdef FACTOR_DEBUG
- assert(address >= code.seg->start && address < code.seg->end);
+ assert(address >= code->seg->start && address < code->seg->end);
#endif
}
/* Mark all literals referenced from a word XT. Only for tenured
collections */
-void mark_code_block(code_block *compiled)
+void factor_vm::mark_code_block(code_block *compiled)
{
check_code_address((cell)compiled);
- mark_block(compiled);
+ code->mark_block(compiled);
- copy_handle(&compiled->literals);
- copy_handle(&compiled->relocation);
+ trace_handle(&compiled->literals);
+ trace_handle(&compiled->relocation);
}
-void mark_stack_frame_step(stack_frame *frame)
-{
- mark_code_block(frame_code(frame));
-}
+struct stack_frame_marker {
+ factor_vm *myvm;
+
+ explicit stack_frame_marker(factor_vm *myvm_) : myvm(myvm_) {}
+ void operator()(stack_frame *frame)
+ {
+ myvm->mark_code_block(myvm->frame_code(frame));
+ }
+};
/* Mark code blocks executing in currently active stack frames. */
-void mark_active_blocks(context *stacks)
+void factor_vm::mark_active_blocks(context *stacks)
{
- if(collecting_gen == data->tenured())
+ if(current_gc->collecting_tenured_p())
{
cell top = (cell)stacks->callstack_top;
cell bottom = (cell)stacks->callstack_bottom;
- iterate_callstack(top,bottom,mark_stack_frame_step);
+ stack_frame_marker marker(this);
+ iterate_callstack(top,bottom,marker);
}
}
-void mark_object_code_block(object *object)
+void factor_vm::mark_object_code_block(object *object)
{
switch(object->h.hi_tag())
{
case CALLSTACK_TYPE:
{
callstack *stack = (callstack *)object;
- iterate_callstack_object(stack,mark_stack_frame_step);
+ stack_frame_marker marker(this);
+ iterate_callstack_object(stack,marker);
break;
}
}
}
+struct code_block_relocator {
+ factor_vm *myvm;
+
+ explicit code_block_relocator(factor_vm *myvm_) : myvm(myvm_) {}
+
+ void operator()(relocation_entry rel, cell index, code_block *compiled)
+ {
+ myvm->relocate_code_block_step(rel,index,compiled);
+ }
+
+};
+
/* Perform all fixups on a code block */
-void relocate_code_block(code_block *compiled)
+void factor_vm::relocate_code_block(code_block *compiled)
{
compiled->last_scan = data->nursery();
compiled->needs_fixup = false;
- iterate_relocations(compiled,relocate_code_block_step);
+ code_block_relocator relocator(this);
+ iterate_relocations(compiled,relocator);
flush_icache_for(compiled);
}
+void relocate_code_block(code_block *compiled, factor_vm *myvm)
+{
+ return myvm->relocate_code_block(compiled);
+}
+
/* Fixup labels. This is done at compile time, not image load time */
-void fixup_labels(array *labels, code_block *compiled)
+void factor_vm::fixup_labels(array *labels, code_block *compiled)
{
cell i;
cell size = array_capacity(labels);
}
/* Might GC */
-code_block *allot_code_block(cell size)
+code_block *factor_vm::allot_code_block(cell size)
{
- heap_block *block = heap_allot(&code,size + sizeof(code_block));
+ heap_block *block = code->heap_allot(size + sizeof(code_block));
/* If allocation failed, do a code GC */
if(block == NULL)
{
gc();
- block = heap_allot(&code,size + sizeof(code_block));
+ block = code->heap_allot(size + sizeof(code_block));
/* Insufficient room even after code GC, give up */
if(block == NULL)
{
cell used, total_free, max_free;
- heap_usage(&code,&used,&total_free,&max_free);
+ code->heap_usage(&used,&total_free,&max_free);
print_string("Code heap stats:\n");
print_string("Used: "); print_cell(used); nl();
}
/* Might GC */
-code_block *add_code_block(
- cell type,
- cell code_,
- cell labels_,
- cell relocation_,
- cell literals_)
+code_block *factor_vm::add_code_block(cell type, cell code_, cell labels_, cell relocation_, cell literals_)
{
- gc_root<byte_array> code(code_);
- gc_root<object> labels(labels_);
- gc_root<byte_array> relocation(relocation_);
- gc_root<array> literals(literals_);
+ gc_root<byte_array> code(code_,this);
+ gc_root<object> labels(labels_,this);
+ gc_root<byte_array> relocation(relocation_,this);
+ gc_root<array> literals(literals_,this);
cell code_length = align8(array_capacity(code.untagged()));
code_block *compiled = allot_code_block(code_length);
RT_UNTAGGED,
/* address of megamorphic_cache_hits var */
RT_MEGAMORPHIC_CACHE_HITS,
+ /* address of vm object */
+ RT_VM,
};
enum relocation_class {
/* code relocation table consists of a table of entries for each fixup */
typedef u32 relocation_entry;
-void flush_icache_for(code_block *compiled);
-
-typedef void (*relocation_iterator)(relocation_entry rel, cell index, code_block *compiled);
-
-void iterate_relocations(code_block *compiled, relocation_iterator iter);
-
-void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
-
-void relocate_code_block(code_block *compiled);
-
-void update_literal_references(code_block *compiled);
-
-void copy_literal_references(code_block *compiled);
-
-void update_word_references(code_block *compiled);
-
-void update_literal_and_word_references(code_block *compiled);
-
-void mark_code_block(code_block *compiled);
-
-void mark_active_blocks(context *stacks);
-
-void mark_object_code_block(object *scan);
-
-void relocate_code_block(code_block *relocating);
-
-inline static bool stack_traces_p()
-{
- return userenv[STACK_TRACES_ENV] != F;
-}
-
-code_block *add_code_block(cell type, cell code, cell labels, cell relocation, cell literals);
-
}
+++ /dev/null
-#include "master.hpp"
-
-namespace factor
-{
-
-static void clear_free_list(heap *heap)
-{
- memset(&heap->free,0,sizeof(heap_free_list));
-}
-
-/* This malloc-style heap code is reasonably generic. Maybe in the future, it
-will be used for the data heap too, if we ever get incremental
-mark/sweep/compact GC. */
-void new_heap(heap *heap, cell size)
-{
- heap->seg = alloc_segment(align_page(size));
- if(!heap->seg)
- fatal_error("Out of memory in new_heap",size);
-
- clear_free_list(heap);
-}
-
-static void add_to_free_list(heap *heap, free_heap_block *block)
-{
- if(block->size < free_list_count * block_size_increment)
- {
- int index = block->size / block_size_increment;
- block->next_free = heap->free.small_blocks[index];
- heap->free.small_blocks[index] = block;
- }
- else
- {
- block->next_free = heap->free.large_blocks;
- heap->free.large_blocks = block;
- }
-}
-
-/* Called after reading the code heap from the image file, and after code GC.
-
-In the former case, we must add a large free block from compiling.base + size to
-compiling.limit. */
-void build_free_list(heap *heap, cell size)
-{
- heap_block *prev = NULL;
-
- clear_free_list(heap);
-
- size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
-
- heap_block *scan = first_block(heap);
- free_heap_block *end = (free_heap_block *)(heap->seg->start + size);
-
- /* Add all free blocks to the free list */
- while(scan && scan < (heap_block *)end)
- {
- switch(scan->status)
- {
- case B_FREE:
- add_to_free_list(heap,(free_heap_block *)scan);
- break;
- case B_ALLOCATED:
- break;
- default:
- critical_error("Invalid scan->status",(cell)scan);
- break;
- }
-
- prev = scan;
- scan = next_block(heap,scan);
- }
-
- /* If there is room at the end of the heap, add a free block. This
- branch is only taken after loading a new image, not after code GC */
- if((cell)(end + 1) <= heap->seg->end)
- {
- end->status = B_FREE;
- end->size = heap->seg->end - (cell)end;
-
- /* add final free block */
- add_to_free_list(heap,end);
- }
- /* This branch is taken if the newly loaded image fits exactly, or
- after code GC */
- else
- {
- /* even if there's no room at the end of the heap for a new
- free block, we might have to jigger it up by a few bytes in
- case prev + prev->size */
- if(prev) prev->size = heap->seg->end - (cell)prev;
- }
-
-}
-
-static void assert_free_block(free_heap_block *block)
-{
- if(block->status != B_FREE)
- critical_error("Invalid block in free list",(cell)block);
-}
-
-static free_heap_block *find_free_block(heap *heap, cell size)
-{
- cell attempt = size;
-
- while(attempt < free_list_count * block_size_increment)
- {
- int index = attempt / block_size_increment;
- free_heap_block *block = heap->free.small_blocks[index];
- if(block)
- {
- assert_free_block(block);
- heap->free.small_blocks[index] = block->next_free;
- return block;
- }
-
- attempt *= 2;
- }
-
- free_heap_block *prev = NULL;
- free_heap_block *block = heap->free.large_blocks;
-
- while(block)
- {
- assert_free_block(block);
- if(block->size >= size)
- {
- if(prev)
- prev->next_free = block->next_free;
- else
- heap->free.large_blocks = block->next_free;
- return block;
- }
-
- prev = block;
- block = block->next_free;
- }
-
- return NULL;
-}
-
-static free_heap_block *split_free_block(heap *heap, free_heap_block *block, cell size)
-{
- if(block->size != size )
- {
- /* split the block in two */
- free_heap_block *split = (free_heap_block *)((cell)block + size);
- split->status = B_FREE;
- split->size = block->size - size;
- split->next_free = block->next_free;
- block->size = size;
- add_to_free_list(heap,split);
- }
-
- return block;
-}
-
-/* Allocate a block of memory from the mark and sweep GC heap */
-heap_block *heap_allot(heap *heap, cell size)
-{
- size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
-
- free_heap_block *block = find_free_block(heap,size);
- if(block)
- {
- block = split_free_block(heap,block,size);
-
- block->status = B_ALLOCATED;
- return block;
- }
- else
- return NULL;
-}
-
-/* Deallocates a block manually */
-void heap_free(heap *heap, heap_block *block)
-{
- block->status = B_FREE;
- add_to_free_list(heap,(free_heap_block *)block);
-}
-
-void mark_block(heap_block *block)
-{
- /* If already marked, do nothing */
- switch(block->status)
- {
- case B_MARKED:
- return;
- case B_ALLOCATED:
- block->status = B_MARKED;
- break;
- default:
- critical_error("Marking the wrong block",(cell)block);
- break;
- }
-}
-
-/* If in the middle of code GC, we have to grow the heap, data GC restarts from
-scratch, so we have to unmark any marked blocks. */
-void unmark_marked(heap *heap)
-{
- heap_block *scan = first_block(heap);
-
- while(scan)
- {
- if(scan->status == B_MARKED)
- scan->status = B_ALLOCATED;
-
- scan = next_block(heap,scan);
- }
-}
-
-/* After code GC, all referenced code blocks have status set to B_MARKED, so any
-which are allocated and not marked can be reclaimed. */
-void free_unmarked(heap *heap, heap_iterator iter)
-{
- clear_free_list(heap);
-
- heap_block *prev = NULL;
- heap_block *scan = first_block(heap);
-
- while(scan)
- {
- switch(scan->status)
- {
- case B_ALLOCATED:
- if(secure_gc)
- memset(scan + 1,0,scan->size - sizeof(heap_block));
-
- if(prev && prev->status == B_FREE)
- prev->size += scan->size;
- else
- {
- scan->status = B_FREE;
- prev = scan;
- }
- break;
- case B_FREE:
- if(prev && prev->status == B_FREE)
- prev->size += scan->size;
- else
- prev = scan;
- break;
- case B_MARKED:
- if(prev && prev->status == B_FREE)
- add_to_free_list(heap,(free_heap_block *)prev);
- scan->status = B_ALLOCATED;
- prev = scan;
- iter(scan);
- break;
- default:
- critical_error("Invalid scan->status",(cell)scan);
- }
-
- scan = next_block(heap,scan);
- }
-
- if(prev && prev->status == B_FREE)
- add_to_free_list(heap,(free_heap_block *)prev);
-}
-
-/* Compute total sum of sizes of free blocks, and size of largest free block */
-void heap_usage(heap *heap, cell *used, cell *total_free, cell *max_free)
-{
- *used = 0;
- *total_free = 0;
- *max_free = 0;
-
- heap_block *scan = first_block(heap);
-
- while(scan)
- {
- switch(scan->status)
- {
- case B_ALLOCATED:
- *used += scan->size;
- break;
- case B_FREE:
- *total_free += scan->size;
- if(scan->size > *max_free)
- *max_free = scan->size;
- break;
- default:
- critical_error("Invalid scan->status",(cell)scan);
- }
-
- scan = next_block(heap,scan);
- }
-}
-
-/* The size of the heap, not including the last block if it's free */
-cell heap_size(heap *heap)
-{
- heap_block *scan = first_block(heap);
-
- while(next_block(heap,scan) != NULL)
- scan = next_block(heap,scan);
-
- /* this is the last block in the heap, and it is free */
- if(scan->status == B_FREE)
- return (cell)scan - heap->seg->start;
- /* otherwise the last block is allocated */
- else
- return heap->seg->size;
-}
-
-/* Compute where each block is going to go, after compaction */
-cell compute_heap_forwarding(heap *heap, unordered_map<heap_block *,char *> &forwarding)
-{
- heap_block *scan = first_block(heap);
- char *address = (char *)first_block(heap);
-
- while(scan)
- {
- if(scan->status == B_ALLOCATED)
- {
- forwarding[scan] = address;
- address += scan->size;
- }
- else if(scan->status == B_MARKED)
- critical_error("Why is the block marked?",0);
-
- scan = next_block(heap,scan);
- }
-
- return (cell)address - heap->seg->start;
-}
-
-void compact_heap(heap *heap, unordered_map<heap_block *,char *> &forwarding)
-{
- heap_block *scan = first_block(heap);
-
- while(scan)
- {
- heap_block *next = next_block(heap,scan);
-
- if(scan->status == B_ALLOCATED)
- memmove(forwarding[scan],scan,scan->size);
- scan = next;
- }
-}
-
-}
+++ /dev/null
-namespace factor
-{
-
-static const cell free_list_count = 16;
-static const cell block_size_increment = 32;
-
-struct heap_free_list {
- free_heap_block *small_blocks[free_list_count];
- free_heap_block *large_blocks;
-};
-
-struct heap {
- segment *seg;
- heap_free_list free;
-};
-
-typedef void (*heap_iterator)(heap_block *compiled);
-
-void new_heap(heap *h, cell size);
-void build_free_list(heap *h, cell size);
-heap_block *heap_allot(heap *h, cell size);
-void heap_free(heap *h, heap_block *block);
-void mark_block(heap_block *block);
-void unmark_marked(heap *heap);
-void free_unmarked(heap *heap, heap_iterator iter);
-void heap_usage(heap *h, cell *used, cell *total_free, cell *max_free);
-cell heap_size(heap *h);
-cell compute_heap_forwarding(heap *h, unordered_map<heap_block *,char *> &forwarding);
-void compact_heap(heap *h, unordered_map<heap_block *,char *> &forwarding);
-
-inline static heap_block *next_block(heap *h, heap_block *block)
-{
- cell next = ((cell)block + block->size);
- if(next == h->seg->end)
- return NULL;
- else
- return (heap_block *)next;
-}
-
-inline static heap_block *first_block(heap *h)
-{
- return (heap_block *)h->seg->start;
-}
-
-inline static heap_block *last_block(heap *h)
-{
- return (heap_block *)h->seg->end;
-}
-
-}
namespace factor
{
-heap code;
-
/* Allocate a code heap during startup */
-void init_code_heap(cell size)
+void factor_vm::init_code_heap(cell size)
{
- new_heap(&code,size);
+ code = new heap(this,size);
}
-bool in_code_heap_p(cell ptr)
+bool factor_vm::in_code_heap_p(cell ptr)
{
- return (ptr >= code.seg->start && ptr <= code.seg->end);
+ return (ptr >= code->seg->start && ptr <= code->seg->end);
}
/* Compile a word definition with the non-optimizing compiler. Allocates memory */
-void jit_compile_word(cell word_, cell def_, bool relocate)
+void factor_vm::jit_compile_word(cell word_, cell def_, bool relocate)
{
- gc_root<word> word(word_);
- gc_root<quotation> def(def_);
+ gc_root<word> word(word_,this);
+ gc_root<quotation> def(def_,this);
jit_compile(def.value(),relocate);
if(word->pic_tail_def != F) jit_compile(word->pic_tail_def,relocate);
}
-/* Apply a function to every code block */
-void iterate_code_heap(code_heap_iterator iter)
-{
- heap_block *scan = first_block(&code);
+struct literal_reference_tracer {
+ factor_vm *myvm;
- while(scan)
+ explicit literal_reference_tracer(factor_vm *myvm_) : myvm(myvm_) {}
+ void operator()(code_block *compiled)
{
- if(scan->status != B_FREE)
- iter((code_block *)scan);
- scan = next_block(&code,scan);
+ myvm->trace_literal_references(compiled);
}
-}
+};
/* Copy literals referenced from all code blocks to newspace. Only for
aging and nursery collections */
-void copy_code_heap_roots()
+void factor_vm::trace_code_heap_roots()
{
- iterate_code_heap(copy_literal_references);
+ code_heap_scans++;
+
+ literal_reference_tracer tracer(this);
+ iterate_code_heap(tracer);
+
+ if(current_gc->collecting_accumulation_gen_p())
+ last_code_heap_scan = current_gc->collecting_gen;
+ else
+ last_code_heap_scan = current_gc->collecting_gen + 1;
}
/* Update pointers to words referenced from all code blocks. Only after
defining a new word. */
-void update_code_heap_words()
+void factor_vm::update_code_heap_words()
{
- iterate_code_heap(update_word_references);
+ word_updater updater(this);
+ iterate_code_heap(updater);
}
-PRIMITIVE(modify_code_heap)
+void factor_vm::primitive_modify_code_heap()
{
- gc_root<array> alist(dpop());
+ gc_root<array> alist(dpop(),this);
cell count = array_capacity(alist.untagged());
cell i;
for(i = 0; i < count; i++)
{
- gc_root<array> pair(array_nth(alist.untagged(),i));
+ gc_root<array> pair(array_nth(alist.untagged(),i),this);
- gc_root<word> word(array_nth(pair.untagged(),0));
- gc_root<object> data(array_nth(pair.untagged(),1));
+ gc_root<word> word(array_nth(pair.untagged(),0),this);
+ gc_root<object> data(array_nth(pair.untagged(),1),this);
switch(data.type())
{
}
/* Push the free space and total size of the code heap */
-PRIMITIVE(code_room)
+void factor_vm::primitive_code_room()
{
cell used, total_free, max_free;
- heap_usage(&code,&used,&total_free,&max_free);
- dpush(tag_fixnum(code.seg->size / 1024));
+ code->heap_usage(&used,&total_free,&max_free);
+ dpush(tag_fixnum(code->seg->size / 1024));
dpush(tag_fixnum(used / 1024));
dpush(tag_fixnum(total_free / 1024));
dpush(tag_fixnum(max_free / 1024));
}
-static unordered_map<heap_block *,char *> forwarding;
-
-code_block *forward_xt(code_block *compiled)
+code_block *factor_vm::forward_xt(code_block *compiled)
{
return (code_block *)forwarding[compiled];
}
-void forward_frame_xt(stack_frame *frame)
-{
- cell offset = (cell)FRAME_RETURN_ADDRESS(frame) - (cell)frame_code(frame);
- code_block *forwarded = forward_xt(frame_code(frame));
- frame->xt = forwarded->xt();
- FRAME_RETURN_ADDRESS(frame) = (void *)((cell)forwarded + offset);
-}
+struct xt_forwarder {
+ factor_vm *myvm;
+
+ explicit xt_forwarder(factor_vm *myvm_) : myvm(myvm_) {}
+
+ void operator()(stack_frame *frame)
+ {
+ cell offset = (cell)FRAME_RETURN_ADDRESS(frame,myvm) - (cell)myvm->frame_code(frame);
+ code_block *forwarded = myvm->forward_xt(myvm->frame_code(frame));
+ frame->xt = forwarded->xt();
+ FRAME_RETURN_ADDRESS(frame,myvm) = (void *)((cell)forwarded + offset);
+ }
+};
-void forward_object_xts()
+void factor_vm::forward_object_xts()
{
begin_scan();
case CALLSTACK_TYPE:
{
callstack *stack = untag<callstack>(obj);
- iterate_callstack_object(stack,forward_frame_xt);
+ xt_forwarder forwarder(this);
+ iterate_callstack_object(stack,forwarder);
}
break;
default:
}
/* Set the XT fields now that the heap has been compacted */
-void fixup_object_xts()
+void factor_vm::fixup_object_xts()
{
begin_scan();
since it makes several passes over the code and data heaps, but we only ever
do this before saving a deployed image and exiting, so performaance is not
critical here */
-void compact_code_heap()
+void factor_vm::compact_code_heap()
{
- /* Free all unreachable code blocks */
- gc();
+ /* Free all unreachable code blocks, don't trace contexts */
+ garbage_collection(data->tenured(),false,false,0);
/* Figure out where the code heap blocks are going to end up */
- cell size = compute_heap_forwarding(&code, forwarding);
+ cell size = code->compute_heap_forwarding(forwarding);
/* Update word and quotation code pointers */
forward_object_xts();
/* Actually perform the compaction */
- compact_heap(&code,forwarding);
+ code->compact_heap(forwarding);
/* Update word and quotation XTs */
fixup_object_xts();
/* Now update the free list; there will be a single free block at
the end */
- build_free_list(&code,size);
+ code->build_free_list(size);
}
}
namespace factor
{
-/* compiled code */
-extern heap code;
-
-void init_code_heap(cell size);
-
-bool in_code_heap_p(cell ptr);
-
-void jit_compile_word(cell word, cell def, bool relocate);
-
-typedef void (*code_heap_iterator)(code_block *compiled);
-
-void iterate_code_heap(code_heap_iterator iter);
-
-void copy_code_heap_roots();
-
-PRIMITIVE(modify_code_heap);
-
-PRIMITIVE(code_room);
-
-void compact_code_heap();
-
-inline static void check_code_pointer(cell ptr)
+inline void factor_vm::check_code_pointer(cell ptr)
{
#ifdef FACTOR_DEBUG
assert(in_code_heap_p(ptr));
#endif
}
+struct word_updater {
+ factor_vm *myvm;
+
+ explicit word_updater(factor_vm *myvm_) : myvm(myvm_) {}
+ void operator()(code_block *compiled)
+ {
+ myvm->update_word_references(compiled);
+ }
+};
+
}
#include "master.hpp"
-factor::context *stack_chain;
-
namespace factor
{
-cell ds_size, rs_size;
-context *unused_contexts;
-
-void reset_datastack()
+void factor_vm::reset_datastack()
{
ds = ds_bot - sizeof(cell);
}
-void reset_retainstack()
+void factor_vm::reset_retainstack()
{
rs = rs_bot - sizeof(cell);
}
static const cell stack_reserved = (64 * sizeof(cell));
-void fix_stacks()
+void factor_vm::fix_stacks()
{
if(ds + sizeof(cell) < ds_bot || ds + stack_reserved >= ds_top) reset_datastack();
if(rs + sizeof(cell) < rs_bot || rs + stack_reserved >= rs_top) reset_retainstack();
/* called before entry into foreign C code. Note that ds and rs might
be stored in registers, so callbacks must save and restore the correct values */
-void save_stacks()
+void factor_vm::save_stacks()
{
if(stack_chain)
{
}
}
-context *alloc_context()
+context *factor_vm::alloc_context()
{
context *new_context;
}
else
{
- new_context = (context *)safe_malloc(sizeof(context));
- new_context->datastack_region = alloc_segment(ds_size);
- new_context->retainstack_region = alloc_segment(rs_size);
+ new_context = new context;
+ new_context->datastack_region = new segment(this,ds_size);
+ new_context->retainstack_region = new segment(this,rs_size);
}
return new_context;
}
-void dealloc_context(context *old_context)
+void factor_vm::dealloc_context(context *old_context)
{
old_context->next = unused_contexts;
unused_contexts = old_context;
}
/* called on entry into a compiled callback */
-void nest_stacks()
+void factor_vm::nest_stacks()
{
context *new_context = alloc_context();
reset_retainstack();
}
+void nest_stacks(factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->nest_stacks();
+}
+
/* called when leaving a compiled callback */
-void unnest_stacks()
+void factor_vm::unnest_stacks()
{
ds = stack_chain->datastack_save;
rs = stack_chain->retainstack_save;
dealloc_context(old_stacks);
}
+void unnest_stacks(factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->unnest_stacks();
+}
+
/* called on startup */
-void init_stacks(cell ds_size_, cell rs_size_)
+void factor_vm::init_stacks(cell ds_size_, cell rs_size_)
{
ds_size = ds_size_;
rs_size = rs_size_;
unused_contexts = NULL;
}
-bool stack_to_array(cell bottom, cell top)
+bool factor_vm::stack_to_array(cell bottom, cell top)
{
fixnum depth = (fixnum)(top - bottom + sizeof(cell));
}
}
-PRIMITIVE(datastack)
+void factor_vm::primitive_datastack()
{
if(!stack_to_array(ds_bot,ds))
general_error(ERROR_DS_UNDERFLOW,F,F,NULL);
}
-PRIMITIVE(retainstack)
+void factor_vm::primitive_retainstack()
{
if(!stack_to_array(rs_bot,rs))
general_error(ERROR_RS_UNDERFLOW,F,F,NULL);
}
/* returns pointer to top of stack */
-cell array_to_stack(array *array, cell bottom)
+cell factor_vm::array_to_stack(array *array, cell bottom)
{
cell depth = array_capacity(array) * sizeof(cell);
memcpy((void*)bottom,array + 1,depth);
return bottom + depth - sizeof(cell);
}
-PRIMITIVE(set_datastack)
+void factor_vm::primitive_set_datastack()
{
ds = array_to_stack(untag_check<array>(dpop()),ds_bot);
}
-PRIMITIVE(set_retainstack)
+void factor_vm::primitive_set_retainstack()
{
rs = array_to_stack(untag_check<array>(dpop()),rs_bot);
}
/* Used to implement call( */
-PRIMITIVE(check_datastack)
+void factor_vm::primitive_check_datastack()
{
fixnum out = to_fixnum(dpop());
fixnum in = to_fixnum(dpop());
context *next;
};
-extern cell ds_size, rs_size;
-
#define ds_bot (stack_chain->datastack_region->start)
#define ds_top (stack_chain->datastack_region->end)
#define rs_bot (stack_chain->retainstack_region->start)
DEFPUSHPOP(d,ds)
DEFPUSHPOP(r,rs)
-void reset_datastack();
-void reset_retainstack();
-void fix_stacks();
-void init_stacks(cell ds_size, cell rs_size);
-
-PRIMITIVE(datastack);
-PRIMITIVE(retainstack);
-PRIMITIVE(set_datastack);
-PRIMITIVE(set_retainstack);
-PRIMITIVE(check_datastack);
-
-VM_C_API void save_stacks();
-VM_C_API void nest_stacks();
-VM_C_API void unnest_stacks();
+VM_C_API void nest_stacks(factor_vm *vm);
+VM_C_API void unnest_stacks(factor_vm *vm);
}
-VM_C_API factor::context *stack_chain;
register cell ds asm("r5");
register cell rs asm("r6");
-#define FRAME_RETURN_ADDRESS(frame) *(XT *)(frame_successor(frame) + 1)
+#define FRAME_RETURN_ADDRESS(frame,vm) *(XT *)(vm->frame_successor(frame) + 1)
void c_to_factor(cell quot);
void set_callstack(stack_frame *to, stack_frame *from, cell length, void *memcpy);
#define DS_REG r13
-DEF(void,primitive_fixnum_add,(void)):
+DEF(void,primitive_fixnum_add,(void *vm)):
+ mr r5,r3 /* save vm ptr for overflow */
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
- addo. r5,r3,r4
+ addo. r6,r3,r4
bso add_overflow
- stw r5,0(DS_REG)
+ stw r6,0(DS_REG)
blr
add_overflow:
b MANGLE(overflow_fixnum_add)
-DEF(void,primitive_fixnum_subtract,(void)):
+DEF(void,primitive_fixnum_subtract,(void *vm)):
+ mr r5,r3 /* save vm ptr for overflow */
lwz r3,-4(DS_REG)
lwz r4,0(DS_REG)
subi DS_REG,DS_REG,4
li r0,0
mtxer r0
- subfo. r5,r4,r3
+ subfo. r6,r4,r3
bso sub_overflow
- stw r5,0(DS_REG)
+ stw r6,0(DS_REG)
blr
sub_overflow:
b MANGLE(overflow_fixnum_subtract)
-DEF(void,primitive_fixnum_multiply,(void)):
+DEF(void,primitive_fixnum_multiply,(void *vm)):
+ mr r5,r3 /* save vm ptr for overflow */
lwz r3,0(DS_REG)
lwz r4,-4(DS_REG)
subi DS_REG,DS_REG,4
srawi r3,r3,3
- mullwo. r5,r3,r4
+ mullwo. r6,r3,r4
bso multiply_overflow
- stw r5,0(DS_REG)
+ stw r6,0(DS_REG)
blr
multiply_overflow:
srawi r4,r4,3
#define SAVED_FP_REGS_SIZE 144
-#define FRAME (RESERVED_SIZE + PARAM_SIZE + SAVED_INT_REGS_SIZE + SAVED_FP_REGS_SIZE + 8)
+#define SAVED_V_REGS_SIZE 208
+
+#define FRAME (RESERVED_SIZE + PARAM_SIZE + SAVED_INT_REGS_SIZE + SAVED_FP_REGS_SIZE + SAVED_V_REGS_SIZE + 8)
#if defined( __APPLE__)
#define LR_SAVE 8
#define SAVE_FP(register,offset) stfd register,SAVE_AT(offset)(r1)
#define RESTORE_FP(register,offset) lfd register,SAVE_AT(offset)(r1)
+#define SAVE_V(register,offset) \
+ li r2,SAVE_AT(offset) XX \
+ stvxl register,r2,r1
+
+#define RESTORE_V(register,offset) \
+ li r2,SAVE_AT(offset) XX \
+ lvxl register,r2,r1
+
#define PROLOGUE \
mflr r0 XX /* get caller's return address */ \
stwu r1,-FRAME(r1) XX /* create a stack frame to hold non-volatile registers */ \
/* We have to save and restore nonvolatile registers because
the Factor compiler treats the entire register file as volatile. */
-DEF(void,c_to_factor,(CELL quot)):
+DEF(void,c_to_factor,(cell quot, void *vm)):
PROLOGUE
SAVE_INT(r15,0) /* save GPRs */
SAVE_FP(f30,52)
SAVE_FP(f31,54)
- SAVE_INT(r3,19) /* save quotation since we're about to mangle it */
-
- mr r3,r1 /* pass call stack pointer as an argument */
+ SAVE_V(v20,56)
+ SAVE_V(v21,60)
+ SAVE_V(v22,64)
+ SAVE_V(v23,68)
+ SAVE_V(v24,72)
+ SAVE_V(v25,76)
+ SAVE_V(v26,80)
+ SAVE_V(v27,84)
+ SAVE_V(v28,88)
+ SAVE_V(v29,92)
+ SAVE_V(v30,96)
+ SAVE_V(v31,100)
+
+ /* r4 vm ptr preserved */
+ mfvscr v0
+ li r2,SAVE_AT(104)
+ stvxl v0,r2,r1
+ addi r2,r2,0xc
+ lwzx r5,r2,r1
+ lis r6,0x1
+ andc r5,r5,r6
+ stwx r5,r2,r1
+ subi r2,r2,0xc
+ lvxl v0,r2,r1
+ mtvscr v0
+
+ /* save args in non-volatile regs */
+ mr r15,r3
+ mr r16,r4
+
+ /* pass call stack pointer as an argument */
+ mr r3,r1
bl MANGLE(save_callstack_bottom)
- RESTORE_INT(r3,19) /* restore quotation */
+ /* restore quotation args */
+ mr r3,r15
+ mr r4,r16
CALL_QUOT
+ RESTORE_V(v0,104)
+ mtvscr v0
+
+ RESTORE_V(v31,100)
+ RESTORE_V(v30,96)
+ RESTORE_V(v29,92)
+ RESTORE_V(v28,88)
+ RESTORE_V(v27,84)
+ RESTORE_V(v26,80)
+ RESTORE_V(v25,76)
+ RESTORE_V(v24,72)
+ RESTORE_V(v23,68)
+ RESTORE_V(v22,64)
+ RESTORE_V(v21,60)
+ RESTORE_V(v20,56)
+
+ /* Restore FPRs */
RESTORE_FP(f31,54)
RESTORE_FP(f30,52)
RESTORE_FP(f29,50)
RESTORE_FP(f17,26)
RESTORE_FP(f16,24)
RESTORE_FP(f15,22)
- RESTORE_FP(f14,20) /* save FPRs */
+ RESTORE_FP(f14,20)
- RESTORE_INT(r31,16) /* restore GPRs */
+ /* restore GPRs */
+ RESTORE_INT(r31,16)
RESTORE_INT(r30,15)
RESTORE_INT(r29,14)
RESTORE_INT(r28,13)
/* We pass a function pointer to memcpy in r6 to work around a Mac OS X ABI
limitation which would otherwise require us to do a bizzaro PC-relative
trampoline to retrieve the function address */
-DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, CELL length, void *memcpy)):
+DEF(void,set_callstack,(F_STACK_FRAME *to, F_STACK_FRAME *from, cell length, void *memcpy)):
sub r1,r3,r5 /* compute new stack pointer */
mr r3,r1 /* start of destination of memcpy() */
stwu r1,-64(r1) /* setup fake stack frame for memcpy() */
mtlr r0 /* prepare to return to restored callstack */
blr /* go */
-DEF(void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
+DEF(void,throw_impl,(cell quot, F_STACK_FRAME *rewind_to, void *vm)):
mr r1,r4 /* compute new stack pointer */
+ mr r4,r5 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
lwz r0,LR_SAVE(r1) /* we have rewound the stack; load return address */
mtlr r0
JUMP_QUOT /* call the quotation */
-DEF(void,lazy_jit_compile,(CELL quot)):
+DEF(void,lazy_jit_compile,(cell quot, void *vm)):
+ mr r5,r4 /* vm ptr is 3rd arg */
mr r4,r1 /* save stack pointer */
PROLOGUE
bl MANGLE(lazy_jit_compile_impl)
isync
blr
-DEF(void,primitive_inline_cache_miss,(void)):
- mflr r6
-DEF(void,primitive_inline_cache_miss_tail,(void)):
- PROLOGUE
- mr r3,r6
- bl MANGLE(inline_cache_miss)
- EPILOGUE
- mtctr r3
- bctr
+DEF(void,primitive_inline_cache_miss,(void *vm)):
+ mflr r6
+DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
+ PROLOGUE
+ mr r4,r3 /* vm ptr in 2nd arg */
+ mr r3,r6
+ bl MANGLE(inline_cache_miss)
+ EPILOGUE
+ mtctr r3
+ bctr
+
+DEF(void,get_ppc_fpu_env,(void*)):
+ mffs f0
+ stfd f0,0(r3)
+ blr
+
+DEF(void,set_ppc_fpu_env,(const void*)):
+ lfd f0,0(r3)
+ mtfsf 0xff,f0
+ blr
+
+DEF(void,get_ppc_vmx_env,(void*)):
+ mfvscr v0
+ subi r4,r1,16
+ li r5,0xf
+ andc r4,r4,r5
+ stvxl v0,0,r4
+ li r5,0xc
+ lwzx r6,r5,r4
+ stw r6,0(r3)
+ blr
+
+DEF(void,set_ppc_vmx_env,(const void*)):
+ subi r4,r1,16
+ li r5,0xf
+ andc r4,r4,r5
+ li r5,0xc
+ lwz r6,0(r3)
+ stwx r6,r5,r4
+ lvxl v0,0,r4
+ mtvscr v0
+ blr
+
return (insn & 0x1) == 0;
}
+inline static unsigned int fpu_status(unsigned int status)
+{
+ unsigned int r = 0;
+
+ if (status & 0x20000000)
+ r |= FP_TRAP_INVALID_OPERATION;
+ if (status & 0x10000000)
+ r |= FP_TRAP_OVERFLOW;
+ if (status & 0x08000000)
+ r |= FP_TRAP_UNDERFLOW;
+ if (status & 0x04000000)
+ r |= FP_TRAP_ZERO_DIVIDE;
+ if (status & 0x02000000)
+ r |= FP_TRAP_INEXACT;
+
+ return r;
+}
+
/* Defined in assembly */
-VM_ASM_API void c_to_factor(cell quot);
-VM_ASM_API void throw_impl(cell quot, stack_frame *rewind);
-VM_ASM_API void lazy_jit_compile(cell quot);
+VM_ASM_API void c_to_factor(cell quot, void *vm);
+VM_ASM_API void throw_impl(cell quot, stack_frame *rewind, void *vm);
+VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_ASM_API void flush_icache(cell start, cell len);
VM_ASM_API void set_callstack(stack_frame *to,
#define ARG0 %eax
#define ARG1 %edx
+#define ARG2 %ecx
#define STACK_REG %esp
#define DS_REG %esi
#define RETURN_REG %eax
-#define NV_TEMP_REG %ebx
+#define NV0 %ebx
+#define NV1 %ebp
#define ARITH_TEMP_1 %ebp
#define ARITH_TEMP_2 %ebx
add $12,%esp /* pop args from the stack */
ret /* return _with new stack_ */
-/* cpu.x86.32 calls this */
-DEF(bool,check_sse2,(void)):
- push %ebx
- mov $1,%eax
- cpuid
- shr $26,%edx
- and $1,%edx
- pop %ebx
- mov %edx,%eax
- ret
-
DEF(long long,read_timestamp_counter,(void)):
rdtsc
ret
-DEF(void,primitive_inline_cache_miss,(void)):
+DEF(void,primitive_inline_cache_miss,(void *vm)):
mov (%esp),%ebx
-DEF(void,primitive_inline_cache_miss_tail,(void)):
- sub $8,%esp
+DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
+ sub $4,%esp
+ push ARG0 /* push vm ptr */
push %ebx
call MANGLE(inline_cache_miss)
add $12,%esp
jmp *%eax
+DEF(void,get_sse_env,(void*)):
+ movl 4(%esp), %eax
+ stmxcsr (%eax)
+ ret
+
+DEF(void,set_sse_env,(const void*)):
+ movl 4(%esp), %eax
+ ldmxcsr (%eax)
+ ret
+
+DEF(void,get_x87_env,(void*)):
+ movl 4(%esp), %eax
+ fnstsw (%eax)
+ fnstcw 2(%eax)
+ ret
+
+DEF(void,set_x87_env,(const void*)):
+ movl 4(%esp), %eax
+ fnclex
+ fldcw 2(%eax)
+ ret
+
+DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
+ mov ARG2,NV0 /* remember vm ptr in case quot_xt = lazy_jit_compile */
+ /* clear x87 stack, but preserve rounding mode and exception flags */
+ sub $2,STACK_REG
+ fnstcw (STACK_REG)
+ fninit
+ fldcw (STACK_REG)
+ /* rewind_to */
+ mov ARG1,STACK_REG
+ mov NV0,ARG1
+ jmp *QUOT_XT_OFFSET(ARG0)
+
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,ARG2
+ mov STACK_REG,ARG1 /* Save stack pointer */
+ sub $STACK_PADDING,STACK_REG
+ call MANGLE(lazy_jit_compile_impl)
+ mov RETURN_REG,ARG0 /* No-op on 32-bit */
+ add $STACK_PADDING,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+
+
#include "cpu-x86.S"
#ifdef WINDOWS
.section .drectve
- .ascii " -export:check_sse2"
.ascii " -export:read_timestamp_counter"
+ .ascii " -export:get_sse_env"
+ .ascii " -export:set_sse_env"
+ .ascii " -export:get_x87_env"
+ .ascii " -export:set_x87_env"
#endif
register cell ds asm("esi");
register cell rs asm("edi");
-#define VM_ASM_API VM_C_API __attribute__ ((regparm (2)))
-
+#define VM_ASM_API VM_C_API __attribute__ ((regparm (3)))
}
#define CELL_SIZE 8
#define STACK_PADDING 56
-#define NV_TEMP_REG %rbp
+#define NV0 %rbp
+#define NV1 %r12
#define ARITH_TEMP_1 %r8
#define ARITH_TEMP_2 %r9
or %rdx,%rax
ret
-DEF(void,primitive_inline_cache_miss,(void)):
+DEF(void,primitive_inline_cache_miss,(void *vm)):
mov (%rsp),%rbx
-DEF(void,primitive_inline_cache_miss_tail,(void)):
+DEF(void,primitive_inline_cache_miss_tail,(void *vm)):
sub $STACK_PADDING,%rsp
+ mov ARG0,ARG1
mov %rbx,ARG0
call MANGLE(inline_cache_miss)
add $STACK_PADDING,%rsp
jmp *%rax
+DEF(void,get_sse_env,(void*)):
+ stmxcsr (%rdi)
+ ret
+
+DEF(void,set_sse_env,(const void*)):
+ ldmxcsr (%rdi)
+ ret
+
+DEF(void,get_x87_env,(void*)):
+ fnstsw (%rdi)
+ fnstcw 2(%rdi)
+ ret
+
+DEF(void,set_x87_env,(const void*)):
+ fnclex
+ fldcw 2(%rdi)
+ ret
+
+DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to, void *vm)):
+ /* clear x87 stack, but preserve rounding mode and exception flags */
+ sub $2,STACK_REG
+ fnstcw (STACK_REG)
+ fninit
+ fldcw (STACK_REG)
+ /* rewind_to */
+ mov ARG1,STACK_REG
+ mov ARG2,ARG1 /* make vm ptr 2nd arg in case quot_xt = lazy_jit_compile */
+ jmp *QUOT_XT_OFFSET(ARG0)
+
+DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot, void *vm)):
+ mov ARG1,ARG2 /* vm is 3rd arg */
+ mov STACK_REG,ARG1 /* Save stack pointer */
+ sub $STACK_PADDING,STACK_REG
+ call MANGLE(lazy_jit_compile_impl)
+ mov RETURN_REG,ARG0 /* No-op on 32-bit */
+ add $STACK_PADDING,STACK_REG
+ jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+
+
#include "cpu-x86.S"
register cell rs asm("r15");
#define VM_ASM_API VM_C_API
-
}
-DEF(void,primitive_fixnum_add,(void)):
- mov (DS_REG),ARG0
- mov -CELL_SIZE(DS_REG),ARG1
- sub $CELL_SIZE,DS_REG
- mov ARG1,ARITH_TEMP_1
- add ARG0,ARITH_TEMP_1
- jo MANGLE(overflow_fixnum_add)
- mov ARITH_TEMP_1,(DS_REG)
- ret
+DEF(void,primitive_fixnum_add,(void *myvm)):
+ mov ARG0, ARG2 /* save vm ptr for overflow */
+ mov (DS_REG),ARG0
+ mov -CELL_SIZE(DS_REG),ARG1
+ sub $CELL_SIZE,DS_REG
+ mov ARG1,ARITH_TEMP_1
+ add ARG0,ARITH_TEMP_1
+ jo MANGLE(overflow_fixnum_add)
+ mov ARITH_TEMP_1,(DS_REG)
+ ret
-DEF(void,primitive_fixnum_subtract,(void)):
- mov (DS_REG),ARG1
- mov -CELL_SIZE(DS_REG),ARG0
- sub $CELL_SIZE,DS_REG
- mov ARG0,ARITH_TEMP_1
- sub ARG1,ARITH_TEMP_1
- jo MANGLE(overflow_fixnum_subtract)
- mov ARITH_TEMP_1,(DS_REG)
- ret
+DEF(void,primitive_fixnum_subtract,(void *myvm)):
+ mov ARG0, ARG2 /* save vm ptr for overflow */
+ mov (DS_REG),ARG1
+ mov -CELL_SIZE(DS_REG),ARG0
+ sub $CELL_SIZE,DS_REG
+ mov ARG0,ARITH_TEMP_1
+ sub ARG1,ARITH_TEMP_1
+ jo MANGLE(overflow_fixnum_subtract)
+ mov ARITH_TEMP_1,(DS_REG)
+ ret
-DEF(void,primitive_fixnum_multiply,(void)):
- mov (DS_REG),ARITH_TEMP_1
- mov ARITH_TEMP_1,DIV_RESULT
- mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
- sar $3,ARITH_TEMP_2
- sub $CELL_SIZE,DS_REG
- imul ARITH_TEMP_2
- jo multiply_overflow
- mov DIV_RESULT,(DS_REG)
- ret
+DEF(void,primitive_fixnum_multiply,(void *myvm)):
+ push ARG0 /* save vm ptr for overflow */
+ mov (DS_REG),ARITH_TEMP_1
+ mov ARITH_TEMP_1,DIV_RESULT
+ mov -CELL_SIZE(DS_REG),ARITH_TEMP_2
+ sar $3,ARITH_TEMP_2
+ sub $CELL_SIZE,DS_REG
+ imul ARITH_TEMP_2
+ jo multiply_overflow
+ mov DIV_RESULT,(DS_REG)
+ pop ARG2
+ ret
multiply_overflow:
- sar $3,ARITH_TEMP_1
- mov ARITH_TEMP_1,ARG0
- mov ARITH_TEMP_2,ARG1
- jmp MANGLE(overflow_fixnum_multiply)
+ sar $3,ARITH_TEMP_1
+ mov ARITH_TEMP_1,ARG0
+ mov ARITH_TEMP_2,ARG1
+ pop ARG2
+ jmp MANGLE(overflow_fixnum_multiply)
-DEF(F_FASTCALL void,c_to_factor,(CELL quot)):
+DEF(F_FASTCALL void,c_to_factor,(CELL quot, void *vm)):
PUSH_NONVOLATILE
- mov ARG0,NV_TEMP_REG
-
+ mov ARG0,NV0
+ mov ARG1,NV1
+
/* Create register shadow area for Win64 */
sub $32,STACK_REG
-
+
/* Save stack pointer */
lea -CELL_SIZE(STACK_REG),ARG0
call MANGLE(save_callstack_bottom)
-
+
/* Call quot-xt */
- mov NV_TEMP_REG,ARG0
+ mov NV0,ARG0
+ mov NV1,ARG1
call *QUOT_XT_OFFSET(ARG0)
/* Tear down register shadow area */
POP_NONVOLATILE
ret
-DEF(F_FASTCALL void,throw_impl,(CELL quot, F_STACK_FRAME *rewind_to)):
- /* rewind_to */
- mov ARG1,STACK_REG
- jmp *QUOT_XT_OFFSET(ARG0)
-
-DEF(F_FASTCALL void,lazy_jit_compile,(CELL quot)):
- mov STACK_REG,ARG1 /* Save stack pointer */
- sub $STACK_PADDING,STACK_REG
- call MANGLE(lazy_jit_compile_impl)
- mov RETURN_REG,ARG0 /* No-op on 32-bit */
- add $STACK_PADDING,STACK_REG
- jmp *QUOT_XT_OFFSET(ARG0) /* Call the quotation */
+/* cpu.x86.features calls this */
+DEF(bool,sse_version,(void)):
+ mov $0x1,RETURN_REG
+ cpuid
+ test $0x100000,%ecx
+ jnz sse_42
+ test $0x80000,%ecx
+ jnz sse_41
+ test $0x200,%ecx
+ jnz ssse_3
+ test $0x1,%ecx
+ jnz sse_3
+ test $0x4000000,%edx
+ jnz sse_2
+ test $0x2000000,%edx
+ jnz sse_1
+ mov $0,%eax
+ ret
+sse_42:
+ mov $42,RETURN_REG
+ ret
+sse_41:
+ mov $41,RETURN_REG
+ ret
+ssse_3:
+ mov $33,RETURN_REG
+ ret
+sse_3:
+ mov $30,RETURN_REG
+ ret
+sse_2:
+ mov $20,RETURN_REG
+ ret
+sse_1:
+ mov $10,RETURN_REG
+ ret
#ifdef WINDOWS
.section .drectve
+ .ascii " -export:sse_version"
.ascii " -export:c_to_factor"
#endif
namespace factor
{
-#define FRAME_RETURN_ADDRESS(frame) *(void **)(frame_successor(frame) + 1)
+#define FRAME_RETURN_ADDRESS(frame,vm) *(void **)(vm->frame_successor(frame) + 1)
inline static void flush_icache(cell start, cell len) {}
return call_site_opcode(return_address) == jmp_opcode;
}
+inline static unsigned int fpu_status(unsigned int status)
+{
+ unsigned int r = 0;
+
+ if (status & 0x01)
+ r |= FP_TRAP_INVALID_OPERATION;
+ if (status & 0x04)
+ r |= FP_TRAP_ZERO_DIVIDE;
+ if (status & 0x08)
+ r |= FP_TRAP_OVERFLOW;
+ if (status & 0x10)
+ r |= FP_TRAP_UNDERFLOW;
+ if (status & 0x20)
+ r |= FP_TRAP_INEXACT;
+
+ return r;
+}
+
/* Defined in assembly */
-VM_ASM_API void c_to_factor(cell quot);
-VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to);
-VM_ASM_API void lazy_jit_compile(cell quot);
+VM_ASM_API void c_to_factor(cell quot, void *vm);
+VM_ASM_API void throw_impl(cell quot, stack_frame *rewind_to, void *vm);
+VM_ASM_API void lazy_jit_compile(cell quot, void *vm);
VM_C_API void set_callstack(stack_frame *to,
stack_frame *from,
namespace factor
{
-/* used during garbage collection only */
-zone *newspace;
-bool performing_gc;
-bool performing_compaction;
-cell collecting_gen;
-
-/* if true, we are collecting aging space for the second time, so if it is still
-full, we go on to collect tenured */
-bool collecting_aging_again;
-
-/* in case a generation fills up in the middle of a gc, we jump back
-up to try collecting the next generation. */
-jmp_buf gc_jmp;
-
-gc_stats stats[max_gen_count];
-u64 cards_scanned;
-u64 decks_scanned;
-u64 card_scan_time;
-cell code_heap_scans;
-
-/* What generation was being collected when copy_code_heap_roots() was last
-called? Until the next call to add_code_block(), future
-collections of younger generations don't have to touch the code
-heap. */
-cell last_code_heap_scan;
-
-/* sometimes we grow the heap */
-bool growing_data_heap;
-data_heap *old_data_heap;
-
-void init_data_gc()
-{
- performing_gc = false;
+void factor_vm::init_data_gc()
+{
last_code_heap_scan = data->nursery();
- collecting_aging_again = false;
}
+gc_state::gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_) :
+ data(data_),
+ growing_data_heap(growing_data_heap_),
+ collecting_gen(collecting_gen_),
+ collecting_aging_again(false),
+ start_time(current_micros()) { }
+
+gc_state::~gc_state() { }
+
/* Given a pointer to oldspace, copy it to newspace */
-static object *copy_untagged_object_impl(object *pointer, cell size)
+object *factor_vm::copy_untagged_object_impl(object *pointer, cell size)
{
- if(newspace->here + size >= newspace->end)
- longjmp(gc_jmp,1);
- object *newpointer = allot_zone(newspace,size);
+ if(current_gc->newspace->here + size >= current_gc->newspace->end)
+ longjmp(current_gc->gc_unwind,1);
+
+ object *newpointer = allot_zone(current_gc->newspace,size);
- gc_stats *s = &stats[collecting_gen];
+ gc_stats *s = &stats[current_gc->collecting_gen];
s->object_count++;
s->bytes_copied += size;
return newpointer;
}
-static object *copy_object_impl(object *untagged)
+object *factor_vm::copy_object_impl(object *untagged)
{
object *newpointer = copy_untagged_object_impl(untagged,untagged_object_size(untagged));
untagged->h.forward_to(newpointer);
return newpointer;
}
-static bool should_copy_p(object *untagged)
+bool factor_vm::should_copy_p(object *untagged)
{
- if(in_zone(newspace,untagged))
+ if(in_zone(current_gc->newspace,untagged))
return false;
- if(collecting_gen == data->tenured())
+ if(current_gc->collecting_tenured_p())
return true;
- else if(data->have_aging_p() && collecting_gen == data->aging())
+ else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
return !in_zone(&data->generations[data->tenured()],untagged);
- else if(collecting_gen == data->nursery())
+ else if(current_gc->collecting_nursery_p())
return in_zone(&nursery,untagged);
else
{
}
/* Follow a chain of forwarding pointers */
-static object *resolve_forwarding(object *untagged)
+object *factor_vm::resolve_forwarding(object *untagged)
{
check_data_pointer(untagged);
}
}
-template <typename T> static T *copy_untagged_object(T *untagged)
+template<typename Type> Type *factor_vm::copy_untagged_object(Type *untagged)
{
check_data_pointer(untagged);
if(untagged->h.forwarding_pointer_p())
- untagged = (T *)resolve_forwarding(untagged->h.forwarding_pointer());
+ untagged = (Type *)resolve_forwarding(untagged->h.forwarding_pointer());
else
{
untagged->h.check_header();
- untagged = (T *)copy_object_impl(untagged);
+ untagged = (Type *)copy_object_impl(untagged);
}
return untagged;
}
-static cell copy_object(cell pointer)
+cell factor_vm::copy_object(cell pointer)
{
return RETAG(copy_untagged_object(untag<object>(pointer)),TAG(pointer));
}
-void copy_handle(cell *handle)
+void factor_vm::trace_handle(cell *handle)
{
cell pointer = *handle;
}
/* Scan all the objects in the card */
-static void copy_card(card *ptr, cell gen, cell here)
+void factor_vm::trace_card(card *ptr, cell gen, cell here)
{
cell card_scan = card_to_addr(ptr) + card_offset(ptr);
cell card_end = card_to_addr(ptr + 1);
cards_scanned++;
}
-static void copy_card_deck(card_deck *deck, cell gen, card mask, card unmask)
+void factor_vm::trace_card_deck(card_deck *deck, cell gen, card mask, card unmask)
{
card *first_card = deck_to_card(deck);
card *last_card = deck_to_card(deck + 1);
{
if(ptr[card] & mask)
{
- copy_card(&ptr[card],gen,here);
+ trace_card(&ptr[card],gen,here);
ptr[card] &= ~unmask;
}
}
}
/* Copy all newspace objects referenced from marked cards to the destination */
-static void copy_gen_cards(cell gen)
+void factor_vm::trace_generation_cards(cell gen)
{
card_deck *first_deck = addr_to_deck(data->generations[gen].start);
card_deck *last_deck = addr_to_deck(data->generations[gen].end);
/* if we are collecting the nursery, we care about old->nursery pointers
but not old->aging pointers */
- if(collecting_gen == data->nursery())
+ if(current_gc->collecting_nursery_p())
{
mask = card_points_to_nursery;
unmask = card_mark_mask;
else
{
- critical_error("bug in copy_gen_cards",gen);
+ critical_error("bug in trace_generation_cards",gen);
return;
}
}
/* if we are collecting aging space into tenured space, we care about
all old->nursery and old->aging pointers. no old->aging pointers can
remain */
- else if(data->have_aging_p() && collecting_gen == data->aging())
+ else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
{
- if(collecting_aging_again)
+ if(current_gc->collecting_aging_again)
{
mask = card_points_to_aging;
unmask = card_mark_mask;
}
else
{
- critical_error("bug in copy_gen_cards",gen);
+ critical_error("bug in trace_generation_cards",gen);
return;
}
{
if(*ptr & mask)
{
- copy_card_deck(ptr,gen,mask,unmask);
+ trace_card_deck(ptr,gen,mask,unmask);
*ptr &= ~unmask;
}
}
/* Scan cards in all generations older than the one being collected, copying
old->new references */
-static void copy_cards()
+void factor_vm::trace_cards()
{
u64 start = current_micros();
cell i;
- for(i = collecting_gen + 1; i < data->gen_count; i++)
- copy_gen_cards(i);
+ for(i = current_gc->collecting_gen + 1; i < data->gen_count; i++)
+ trace_generation_cards(i);
card_scan_time += (current_micros() - start);
}
/* Copy all tagged pointers in a range of memory */
-static void copy_stack_elements(segment *region, cell top)
+void factor_vm::trace_stack_elements(segment *region, cell top)
{
cell ptr = region->start;
for(; ptr <= top; ptr += sizeof(cell))
- copy_handle((cell*)ptr);
+ trace_handle((cell*)ptr);
}
-static void copy_registered_locals()
+void factor_vm::trace_registered_locals()
{
- cell scan = gc_locals_region->start;
+ std::vector<cell>::const_iterator iter = gc_locals.begin();
+ std::vector<cell>::const_iterator end = gc_locals.end();
- for(; scan <= gc_locals; scan += sizeof(cell))
- copy_handle(*(cell **)scan);
+ for(; iter < end; iter++)
+ trace_handle((cell *)(*iter));
}
-static void copy_registered_bignums()
+void factor_vm::trace_registered_bignums()
{
- cell scan = gc_bignums_region->start;
+ std::vector<cell>::const_iterator iter = gc_bignums.begin();
+ std::vector<cell>::const_iterator end = gc_bignums.end();
- for(; scan <= gc_bignums; scan += sizeof(cell))
+ for(; iter < end; iter++)
{
- bignum **handle = *(bignum ***)scan;
+ bignum **handle = (bignum **)(*iter);
bignum *pointer = *handle;
if(pointer)
/* Copy roots over at the start of GC, namely various constants, stacks,
the user environment and extra roots registered by local_roots.hpp */
-static void copy_roots()
+void factor_vm::trace_roots()
{
- copy_handle(&T);
- copy_handle(&bignum_zero);
- copy_handle(&bignum_pos_one);
- copy_handle(&bignum_neg_one);
+ trace_handle(&T);
+ trace_handle(&bignum_zero);
+ trace_handle(&bignum_pos_one);
+ trace_handle(&bignum_neg_one);
- copy_registered_locals();
- copy_registered_bignums();
+ trace_registered_locals();
+ trace_registered_bignums();
- if(!performing_compaction)
- {
- save_stacks();
- context *stacks = stack_chain;
+ int i;
+ for(i = 0; i < USER_ENV; i++)
+ trace_handle(&userenv[i]);
+}
- while(stacks)
- {
- copy_stack_elements(stacks->datastack_region,stacks->datastack);
- copy_stack_elements(stacks->retainstack_region,stacks->retainstack);
+void factor_vm::trace_contexts()
+{
+ save_stacks();
+ context *stacks = stack_chain;
- copy_handle(&stacks->catchstack_save);
- copy_handle(&stacks->current_callback_save);
+ while(stacks)
+ {
+ trace_stack_elements(stacks->datastack_region,stacks->datastack);
+ trace_stack_elements(stacks->retainstack_region,stacks->retainstack);
- mark_active_blocks(stacks);
+ trace_handle(&stacks->catchstack_save);
+ trace_handle(&stacks->current_callback_save);
- stacks = stacks->next;
- }
- }
+ mark_active_blocks(stacks);
- int i;
- for(i = 0; i < USER_ENV; i++)
- copy_handle(&userenv[i]);
+ stacks = stacks->next;
+ }
}
-static cell copy_next_from_nursery(cell scan)
+cell factor_vm::copy_next_from_nursery(cell scan)
{
cell *obj = (cell *)scan;
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
return scan + untagged_object_size((object *)scan);
}
-static cell copy_next_from_aging(cell scan)
+cell factor_vm::copy_next_from_aging(cell scan)
{
cell *obj = (cell *)scan;
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
cell tenured_start = data->generations[data->tenured()].start;
cell tenured_end = data->generations[data->tenured()].end;
- cell newspace_start = newspace->start;
- cell newspace_end = newspace->end;
+ cell newspace_start = current_gc->newspace->start;
+ cell newspace_end = current_gc->newspace->end;
for(; obj < end; obj++)
{
return scan + untagged_object_size((object *)scan);
}
-static cell copy_next_from_tenured(cell scan)
+cell factor_vm::copy_next_from_tenured(cell scan)
{
cell *obj = (cell *)scan;
cell *end = (cell *)(scan + binary_payload_start((object *)scan));
{
obj++;
- cell newspace_start = newspace->start;
- cell newspace_end = newspace->end;
+ cell newspace_start = current_gc->newspace->start;
+ cell newspace_end = current_gc->newspace->end;
for(; obj < end; obj++)
{
return scan + untagged_object_size((object *)scan);
}
-void copy_reachable_objects(cell scan, cell *end)
+void factor_vm::copy_reachable_objects(cell scan, cell *end)
{
- if(collecting_gen == data->nursery())
+ if(current_gc->collecting_nursery_p())
{
while(scan < *end)
scan = copy_next_from_nursery(scan);
}
- else if(data->have_aging_p() && collecting_gen == data->aging())
+ else if(data->have_aging_p() && current_gc->collecting_gen == data->aging())
{
while(scan < *end)
scan = copy_next_from_aging(scan);
}
- else if(collecting_gen == data->tenured())
+ else if(current_gc->collecting_tenured_p())
{
while(scan < *end)
scan = copy_next_from_tenured(scan);
}
}
+void factor_vm::update_code_heap_roots()
+{
+ if(current_gc->collecting_gen >= last_code_heap_scan)
+ {
+ code_heap_scans++;
+
+ trace_code_heap_roots();
+
+ if(current_gc->collecting_accumulation_gen_p())
+ last_code_heap_scan = current_gc->collecting_gen;
+ else
+ last_code_heap_scan = current_gc->collecting_gen + 1;
+ }
+}
+
+struct literal_and_word_reference_updater {
+ factor_vm *myvm;
+
+ literal_and_word_reference_updater(factor_vm *myvm_) : myvm(myvm_) {}
+
+ void operator()(heap_block *block)
+ {
+ code_block *compiled = (code_block *)block;
+ myvm->update_literal_references(compiled);
+ myvm->update_word_references(compiled);
+ }
+};
+
+void factor_vm::free_unmarked_code_blocks()
+{
+ literal_and_word_reference_updater updater(this);
+ code->free_unmarked(updater);
+ last_code_heap_scan = current_gc->collecting_gen;
+}
+
+void factor_vm::update_dirty_code_blocks()
+{
+ std::set<code_block *> dirty_code_blocks = current_gc->dirty_code_blocks;
+ std::set<code_block *>::const_iterator iter = dirty_code_blocks.begin();
+ std::set<code_block *>::const_iterator end = dirty_code_blocks.end();
+
+ for(; iter != end; iter++)
+ update_literal_references(*iter);
+
+ dirty_code_blocks.clear();
+}
+
/* Prepare to start copying reachable objects into an unused zone */
-static void begin_gc(cell requested_bytes)
+void factor_vm::begin_gc(cell requested_bytes)
{
- if(growing_data_heap)
+ if(current_gc->growing_data_heap)
{
- if(collecting_gen != data->tenured())
- critical_error("Invalid parameters to begin_gc",0);
+ assert(current_gc->collecting_tenured_p());
- old_data_heap = data;
- set_data_heap(grow_data_heap(old_data_heap,requested_bytes));
- newspace = &data->generations[data->tenured()];
+ current_gc->old_data_heap = data;
+ set_data_heap(grow_data_heap(current_gc->old_data_heap,requested_bytes));
+ current_gc->newspace = &data->generations[data->tenured()];
}
- else if(collecting_accumulation_gen_p())
+ else if(current_gc->collecting_accumulation_gen_p())
{
/* when collecting one of these generations, rotate it
with the semispace */
- zone z = data->generations[collecting_gen];
- data->generations[collecting_gen] = data->semispaces[collecting_gen];
- data->semispaces[collecting_gen] = z;
- reset_generation(collecting_gen);
- newspace = &data->generations[collecting_gen];
- clear_cards(collecting_gen,collecting_gen);
- clear_decks(collecting_gen,collecting_gen);
- clear_allot_markers(collecting_gen,collecting_gen);
+ zone z = data->generations[current_gc->collecting_gen];
+ data->generations[current_gc->collecting_gen] = data->semispaces[current_gc->collecting_gen];
+ data->semispaces[current_gc->collecting_gen] = z;
+ reset_generation(current_gc->collecting_gen);
+ current_gc->newspace = &data->generations[current_gc->collecting_gen];
+ clear_cards(current_gc->collecting_gen,current_gc->collecting_gen);
+ clear_decks(current_gc->collecting_gen,current_gc->collecting_gen);
+ clear_allot_markers(current_gc->collecting_gen,current_gc->collecting_gen);
}
else
{
/* when collecting a younger generation, we copy
reachable objects to the next oldest generation,
so we set the newspace so the next generation. */
- newspace = &data->generations[collecting_gen + 1];
+ current_gc->newspace = &data->generations[current_gc->collecting_gen + 1];
}
}
-static void end_gc(cell gc_elapsed)
+void factor_vm::end_gc()
{
- gc_stats *s = &stats[collecting_gen];
+ gc_stats *s = &stats[current_gc->collecting_gen];
+ cell gc_elapsed = (current_micros() - current_gc->start_time);
s->collections++;
s->gc_time += gc_elapsed;
if(s->max_gc_time < gc_elapsed)
s->max_gc_time = gc_elapsed;
- if(growing_data_heap)
- {
- dealloc_data_heap(old_data_heap);
- old_data_heap = NULL;
- growing_data_heap = false;
- }
+ if(current_gc->growing_data_heap)
+ delete current_gc->old_data_heap;
- if(collecting_accumulation_gen_p())
+ if(current_gc->collecting_nursery_p())
{
- /* all younger generations except are now empty.
- if collecting_gen == data->nursery() here, we only have 1 generation;
- old-school Cheney collector */
- if(collecting_gen != data->nursery())
- reset_generations(data->nursery(),collecting_gen - 1);
+ nursery.here = nursery.start;
}
- else if(collecting_gen == data->nursery())
+ else if(current_gc->collecting_accumulation_gen_p())
{
- nursery.here = nursery.start;
+ reset_generations(data->nursery(),current_gc->collecting_gen - 1);
}
else
{
/* all generations up to and including the one
collected are now empty */
- reset_generations(data->nursery(),collecting_gen);
+ reset_generations(data->nursery(),current_gc->collecting_gen);
}
-
- collecting_aging_again = false;
}
/* Collect gen and all younger generations.
If growing_data_heap_ is true, we must grow the data heap to such a size that
an allocation of requested_bytes won't fail */
-void garbage_collection(cell gen,
- bool growing_data_heap_,
- cell requested_bytes)
+void factor_vm::garbage_collection(cell collecting_gen_, bool growing_data_heap_, bool trace_contexts_, cell requested_bytes)
{
if(gc_off)
{
- critical_error("GC disabled",gen);
+ critical_error("GC disabled",collecting_gen_);
return;
}
- u64 start = current_micros();
-
- performing_gc = true;
- growing_data_heap = growing_data_heap_;
- collecting_gen = gen;
-
- /* we come back here if a generation is full */
- if(setjmp(gc_jmp))
- {
- /* We have no older generations we can try collecting, so we
- resort to growing the data heap */
- if(collecting_gen == data->tenured())
- {
- growing_data_heap = true;
-
- /* see the comment in unmark_marked() */
- unmark_marked(&code);
- }
- /* we try collecting aging space twice before going on to
- collect tenured */
- else if(data->have_aging_p()
- && collecting_gen == data->aging()
- && !collecting_aging_again)
- {
- collecting_aging_again = true;
- }
- /* Collect the next oldest generation */
- else
- {
- collecting_gen++;
- }
- }
-
- begin_gc(requested_bytes);
-
- /* initialize chase pointer */
- cell scan = newspace->here;
-
- /* collect objects referenced from stacks and environment */
- copy_roots();
- /* collect objects referenced from older generations */
- copy_cards();
-
- /* do some tracing */
- copy_reachable_objects(scan,&newspace->here);
-
- /* don't scan code heap unless it has pointers to this
- generation or younger */
- if(collecting_gen >= last_code_heap_scan)
- {
- code_heap_scans++;
-
- if(collecting_gen == data->tenured())
- free_unmarked(&code,(heap_iterator)update_literal_and_word_references);
- else
- copy_code_heap_roots();
-
- if(collecting_accumulation_gen_p())
- last_code_heap_scan = collecting_gen;
- else
- last_code_heap_scan = collecting_gen + 1;
- }
-
- cell gc_elapsed = (current_micros() - start);
-
- end_gc(gc_elapsed);
-
- performing_gc = false;
+ current_gc = new gc_state(data,growing_data_heap_,collecting_gen_);
+
+ /* Keep trying to GC higher and higher generations until we don't run out
+ of space */
+ if(setjmp(current_gc->gc_unwind))
+ {
+ /* We come back here if a generation is full */
+
+ /* We have no older generations we can try collecting, so we
+ resort to growing the data heap */
+ if(current_gc->collecting_tenured_p())
+ {
+ current_gc->growing_data_heap = true;
+
+ /* see the comment in unmark_marked() */
+ code->unmark_marked();
+ }
+ /* we try collecting aging space twice before going on to
+ collect tenured */
+ else if(data->have_aging_p()
+ && current_gc->collecting_gen == data->aging()
+ && !current_gc->collecting_aging_again)
+ {
+ current_gc->collecting_aging_again = true;
+ }
+ /* Collect the next oldest generation */
+ else
+ {
+ current_gc->collecting_gen++;
+ }
+ }
+
+ begin_gc(requested_bytes);
+
+ /* Initialize chase pointer */
+ cell scan = current_gc->newspace->here;
+
+ /* Trace objects referenced from global environment */
+ trace_roots();
+
+ /* Trace objects referenced from stacks, unless we're doing
+ save-image-and-exit in which case stack objects are irrelevant */
+ if(trace_contexts_) trace_contexts();
+
+ /* Trace objects referenced from older generations */
+ trace_cards();
+
+ /* On minor GC, trace code heap roots if it has pointers
+ to this generation or younger. Otherwise, tracing data heap objects
+ will mark all reachable code blocks, and we free the unmarked ones
+ after. */
+ if(!current_gc->collecting_tenured_p() && current_gc->collecting_gen >= last_code_heap_scan)
+ {
+ update_code_heap_roots();
+ }
+
+ /* do some copying -- this is where most of the work is done */
+ copy_reachable_objects(scan,¤t_gc->newspace->here);
+
+ /* On minor GC, update literal references in code blocks, now that all
+ data heap objects are in their final location. On a major GC,
+ free all code blocks that did not get marked during tracing. */
+ if(current_gc->collecting_tenured_p())
+ free_unmarked_code_blocks();
+ else
+ update_dirty_code_blocks();
+
+ /* GC completed without any generations filling up; finish up */
+ end_gc();
+
+ delete current_gc;
+ current_gc = NULL;
}
-void gc()
+void factor_vm::gc()
{
- garbage_collection(data->tenured(),false,0);
+ garbage_collection(data->tenured(),false,true,0);
}
-PRIMITIVE(gc)
+void factor_vm::primitive_gc()
{
gc();
}
-PRIMITIVE(gc_stats)
+void factor_vm::primitive_gc_stats()
{
- growable_array result;
+ growable_array result(this);
cell i;
u64 total_gc_time = 0;
dpush(result.elements.value());
}
-void clear_gc_stats()
+void factor_vm::clear_gc_stats()
{
for(cell i = 0; i < max_gen_count; i++)
memset(&stats[i],0,sizeof(gc_stats));
code_heap_scans = 0;
}
-PRIMITIVE(clear_gc_stats)
+void factor_vm::primitive_clear_gc_stats()
{
clear_gc_stats();
}
/* classes.tuple uses this to reshape tuples; tools.deploy.shaker uses this
to coalesce equal but distinct quotations and wrappers. */
-PRIMITIVE(become)
+void factor_vm::primitive_become()
{
array *new_objects = untag_check<array>(dpop());
array *old_objects = untag_check<array>(dpop());
compile_all_words();
}
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size)
+void factor_vm::inline_gc(cell *gc_roots_base, cell gc_roots_size)
{
for(cell i = 0; i < gc_roots_size; i++)
- gc_local_push((cell)&gc_roots_base[i]);
+ gc_locals.push_back((cell)&gc_roots_base[i]);
- garbage_collection(data->nursery(),false,0);
+ garbage_collection(data->nursery(),false,true,0);
for(cell i = 0; i < gc_roots_size; i++)
- gc_local_pop();
+ gc_locals.pop_back();
+}
+
+VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm)
+{
+ ASSERTVM();
+ VM_PTR->inline_gc(gc_roots_base,gc_roots_size);
+}
+
+inline object *factor_vm::allot_zone(zone *z, cell a)
+{
+ cell h = z->here;
+ z->here = h + align8(a);
+ object *obj = (object *)h;
+ allot_barrier(obj);
+ return obj;
+}
+
+/*
+ * It is up to the caller to fill in the object's fields in a meaningful
+ * fashion!
+ */
+object *factor_vm::allot_object(header header, cell size)
+{
+#ifdef GC_DEBUG
+ if(!gc_off)
+ gc();
+#endif
+
+ object *obj;
+
+ if(nursery.size > size)
+ {
+ /* If there is insufficient room, collect the nursery */
+ if(nursery.here + size > nursery.end)
+ garbage_collection(data->nursery(),false,true,0);
+
+ cell h = nursery.here;
+ nursery.here = h + align8(size);
+ obj = (object *)h;
+ }
+ /* If the object is bigger than the nursery, allocate it in
+ tenured space */
+ else
+ {
+ zone *tenured = &data->generations[data->tenured()];
+
+ /* If tenured space does not have enough room, collect */
+ if(tenured->here + size > tenured->end)
+ {
+ gc();
+ tenured = &data->generations[data->tenured()];
+ }
+
+ /* If it still won't fit, grow the heap */
+ if(tenured->here + size > tenured->end)
+ {
+ garbage_collection(data->tenured(),true,true,size);
+ tenured = &data->generations[data->tenured()];
+ }
+
+ obj = allot_zone(tenured,size);
+
+ /* Allows initialization code to store old->new pointers
+ without hitting the write barrier in the common case of
+ a nursery allocation */
+ write_barrier(obj);
+ }
+
+ obj->h = header;
+ return obj;
}
}
u64 bytes_copied;
};
-extern zone *newspace;
+struct gc_state {
+ /* The data heap we're collecting */
+ data_heap *data;
-extern bool performing_compaction;
-extern cell collecting_gen;
-extern bool collecting_aging_again;
+ /* New objects are copied here */
+ zone *newspace;
-extern cell last_code_heap_scan;
+ /* sometimes we grow the heap */
+ bool growing_data_heap;
+ data_heap *old_data_heap;
-void init_data_gc();
+ /* Which generation is being collected */
+ cell collecting_gen;
-void gc();
+ /* If true, we are collecting aging space for the second time, so if it is still
+ full, we go on to collect tenured */
+ bool collecting_aging_again;
-inline static bool collecting_accumulation_gen_p()
-{
- return ((data->have_aging_p()
- && collecting_gen == data->aging()
- && !collecting_aging_again)
- || collecting_gen == data->tenured());
-}
-
-void copy_handle(cell *handle);
-
-void garbage_collection(volatile cell gen,
- bool growing_data_heap_,
- cell requested_bytes);
-
-/* We leave this many bytes free at the top of the nursery so that inline
-allocation (which does not call GC because of possible roots in volatile
-registers) does not run out of memory */
-static const cell allot_buffer_zone = 1024;
-
-inline static object *allot_zone(zone *z, cell a)
-{
- cell h = z->here;
- z->here = h + align8(a);
- object *obj = (object *)h;
- allot_barrier(obj);
- return obj;
-}
+ /* A set of code blocks which need to have their literals updated */
+ std::set<code_block *> dirty_code_blocks;
-/*
- * It is up to the caller to fill in the object's fields in a meaningful
- * fashion!
- */
-inline static object *allot_object(header header, cell size)
-{
-#ifdef GC_DEBUG
- if(!gc_off)
- gc();
-#endif
+ /* GC start time, for benchmarking */
+ u64 start_time;
- object *obj;
+ jmp_buf gc_unwind;
- if(nursery.size - allot_buffer_zone > size)
- {
- /* If there is insufficient room, collect the nursery */
- if(nursery.here + allot_buffer_zone + size > nursery.end)
- garbage_collection(data->nursery(),false,0);
+ explicit gc_state(data_heap *data_, bool growing_data_heap_, cell collecting_gen_);
+ ~gc_state();
- cell h = nursery.here;
- nursery.here = h + align8(size);
- obj = (object *)h;
- }
- /* If the object is bigger than the nursery, allocate it in
- tenured space */
- else
+ inline bool collecting_nursery_p()
{
- zone *tenured = &data->generations[data->tenured()];
-
- /* If tenured space does not have enough room, collect */
- if(tenured->here + size > tenured->end)
- {
- gc();
- tenured = &data->generations[data->tenured()];
- }
-
- /* If it still won't fit, grow the heap */
- if(tenured->here + size > tenured->end)
- {
- garbage_collection(data->tenured(),true,size);
- tenured = &data->generations[data->tenured()];
- }
-
- obj = allot_zone(tenured,size);
-
- /* Allows initialization code to store old->new pointers
- without hitting the write barrier in the common case of
- a nursery allocation */
- write_barrier(obj);
+ return collecting_gen == data->nursery();
}
- obj->h = header;
- return obj;
-}
-
-template<typename T> T *allot(cell size)
-{
- return (T *)allot_object(header(T::type_number),size);
-}
-
-void copy_reachable_objects(cell scan, cell *end);
-
-PRIMITIVE(gc);
-PRIMITIVE(gc_stats);
-void clear_gc_stats();
-PRIMITIVE(clear_gc_stats);
-PRIMITIVE(become);
-
-extern bool growing_data_heap;
-
-inline static void check_data_pointer(object *pointer)
-{
-#ifdef FACTOR_DEBUG
- if(!growing_data_heap)
+ inline bool collecting_tenured_p()
{
- assert((cell)pointer >= data->seg->start
- && (cell)pointer < data->seg->end);
+ return collecting_gen == data->tenured();
}
-#endif
-}
-inline static void check_tagged_pointer(cell tagged)
-{
-#ifdef FACTOR_DEBUG
- if(!immediate_p(tagged))
+ inline bool collecting_accumulation_gen_p()
{
- object *obj = untag<object>(tagged);
- check_data_pointer(obj);
- obj->h.hi_tag();
+ return ((data->have_aging_p()
+ && collecting_gen == data->aging()
+ && !collecting_aging_again)
+ || collecting_gen == data->tenured());
}
-#endif
-}
+};
-VM_ASM_API void inline_gc(cell *gc_roots_base, cell gc_roots_size);
+VM_C_API void inline_gc(cell *gc_roots_base, cell gc_roots_size, factor_vm *myvm);
}
#include "master.hpp"
-factor::zone nursery;
-
namespace factor
{
-/* Set by the -securegc command line argument */
-bool secure_gc;
-
-/* new objects are allocated here */
-VM_C_API zone nursery;
-
-/* GC is off during heap walking */
-bool gc_off;
-
-data_heap *data;
-
-cell init_zone(zone *z, cell size, cell start)
-{
- z->size = size;
- z->start = z->here = start;
- z->end = start + size;
- return z->end;
-}
-
-void init_card_decks()
+void factor_vm::init_card_decks()
{
cell start = align(data->seg->start,deck_size);
allot_markers_offset = (cell)data->allot_markers - (start >> card_bits);
decks_offset = (cell)data->decks - (start >> deck_bits);
}
-data_heap *alloc_data_heap(cell gens,
- cell young_size,
- cell aging_size,
- cell tenured_size)
+data_heap::data_heap(factor_vm *myvm, cell gen_count_, cell young_size_, cell aging_size_, cell tenured_size_)
{
- young_size = align(young_size,deck_size);
- aging_size = align(aging_size,deck_size);
- tenured_size = align(tenured_size,deck_size);
+ young_size_ = align(young_size_,deck_size);
+ aging_size_ = align(aging_size_,deck_size);
+ tenured_size_ = align(tenured_size_,deck_size);
- data_heap *data = (data_heap *)safe_malloc(sizeof(data_heap));
- data->young_size = young_size;
- data->aging_size = aging_size;
- data->tenured_size = tenured_size;
- data->gen_count = gens;
+ young_size = young_size_;
+ aging_size = aging_size_;
+ tenured_size = tenured_size_;
+ gen_count = gen_count_;
cell total_size;
- if(data->gen_count == 2)
+ if(gen_count == 2)
total_size = young_size + 2 * tenured_size;
- else if(data->gen_count == 3)
+ else if(gen_count == 3)
total_size = young_size + 2 * aging_size + 2 * tenured_size;
else
{
- fatal_error("Invalid number of generations",data->gen_count);
- return NULL; /* can't happen */
+ total_size = 0;
+ fatal_error("Invalid number of generations",gen_count);
}
total_size += deck_size;
- data->seg = alloc_segment(total_size);
+ seg = new segment(myvm,total_size);
- data->generations = (zone *)safe_malloc(sizeof(zone) * data->gen_count);
- data->semispaces = (zone *)safe_malloc(sizeof(zone) * data->gen_count);
+ generations = new zone[gen_count];
+ semispaces = new zone[gen_count];
cell cards_size = total_size >> card_bits;
- data->allot_markers = (cell *)safe_malloc(cards_size);
- data->allot_markers_end = data->allot_markers + cards_size;
+ allot_markers = new char[cards_size];
+ allot_markers_end = allot_markers + cards_size;
- data->cards = (cell *)safe_malloc(cards_size);
- data->cards_end = data->cards + cards_size;
+ cards = new char[cards_size];
+ cards_end = cards + cards_size;
cell decks_size = total_size >> deck_bits;
- data->decks = (cell *)safe_malloc(decks_size);
- data->decks_end = data->decks + decks_size;
+ decks = new char[decks_size];
+ decks_end = decks + decks_size;
- cell alloter = align(data->seg->start,deck_size);
+ cell alloter = align(seg->start,deck_size);
- alloter = init_zone(&data->generations[data->tenured()],tenured_size,alloter);
- alloter = init_zone(&data->semispaces[data->tenured()],tenured_size,alloter);
+ alloter = generations[tenured()].init_zone(tenured_size,alloter);
+ alloter = semispaces[tenured()].init_zone(tenured_size,alloter);
- if(data->gen_count == 3)
+ if(gen_count == 3)
{
- alloter = init_zone(&data->generations[data->aging()],aging_size,alloter);
- alloter = init_zone(&data->semispaces[data->aging()],aging_size,alloter);
+ alloter = generations[aging()].init_zone(aging_size,alloter);
+ alloter = semispaces[aging()].init_zone(aging_size,alloter);
}
- if(data->gen_count >= 2)
+ if(gen_count >= 2)
{
- alloter = init_zone(&data->generations[data->nursery()],young_size,alloter);
- alloter = init_zone(&data->semispaces[data->nursery()],0,alloter);
+ alloter = generations[nursery()].init_zone(young_size,alloter);
+ alloter = semispaces[nursery()].init_zone(0,alloter);
}
- if(data->seg->end - alloter > deck_size)
- critical_error("Bug in alloc_data_heap",alloter);
-
- return data;
+ if(seg->end - alloter > deck_size)
+ myvm->critical_error("Bug in alloc_data_heap",alloter);
}
-data_heap *grow_data_heap(data_heap *data, cell requested_bytes)
+data_heap *factor_vm::grow_data_heap(data_heap *data, cell requested_bytes)
{
cell new_tenured_size = (data->tenured_size * 2) + requested_bytes;
- return alloc_data_heap(data->gen_count,
+ return new data_heap(this,
+ data->gen_count,
data->young_size,
data->aging_size,
new_tenured_size);
}
-void dealloc_data_heap(data_heap *data)
+data_heap::~data_heap()
{
- dealloc_segment(data->seg);
- free(data->generations);
- free(data->semispaces);
- free(data->allot_markers);
- free(data->cards);
- free(data->decks);
- free(data);
+ delete seg;
+ delete[] generations;
+ delete[] semispaces;
+ delete[] allot_markers;
+ delete[] cards;
+ delete[] decks;
}
-void clear_cards(cell from, cell to)
+void factor_vm::clear_cards(cell from, cell to)
{
/* NOTE: reverse order due to heap layout. */
card *first_card = addr_to_card(data->generations[to].start);
memset(first_card,0,last_card - first_card);
}
-void clear_decks(cell from, cell to)
+void factor_vm::clear_decks(cell from, cell to)
{
/* NOTE: reverse order due to heap layout. */
card_deck *first_deck = addr_to_deck(data->generations[to].start);
memset(first_deck,0,last_deck - first_deck);
}
-void clear_allot_markers(cell from, cell to)
+void factor_vm::clear_allot_markers(cell from, cell to)
{
/* NOTE: reverse order due to heap layout. */
card *first_card = addr_to_allot_marker((object *)data->generations[to].start);
memset(first_card,invalid_allot_marker,last_card - first_card);
}
-void reset_generation(cell i)
+void factor_vm::reset_generation(cell i)
{
zone *z = (i == data->nursery() ? &nursery : &data->generations[i]);
/* After garbage collection, any generations which are now empty need to have
their allocation pointers and cards reset. */
-void reset_generations(cell from, cell to)
+void factor_vm::reset_generations(cell from, cell to)
{
cell i;
for(i = from; i <= to; i++)
clear_allot_markers(from,to);
}
-void set_data_heap(data_heap *data_)
+void factor_vm::set_data_heap(data_heap *data_)
{
data = data_;
nursery = data->generations[data->nursery()];
clear_allot_markers(data->nursery(),data->tenured());
}
-void init_data_heap(cell gens,
- cell young_size,
- cell aging_size,
- cell tenured_size,
- bool secure_gc_)
+void factor_vm::init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_)
{
- set_data_heap(alloc_data_heap(gens,young_size,aging_size,tenured_size));
-
- gc_locals_region = alloc_segment(getpagesize());
- gc_locals = gc_locals_region->start - sizeof(cell);
-
- gc_bignums_region = alloc_segment(getpagesize());
- gc_bignums = gc_bignums_region->start - sizeof(cell);
-
+ set_data_heap(new data_heap(this,gens,young_size,aging_size,tenured_size));
secure_gc = secure_gc_;
-
init_data_gc();
}
/* Size of the object pointed to by a tagged pointer */
-cell object_size(cell tagged)
+cell factor_vm::object_size(cell tagged)
{
if(immediate_p(tagged))
return 0;
}
/* Size of the object pointed to by an untagged pointer */
-cell untagged_object_size(object *pointer)
+cell factor_vm::untagged_object_size(object *pointer)
{
return align8(unaligned_object_size(pointer));
}
/* Size of the data area of an object pointed to by an untagged pointer */
-cell unaligned_object_size(object *pointer)
+cell factor_vm::unaligned_object_size(object *pointer)
{
switch(pointer->h.hi_tag())
{
}
}
-PRIMITIVE(size)
+void factor_vm::primitive_size()
{
box_unsigned_cell(object_size(dpop()));
}
/* The number of cells from the start of the object which should be scanned by
the GC. Some types have a binary payload at the end (string, word, DLL) which
we ignore. */
-cell binary_payload_start(object *pointer)
+cell factor_vm::binary_payload_start(object *pointer)
{
switch(pointer->h.hi_tag())
{
}
/* Push memory usage statistics in data heap */
-PRIMITIVE(data_room)
+void factor_vm::primitive_data_room()
{
dpush(tag_fixnum((data->cards_end - data->cards) >> 10));
dpush(tag_fixnum((data->decks_end - data->decks) >> 10));
- growable_array a;
+ growable_array a(this);
cell gen;
for(gen = 0; gen < data->gen_count; gen++)
dpush(a.elements.value());
}
-/* A heap walk allows useful things to be done, like finding all
-references to an object for debugging purposes. */
-cell heap_scan_ptr;
-
/* Disables GC and activates next-object ( -- obj ) primitive */
-void begin_scan()
+void factor_vm::begin_scan()
{
heap_scan_ptr = data->generations[data->tenured()].start;
gc_off = true;
}
-void end_scan()
+void factor_vm::end_scan()
{
gc_off = false;
}
-PRIMITIVE(begin_scan)
+void factor_vm::primitive_begin_scan()
{
begin_scan();
}
-cell next_object()
+cell factor_vm::next_object()
{
if(!gc_off)
general_error(ERROR_HEAP_SCAN,F,F,NULL);
}
/* Push object at heap scan cursor and advance; pushes f when done */
-PRIMITIVE(next_object)
+void factor_vm::primitive_next_object()
{
dpush(next_object());
}
/* Re-enables GC */
-PRIMITIVE(end_scan)
+void factor_vm::primitive_end_scan()
{
gc_off = false;
}
-template<typename T> void each_object(T &functor)
+template<typename Iterator> void factor_vm::each_object(Iterator &iterator)
{
begin_scan();
cell obj;
while((obj = next_object()) != F)
- functor(tagged<object>(obj));
+ iterator(tagged<object>(obj));
end_scan();
}
struct word_counter {
cell count;
- word_counter() : count(0) {}
+ explicit word_counter() : count(0) {}
void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) count++; }
};
struct word_accumulator {
growable_array words;
- word_accumulator(int count) : words(count) {}
+ explicit word_accumulator(int count,factor_vm *vm) : words(vm,count) {}
void operator()(tagged<object> obj) { if(obj.type_p(WORD_TYPE)) words.add(obj.value()); }
};
}
-cell find_all_words()
+cell factor_vm::find_all_words()
{
word_counter counter;
each_object(counter);
- word_accumulator accum(counter.count);
+ word_accumulator accum(counter.count,this);
each_object(accum);
accum.words.trim();
return accum.words.elements.value();
namespace factor
{
-/* Set by the -securegc command line argument */
-extern bool secure_gc;
-
/* generational copying GC divides memory into zones */
struct zone {
/* allocation pointer is 'here'; its offset is hardcoded in the
cell here;
cell size;
cell end;
+
+ cell init_zone(cell size_, cell start_)
+ {
+ size = size_;
+ start = here = start_;
+ end = start_ + size_;
+ return end;
+ }
};
struct data_heap {
zone *generations;
zone *semispaces;
- cell *allot_markers;
- cell *allot_markers_end;
+ char *allot_markers;
+ char *allot_markers_end;
- cell *cards;
- cell *cards_end;
+ char *cards;
+ char *cards_end;
- cell *decks;
- cell *decks_end;
+ char *decks;
+ char *decks_end;
/* the 0th generation is where new objects are allocated. */
cell nursery() { return 0; }
cell tenured() { return gen_count - 1; }
bool have_aging_p() { return gen_count > 2; }
-};
-extern data_heap *data;
+ explicit data_heap(factor_vm *myvm, cell gen_count, cell young_size, cell aging_size, cell tenured_size);
+ ~data_heap();
+};
static const cell max_gen_count = 3;
return (cell)pointer >= z->start && (cell)pointer < z->end;
}
-cell init_zone(zone *z, cell size, cell base);
-
-void init_card_decks();
-
-data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
-
-void dealloc_data_heap(data_heap *data);
-
-void clear_cards(cell from, cell to);
-void clear_decks(cell from, cell to);
-void clear_allot_markers(cell from, cell to);
-void reset_generation(cell i);
-void reset_generations(cell from, cell to);
-
-void set_data_heap(data_heap *data_heap_);
-
-void init_data_heap(cell gens,
- cell young_size,
- cell aging_size,
- cell tenured_size,
- bool secure_gc_);
-
-/* set up guard pages to check for under/overflow.
-size must be a multiple of the page size */
-segment *alloc_segment(cell size);
-void dealloc_segment(segment *block);
-
-cell untagged_object_size(object *pointer);
-cell unaligned_object_size(object *pointer);
-cell binary_payload_start(object *pointer);
-cell object_size(cell tagged);
-
-void begin_scan();
-void end_scan();
-cell next_object();
-
-PRIMITIVE(data_room);
-PRIMITIVE(size);
-
-PRIMITIVE(begin_scan);
-PRIMITIVE(next_object);
-PRIMITIVE(end_scan);
-
-/* GC is off during heap walking */
-extern bool gc_off;
-
-cell find_all_words();
-
-/* Every object has a regular representation in the runtime, which makes GC
-much simpler. Every slot of the object until binary_payload_start is a pointer
-to some other object. */
-inline static void do_slots(cell obj, void (* iter)(cell *))
-{
- cell scan = obj;
- cell payload_start = binary_payload_start((object *)obj);
- cell end = obj + payload_start;
-
- scan += sizeof(cell);
-
- while(scan < end)
- {
- iter((cell *)scan);
- scan += sizeof(cell);
- }
-}
-
}
-
-/* new objects are allocated here */
-VM_C_API factor::zone nursery;
namespace factor
{
-static bool fep_disabled;
-static bool full_output;
-
-void print_chars(string* str)
+void factor_vm::print_chars(string* str)
{
cell i;
for(i = 0; i < string_capacity(str); i++)
putchar(string_nth(str,i));
}
-void print_word(word* word, cell nesting)
+void factor_vm::print_word(word* word, cell nesting)
{
if(tagged<object>(word->vocabulary).type_p(STRING_TYPE))
{
}
}
-void print_factor_string(string* str)
+void factor_vm::print_factor_string(string* str)
{
putchar('"');
print_chars(str);
putchar('"');
}
-void print_array(array* array, cell nesting)
+void factor_vm::print_array(array* array, cell nesting)
{
cell length = array_capacity(array);
cell i;
print_string("...");
}
-void print_tuple(tuple *tuple, cell nesting)
+void factor_vm::print_tuple(tuple *tuple, cell nesting)
{
tuple_layout *layout = untag<tuple_layout>(tuple->layout);
cell length = to_fixnum(layout->size);
print_string("...");
}
-void print_nested_obj(cell obj, fixnum nesting)
+void factor_vm::print_nested_obj(cell obj, fixnum nesting)
{
if(nesting <= 0 && !full_output)
{
}
}
-void print_obj(cell obj)
+void factor_vm::print_obj(cell obj)
{
print_nested_obj(obj,10);
}
-void print_objects(cell *start, cell *end)
+void factor_vm::print_objects(cell *start, cell *end)
{
for(; start <= end; start++)
{
}
}
-void print_datastack()
+void factor_vm::print_datastack()
{
print_string("==== DATA STACK:\n");
print_objects((cell *)ds_bot,(cell *)ds);
}
-void print_retainstack()
+void factor_vm::print_retainstack()
{
print_string("==== RETAIN STACK:\n");
print_objects((cell *)rs_bot,(cell *)rs);
}
-void print_stack_frame(stack_frame *frame)
-{
- print_obj(frame_executing(frame));
- print_string("\n");
- print_obj(frame_scan(frame));
- print_string("\n");
- print_string("word/quot addr: ");
- print_cell_hex((cell)frame_executing(frame));
- print_string("\n");
- print_string("word/quot xt: ");
- print_cell_hex((cell)frame->xt);
- print_string("\n");
- print_string("return address: ");
- print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame));
- print_string("\n");
-}
+struct stack_frame_printer {
+ factor_vm *myvm;
+
+ explicit stack_frame_printer(factor_vm *myvm_) : myvm(myvm_) {}
+ void operator()(stack_frame *frame)
+ {
+ myvm->print_obj(myvm->frame_executing(frame));
+ print_string("\n");
+ myvm->print_obj(myvm->frame_scan(frame));
+ print_string("\n");
+ print_string("word/quot addr: ");
+ print_cell_hex((cell)myvm->frame_executing(frame));
+ print_string("\n");
+ print_string("word/quot xt: ");
+ print_cell_hex((cell)frame->xt);
+ print_string("\n");
+ print_string("return address: ");
+ print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame,myvm));
+ print_string("\n");
+ }
+};
-void print_callstack()
+void factor_vm::print_callstack()
{
print_string("==== CALL STACK:\n");
cell bottom = (cell)stack_chain->callstack_bottom;
cell top = (cell)stack_chain->callstack_top;
- iterate_callstack(top,bottom,print_stack_frame);
+ stack_frame_printer printer(this);
+ iterate_callstack(top,bottom,printer);
}
-void dump_cell(cell x)
+void factor_vm::dump_cell(cell x)
{
print_cell_hex_pad(x); print_string(": ");
x = *(cell *)x;
nl();
}
-void dump_memory(cell from, cell to)
+void factor_vm::dump_memory(cell from, cell to)
{
from = UNTAG(from);
dump_cell(from);
}
-void dump_zone(zone *z)
+void factor_vm::dump_zone(zone *z)
{
print_string("Start="); print_cell(z->start);
print_string(", size="); print_cell(z->size);
print_string(", here="); print_cell(z->here - z->start); nl();
}
-void dump_generations()
+void factor_vm::dump_generations()
{
cell i;
nl();
}
-void dump_objects(cell type)
+void factor_vm::dump_objects(cell type)
{
gc();
begin_scan();
end_scan();
}
-cell look_for;
-cell obj;
+struct data_references_finder {
+ cell look_for, obj;
+ factor_vm *myvm;
-void find_data_references_step(cell *scan)
-{
- if(look_for == *scan)
+ explicit data_references_finder(cell look_for_, cell obj_, factor_vm *myvm_)
+ : look_for(look_for_), obj(obj_), myvm(myvm_) { }
+
+ void operator()(cell *scan)
{
- print_cell_hex_pad(obj);
- print_string(" ");
- print_nested_obj(obj,2);
- nl();
+ if(look_for == *scan)
+ {
+ print_cell_hex_pad(obj);
+ print_string(" ");
+ myvm->print_nested_obj(obj,2);
+ nl();
+ }
}
-}
+};
-void find_data_references(cell look_for_)
+void factor_vm::find_data_references(cell look_for)
{
- look_for = look_for_;
-
begin_scan();
+ cell obj;
+
while((obj = next_object()) != F)
- do_slots(UNTAG(obj),find_data_references_step);
+ {
+ data_references_finder finder(look_for,obj,this);
+ do_slots(UNTAG(obj),finder);
+ }
end_scan();
}
/* Dump all code blocks for debugging */
-void dump_code_heap()
+void factor_vm::dump_code_heap()
{
cell reloc_size = 0, literal_size = 0;
- heap_block *scan = first_block(&code);
+ heap_block *scan = code->first_block();
while(scan)
{
print_cell_hex(scan->size); print_string(" ");
print_string(status); print_string("\n");
- scan = next_block(&code,scan);
+ scan = code->next_block(scan);
}
print_cell(reloc_size); print_string(" bytes of relocation data\n");
print_cell(literal_size); print_string(" bytes of literal data\n");
}
-void factorbug()
+void factor_vm::factorbug()
{
if(fep_disabled)
{
}
}
-PRIMITIVE(die)
+void factor_vm::primitive_die()
{
print_string("The die word was called by the library. Unless you called it yourself,\n");
print_string("you have triggered a bug in Factor. Please report.\n");
namespace factor
{
-void print_obj(cell obj);
-void print_nested_obj(cell obj, fixnum nesting);
-void dump_generations();
-void factorbug();
-void dump_zone(zone *z);
-
-PRIMITIVE(die);
-
}
namespace factor
{
-cell megamorphic_cache_hits;
-cell megamorphic_cache_misses;
-
-static cell search_lookup_alist(cell table, cell klass)
+cell factor_vm::search_lookup_alist(cell table, cell klass)
{
array *elements = untag<array>(table);
fixnum index = array_capacity(elements) - 2;
return F;
}
-static cell search_lookup_hash(cell table, cell klass, cell hashcode)
+cell factor_vm::search_lookup_hash(cell table, cell klass, cell hashcode)
{
array *buckets = untag<array>(table);
cell bucket = array_nth(buckets,hashcode & (array_capacity(buckets) - 1));
return search_lookup_alist(bucket,klass);
}
-static cell nth_superclass(tuple_layout *layout, fixnum echelon)
+cell factor_vm::nth_superclass(tuple_layout *layout, fixnum echelon)
{
cell *ptr = (cell *)(layout + 1);
return ptr[echelon * 2];
}
-static cell nth_hashcode(tuple_layout *layout, fixnum echelon)
+cell factor_vm::nth_hashcode(tuple_layout *layout, fixnum echelon)
{
cell *ptr = (cell *)(layout + 1);
return ptr[echelon * 2 + 1];
}
-static cell lookup_tuple_method(cell obj, cell methods)
+cell factor_vm::lookup_tuple_method(cell obj, cell methods)
{
tuple_layout *layout = untag<tuple_layout>(untag<tuple>(obj)->layout);
return F;
}
-static cell lookup_hi_tag_method(cell obj, cell methods)
+cell factor_vm::lookup_hi_tag_method(cell obj, cell methods)
{
array *hi_tag_methods = untag<array>(methods);
cell tag = untag<object>(obj)->h.hi_tag() - HEADER_TYPE;
return array_nth(hi_tag_methods,tag);
}
-static cell lookup_hairy_method(cell obj, cell methods)
+cell factor_vm::lookup_hairy_method(cell obj, cell methods)
{
cell method = array_nth(untag<array>(methods),TAG(obj));
if(tagged<object>(method).type_p(WORD_TYPE))
}
}
-cell lookup_method(cell obj, cell methods)
+cell factor_vm::lookup_method(cell obj, cell methods)
{
cell tag = TAG(obj);
if(tag == TUPLE_TYPE || tag == OBJECT_TYPE)
return array_nth(untag<array>(methods),TAG(obj));
}
-PRIMITIVE(lookup_method)
+void factor_vm::primitive_lookup_method()
{
cell methods = dpop();
cell obj = dpop();
dpush(lookup_method(obj,methods));
}
-cell object_class(cell obj)
+cell factor_vm::object_class(cell obj)
{
switch(TAG(obj))
{
}
}
-static cell method_cache_hashcode(cell klass, array *array)
+cell factor_vm::method_cache_hashcode(cell klass, array *array)
{
cell capacity = (array_capacity(array) >> 1) - 1;
return ((klass >> TAG_BITS) & capacity) << 1;
}
-static void update_method_cache(cell cache, cell klass, cell method)
+void factor_vm::update_method_cache(cell cache, cell klass, cell method)
{
array *cache_elements = untag<array>(cache);
cell hashcode = method_cache_hashcode(klass,cache_elements);
set_array_nth(cache_elements,hashcode + 1,method);
}
-PRIMITIVE(mega_cache_miss)
+void factor_vm::primitive_mega_cache_miss()
{
megamorphic_cache_misses++;
dpush(method);
}
-PRIMITIVE(reset_dispatch_stats)
+void factor_vm::primitive_reset_dispatch_stats()
{
megamorphic_cache_hits = megamorphic_cache_misses = 0;
}
-PRIMITIVE(dispatch_stats)
+void factor_vm::primitive_dispatch_stats()
{
- growable_array stats;
+ growable_array stats(this);
stats.add(allot_cell(megamorphic_cache_hits));
stats.add(allot_cell(megamorphic_cache_misses));
stats.trim();
void quotation_jit::emit_mega_cache_lookup(cell methods_, fixnum index, cell cache_)
{
- gc_root<array> methods(methods_);
- gc_root<array> cache(cache_);
+ gc_root<array> methods(methods_,parent_vm);
+ gc_root<array> cache(cache_,parent_vm);
/* Generate machine code to determine the object's class. */
emit_class_lookup(index,PIC_HI_TAG_TUPLE);
/* Do a cache lookup. */
- emit_with(userenv[MEGA_LOOKUP],cache.value());
+ emit_with(parent_vm->userenv[MEGA_LOOKUP],cache.value());
/* If we end up here, the cache missed. */
- emit(userenv[JIT_PROLOG]);
+ emit(parent_vm->userenv[JIT_PROLOG]);
/* Push index, method table and cache on the stack. */
push(methods.value());
push(tag_fixnum(index));
push(cache.value());
- word_call(userenv[MEGA_MISS_WORD]);
+ word_call(parent_vm->userenv[MEGA_MISS_WORD]);
/* Now the new method has been stored into the cache, and its on
the stack. */
- emit(userenv[JIT_EPILOG]);
- emit(userenv[JIT_EXECUTE_JUMP]);
+ emit(parent_vm->userenv[JIT_EPILOG]);
+ emit(parent_vm->userenv[JIT_EXECUTE_JUMP]);
}
}
namespace factor
{
-extern cell megamorphic_cache_hits;
-extern cell megamorphic_cache_misses;
-
-cell lookup_method(cell object, cell methods);
-PRIMITIVE(lookup_method);
-
-cell object_class(cell object);
-
-PRIMITIVE(mega_cache_miss);
-
-PRIMITIVE(reset_dispatch_stats);
-PRIMITIVE(dispatch_stats);
-
-void jit_emit_class_lookup(jit *jit, fixnum index, cell type);
-
-void jit_emit_mega_cache_lookup(jit *jit, cell methods, fixnum index, cell cache);
-
}
namespace factor
{
-/* Global variables used to pass fault handler state from signal handler to
-user-space */
-cell signal_number;
-cell signal_fault_addr;
-stack_frame *signal_callstack_top;
-
-void out_of_memory()
+void factor_vm::out_of_memory()
{
print_string("Out of memory\n\n");
dump_generations();
exit(1);
}
-void critical_error(const char* msg, cell tagged)
+void factor_vm::critical_error(const char* msg, cell tagged)
{
print_string("You have triggered a bug in Factor. Please report.\n");
print_string("critical_error: "); print_string(msg);
factorbug();
}
-void throw_error(cell error, stack_frame *callstack_top)
+void factor_vm::throw_error(cell error, stack_frame *callstack_top)
{
/* If the error handler is set, we rewind any C stack frames and
pass the error to user-space. */
gc_off = false;
/* Reset local roots */
- gc_locals = gc_locals_region->start - sizeof(cell);
- gc_bignums = gc_bignums_region->start - sizeof(cell);
+ gc_locals.clear();
+ gc_bignums.clear();
/* If we had an underflow or overflow, stack pointers might be
out of bounds */
else
callstack_top = stack_chain->callstack_top;
- throw_impl(userenv[BREAK_ENV],callstack_top);
+ throw_impl(userenv[BREAK_ENV],callstack_top,this);
}
/* Error was thrown in early startup before error handler is set, just
crash. */
}
}
-void general_error(vm_error_type error, cell arg1, cell arg2,
- stack_frame *callstack_top)
+void factor_vm::general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *callstack_top)
{
throw_error(allot_array_4(userenv[ERROR_ENV],
tag_fixnum(error),arg1,arg2),callstack_top);
}
-void type_error(cell type, cell tagged)
+void factor_vm::type_error(cell type, cell tagged)
{
general_error(ERROR_TYPE,tag_fixnum(type),tagged,NULL);
}
-void not_implemented_error()
+void factor_vm::not_implemented_error()
{
general_error(ERROR_NOT_IMPLEMENTED,F,F,NULL);
}
/* Test if 'fault' is in the guard page at the top or bottom (depending on
offset being 0 or -1) of area+area_size */
-bool in_page(cell fault, cell area, cell area_size, int offset)
+bool factor_vm::in_page(cell fault, cell area, cell area_size, int offset)
{
int pagesize = getpagesize();
area += area_size;
return fault >= area && fault <= area + pagesize;
}
-void memory_protection_error(cell addr, stack_frame *native_stack)
+void factor_vm::memory_protection_error(cell addr, stack_frame *native_stack)
{
if(in_page(addr, ds_bot, 0, -1))
general_error(ERROR_DS_UNDERFLOW,F,F,native_stack);
general_error(ERROR_MEMORY,allot_cell(addr),F,native_stack);
}
-void signal_error(int signal, stack_frame *native_stack)
+void factor_vm::signal_error(int signal, stack_frame *native_stack)
{
general_error(ERROR_SIGNAL,tag_fixnum(signal),F,native_stack);
}
-void divide_by_zero_error()
+void factor_vm::divide_by_zero_error()
{
general_error(ERROR_DIVIDE_BY_ZERO,F,F,NULL);
}
-PRIMITIVE(call_clear)
+void factor_vm::fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top)
{
- throw_impl(dpop(),stack_chain->callstack_bottom);
+ general_error(ERROR_FP_TRAP,tag_fixnum(fpu_status),F,signal_callstack_top);
+}
+
+void factor_vm::primitive_call_clear()
+{
+ throw_impl(dpop(),stack_chain->callstack_bottom,this);
}
/* For testing purposes */
-PRIMITIVE(unimplemented)
+void factor_vm::primitive_unimplemented()
{
not_implemented_error();
}
-void memory_signal_handler_impl()
+void factor_vm::memory_signal_handler_impl()
{
memory_protection_error(signal_fault_addr,signal_callstack_top);
}
-void misc_signal_handler_impl()
+void memory_signal_handler_impl()
+{
+ SIGNAL_VM_PTR()->memory_signal_handler_impl();
+}
+
+void factor_vm::misc_signal_handler_impl()
{
signal_error(signal_number,signal_callstack_top);
}
+void misc_signal_handler_impl()
+{
+ SIGNAL_VM_PTR()->misc_signal_handler_impl();
+}
+
+void factor_vm::fp_signal_handler_impl()
+{
+ fp_trap_error(signal_fpu_status,signal_callstack_top);
+}
+
+void fp_signal_handler_impl()
+{
+ SIGNAL_VM_PTR()->fp_signal_handler_impl();
+}
+
}
ERROR_RS_UNDERFLOW,
ERROR_RS_OVERFLOW,
ERROR_MEMORY,
+ ERROR_FP_TRAP,
};
-void out_of_memory();
void fatal_error(const char* msg, cell tagged);
-void critical_error(const char* msg, cell tagged);
-
-PRIMITIVE(die);
-
-void throw_error(cell error, stack_frame *native_stack);
-void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
-void divide_by_zero_error();
-void memory_protection_error(cell addr, stack_frame *native_stack);
-void signal_error(int signal, stack_frame *native_stack);
-void type_error(cell type, cell tagged);
-void not_implemented_error();
-
-PRIMITIVE(call_clear);
-PRIMITIVE(unimplemented);
-
-/* Global variables used to pass fault handler state from signal handler to
-user-space */
-extern cell signal_number;
-extern cell signal_fault_addr;
-extern stack_frame *signal_callstack_top;
-
void memory_signal_handler_impl();
+void fp_signal_handler_impl();
void misc_signal_handler_impl();
}
namespace factor
{
-VM_C_API void default_parameters(vm_parameters *p)
+factor_vm *vm;
+unordered_map<THREADHANDLE, factor_vm*> thread_vms;
+
+void init_globals()
+{
+ init_platform_globals();
+}
+
+void factor_vm::default_parameters(vm_parameters *p)
{
p->image_path = NULL;
#ifdef WINDOWS
p->console = false;
#else
- p->console = true;
+ if (this == vm)
+ p->console = true;
+ else
+ p->console = false;
+
#endif
p->stack_traces = true;
}
-static bool factor_arg(const vm_char* str, const vm_char* arg, cell* value)
+bool factor_vm::factor_arg(const vm_char* str, const vm_char* arg, cell* value)
{
int val;
if(SSCANF(str,arg,&val) > 0)
return false;
}
-VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
+void factor_vm::init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv)
{
default_parameters(p);
p->executable_path = argv[0];
}
/* Do some initialization that we do once only */
-static void do_stage1_init()
+void factor_vm::do_stage1_init()
{
print_string("*** Stage 2 early init... ");
fflush(stdout);
fflush(stdout);
}
-VM_C_API void init_factor(vm_parameters *p)
+void factor_vm::init_factor(vm_parameters *p)
{
/* Kilobytes */
p->ds_size = align_page(p->ds_size << 10);
}
/* May allocate memory */
-VM_C_API void pass_args_to_factor(int argc, vm_char **argv)
+void factor_vm::pass_args_to_factor(int argc, vm_char **argv)
{
- growable_array args;
+ growable_array args(this);
int i;
- for(i = 1; i < argc; i++)
+ for(i = 1; i < argc; i++){
args.add(allot_alien(F,(cell)argv[i]));
+ }
args.trim();
userenv[ARGS_ENV] = args.elements.value();
}
-static void start_factor(vm_parameters *p)
+void factor_vm::start_factor(vm_parameters *p)
{
if(p->fep) factorbug();
unnest_stacks();
}
-VM_C_API void start_embedded_factor(vm_parameters *p)
+char *factor_vm::factor_eval_string(char *string)
{
- userenv[EMBEDDED_ENV] = T;
- start_factor(p);
+ char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
+ return callback(string);
}
-VM_C_API void start_standalone_factor(int argc, vm_char **argv)
+void factor_vm::factor_eval_free(char *result)
+{
+ free(result);
+}
+
+void factor_vm::factor_yield()
+{
+ void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
+ callback();
+}
+
+void factor_vm::factor_sleep(long us)
+{
+ void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
+ callback(us);
+}
+
+void factor_vm::start_standalone_factor(int argc, vm_char **argv)
{
vm_parameters p;
default_parameters(&p);
start_factor(&p);
}
-VM_C_API char *factor_eval_string(char *string)
+struct startargs {
+ int argc;
+ vm_char **argv;
+};
+
+factor_vm *new_factor_vm()
{
- char *(*callback)(char *) = (char *(*)(char *))alien_offset(userenv[EVAL_CALLBACK_ENV]);
- return callback(string);
+ factor_vm *newvm = new factor_vm();
+ register_vm_with_thread(newvm);
+ thread_vms[thread_id()] = newvm;
+
+ return newvm;
}
-VM_C_API void factor_eval_free(char *result)
+// arg must be new'ed because we're going to delete it!
+void* start_standalone_factor_thread(void *arg)
{
- free(result);
+ factor_vm *newvm = new_factor_vm();
+ startargs *args = (startargs*) arg;
+ int argc = args->argc; vm_char **argv = args->argv;
+ delete args;
+ newvm->start_standalone_factor(argc, argv);
+ return 0;
}
-VM_C_API void factor_yield()
+VM_C_API void start_standalone_factor(int argc, vm_char **argv)
{
- void (*callback)() = (void (*)())alien_offset(userenv[YIELD_CALLBACK_ENV]);
- callback();
+ factor_vm *newvm = new_factor_vm();
+ vm = newvm;
+ return newvm->start_standalone_factor(argc,argv);
}
-VM_C_API void factor_sleep(long us)
+VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv)
{
- void (*callback)(long) = (void (*)(long))alien_offset(userenv[SLEEP_CALLBACK_ENV]);
- callback(us);
+ startargs *args = new startargs;
+ args->argc = argc; args->argv = argv;
+ return start_thread(start_standalone_factor_thread,args);
}
}
namespace factor
{
-VM_C_API void default_parameters(vm_parameters *p);
-VM_C_API void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv);
-VM_C_API void init_factor(vm_parameters *p);
-VM_C_API void pass_args_to_factor(int argc, vm_char **argv);
-VM_C_API void start_embedded_factor(vm_parameters *p);
-VM_C_API void start_standalone_factor(int argc, vm_char **argv);
-
-VM_C_API char *factor_eval_string(char *string);
-VM_C_API void factor_eval_free(char *result);
-VM_C_API void factor_yield();
-VM_C_API void factor_sleep(long ms);
+VM_C_API void init_globals();
+VM_C_API void start_standalone_factor(int argc, vm_char **argv);
+VM_C_API THREADHANDLE start_standalone_factor_in_new_thread(int argc, vm_char **argv);
}
representations and vice versa */
union double_bits_pun {
- double x;
- u64 y;
+ double x;
+ u64 y;
};
inline static u64 double_bits(double x)
}
union float_bits_pun {
- float x;
- u32 y;
+ float x;
+ u32 y;
};
inline static u32 float_bits(float x)
namespace factor
{
-template<typename T> cell array_capacity(T *array)
+template<typename Array> cell array_capacity(Array *array)
{
#ifdef FACTOR_DEBUG
- assert(array->h.hi_tag() == T::type_number);
+ assert(array->h.hi_tag() == Array::type_number);
#endif
return array->capacity >> TAG_BITS;
}
-template <typename T> cell array_size(cell capacity)
+template<typename Array> cell array_size(cell capacity)
{
- return sizeof(T) + capacity * T::element_size;
+ return sizeof(Array) + capacity * Array::element_size;
}
-template <typename T> cell array_size(T *array)
+template<typename Array> cell array_size(Array *array)
{
- return array_size<T>(array_capacity(array));
+ return array_size<Array>(array_capacity(array));
}
-template <typename T> T *allot_array_internal(cell capacity)
+template<typename Array> Array *factor_vm::allot_array_internal(cell capacity)
{
- T *array = allot<T>(array_size<T>(capacity));
+ Array *array = allot<Array>(array_size<Array>(capacity));
array->capacity = tag_fixnum(capacity);
return array;
}
-template <typename T> bool reallot_array_in_place_p(T *array, cell capacity)
+template<typename Array> bool factor_vm::reallot_array_in_place_p(Array *array, cell capacity)
{
return in_zone(&nursery,array) && capacity <= array_capacity(array);
}
-template <typename T> T *reallot_array(T *array_, cell capacity)
+template<typename Array> Array *factor_vm::reallot_array(Array *array_, cell capacity)
{
- gc_root<T> array(array_);
+ gc_root<Array> array(array_,this);
if(reallot_array_in_place_p(array.untagged(),capacity))
{
cell to_copy = array_capacity(array.untagged());
if(capacity < to_copy)
to_copy = capacity;
-
- T *new_array = allot_array_internal<T>(capacity);
-
- memcpy(new_array + 1,array.untagged() + 1,to_copy * T::element_size);
- memset((char *)(new_array + 1) + to_copy * T::element_size,
- 0,(capacity - to_copy) * T::element_size);
-
+
+ Array *new_array = allot_array_internal<Array>(capacity);
+
+ memcpy(new_array + 1,array.untagged() + 1,to_copy * Array::element_size);
+ memset((char *)(new_array + 1) + to_copy * Array::element_size,
+ 0,(capacity - to_copy) * Array::element_size);
+
return new_array;
}
}
--- /dev/null
+#include "master.hpp"
+
+/* This malloc-style heap code is reasonably generic. Maybe in the future, it
+will be used for the data heap too, if we ever get mark/sweep/compact GC. */
+
+namespace factor
+{
+
+void heap::clear_free_list()
+{
+ memset(&free,0,sizeof(heap_free_list));
+}
+
+heap::heap(factor_vm *myvm_, cell size)
+{
+ myvm = myvm_;
+ seg = new segment(myvm,align_page(size));
+ if(!seg) fatal_error("Out of memory in new_heap",size);
+ clear_free_list();
+}
+
+void heap::add_to_free_list(free_heap_block *block)
+{
+ if(block->size < free_list_count * block_size_increment)
+ {
+ int index = block->size / block_size_increment;
+ block->next_free = free.small_blocks[index];
+ free.small_blocks[index] = block;
+ }
+ else
+ {
+ block->next_free = free.large_blocks;
+ free.large_blocks = block;
+ }
+}
+
+/* Called after reading the code heap from the image file, and after code GC.
+
+In the former case, we must add a large free block from compiling.base + size to
+compiling.limit. */
+void heap::build_free_list(cell size)
+{
+ heap_block *prev = NULL;
+
+ clear_free_list();
+
+ size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
+
+ heap_block *scan = first_block();
+ free_heap_block *end = (free_heap_block *)(seg->start + size);
+
+ /* Add all free blocks to the free list */
+ while(scan && scan < (heap_block *)end)
+ {
+ switch(scan->status)
+ {
+ case B_FREE:
+ add_to_free_list((free_heap_block *)scan);
+ break;
+ case B_ALLOCATED:
+ break;
+ default:
+ myvm->critical_error("Invalid scan->status",(cell)scan);
+ break;
+ }
+
+ prev = scan;
+ scan = next_block(scan);
+ }
+
+ /* If there is room at the end of the heap, add a free block. This
+ branch is only taken after loading a new image, not after code GC */
+ if((cell)(end + 1) <= seg->end)
+ {
+ end->status = B_FREE;
+ end->size = seg->end - (cell)end;
+
+ /* add final free block */
+ add_to_free_list(end);
+ }
+ /* This branch is taken if the newly loaded image fits exactly, or
+ after code GC */
+ else
+ {
+ /* even if there's no room at the end of the heap for a new
+ free block, we might have to jigger it up by a few bytes in
+ case prev + prev->size */
+ if(prev) prev->size = seg->end - (cell)prev;
+ }
+
+}
+
+void heap::assert_free_block(free_heap_block *block)
+{
+ if(block->status != B_FREE)
+ myvm->critical_error("Invalid block in free list",(cell)block);
+}
+
+
+free_heap_block *heap::find_free_block(cell size)
+{
+ cell attempt = size;
+
+ while(attempt < free_list_count * block_size_increment)
+ {
+ int index = attempt / block_size_increment;
+ free_heap_block *block = free.small_blocks[index];
+ if(block)
+ {
+ assert_free_block(block);
+ free.small_blocks[index] = block->next_free;
+ return block;
+ }
+
+ attempt *= 2;
+ }
+
+ free_heap_block *prev = NULL;
+ free_heap_block *block = free.large_blocks;
+
+ while(block)
+ {
+ assert_free_block(block);
+ if(block->size >= size)
+ {
+ if(prev)
+ prev->next_free = block->next_free;
+ else
+ free.large_blocks = block->next_free;
+ return block;
+ }
+
+ prev = block;
+ block = block->next_free;
+ }
+
+ return NULL;
+}
+
+free_heap_block *heap::split_free_block(free_heap_block *block, cell size)
+{
+ if(block->size != size )
+ {
+ /* split the block in two */
+ free_heap_block *split = (free_heap_block *)((cell)block + size);
+ split->status = B_FREE;
+ split->size = block->size - size;
+ split->next_free = block->next_free;
+ block->size = size;
+ add_to_free_list(split);
+ }
+
+ return block;
+}
+
+/* Allocate a block of memory from the mark and sweep GC heap */
+heap_block *heap::heap_allot(cell size)
+{
+ size = (size + block_size_increment - 1) & ~(block_size_increment - 1);
+
+ free_heap_block *block = find_free_block(size);
+ if(block)
+ {
+ block = split_free_block(block,size);
+
+ block->status = B_ALLOCATED;
+ return block;
+ }
+ else
+ return NULL;
+}
+
+/* Deallocates a block manually */
+void heap::heap_free(heap_block *block)
+{
+ block->status = B_FREE;
+ add_to_free_list((free_heap_block *)block);
+}
+
+void heap::mark_block(heap_block *block)
+{
+ /* If already marked, do nothing */
+ switch(block->status)
+ {
+ case B_MARKED:
+ return;
+ case B_ALLOCATED:
+ block->status = B_MARKED;
+ break;
+ default:
+ myvm->critical_error("Marking the wrong block",(cell)block);
+ break;
+ }
+}
+
+/* If in the middle of code GC, we have to grow the heap, data GC restarts from
+scratch, so we have to unmark any marked blocks. */
+void heap::unmark_marked()
+{
+ heap_block *scan = first_block();
+
+ while(scan)
+ {
+ if(scan->status == B_MARKED)
+ scan->status = B_ALLOCATED;
+
+ scan = next_block(scan);
+ }
+}
+
+/* Compute total sum of sizes of free blocks, and size of largest free block */
+void heap::heap_usage(cell *used, cell *total_free, cell *max_free)
+{
+ *used = 0;
+ *total_free = 0;
+ *max_free = 0;
+
+ heap_block *scan = first_block();
+
+ while(scan)
+ {
+ switch(scan->status)
+ {
+ case B_ALLOCATED:
+ *used += scan->size;
+ break;
+ case B_FREE:
+ *total_free += scan->size;
+ if(scan->size > *max_free)
+ *max_free = scan->size;
+ break;
+ default:
+ myvm->critical_error("Invalid scan->status",(cell)scan);
+ }
+
+ scan = next_block(scan);
+ }
+}
+
+/* The size of the heap, not including the last block if it's free */
+cell heap::heap_size()
+{
+ heap_block *scan = first_block();
+
+ while(next_block(scan) != NULL)
+ scan = next_block(scan);
+
+ /* this is the last block in the heap, and it is free */
+ if(scan->status == B_FREE)
+ return (cell)scan - seg->start;
+ /* otherwise the last block is allocated */
+ else
+ return seg->size;
+}
+
+/* Compute where each block is going to go, after compaction */
+cell heap::compute_heap_forwarding(unordered_map<heap_block *,char *> &forwarding)
+{
+ heap_block *scan = first_block();
+ char *address = (char *)first_block();
+
+ while(scan)
+ {
+ if(scan->status == B_ALLOCATED)
+ {
+ forwarding[scan] = address;
+ address += scan->size;
+ }
+ else if(scan->status == B_MARKED)
+ myvm->critical_error("Why is the block marked?",0);
+
+ scan = next_block(scan);
+ }
+
+ return (cell)address - seg->start;
+}
+
+void heap::compact_heap(unordered_map<heap_block *,char *> &forwarding)
+{
+ heap_block *scan = first_block();
+
+ while(scan)
+ {
+ heap_block *next = next_block(scan);
+
+ if(scan->status == B_ALLOCATED)
+ memmove(forwarding[scan],scan,scan->size);
+ scan = next;
+ }
+}
+
+heap_block *heap::free_allocated(heap_block *prev, heap_block *scan)
+{
+ if(myvm->secure_gc)
+ memset(scan + 1,0,scan->size - sizeof(heap_block));
+
+ if(prev && prev->status == B_FREE)
+ {
+ prev->size += scan->size;
+ return prev;
+ }
+ else
+ {
+ scan->status = B_FREE;
+ return scan;
+ }
+}
+
+}
--- /dev/null
+namespace factor
+{
+
+static const cell free_list_count = 16;
+static const cell block_size_increment = 32;
+
+struct heap_free_list {
+ free_heap_block *small_blocks[free_list_count];
+ free_heap_block *large_blocks;
+};
+
+struct heap {
+ factor_vm *myvm;
+ segment *seg;
+ heap_free_list free;
+
+ explicit heap(factor_vm *myvm, cell size);
+
+ inline heap_block *next_block(heap_block *block)
+ {
+ cell next = ((cell)block + block->size);
+ if(next == seg->end)
+ return NULL;
+ else
+ return (heap_block *)next;
+ }
+
+ inline heap_block *first_block()
+ {
+ return (heap_block *)seg->start;
+ }
+
+ inline heap_block *last_block()
+ {
+ return (heap_block *)seg->end;
+ }
+
+ void clear_free_list();
+ void new_heap(cell size);
+ void add_to_free_list(free_heap_block *block);
+ void build_free_list(cell size);
+ void assert_free_block(free_heap_block *block);
+ free_heap_block *find_free_block(cell size);
+ free_heap_block *split_free_block(free_heap_block *block, cell size);
+ heap_block *heap_allot(cell size);
+ void heap_free(heap_block *block);
+ void mark_block(heap_block *block);
+ void unmark_marked();
+ void heap_usage(cell *used, cell *total_free, cell *max_free);
+ cell heap_size();
+ cell compute_heap_forwarding(unordered_map<heap_block *,char *> &forwarding);
+ void compact_heap(unordered_map<heap_block *,char *> &forwarding);
+
+ heap_block *free_allocated(heap_block *prev, heap_block *scan);
+
+ /* After code GC, all referenced code blocks have status set to B_MARKED, so any
+ which are allocated and not marked can be reclaimed. */
+ template<typename Iterator> void free_unmarked(Iterator &iter)
+ {
+ clear_free_list();
+
+ heap_block *prev = NULL;
+ heap_block *scan = first_block();
+
+ while(scan)
+ {
+ switch(scan->status)
+ {
+ case B_ALLOCATED:
+ prev = free_allocated(prev,scan);
+ break;
+ case B_FREE:
+ if(prev && prev->status == B_FREE)
+ prev->size += scan->size;
+ else
+ prev = scan;
+ break;
+ case B_MARKED:
+ if(prev && prev->status == B_FREE)
+ add_to_free_list((free_heap_block *)prev);
+ scan->status = B_ALLOCATED;
+ prev = scan;
+ iter(scan);
+ break;
+ }
+
+ scan = next_block(scan);
+ }
+
+ if(prev && prev->status == B_FREE)
+ add_to_free_list((free_heap_block *)prev);
+ }
+};
+
+}
{
/* Certain special objects in the image are known to the runtime */
-static void init_objects(image_header *h)
+void factor_vm::init_objects(image_header *h)
{
memcpy(userenv,h->userenv,sizeof(userenv));
bignum_neg_one = h->bignum_neg_one;
}
-cell data_relocation_base;
-
-static void load_data_heap(FILE *file, image_header *h, vm_parameters *p)
+void factor_vm::load_data_heap(FILE *file, image_header *h, vm_parameters *p)
{
cell good_size = h->data_size + (1 << 20);
data_relocation_base = h->data_relocation_base;
}
-cell code_relocation_base;
-
-static void load_code_heap(FILE *file, image_header *h, vm_parameters *p)
+void factor_vm::load_code_heap(FILE *file, image_header *h, vm_parameters *p)
{
if(h->code_size > p->code_size)
fatal_error("Code heap too small to fit image",h->code_size);
if(h->code_size != 0)
{
- size_t bytes_read = fread(first_block(&code),1,h->code_size,file);
+ size_t bytes_read = fread(code->first_block(),1,h->code_size,file);
if(bytes_read != h->code_size)
{
print_string("truncated image: ");
}
code_relocation_base = h->code_relocation_base;
- build_free_list(&code,h->code_size);
+ code->build_free_list(h->code_size);
}
/* Save the current image to disk */
-bool save_image(const vm_char *filename)
+bool factor_vm::save_image(const vm_char *filename)
{
FILE* file;
image_header h;
h.version = image_version;
h.data_relocation_base = tenured->start;
h.data_size = tenured->here - tenured->start;
- h.code_relocation_base = code.seg->start;
- h.code_size = heap_size(&code);
+ h.code_relocation_base = code->seg->start;
+ h.code_size = code->heap_size();
h.t = T;
h.bignum_zero = bignum_zero;
if(fwrite(&h,sizeof(image_header),1,file) != 1) ok = false;
if(fwrite((void*)tenured->start,h.data_size,1,file) != 1) ok = false;
- if(fwrite(first_block(&code),h.code_size,1,file) != 1) ok = false;
+ if(fwrite(code->first_block(),h.code_size,1,file) != 1) ok = false;
if(fclose(file)) ok = false;
if(!ok)
return ok;
}
-PRIMITIVE(save_image)
+void factor_vm::primitive_save_image()
{
/* do a full GC to push everything into tenured space */
gc();
- gc_root<byte_array> path(dpop());
- path.untag_check();
+ gc_root<byte_array> path(dpop(),this);
+ path.untag_check(this);
save_image((vm_char *)(path.untagged() + 1));
}
-PRIMITIVE(save_image_and_exit)
-{
+void factor_vm::primitive_save_image_and_exit()
+{
/* We unbox this before doing anything else. This is the only point
where we might throw an error, so we have to throw an error here since
later steps destroy the current image. */
- gc_root<byte_array> path(dpop());
- path.untag_check();
+ gc_root<byte_array> path(dpop(),this);
+ path.untag_check(this);
/* strip out userenv data which is set on startup anyway */
for(cell i = 0; i < USER_ENV; i++)
}
/* do a full GC + code heap compaction */
- performing_compaction = true;
compact_code_heap();
- performing_compaction = false;
/* Save the image */
if(save_image((vm_char *)(path.untagged() + 1)))
exit(1);
}
-static void data_fixup(cell *cell)
+void factor_vm::data_fixup(cell *cell)
{
if(immediate_p(*cell))
return;
*cell += (tenured->start - data_relocation_base);
}
-template <typename T> void code_fixup(T **handle)
+template<typename Type> void factor_vm::code_fixup(Type **handle)
{
- T *ptr = *handle;
- T *new_ptr = (T *)(((cell)ptr) + (code.seg->start - code_relocation_base));
+ Type *ptr = *handle;
+ Type *new_ptr = (Type *)(((cell)ptr) + (code->seg->start - code_relocation_base));
*handle = new_ptr;
}
-static void fixup_word(word *word)
+void factor_vm::fixup_word(word *word)
{
if(word->code)
code_fixup(&word->code);
code_fixup(&word->xt);
}
-static void fixup_quotation(quotation *quot)
+void factor_vm::fixup_quotation(quotation *quot)
{
if(quot->code)
{
quot->xt = (void *)lazy_jit_compile;
}
-static void fixup_alien(alien *d)
+void factor_vm::fixup_alien(alien *d)
{
d->expired = T;
}
-static void fixup_stack_frame(stack_frame *frame)
-{
- code_fixup(&frame->xt);
- code_fixup(&FRAME_RETURN_ADDRESS(frame));
-}
+struct stack_frame_fixupper {
+ factor_vm *myvm;
-static void fixup_callstack_object(callstack *stack)
+ explicit stack_frame_fixupper(factor_vm *myvm_) : myvm(myvm_) {}
+ void operator()(stack_frame *frame)
+ {
+ myvm->code_fixup(&frame->xt);
+ myvm->code_fixup(&FRAME_RETURN_ADDRESS(frame,myvm));
+ }
+};
+
+void factor_vm::fixup_callstack_object(callstack *stack)
{
- iterate_callstack_object(stack,fixup_stack_frame);
+ stack_frame_fixupper fixupper(this);
+ iterate_callstack_object(stack,fixupper);
}
+struct object_fixupper {
+ factor_vm *myvm;
+
+ explicit object_fixupper(factor_vm *myvm_) : myvm(myvm_) { }
+
+ void operator()(cell *scan)
+ {
+ myvm->data_fixup(scan);
+ }
+};
+
/* Initialize an object in a newly-loaded image */
-static void relocate_object(object *object)
+void factor_vm::relocate_object(object *object)
{
cell hi_tag = object->h.hi_tag();
}
else
{
- do_slots((cell)object,data_fixup);
+ object_fixupper fixupper(this);
+ do_slots((cell)object,fixupper);
switch(hi_tag)
{
/* Since the image might have been saved with a different base address than
where it is loaded, we need to fix up pointers in the image. */
-void relocate_data()
+void factor_vm::relocate_data()
{
cell relocating;
}
}
-static void fixup_code_block(code_block *compiled)
+void factor_vm::fixup_code_block(code_block *compiled)
{
/* relocate literal table data */
data_fixup(&compiled->relocation);
relocate_code_block(compiled);
}
-void relocate_code()
+struct code_block_fixupper {
+ factor_vm *myvm;
+
+ code_block_fixupper(factor_vm *myvm_) : myvm(myvm_) { }
+
+ void operator()(code_block *compiled)
+ {
+ myvm->fixup_code_block(compiled);
+ }
+};
+
+void factor_vm::relocate_code()
{
- iterate_code_heap(fixup_code_block);
+ code_block_fixupper fixupper(this);
+ iterate_code_heap(fixupper);
}
/* Read an image file from disk, only done once during startup */
/* This function also initializes the data and code heaps */
-void load_image(vm_parameters *p)
+void factor_vm::load_image(vm_parameters *p)
{
FILE *file = OPEN_READ(p->image_path);
if(file == NULL)
cell max_pic_size;
};
-void load_image(vm_parameters *p);
-bool save_image(const vm_char *file);
-
-PRIMITIVE(save_image);
-PRIMITIVE(save_image_and_exit);
-
}
namespace factor
{
-cell max_pic_size;
-
-cell cold_call_to_ic_transitions;
-cell ic_to_pic_transitions;
-cell pic_to_mega_transitions;
-
-/* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
-cell pic_counts[4];
-
-void init_inline_caching(int max_size)
+void factor_vm::init_inline_caching(int max_size)
{
max_pic_size = max_size;
}
-void deallocate_inline_cache(cell return_address)
+void factor_vm::deallocate_inline_cache(cell return_address)
{
/* Find the call target. */
void *old_xt = get_call_target(return_address);
#endif
if(old_type == PIC_TYPE)
- heap_free(&code,old_block);
+ code->heap_free(old_block);
}
/* Figure out what kind of type check the PIC needs based on the methods
it contains */
-static cell determine_inline_cache_type(array *cache_entries)
+cell factor_vm::determine_inline_cache_type(array *cache_entries)
{
bool seen_hi_tag = false, seen_tuple = false;
return 0;
}
-static void update_pic_count(cell type)
+void factor_vm::update_pic_count(cell type)
{
pic_counts[type - PIC_TAG]++;
}
struct inline_cache_jit : public jit {
fixnum index;
- inline_cache_jit(cell generic_word_) : jit(PIC_TYPE,generic_word_) {};
+ explicit inline_cache_jit(cell generic_word_,factor_vm *vm) : jit(PIC_TYPE,generic_word_,vm) {};
void emit_check(cell klass);
void compile_inline_cache(fixnum index,
{
cell code_template;
if(TAG(klass) == FIXNUM_TYPE && untag_fixnum(klass) < HEADER_TYPE)
- code_template = userenv[PIC_CHECK_TAG];
+ code_template = parent_vm->userenv[PIC_CHECK_TAG];
else
- code_template = userenv[PIC_CHECK];
+ code_template = parent_vm->userenv[PIC_CHECK];
emit_with(code_template,klass);
}
cell cache_entries_,
bool tail_call_p)
{
- gc_root<word> generic_word(generic_word_);
- gc_root<array> methods(methods_);
- gc_root<array> cache_entries(cache_entries_);
+ gc_root<word> generic_word(generic_word_,parent_vm);
+ gc_root<array> methods(methods_,parent_vm);
+ gc_root<array> cache_entries(cache_entries_,parent_vm);
- cell inline_cache_type = determine_inline_cache_type(cache_entries.untagged());
- update_pic_count(inline_cache_type);
+ cell inline_cache_type = parent_vm->determine_inline_cache_type(cache_entries.untagged());
+ parent_vm->update_pic_count(inline_cache_type);
/* Generate machine code to determine the object's class. */
emit_class_lookup(index,inline_cache_type);
/* Yes? Jump to method */
cell method = array_nth(cache_entries.untagged(),i + 1);
- emit_with(userenv[PIC_HIT],method);
+ emit_with(parent_vm->userenv[PIC_HIT],method);
}
/* Generate machine code to handle a cache miss, which ultimately results in
push(methods.value());
push(tag_fixnum(index));
push(cache_entries.value());
- word_special(userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
+ word_special(parent_vm->userenv[tail_call_p ? PIC_MISS_TAIL_WORD : PIC_MISS_WORD]);
}
-static code_block *compile_inline_cache(fixnum index,
- cell generic_word_,
- cell methods_,
- cell cache_entries_,
- bool tail_call_p)
+code_block *factor_vm::compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p)
{
- gc_root<word> generic_word(generic_word_);
- gc_root<array> methods(methods_);
- gc_root<array> cache_entries(cache_entries_);
+ gc_root<word> generic_word(generic_word_,this);
+ gc_root<array> methods(methods_,this);
+ gc_root<array> cache_entries(cache_entries_,this);
- inline_cache_jit jit(generic_word.value());
+ inline_cache_jit jit(generic_word.value(),this);
jit.compile_inline_cache(index,
generic_word.value(),
methods.value(),
}
/* A generic word's definition performs general method lookup. Allocates memory */
-static void *megamorphic_call_stub(cell generic_word)
+void *factor_vm::megamorphic_call_stub(cell generic_word)
{
return untag<word>(generic_word)->xt;
}
-static cell inline_cache_size(cell cache_entries)
+cell factor_vm::inline_cache_size(cell cache_entries)
{
return array_capacity(untag_check<array>(cache_entries)) / 2;
}
/* Allocates memory */
-static cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
+cell factor_vm::add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_)
{
- gc_root<array> cache_entries(cache_entries_);
- gc_root<object> klass(klass_);
- gc_root<word> method(method_);
+ gc_root<array> cache_entries(cache_entries_,this);
+ gc_root<object> klass(klass_,this);
+ gc_root<word> method(method_,this);
cell pic_size = array_capacity(cache_entries.untagged());
- gc_root<array> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2));
+ gc_root<array> new_cache_entries(reallot_array(cache_entries.untagged(),pic_size + 2),this);
set_array_nth(new_cache_entries.untagged(),pic_size,klass.value());
set_array_nth(new_cache_entries.untagged(),pic_size + 1,method.value());
return new_cache_entries.value();
}
-static void update_pic_transitions(cell pic_size)
+void factor_vm::update_pic_transitions(cell pic_size)
{
if(pic_size == max_pic_size)
pic_to_mega_transitions++;
/* The cache_entries parameter is either f (on cold call site) or an array (on cache miss).
Called from assembly with the actual return address */
-void *inline_cache_miss(cell return_address)
+void *factor_vm::inline_cache_miss(cell return_address)
{
check_code_pointer(return_address);
instead of leaving dead PICs around until the next GC. */
deallocate_inline_cache(return_address);
- gc_root<array> cache_entries(dpop());
+ gc_root<array> cache_entries(dpop(),this);
fixnum index = untag_fixnum(dpop());
- gc_root<array> methods(dpop());
- gc_root<word> generic_word(dpop());
- gc_root<object> object(((cell *)ds)[-index]);
+ gc_root<array> methods(dpop(),this);
+ gc_root<word> generic_word(dpop(),this);
+ gc_root<object> object(((cell *)ds)[-index],this);
void *xt;
gc_root<array> new_cache_entries(add_inline_cache_entry(
cache_entries.value(),
klass,
- method));
+ method),this);
xt = compile_inline_cache(index,
generic_word.value(),
methods.value(),
return xt;
}
-PRIMITIVE(reset_inline_cache_stats)
+VM_C_API void *inline_cache_miss(cell return_address, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->inline_cache_miss(return_address);
+}
+
+void factor_vm::primitive_reset_inline_cache_stats()
{
cold_call_to_ic_transitions = ic_to_pic_transitions = pic_to_mega_transitions = 0;
cell i;
for(i = 0; i < 4; i++) pic_counts[i] = 0;
}
-PRIMITIVE(inline_cache_stats)
+void factor_vm::primitive_inline_cache_stats()
{
- growable_array stats;
+ growable_array stats(this);
stats.add(allot_cell(cold_call_to_ic_transitions));
stats.add(allot_cell(ic_to_pic_transitions));
stats.add(allot_cell(pic_to_mega_transitions));
namespace factor
{
-extern cell max_pic_size;
-
-void init_inline_caching(int max_size);
-
-PRIMITIVE(reset_inline_cache_stats);
-PRIMITIVE(inline_cache_stats);
-PRIMITIVE(inline_cache_miss);
-PRIMITIVE(inline_cache_miss_tail);
-
-VM_C_API void *inline_cache_miss(cell return_address);
+VM_C_API void *inline_cache_miss(cell return_address, factor_vm *vm);
}
with many more capabilities so these words are not usually used in
normal operation. */
-void init_c_io()
+void factor_vm::init_c_io()
{
userenv[STDIN_ENV] = allot_alien(F,(cell)stdin);
userenv[STDOUT_ENV] = allot_alien(F,(cell)stdout);
userenv[STDERR_ENV] = allot_alien(F,(cell)stderr);
}
-void io_error()
+void factor_vm::io_error()
{
#ifndef WINCE
if(errno == EINTR)
general_error(ERROR_IO,tag_fixnum(errno),F,NULL);
}
-PRIMITIVE(fopen)
+void factor_vm::primitive_fopen()
{
- gc_root<byte_array> mode(dpop());
- gc_root<byte_array> path(dpop());
- mode.untag_check();
- path.untag_check();
+ gc_root<byte_array> mode(dpop(),this);
+ gc_root<byte_array> path(dpop(),this);
+ mode.untag_check(this);
+ path.untag_check(this);
for(;;)
{
}
}
-PRIMITIVE(fgetc)
+void factor_vm::primitive_fgetc()
{
FILE *file = (FILE *)unbox_alien();
}
}
-PRIMITIVE(fread)
+void factor_vm::primitive_fread()
{
FILE *file = (FILE *)unbox_alien();
fixnum size = unbox_array_size();
return;
}
- gc_root<byte_array> buf(allot_array_internal<byte_array>(size));
+ gc_root<byte_array> buf(allot_array_internal<byte_array>(size),this);
for(;;)
{
}
}
-PRIMITIVE(fputc)
+void factor_vm::primitive_fputc()
{
FILE *file = (FILE *)unbox_alien();
fixnum ch = to_fixnum(dpop());
}
}
-PRIMITIVE(fwrite)
+void factor_vm::primitive_fwrite()
{
FILE *file = (FILE *)unbox_alien();
byte_array *text = untag_check<byte_array>(dpop());
}
}
-PRIMITIVE(fseek)
+void factor_vm::primitive_ftell()
+{
+ FILE *file = (FILE *)unbox_alien();
+ off_t offset;
+
+ if((offset = FTELL(file)) == -1)
+ io_error();
+
+ box_signed_8(offset);
+}
+
+void factor_vm::primitive_fseek()
{
int whence = to_fixnum(dpop());
FILE *file = (FILE *)unbox_alien();
}
}
-PRIMITIVE(fflush)
+void factor_vm::primitive_fflush()
{
FILE *file = (FILE *)unbox_alien();
for(;;)
}
}
-PRIMITIVE(fclose)
+void factor_vm::primitive_fclose()
{
FILE *file = (FILE *)unbox_alien();
for(;;)
{
errno = 0;
}
-
}
namespace factor
{
-void init_c_io();
-void io_error();
-
-PRIMITIVE(fopen);
-PRIMITIVE(fgetc);
-PRIMITIVE(fread);
-PRIMITIVE(fputc);
-PRIMITIVE(fwrite);
-PRIMITIVE(fflush);
-PRIMITIVE(fseek);
-PRIMITIVE(fclose);
-
/* Platform specific primitives */
-PRIMITIVE(open_file);
-PRIMITIVE(existsp);
-PRIMITIVE(read_dir);
VM_C_API int err_no();
VM_C_API void clear_err_no();
- polymorphic inline caches (inline_cache.cpp) */
/* Allocates memory */
-jit::jit(cell type_, cell owner_)
+jit::jit(cell type_, cell owner_, factor_vm *vm)
: type(type_),
- owner(owner_),
- code(),
- relocation(),
- literals(),
+ owner(owner_,vm),
+ code(vm),
+ relocation(vm),
+ literals(vm),
computing_offset_p(false),
position(0),
- offset(0)
+ offset(0),
+ parent_vm(vm)
{
- if(stack_traces_p()) literal(owner.value());
+ if(parent_vm->stack_traces_p()) literal(owner.value());
}
void jit::emit_relocation(cell code_template_)
{
- gc_root<array> code_template(code_template_);
+ gc_root<array> code_template(code_template_,parent_vm);
cell capacity = array_capacity(code_template.untagged());
for(cell i = 1; i < capacity; i += 3)
{
/* Allocates memory */
void jit::emit(cell code_template_)
{
- gc_root<array> code_template(code_template_);
+ gc_root<array> code_template(code_template_,parent_vm);
emit_relocation(code_template.value());
- gc_root<byte_array> insns(array_nth(code_template.untagged(),0));
+ gc_root<byte_array> insns(array_nth(code_template.untagged(),0),parent_vm);
if(computing_offset_p)
{
}
void jit::emit_with(cell code_template_, cell argument_) {
- gc_root<array> code_template(code_template_);
- gc_root<object> argument(argument_);
+ gc_root<array> code_template(code_template_,parent_vm);
+ gc_root<object> argument(argument_,parent_vm);
literal(argument.value());
emit(code_template.value());
}
void jit::emit_class_lookup(fixnum index, cell type)
{
- emit_with(userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
- emit(userenv[type]);
+ emit_with(parent_vm->userenv[PIC_LOAD],tag_fixnum(-index * sizeof(cell)));
+ emit(parent_vm->userenv[type]);
}
/* Facility to convert compiled code offsets to quotation offsets.
relocation.trim();
literals.trim();
- return add_code_block(
+ return parent_vm->add_code_block(
type,
code.elements.value(),
F, /* no labels */
bool computing_offset_p;
fixnum position;
cell offset;
+ factor_vm *parent_vm;
- jit(cell jit_type, cell owner);
+ explicit jit(cell jit_type, cell owner, factor_vm *vm);
void compute_position(cell offset);
void emit_relocation(cell code_template);
void emit_with(cell code_template_, cell literal_);
void push(cell literal) {
- emit_with(userenv[JIT_PUSH_IMMEDIATE],literal);
+ emit_with(parent_vm->userenv[JIT_PUSH_IMMEDIATE],literal);
}
void word_jump(cell word) {
literal(tag_fixnum(xt_tail_pic_offset));
literal(word);
- emit(userenv[JIT_WORD_JUMP]);
+ emit(parent_vm->userenv[JIT_WORD_JUMP]);
}
void word_call(cell word) {
- emit_with(userenv[JIT_WORD_CALL],word);
+ emit_with(parent_vm->userenv[JIT_WORD_CALL],word);
}
void word_special(cell word) {
- emit_with(userenv[JIT_WORD_SPECIAL],word);
+ emit_with(parent_vm->userenv[JIT_WORD_SPECIAL],word);
}
void emit_subprimitive(cell word_) {
- gc_root<word> word(word_);
- gc_root<array> code_template(word->subprimitive);
- if(array_capacity(code_template.untagged()) > 1) literal(T);
+ gc_root<word> word(word_,parent_vm);
+ gc_root<array> code_template(word->subprimitive,parent_vm);
+ if(array_capacity(code_template.untagged()) > 1) literal(parent_vm->T);
emit(code_template.value());
}
/* Not a real type, but code_block's type field can be set to this */
#define PIC_TYPE 69
+/* Constants used when floating-point trap exceptions are thrown */
+enum
+{
+ FP_TRAP_INVALID_OPERATION = 1 << 0,
+ FP_TRAP_OVERFLOW = 1 << 1,
+ FP_TRAP_UNDERFLOW = 1 << 2,
+ FP_TRAP_ZERO_DIVIDE = 1 << 3,
+ FP_TRAP_INEXACT = 1 << 4,
+};
+
inline static bool immediate_p(cell obj)
{
return (obj == F || TAG(obj) == FIXNUM_TYPE);
cell value;
/* Default ctor to make gcc 3.x happy */
- header() { abort(); }
+ explicit header() { abort(); }
- header(cell value_) : value(value_ << TAG_BITS) {}
+ explicit header(cell value_) : value(value_ << TAG_BITS) {}
void check_header() {
#ifdef FACTOR_DEBUG
/* tagged */
cell capacity;
- template<typename T> T *data() { return (T *)(this + 1); }
+ template<typename Scalar> Scalar *data() { return (Scalar *)(this + 1); }
};
/* Assembly code makes assumptions about the layout of this struct */
namespace factor
{
-
-segment *gc_locals_region;
-cell gc_locals;
-
-segment *gc_bignums_region;
-cell gc_bignums;
-
}
namespace factor
{
-/* If a runtime function needs to call another function which potentially
-allocates memory, it must wrap any local variable references to Factor
-objects in gc_root instances */
-extern segment *gc_locals_region;
-extern cell gc_locals;
-
-DEFPUSHPOP(gc_local_,gc_locals)
-
-template <typename T>
-struct gc_root : public tagged<T>
+template<typename Type>
+struct gc_root : public tagged<Type>
{
- void push() { check_tagged_pointer(tagged<T>::value()); gc_local_push((cell)this); }
+ factor_vm *parent_vm;
+
+ void push() { parent_vm->check_tagged_pointer(tagged<Type>::value()); parent_vm->gc_locals.push_back((cell)this); }
- explicit gc_root(cell value_) : tagged<T>(value_) { push(); }
- explicit gc_root(T *value_) : tagged<T>(value_) { push(); }
+ explicit gc_root(cell value_,factor_vm *vm) : tagged<Type>(value_),parent_vm(vm) { push(); }
+ explicit gc_root(Type *value_, factor_vm *vm) : tagged<Type>(value_),parent_vm(vm) { push(); }
- const gc_root<T>& operator=(const T *x) { tagged<T>::operator=(x); return *this; }
- const gc_root<T>& operator=(const cell &x) { tagged<T>::operator=(x); return *this; }
+ const gc_root<Type>& operator=(const Type *x) { tagged<Type>::operator=(x); return *this; }
+ const gc_root<Type>& operator=(const cell &x) { tagged<Type>::operator=(x); return *this; }
~gc_root() {
#ifdef FACTOR_DEBUG
- cell old = gc_local_pop();
- assert(old == (cell)this);
-#else
- gc_local_pop();
+ assert(parent_vm->gc_locals.back() == (cell)this);
#endif
+ parent_vm->gc_locals.pop_back();
}
};
/* A similar hack for the bignum implementation */
-extern segment *gc_bignums_region;
-extern cell gc_bignums;
-
-DEFPUSHPOP(gc_bignum_,gc_bignums)
-
struct gc_bignum
{
bignum **addr;
-
- gc_bignum(bignum **addr_) : addr(addr_) {
+ factor_vm *parent_vm;
+ gc_bignum(bignum **addr_, factor_vm *vm) : addr(addr_), parent_vm(vm) {
if(*addr_)
- check_data_pointer(*addr_);
- gc_bignum_push((cell)addr);
+ parent_vm->check_data_pointer(*addr_);
+ parent_vm->gc_bignums.push_back((cell)addr);
}
- ~gc_bignum() { assert((cell)addr == gc_bignum_pop()); }
+ ~gc_bignum() {
+#ifdef FACTOR_DEBUG
+ assert(parent_vm->gc_bignums.back() == (cell)addr);
+#endif
+ parent_vm->gc_bignums.pop_back();
+ }
};
-#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x)
+#define GC_BIGNUM(x) gc_bignum x##__gc_root(&x,this)
}
/* Modify a suspended thread's thread_state so that when the thread resumes
executing, the call frame of the current C primitive (if any) is rewound, and
the appropriate Factor error is thrown from the top-most Factor frame. */
-static void call_fault_handler(exception_type_t exception,
+void factor_vm::call_fault_handler(
+ exception_type_t exception,
+ exception_data_type_t code,
MACH_EXC_STATE_TYPE *exc_state,
- MACH_THREAD_STATE_TYPE *thread_state)
+ MACH_THREAD_STATE_TYPE *thread_state,
+ MACH_FLOAT_STATE_TYPE *float_state)
{
/* There is a race condition here, but in practice an exception
delivered during stack frame setup/teardown or while transitioning
if(exception == EXC_BAD_ACCESS)
{
signal_fault_addr = MACH_EXC_STATE_FAULT(exc_state);
- MACH_PROGRAM_COUNTER(thread_state) = (cell)memory_signal_handler_impl;
+ MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::memory_signal_handler_impl;
+ }
+ else if(exception == EXC_ARITHMETIC && code != MACH_EXC_INTEGER_DIV)
+ {
+ signal_fpu_status = fpu_status(mach_fpu_status(float_state));
+ mach_clear_fpu_status(float_state);
+ MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::fp_signal_handler_impl;
}
else
{
- if(exception == EXC_ARITHMETIC)
- signal_number = SIGFPE;
- else
- signal_number = SIGABRT;
- MACH_PROGRAM_COUNTER(thread_state) = (cell)misc_signal_handler_impl;
+ signal_number = (exception == EXC_ARITHMETIC ? SIGFPE : SIGABRT);
+ MACH_PROGRAM_COUNTER(thread_state) = (cell)factor::misc_signal_handler_impl;
}
}
+static void call_fault_handler(
+ mach_port_t thread,
+ exception_type_t exception,
+ exception_data_type_t code,
+ MACH_EXC_STATE_TYPE *exc_state,
+ MACH_THREAD_STATE_TYPE *thread_state,
+ MACH_FLOAT_STATE_TYPE *float_state)
+{
+ THREADHANDLE thread_id = pthread_from_mach_thread_np(thread);
+ assert(thread_id);
+ unordered_map<THREADHANDLE, factor_vm*>::const_iterator vm = thread_vms.find(thread_id);
+ if (vm != thread_vms.end())
+ vm->second->call_fault_handler(exception,code,exc_state,thread_state,float_state);
+}
+
/* Handle an exception by invoking the user's fault handler and/or forwarding
-the duty to the previously installed handlers. */
+the duty to the previously installed handlers. */
extern "C"
kern_return_t
catch_exception_raise (mach_port_t exception_port,
{
MACH_EXC_STATE_TYPE exc_state;
MACH_THREAD_STATE_TYPE thread_state;
- mach_msg_type_number_t state_count;
+ MACH_FLOAT_STATE_TYPE float_state;
+ mach_msg_type_number_t exc_state_count, thread_state_count, float_state_count;
/* Get fault information and the faulting thread's register contents..
- See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_get_state.html. */
- state_count = MACH_EXC_STATE_COUNT;
+ See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_get_state.html. */
+ exc_state_count = MACH_EXC_STATE_COUNT;
if (thread_get_state (thread, MACH_EXC_STATE_FLAVOR,
- (natural_t *)&exc_state, &state_count)
+ (natural_t *)&exc_state, &exc_state_count)
!= KERN_SUCCESS)
{
/* The thread is supposed to be suspended while the exception
return KERN_FAILURE;
}
- state_count = MACH_THREAD_STATE_COUNT;
+ thread_state_count = MACH_THREAD_STATE_COUNT;
if (thread_get_state (thread, MACH_THREAD_STATE_FLAVOR,
- (natural_t *)&thread_state, &state_count)
+ (natural_t *)&thread_state, &thread_state_count)
+ != KERN_SUCCESS)
+ {
+ /* The thread is supposed to be suspended while the exception
+ handler is called. This shouldn't fail. */
+ return KERN_FAILURE;
+ }
+
+ float_state_count = MACH_FLOAT_STATE_COUNT;
+ if (thread_get_state (thread, MACH_FLOAT_STATE_FLAVOR,
+ (natural_t *)&float_state, &float_state_count)
!= KERN_SUCCESS)
{
/* The thread is supposed to be suspended while the exception
/* Modify registers so to have the thread resume executing the
fault handler */
- call_fault_handler(exception,&exc_state,&thread_state);
+ call_fault_handler(thread,exception,code[0],&exc_state,&thread_state,&float_state);
/* Set the faulting thread's register contents..
- See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_set_state.html. */
+ See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/thread_set_state.html. */
+ if (thread_set_state (thread, MACH_FLOAT_STATE_FLAVOR,
+ (natural_t *)&float_state, float_state_count)
+ != KERN_SUCCESS)
+ {
+ return KERN_FAILURE;
+ }
+
if (thread_set_state (thread, MACH_THREAD_STATE_FLAVOR,
- (natural_t *)&thread_state, state_count)
+ (natural_t *)&thread_state, thread_state_count)
!= KERN_SUCCESS)
{
return KERN_FAILURE;
return KERN_SUCCESS;
}
-
/* The main function of the thread listening for exceptions. */
static void *
mach_exception_thread (void *arg)
char data[1024];
}
msg;
- /* Buffer for a reply message. */
+ /* Buffer for a reply message. */
struct
{
mach_msg_header_t head;
mask = EXC_MASK_BAD_ACCESS | EXC_MASK_ARITHMETIC;
/* Create the thread listening on the exception port. */
- start_thread(mach_exception_thread);
+ start_thread(mach_exception_thread,NULL);
/* Replace the exception port info for these exceptions with our own.
Note that we replace the exception port for the entire task, not only
for a particular thread. This has the effect that when our exception
port gets the message, the thread specific exception port has already
been asked, and we don't need to bother about it.
- See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/task_set_exception_ports.html. */
+ See http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/task_set_exception_ports.html. */
if (task_set_exception_ports (self, mask, our_exception_port,
EXCEPTION_DEFAULT, MACHINE_THREAD_STATE)
!= KERN_SUCCESS)
exception thread directly. */
extern "C" boolean_t exc_server (mach_msg_header_t *request_msg, mach_msg_header_t *reply_msg);
-
/* http://web.mit.edu/darwin/src/modules/xnu/osfmk/man/catch_exception_raise.html
These functions are defined in this file, and called by exc_server.
FIXME: What needs to be done when this code is put into a shared library? */
int main(int argc, char **argv)
{
+ factor::init_globals();
factor::start_standalone_factor(argc,argv);
return 0;
}
return 1;
}
+ factor::init_globals();
+ #ifdef FACTOR_MULTITHREADED
+ factor::THREADHANDLE thread = factor::start_standalone_factor_in_new_thread(nArgs,szArglist);
+ WaitForSingleObject(thread, INFINITE);
+ #else
factor::start_standalone_factor(nArgs,szArglist);
+ #endif
LocalFree(szArglist);
#ifndef __FACTOR_MASTER_H__
#define __FACTOR_MASTER_H__
+#define _THREAD_SAFE
+#define _REENTRANT
+
#ifndef WINCE
#include <errno.h>
#endif
#include <time.h>
/* C++ headers */
+#include <vector>
+#include <set>
+
#if __GNUC__ == 4
#include <tr1/unordered_map>
- #define unordered_map std::tr1::unordered_map
+
+ namespace factor
+ {
+ using std::tr1::unordered_map;
+ }
#elif __GNUC__ == 3
#include <boost/unordered_map.hpp>
- #define unordered_map boost::unordered_map
+
+ namespace factor
+ {
+ using boost::unordered_map;
+ }
#else
#error Factor requires GCC 3.x or later
#endif
+/* Forward-declare this since it comes up in function prototypes */
+namespace factor
+{
+ struct factor_vm;
+}
+
/* Factor headers */
#include "layouts.hpp"
#include "platform.hpp"
#include "segments.hpp"
#include "contexts.hpp"
#include "run.hpp"
-#include "tagged.hpp"
#include "profiler.hpp"
#include "errors.hpp"
#include "bignumint.hpp"
#include "bignum.hpp"
+#include "code_block.hpp"
#include "data_heap.hpp"
#include "write_barrier.hpp"
#include "data_gc.hpp"
-#include "local_roots.hpp"
-#include "generic_arrays.hpp"
#include "debug.hpp"
-#include "arrays.hpp"
#include "strings.hpp"
-#include "booleans.hpp"
-#include "byte_arrays.hpp"
#include "tuples.hpp"
#include "words.hpp"
-#include "math.hpp"
#include "float_bits.hpp"
#include "io.hpp"
-#include "code_gc.hpp"
-#include "code_block.hpp"
-#include "code_heap.hpp"
+#include "heap.hpp"
#include "image.hpp"
-#include "callstack.hpp"
#include "alien.hpp"
+#include "vm.hpp"
+#include "tagged.hpp"
+#include "local_roots.hpp"
+#include "callstack.hpp"
+#include "generic_arrays.hpp"
+#include "arrays.hpp"
+#include "math.hpp"
+#include "booleans.hpp"
+#include "code_heap.hpp"
+#include "byte_arrays.hpp"
#include "jit.hpp"
#include "quotations.hpp"
#include "dispatch.hpp"
namespace factor
{
-cell bignum_zero;
-cell bignum_pos_one;
-cell bignum_neg_one;
-
-PRIMITIVE(bignum_to_fixnum)
+void factor_vm::primitive_bignum_to_fixnum()
{
drepl(tag_fixnum(bignum_to_fixnum(untag<bignum>(dpeek()))));
}
-PRIMITIVE(float_to_fixnum)
+void factor_vm::primitive_float_to_fixnum()
{
drepl(tag_fixnum(float_to_fixnum(dpeek())));
}
/* Division can only overflow when we are dividing the most negative fixnum
by -1. */
-PRIMITIVE(fixnum_divint)
+void factor_vm::primitive_fixnum_divint()
{
fixnum y = untag_fixnum(dpop()); \
fixnum x = untag_fixnum(dpeek());
drepl(tag_fixnum(result));
}
-PRIMITIVE(fixnum_divmod)
+void factor_vm::primitive_fixnum_divmod()
{
cell y = ((cell *)ds)[0];
cell x = ((cell *)ds)[-1];
* If we're shifting right by n bits, we won't overflow as long as none of the
* high WORD_SIZE-TAG_BITS-n bits are set.
*/
-static inline fixnum sign_mask(fixnum x)
+inline fixnum factor_vm::sign_mask(fixnum x)
{
return x >> (WORD_SIZE - 1);
}
-static inline fixnum branchless_max(fixnum x, fixnum y)
+inline fixnum factor_vm::branchless_max(fixnum x, fixnum y)
{
return (x - ((x - y) & sign_mask(x - y)));
}
-static inline fixnum branchless_abs(fixnum x)
+inline fixnum factor_vm::branchless_abs(fixnum x)
{
return (x ^ sign_mask(x)) - sign_mask(x);
}
-PRIMITIVE(fixnum_shift)
+void factor_vm::primitive_fixnum_shift()
{
fixnum y = untag_fixnum(dpop());
fixnum x = untag_fixnum(dpeek());
fixnum_to_bignum(x),y)));
}
-PRIMITIVE(fixnum_to_bignum)
+void factor_vm::primitive_fixnum_to_bignum()
{
drepl(tag<bignum>(fixnum_to_bignum(untag_fixnum(dpeek()))));
}
-PRIMITIVE(float_to_bignum)
+void factor_vm::primitive_float_to_bignum()
{
drepl(tag<bignum>(float_to_bignum(dpeek())));
}
bignum * y = untag<bignum>(dpop()); \
bignum * x = untag<bignum>(dpop());
-PRIMITIVE(bignum_eq)
+void factor_vm::primitive_bignum_eq()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_equal_p(x,y));
}
-PRIMITIVE(bignum_add)
+void factor_vm::primitive_bignum_add()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_add(x,y)));
}
-PRIMITIVE(bignum_subtract)
+void factor_vm::primitive_bignum_subtract()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_subtract(x,y)));
}
-PRIMITIVE(bignum_multiply)
+void factor_vm::primitive_bignum_multiply()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_multiply(x,y)));
}
-PRIMITIVE(bignum_divint)
+void factor_vm::primitive_bignum_divint()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_quotient(x,y)));
}
-PRIMITIVE(bignum_divmod)
+void factor_vm::primitive_bignum_divmod()
{
bignum *q, *r;
POP_BIGNUMS(x,y);
dpush(tag<bignum>(r));
}
-PRIMITIVE(bignum_mod)
+void factor_vm::primitive_bignum_mod()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_remainder(x,y)));
}
-PRIMITIVE(bignum_and)
+void factor_vm::primitive_bignum_and()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_and(x,y)));
}
-PRIMITIVE(bignum_or)
+void factor_vm::primitive_bignum_or()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_ior(x,y)));
}
-PRIMITIVE(bignum_xor)
+void factor_vm::primitive_bignum_xor()
{
POP_BIGNUMS(x,y);
dpush(tag<bignum>(bignum_bitwise_xor(x,y)));
}
-PRIMITIVE(bignum_shift)
+void factor_vm::primitive_bignum_shift()
{
fixnum y = untag_fixnum(dpop());
bignum* x = untag<bignum>(dpop());
dpush(tag<bignum>(bignum_arithmetic_shift(x,y)));
}
-PRIMITIVE(bignum_less)
+void factor_vm::primitive_bignum_less()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) == bignum_comparison_less);
}
-PRIMITIVE(bignum_lesseq)
+void factor_vm::primitive_bignum_lesseq()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) != bignum_comparison_greater);
}
-PRIMITIVE(bignum_greater)
+void factor_vm::primitive_bignum_greater()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) == bignum_comparison_greater);
}
-PRIMITIVE(bignum_greatereq)
+void factor_vm::primitive_bignum_greatereq()
{
POP_BIGNUMS(x,y);
box_boolean(bignum_compare(x,y) != bignum_comparison_less);
}
-PRIMITIVE(bignum_not)
+void factor_vm::primitive_bignum_not()
{
drepl(tag<bignum>(bignum_bitwise_not(untag<bignum>(dpeek()))));
}
-PRIMITIVE(bignum_bitp)
+void factor_vm::primitive_bignum_bitp()
{
fixnum bit = to_fixnum(dpop());
bignum *x = untag<bignum>(dpop());
box_boolean(bignum_logbitp(bit,x));
}
-PRIMITIVE(bignum_log2)
+void factor_vm::primitive_bignum_log2()
{
drepl(tag<bignum>(bignum_integer_length(untag<bignum>(dpeek()))));
}
-unsigned int bignum_producer(unsigned int digit)
+unsigned int factor_vm::bignum_producer(unsigned int digit)
{
unsigned char *ptr = (unsigned char *)alien_offset(dpeek());
return *(ptr + digit);
}
-PRIMITIVE(byte_array_to_bignum)
+unsigned int bignum_producer(unsigned int digit, factor_vm *myvm)
+{
+ return myvm->bignum_producer(digit);
+}
+
+void factor_vm::primitive_byte_array_to_bignum()
{
cell n_digits = array_capacity(untag_check<byte_array>(dpeek()));
- bignum * result = digit_stream_to_bignum(n_digits,bignum_producer,0x100,0);
+ bignum * result = digit_stream_to_bignum(n_digits,factor::bignum_producer,0x100,0);
drepl(tag<bignum>(result));
}
-cell unbox_array_size()
+cell factor_vm::unbox_array_size()
{
switch(tagged<object>(dpeek()).type())
{
return 0; /* can't happen */
}
-PRIMITIVE(fixnum_to_float)
+void factor_vm::primitive_fixnum_to_float()
{
drepl(allot_float(fixnum_to_float(dpeek())));
}
-PRIMITIVE(bignum_to_float)
+void factor_vm::primitive_bignum_to_float()
{
drepl(allot_float(bignum_to_float(dpeek())));
}
-PRIMITIVE(str_to_float)
+void factor_vm::primitive_str_to_float()
{
byte_array *bytes = untag_check<byte_array>(dpeek());
cell capacity = array_capacity(bytes);
drepl(F);
}
-PRIMITIVE(float_to_str)
+void factor_vm::primitive_float_to_str()
{
byte_array *array = allot_byte_array(33);
snprintf((char *)(array + 1),32,"%.16g",untag_float_check(dpop()));
double y = untag_float(dpop()); \
double x = untag_float(dpop());
-PRIMITIVE(float_eq)
+void factor_vm::primitive_float_eq()
{
POP_FLOATS(x,y);
box_boolean(x == y);
}
-PRIMITIVE(float_add)
+void factor_vm::primitive_float_add()
{
POP_FLOATS(x,y);
box_double(x + y);
}
-PRIMITIVE(float_subtract)
+void factor_vm::primitive_float_subtract()
{
POP_FLOATS(x,y);
box_double(x - y);
}
-PRIMITIVE(float_multiply)
+void factor_vm::primitive_float_multiply()
{
POP_FLOATS(x,y);
box_double(x * y);
}
-PRIMITIVE(float_divfloat)
+void factor_vm::primitive_float_divfloat()
{
POP_FLOATS(x,y);
box_double(x / y);
}
-PRIMITIVE(float_mod)
+void factor_vm::primitive_float_mod()
{
POP_FLOATS(x,y);
box_double(fmod(x,y));
}
-PRIMITIVE(float_less)
+void factor_vm::primitive_float_less()
{
POP_FLOATS(x,y);
box_boolean(x < y);
}
-PRIMITIVE(float_lesseq)
+void factor_vm::primitive_float_lesseq()
{
POP_FLOATS(x,y);
box_boolean(x <= y);
}
-PRIMITIVE(float_greater)
+void factor_vm::primitive_float_greater()
{
POP_FLOATS(x,y);
box_boolean(x > y);
}
-PRIMITIVE(float_greatereq)
+void factor_vm::primitive_float_greatereq()
{
POP_FLOATS(x,y);
box_boolean(x >= y);
}
-PRIMITIVE(float_bits)
+void factor_vm::primitive_float_bits()
{
box_unsigned_4(float_bits(untag_float_check(dpop())));
}
-PRIMITIVE(bits_float)
+void factor_vm::primitive_bits_float()
{
box_float(bits_float(to_cell(dpop())));
}
-PRIMITIVE(double_bits)
+void factor_vm::primitive_double_bits()
{
box_unsigned_8(double_bits(untag_float_check(dpop())));
}
-PRIMITIVE(bits_double)
+void factor_vm::primitive_bits_double()
{
box_double(bits_double(to_unsigned_8(dpop())));
}
-VM_C_API fixnum to_fixnum(cell tagged)
+fixnum factor_vm::to_fixnum(cell tagged)
{
switch(TAG(tagged))
{
}
}
-VM_C_API cell to_cell(cell tagged)
+VM_C_API fixnum to_fixnum(cell tagged,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_fixnum(tagged);
+}
+
+cell factor_vm::to_cell(cell tagged)
{
return (cell)to_fixnum(tagged);
}
-VM_C_API void box_signed_1(s8 n)
+VM_C_API cell to_cell(cell tagged, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_cell(tagged);
+}
+
+void factor_vm::box_signed_1(s8 n)
{
dpush(tag_fixnum(n));
}
-VM_C_API void box_unsigned_1(u8 n)
+VM_C_API void box_signed_1(s8 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_signed_1(n);
+}
+
+void factor_vm::box_unsigned_1(u8 n)
{
dpush(tag_fixnum(n));
}
-VM_C_API void box_signed_2(s16 n)
+VM_C_API void box_unsigned_1(u8 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_unsigned_1(n);
+}
+
+void factor_vm::box_signed_2(s16 n)
{
dpush(tag_fixnum(n));
}
-VM_C_API void box_unsigned_2(u16 n)
+VM_C_API void box_signed_2(s16 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_signed_2(n);
+}
+
+void factor_vm::box_unsigned_2(u16 n)
{
dpush(tag_fixnum(n));
}
-VM_C_API void box_signed_4(s32 n)
+VM_C_API void box_unsigned_2(u16 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_unsigned_2(n);
+}
+
+void factor_vm::box_signed_4(s32 n)
{
dpush(allot_integer(n));
}
-VM_C_API void box_unsigned_4(u32 n)
+VM_C_API void box_signed_4(s32 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_signed_4(n);
+}
+
+void factor_vm::box_unsigned_4(u32 n)
{
dpush(allot_cell(n));
}
-VM_C_API void box_signed_cell(fixnum integer)
+VM_C_API void box_unsigned_4(u32 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_unsigned_4(n);
+}
+
+void factor_vm::box_signed_cell(fixnum integer)
{
dpush(allot_integer(integer));
}
-VM_C_API void box_unsigned_cell(cell cell)
+VM_C_API void box_signed_cell(fixnum integer,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_signed_cell(integer);
+}
+
+void factor_vm::box_unsigned_cell(cell cell)
{
dpush(allot_cell(cell));
}
-VM_C_API void box_signed_8(s64 n)
+VM_C_API void box_unsigned_cell(cell cell,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_unsigned_cell(cell);
+}
+
+void factor_vm::box_signed_8(s64 n)
{
if(n < fixnum_min || n > fixnum_max)
dpush(tag<bignum>(long_long_to_bignum(n)));
dpush(tag_fixnum(n));
}
-VM_C_API s64 to_signed_8(cell obj)
+VM_C_API void box_signed_8(s64 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_signed_8(n);
+}
+
+s64 factor_vm::to_signed_8(cell obj)
{
switch(tagged<object>(obj).type())
{
}
}
-VM_C_API void box_unsigned_8(u64 n)
+VM_C_API s64 to_signed_8(cell obj,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_signed_8(obj);
+}
+
+void factor_vm::box_unsigned_8(u64 n)
{
if(n > (u64)fixnum_max)
dpush(tag<bignum>(ulong_long_to_bignum(n)));
dpush(tag_fixnum(n));
}
-VM_C_API u64 to_unsigned_8(cell obj)
+VM_C_API void box_unsigned_8(u64 n,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_unsigned_8(n);
+}
+
+u64 factor_vm::to_unsigned_8(cell obj)
{
switch(tagged<object>(obj).type())
{
}
}
-VM_C_API void box_float(float flo)
+VM_C_API u64 to_unsigned_8(cell obj,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_unsigned_8(obj);
+}
+
+void factor_vm::box_float(float flo)
{
dpush(allot_float(flo));
}
-VM_C_API float to_float(cell value)
+VM_C_API void box_float(float flo, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_float(flo);
+}
+
+float factor_vm::to_float(cell value)
{
return untag_float_check(value);
}
-VM_C_API void box_double(double flo)
+VM_C_API float to_float(cell value,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_float(value);
+}
+
+void factor_vm::box_double(double flo)
{
dpush(allot_float(flo));
}
-VM_C_API double to_double(cell value)
+VM_C_API void box_double(double flo,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->box_double(flo);
+}
+
+double factor_vm::to_double(cell value)
{
return untag_float_check(value);
}
+VM_C_API double to_double(cell value,factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->to_double(value);
+}
+
/* The fixnum+, fixnum- and fixnum* primitives are defined in cpu_*.S. On
overflow, they call these functions. */
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y)
+inline void factor_vm::overflow_fixnum_add(fixnum x, fixnum y)
{
drepl(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) + untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *myvm)
+{
+ PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_add(x,y);
+}
+
+inline void factor_vm::overflow_fixnum_subtract(fixnum x, fixnum y)
{
drepl(tag<bignum>(fixnum_to_bignum(
untag_fixnum(x) - untag_fixnum(y))));
}
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y)
+VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *myvm)
+{
+ PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_subtract(x,y);
+}
+
+inline void factor_vm::overflow_fixnum_multiply(fixnum x, fixnum y)
{
bignum *bx = fixnum_to_bignum(x);
GC_BIGNUM(bx);
drepl(tag<bignum>(bignum_multiply(bx,by)));
}
+VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *myvm)
+{
+ PRIMITIVE_OVERFLOW_GETVM()->overflow_fixnum_multiply(x,y);
+}
+
}
namespace factor
{
-extern cell bignum_zero;
-extern cell bignum_pos_one;
-extern cell bignum_neg_one;
-
static const fixnum fixnum_max = (((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)) - 1);
static const fixnum fixnum_min = (-((fixnum)1 << (WORD_SIZE - TAG_BITS - 1)));
static const fixnum array_size_max = ((cell)1 << (WORD_SIZE - TAG_BITS - 2));
-PRIMITIVE(fixnum_add);
-PRIMITIVE(fixnum_subtract);
-PRIMITIVE(fixnum_multiply);
-
-PRIMITIVE(bignum_to_fixnum);
-PRIMITIVE(float_to_fixnum);
-
-PRIMITIVE(fixnum_divint);
-PRIMITIVE(fixnum_divmod);
-PRIMITIVE(fixnum_shift);
-
-PRIMITIVE(fixnum_to_bignum);
-PRIMITIVE(float_to_bignum);
-PRIMITIVE(bignum_eq);
-PRIMITIVE(bignum_add);
-PRIMITIVE(bignum_subtract);
-PRIMITIVE(bignum_multiply);
-PRIMITIVE(bignum_divint);
-PRIMITIVE(bignum_divmod);
-PRIMITIVE(bignum_mod);
-PRIMITIVE(bignum_and);
-PRIMITIVE(bignum_or);
-PRIMITIVE(bignum_xor);
-PRIMITIVE(bignum_shift);
-PRIMITIVE(bignum_less);
-PRIMITIVE(bignum_lesseq);
-PRIMITIVE(bignum_greater);
-PRIMITIVE(bignum_greatereq);
-PRIMITIVE(bignum_not);
-PRIMITIVE(bignum_bitp);
-PRIMITIVE(bignum_log2);
-PRIMITIVE(byte_array_to_bignum);
-
-inline static cell allot_integer(fixnum x)
+inline cell factor_vm::allot_integer(fixnum x)
{
if(x < fixnum_min || x > fixnum_max)
return tag<bignum>(fixnum_to_bignum(x));
return tag_fixnum(x);
}
-inline static cell allot_cell(cell x)
+inline cell factor_vm::allot_cell(cell x)
{
if(x > (cell)fixnum_max)
return tag<bignum>(cell_to_bignum(x));
return tag_fixnum(x);
}
-cell unbox_array_size();
-
-inline static double untag_float(cell tagged)
+inline cell factor_vm::allot_float(double n)
{
- return untag<boxed_float>(tagged)->n;
+ boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
+ flo->n = n;
+ return tag(flo);
}
-inline static double untag_float_check(cell tagged)
+inline bignum *factor_vm::float_to_bignum(cell tagged)
{
- return untag_check<boxed_float>(tagged)->n;
+ return double_to_bignum(untag_float(tagged));
}
-inline static cell allot_float(double n)
+inline double factor_vm::bignum_to_float(cell tagged)
{
- boxed_float *flo = allot<boxed_float>(sizeof(boxed_float));
- flo->n = n;
- return tag(flo);
+ return bignum_to_double(untag<bignum>(tagged));
}
-inline static fixnum float_to_fixnum(cell tagged)
+inline double factor_vm::untag_float(cell tagged)
{
- return (fixnum)untag_float(tagged);
+ return untag<boxed_float>(tagged)->n;
}
-inline static bignum *float_to_bignum(cell tagged)
+inline double factor_vm::untag_float_check(cell tagged)
{
- return double_to_bignum(untag_float(tagged));
+ return untag_check<boxed_float>(tagged)->n;
}
-inline static double fixnum_to_float(cell tagged)
+inline fixnum factor_vm::float_to_fixnum(cell tagged)
{
- return (double)untag_fixnum(tagged);
+ return (fixnum)untag_float(tagged);
}
-inline static double bignum_to_float(cell tagged)
+inline double factor_vm::fixnum_to_float(cell tagged)
{
- return bignum_to_double(untag<bignum>(tagged));
+ return (double)untag_fixnum(tagged);
}
-PRIMITIVE(fixnum_to_float);
-PRIMITIVE(bignum_to_float);
-PRIMITIVE(str_to_float);
-PRIMITIVE(float_to_str);
-PRIMITIVE(float_to_bits);
-
-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(float_bits);
-PRIMITIVE(bits_float);
-PRIMITIVE(double_bits);
-PRIMITIVE(bits_double);
-
-VM_C_API void box_float(float flo);
-VM_C_API float to_float(cell value);
-VM_C_API void box_double(double flo);
-VM_C_API double to_double(cell value);
-
-VM_C_API void box_signed_1(s8 n);
-VM_C_API void box_unsigned_1(u8 n);
-VM_C_API void box_signed_2(s16 n);
-VM_C_API void box_unsigned_2(u16 n);
-VM_C_API void box_signed_4(s32 n);
-VM_C_API void box_unsigned_4(u32 n);
-VM_C_API void box_signed_cell(fixnum integer);
-VM_C_API void box_unsigned_cell(cell cell);
-VM_C_API void box_signed_8(s64 n);
-VM_C_API void box_unsigned_8(u64 n);
-
-VM_C_API s64 to_signed_8(cell obj);
-VM_C_API u64 to_unsigned_8(cell obj);
-
-VM_C_API fixnum to_fixnum(cell tagged);
-VM_C_API cell to_cell(cell tagged);
-
-VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y);
-VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y);
-VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y);
+// defined in assembler
+
+VM_C_API void box_float(float flo, factor_vm *vm);
+VM_C_API float to_float(cell value, factor_vm *vm);
+VM_C_API void box_double(double flo, factor_vm *vm);
+VM_C_API double to_double(cell value, factor_vm *vm);
+
+VM_C_API void box_signed_1(s8 n, factor_vm *vm);
+VM_C_API void box_unsigned_1(u8 n, factor_vm *vm);
+VM_C_API void box_signed_2(s16 n, factor_vm *vm);
+VM_C_API void box_unsigned_2(u16 n, factor_vm *vm);
+VM_C_API void box_signed_4(s32 n, factor_vm *vm);
+VM_C_API void box_unsigned_4(u32 n, factor_vm *vm);
+VM_C_API void box_signed_cell(fixnum integer, factor_vm *vm);
+VM_C_API void box_unsigned_cell(cell cell, factor_vm *vm);
+VM_C_API void box_signed_8(s64 n, factor_vm *vm);
+VM_C_API void box_unsigned_8(u64 n, factor_vm *vm);
+
+VM_C_API s64 to_signed_8(cell obj, factor_vm *vm);
+VM_C_API u64 to_unsigned_8(cell obj, factor_vm *vm);
+
+VM_C_API fixnum to_fixnum(cell tagged, factor_vm *vm);
+VM_C_API cell to_cell(cell tagged, factor_vm *vm);
+
+VM_ASM_API void overflow_fixnum_add(fixnum x, fixnum y, factor_vm *vm);
+VM_ASM_API void overflow_fixnum_subtract(fixnum x, fixnum y, factor_vm *vm);
+VM_ASM_API void overflow_fixnum_multiply(fixnum x, fixnum y, factor_vm *vm);
}
#include <ucontext.h>
+#include <machine/npx.h>
namespace factor
{
return (void *)ucontext->uc_mcontext.mc_esp;
}
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387)
+ {
+ struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate);
+ return x87->sv_env.en_sw;
+ }
+ else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
+ {
+ struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
+ return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr;
+ }
+ else
+ return 0;
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_387)
+ {
+ struct save87 *x87 = (struct save87 *)(&ucontext->uc_mcontext.mc_fpstate);
+ x87->sv_env.en_sw = 0;
+ }
+ else if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
+ {
+ struct savexmm *xmm = (struct savexmm *)(&ucontext->uc_mcontext.mc_fpstate);
+ xmm->sv_env.en_sw = 0;
+ xmm->sv_env.en_mxcsr &= 0xffffffc0;
+ }
+}
+
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_eip)
}
#include <ucontext.h>
+#include <machine/fpu.h>
namespace factor
{
return (void *)ucontext->uc_mcontext.mc_rsp;
}
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
+ {
+ struct savefpu *xmm = (struct savefpu *)(&ucontext->uc_mcontext.mc_fpstate);
+ return xmm->sv_env.en_sw | xmm->sv_env.en_mxcsr;
+ }
+ else
+ return 0;
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ if (ucontext->uc_mcontext.mc_fpformat == _MC_FPFMT_XMM)
+ {
+ struct savefpu *xmm = (struct savefpu *)(&ucontext->uc_mcontext.mc_fpstate);
+ xmm->sv_env.en_sw = 0;
+ xmm->sv_env.en_mxcsr &= 0xffffffc0;
+ }
+}
+
#define UAP_PROGRAM_COUNTER(ucontext) (((ucontext_t *)(ucontext))->uc_mcontext.mc_rip)
}
namespace factor
{
-void c_to_factor_toplevel(cell quot)
+void factor_vm::c_to_factor_toplevel(cell quot)
{
- c_to_factor(quot);
+ c_to_factor(quot,this);
}
void init_signals()
#define SUFFIX ".image"
#define SUFFIX_LEN 6
+/* You must delete[] the result yourself. */
const char *default_image_path()
{
const char *path = vm_executable_path();
if(!path)
return "factor.image";
- /* We can't call strlen() here because with gcc 4.1.2 this
- causes an internal compiler error. */
- int len = 0;
- const char *iter = path;
- while(*iter) { len++; iter++; }
-
- char *new_path = (char *)safe_malloc(PATH_MAX + SUFFIX_LEN + 1);
+ int len = strlen(path);
+ char *new_path = new char[PATH_MAX + SUFFIX_LEN + 1];
memcpy(new_path,path,len + 1);
memcpy(new_path + len,SUFFIX,SUFFIX_LEN + 1);
+ free(const_cast<char *>(path));
return new_path;
}
: "r0","r1","r2");
if(result < 0)
- critical_error("flush_icache() failed",result);
+ SIGNAL_VM_PTR->critical_error("flush_icache() failed",result);
}
}
namespace factor
{
-#define FRAME_RETURN_ADDRESS(frame) *((void **)(frame_successor(frame) + 1) + 1)
+#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 1)
inline static void *ucontext_stack_pointer(void *uap)
{
namespace factor
{
+// glibc lies about the contents of the fpstate the kernel provides, hiding the FXSR
+// environment
+struct _fpstate {
+ /* Regular FPU environment */
+ unsigned long cw;
+ unsigned long sw;
+ unsigned long tag;
+ unsigned long ipoff;
+ unsigned long cssel;
+ unsigned long dataoff;
+ unsigned long datasel;
+ struct _fpreg _st[8];
+ unsigned short status;
+ unsigned short magic; /* 0xffff = regular FPU data only */
+
+ /* FXSR FPU environment */
+ unsigned long _fxsr_env[6]; /* FXSR FPU env is ignored */
+ unsigned long mxcsr;
+ unsigned long reserved;
+ struct _fpxreg _fxsr_st[8]; /* FXSR FPU reg data is ignored */
+ struct _xmmreg _xmm[8];
+ unsigned long padding[56];
+};
+
+#define X86_FXSR_MAGIC 0x0000
+
inline static void *ucontext_stack_pointer(void *uap)
{
- ucontext_t *ucontext = (ucontext_t *)uap;
- return (void *)ucontext->uc_mcontext.gregs[7];
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ return (void *)ucontext->uc_mcontext.gregs[7];
+}
+
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ struct _fpstate *fpregs = (struct _fpstate *)ucontext->uc_mcontext.fpregs;
+ if (fpregs->magic == X86_FXSR_MAGIC)
+ return fpregs->sw | fpregs->mxcsr;
+ else
+ return fpregs->sw;
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ struct _fpstate *fpregs = (struct _fpstate *)ucontext->uc_mcontext.fpregs;
+ fpregs->sw = 0;
+ if (fpregs->magic == X86_FXSR_MAGIC)
+ fpregs->mxcsr &= 0xffffffc0;
}
#define UAP_PROGRAM_COUNTER(ucontext) \
return (void *)ucontext->uc_mcontext.gregs[15];
}
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ return ucontext->uc_mcontext.fpregs->swd
+ | ucontext->uc_mcontext.fpregs->mxcsr;
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ ucontext_t *ucontext = (ucontext_t *)uap;
+ ucontext->uc_mcontext.fpregs->swd = 0;
+ ucontext->uc_mcontext.fpregs->mxcsr &= 0xffffffc0;
+}
+
#define UAP_PROGRAM_COUNTER(ucontext) \
(((ucontext_t *)(ucontext))->uc_mcontext.gregs[16])
namespace factor
{
-/* Snarfed from SBCL linux-so.c. You must free() this yourself. */
+/* Snarfed from SBCL linux-so.c. You must free() the result yourself. */
const char *vm_executable_path()
{
- char *path = (char *)safe_malloc(PATH_MAX + 1);
+ char *path = new char[PATH_MAX + 1];
int size = readlink("/proc/self/exe", path, PATH_MAX);
if (size < 0)
else
{
path[size] = '\0';
- return safe_strdup(path);
+
+ const char *ret = safe_strdup(path);
+ delete[] path;
+ return ret;
}
}
VM_C_API int inotify_init()
{
- not_implemented_error();
+ VM_PTR->not_implemented_error();
return -1;
}
VM_C_API int inotify_add_watch(int fd, const char *name, u32 mask)
{
- not_implemented_error();
+ VM_PTR->not_implemented_error();
return -1;
}
VM_C_API int inotify_rm_watch(int fd, u32 wd)
{
- not_implemented_error();
+ VM_PTR->not_implemented_error();
return -1;
}
http://sourceforge.net/mailarchive/message.php?msg_name=200503102200.32002.bruno%40clisp.org
Modified for Factor by Slava Pestov */
-#define FRAME_RETURN_ADDRESS(frame) *((void **)(frame_successor(frame) + 1) + 2)
+#define FRAME_RETURN_ADDRESS(frame,vm) *((void **)(vm->frame_successor(frame) + 1) + 2)
#define MACH_EXC_STATE_TYPE ppc_exception_state_t
#define MACH_EXC_STATE_FLAVOR PPC_EXCEPTION_STATE
#define MACH_EXC_STATE_COUNT PPC_EXCEPTION_STATE_COUNT
+
+#define MACH_EXC_INTEGER_DIV EXC_PPC_ZERO_DIVIDE
+
#define MACH_THREAD_STATE_TYPE ppc_thread_state_t
#define MACH_THREAD_STATE_FLAVOR PPC_THREAD_STATE
#define MACH_THREAD_STATE_COUNT PPC_THREAD_STATE_COUNT
+#define MACH_FLOAT_STATE_TYPE ppc_float_state_t
+#define MACH_FLOAT_STATE_FLAVOR PPC_FLOAT_STATE
+#define MACH_FLOAT_STATE_COUNT PPC_FLOAT_STATE_COUNT
+
#if __DARWIN_UNIX03
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->__dar
#define MACH_STACK_POINTER(thr_state) (thr_state)->__r1
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->__srr0
- #define UAP_PROGRAM_COUNTER(ucontext) \
- MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->__ss))
+
+ #define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__ss)
+ #define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__fs)
+
+ #define FPSCR(float_state) (float_state)->__fpscr
#else
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->dar
#define MACH_STACK_POINTER(thr_state) (thr_state)->r1
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->srr0
- #define UAP_PROGRAM_COUNTER(ucontext) \
- MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->ss))
+
+ #define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->ss)
+ #define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->fs)
+
+ #define FPSCR(float_state) (float_state)->fpscr
#endif
+#define UAP_PROGRAM_COUNTER(ucontext) \
+ MACH_PROGRAM_COUNTER(UAP_SS(ucontext))
+
+inline static unsigned int mach_fpu_status(ppc_float_state_t *float_state)
+{
+ return FPSCR(float_state);
+}
+
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ return mach_fpu_status(UAP_FS(uap));
+}
+
inline static cell fix_stack_pointer(cell sp)
{
return sp;
}
+inline static void mach_clear_fpu_status(ppc_float_state_t *float_state)
+{
+ FPSCR(float_state) &= 0x0007f8ff;
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ mach_clear_fpu_status(UAP_FS(uap));
+}
+
}
#define MACH_EXC_STATE_TYPE i386_exception_state_t
#define MACH_EXC_STATE_FLAVOR i386_EXCEPTION_STATE
#define MACH_EXC_STATE_COUNT i386_EXCEPTION_STATE_COUNT
+
+#define MACH_EXC_INTEGER_DIV EXC_I386_DIV
+
#define MACH_THREAD_STATE_TYPE i386_thread_state_t
#define MACH_THREAD_STATE_FLAVOR i386_THREAD_STATE
#define MACH_THREAD_STATE_COUNT i386_THREAD_STATE_COUNT
+#define MACH_FLOAT_STATE_TYPE i386_float_state_t
+#define MACH_FLOAT_STATE_FLAVOR i386_FLOAT_STATE
+#define MACH_FLOAT_STATE_COUNT i386_FLOAT_STATE_COUNT
+
#if __DARWIN_UNIX03
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->__faultvaddr
#define MACH_STACK_POINTER(thr_state) (thr_state)->__esp
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->__eip
- #define UAP_PROGRAM_COUNTER(ucontext) \
- MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->__ss))
+
+ #define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__ss)
+ #define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__fs)
+
+ #define MXCSR(float_state) (float_state)->__fpu_mxcsr
+ #define X87SW(float_state) (float_state)->__fpu_fsw
#else
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->faultvaddr
#define MACH_STACK_POINTER(thr_state) (thr_state)->esp
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->eip
- #define UAP_PROGRAM_COUNTER(ucontext) \
- MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->ss))
+
+ #define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->ss)
+ #define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->fs)
+
+ #define MXCSR(float_state) (float_state)->fpu_mxcsr
+ #define X87SW(float_state) (float_state)->fpu_fsw
#endif
+#define UAP_PROGRAM_COUNTER(ucontext) \
+ MACH_PROGRAM_COUNTER(UAP_SS(ucontext))
+
+inline static unsigned int mach_fpu_status(i386_float_state_t *float_state)
+{
+ unsigned short x87sw;
+ memcpy(&x87sw, &X87SW(float_state), sizeof(x87sw));
+ return MXCSR(float_state) | x87sw;
+}
+
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ return mach_fpu_status(UAP_FS(uap));
+}
+
inline static cell fix_stack_pointer(cell sp)
{
return ((sp + 4) & ~15) - 4;
}
+inline static void mach_clear_fpu_status(i386_float_state_t *float_state)
+{
+ MXCSR(float_state) &= 0xffffffc0;
+ memset(&X87SW(float_state), 0, sizeof(X87SW(float_state)));
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ mach_clear_fpu_status(UAP_FS(uap));
+}
+
}
#define MACH_EXC_STATE_TYPE x86_exception_state64_t
#define MACH_EXC_STATE_FLAVOR x86_EXCEPTION_STATE64
#define MACH_EXC_STATE_COUNT x86_EXCEPTION_STATE64_COUNT
+
+#define MACH_EXC_INTEGER_DIV EXC_I386_DIV
+
#define MACH_THREAD_STATE_TYPE x86_thread_state64_t
#define MACH_THREAD_STATE_FLAVOR x86_THREAD_STATE64
#define MACH_THREAD_STATE_COUNT MACHINE_THREAD_STATE_COUNT
+#define MACH_FLOAT_STATE_TYPE x86_float_state64_t
+#define MACH_FLOAT_STATE_FLAVOR x86_FLOAT_STATE64
+#define MACH_FLOAT_STATE_COUNT x86_FLOAT_STATE64_COUNT
+
#if __DARWIN_UNIX03
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->__faultvaddr
#define MACH_STACK_POINTER(thr_state) (thr_state)->__rsp
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->__rip
- #define UAP_PROGRAM_COUNTER(ucontext) \
- MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->__ss))
+ #define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__ss)
+ #define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->__fs)
+
+ #define MXCSR(float_state) (float_state)->__fpu_mxcsr
+ #define X87SW(float_state) (float_state)->__fpu_fsw
#else
#define MACH_EXC_STATE_FAULT(exc_state) (exc_state)->faultvaddr
#define MACH_STACK_POINTER(thr_state) (thr_state)->rsp
#define MACH_PROGRAM_COUNTER(thr_state) (thr_state)->rip
- #define UAP_PROGRAM_COUNTER(ucontext) \
- MACH_PROGRAM_COUNTER(&(((ucontext_t *)(ucontext))->uc_mcontext->ss))
+ #define UAP_SS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->ss)
+ #define UAP_FS(ucontext) &(((ucontext_t *)(ucontext))->uc_mcontext->fs)
+
+ #define MXCSR(float_state) (float_state)->fpu_mxcsr
+ #define X87SW(float_state) (float_state)->fpu_fsw
#endif
+#define UAP_PROGRAM_COUNTER(ucontext) \
+ MACH_PROGRAM_COUNTER(UAP_SS(ucontext))
+
+inline static unsigned int mach_fpu_status(x86_float_state64_t *float_state)
+{
+ unsigned short x87sw;
+ memcpy(&x87sw, &X87SW(float_state), sizeof(x87sw));
+ return MXCSR(float_state) | x87sw;
+}
+
+inline static unsigned int uap_fpu_status(void *uap)
+{
+ return mach_fpu_status(UAP_FS(uap));
+}
+
inline static cell fix_stack_pointer(cell sp)
{
return ((sp + 8) & ~15) - 8;
}
+inline static void mach_clear_fpu_status(x86_float_state64_t *float_state)
+{
+ MXCSR(float_state) &= 0xffffffc0;
+ memset(&X87SW(float_state), 0, sizeof(X87SW(float_state)));
+}
+
+inline static void uap_clear_fpu_status(void *uap)
+{
+ mach_clear_fpu_status(UAP_FS(uap));
+}
+
}
namespace factor
{
-void c_to_factor_toplevel(cell quot)
+void factor_vm::c_to_factor_toplevel(cell quot)
{
for(;;)
{
NS_DURING
- c_to_factor(quot);
+ c_to_factor(quot,this);
NS_VOIDRETURN;
NS_HANDLER
dpush(allot_alien(F,(cell)localException));
#define ucontext_stack_pointer(uap) ((void *)_UC_MACHINE_SP((ucontext_t *)uap))
+static inline unsigned int uap_fpu_status(void *uap) { return 0; }
+static inline void uap_clear_fpu_status(void *uap) { }
+
}
#define ucontext_stack_pointer(uap) \
((void *)(((ucontext_t *)(uap))->uc_mcontext.__gregs[_REG_URSP]))
+static inline unsigned int uap_fpu_status(void *uap) { return 0; }
+static inline void uap_clear_fpu_status(void *uap) { }
+
}
#define UAP_PROGRAM_COUNTER(uap) _UC_MACHINE_PC((ucontext_t *)uap)
-#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
-
}
#define ucontext_stack_pointer openbsd_stack_pointer
#define UAP_PROGRAM_COUNTER(uap) (((struct sigcontext*)(uap))->sc_eip)
+static inline unsigned int uap_fpu_status(void *uap) { return 0; }
+static inline void uap_clear_fpu_status(void *uap) { }
+
}
#define ucontext_stack_pointer openbsd_stack_pointer
#define UAP_PROGRAM_COUNTER(uap) (((struct sigcontext*)(uap))->sc_rip)
+static inline unsigned int uap_fpu_status(void *uap) { return 0; }
+static inline void uap_clear_fpu_status(void *uap) { }
+
}
namespace factor
{
-void start_thread(void *(*start_routine)(void *))
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args)
{
pthread_attr_t attr;
pthread_t thread;
-
if (pthread_attr_init (&attr) != 0)
fatal_error("pthread_attr_init() failed",0);
- if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED) != 0)
+ if (pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_JOINABLE) != 0)
fatal_error("pthread_attr_setdetachstate() failed",0);
- if (pthread_create (&thread, &attr, start_routine, NULL) != 0)
+ if (pthread_create (&thread, &attr, start_routine, args) != 0)
fatal_error("pthread_create() failed",0);
pthread_attr_destroy (&attr);
+ return thread;
+}
+
+pthread_key_t tlsKey = 0;
+
+void init_platform_globals()
+{
+ if (pthread_key_create(&tlsKey, NULL) != 0)
+ fatal_error("pthread_key_create() failed",0);
+
+}
+
+void register_vm_with_thread(factor_vm *vm)
+{
+ pthread_setspecific(tlsKey,vm);
+}
+
+factor_vm *tls_vm()
+{
+ factor_vm *vm = (factor_vm*)pthread_getspecific(tlsKey);
+ assert(vm != NULL);
+ return vm;
}
static void *null_dll;
usleep(usec);
}
-void init_ffi()
+void factor_vm::init_ffi()
{
/* NULL_DLL is "libfactor.dylib" for OS X and NULL for generic unix */
null_dll = dlopen(NULL_DLL,RTLD_LAZY);
}
-void ffi_dlopen(dll *dll)
+void factor_vm::ffi_dlopen(dll *dll)
{
dll->dll = dlopen(alien_offset(dll->path), RTLD_LAZY);
}
-void *ffi_dlsym(dll *dll, symbol_char *symbol)
+void *factor_vm::ffi_dlsym(dll *dll, symbol_char *symbol)
{
void *handle = (dll == NULL ? null_dll : dll->dll);
return dlsym(handle,symbol);
}
-void ffi_dlclose(dll *dll)
+void factor_vm::ffi_dlclose(dll *dll)
{
if(dlclose(dll->dll))
general_error(ERROR_FFI,F,F,NULL);
dll->dll = NULL;
}
-PRIMITIVE(existsp)
+void factor_vm::primitive_existsp()
{
struct stat sb;
char *path = (char *)(untag_check<byte_array>(dpop()) + 1);
box_boolean(stat(path,&sb) >= 0);
}
-segment *alloc_segment(cell size)
+segment::segment(factor_vm *myvm_, cell size_)
{
+ myvm = myvm_;
+ size = size_;
+
int pagesize = getpagesize();
char *array = (char *)mmap(NULL,pagesize + size + pagesize,
MAP_ANON | MAP_PRIVATE,-1,0);
if(array == (char*)-1)
- out_of_memory();
+ myvm->out_of_memory();
if(mprotect(array,pagesize,PROT_NONE) == -1)
fatal_error("Cannot protect low guard page",(cell)array);
if(mprotect(array + pagesize + size,pagesize,PROT_NONE) == -1)
fatal_error("Cannot protect high guard page",(cell)array);
- segment *retval = (segment *)safe_malloc(sizeof(segment));
-
- retval->start = (cell)(array + pagesize);
- retval->size = size;
- retval->end = retval->start + size;
-
- return retval;
+ start = (cell)(array + pagesize);
+ end = start + size;
}
-void dealloc_segment(segment *block)
+segment::~segment()
{
int pagesize = getpagesize();
-
- int retval = munmap((void*)(block->start - pagesize),
- pagesize + block->size + pagesize);
-
+ int retval = munmap((void*)(start - pagesize),pagesize + size + pagesize);
if(retval)
- fatal_error("dealloc_segment failed",0);
-
- free(block);
+ fatal_error("Segment deallocation failed",0);
}
-static stack_frame *uap_stack_pointer(void *uap)
+stack_frame *factor_vm::uap_stack_pointer(void *uap)
{
/* There is a race condition here, but in practice a signal
delivered during stack frame setup/teardown or while transitioning
return NULL;
}
-void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+void factor_vm::memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
signal_fault_addr = (cell)siginfo->si_addr;
signal_callstack_top = uap_stack_pointer(uap);
- UAP_PROGRAM_COUNTER(uap) = (cell)memory_signal_handler_impl;
+ UAP_PROGRAM_COUNTER(uap) = (cell)factor::memory_signal_handler_impl;
+}
+
+void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ SIGNAL_VM_PTR()->memory_signal_handler(signal,siginfo,uap);
+}
+
+void factor_vm::misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ signal_number = signal;
+ signal_callstack_top = uap_stack_pointer(uap);
+ UAP_PROGRAM_COUNTER(uap) = (cell)factor::misc_signal_handler_impl;
}
void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ SIGNAL_VM_PTR()->misc_signal_handler(signal,siginfo,uap);
+}
+
+void factor_vm::fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
{
signal_number = signal;
signal_callstack_top = uap_stack_pointer(uap);
- UAP_PROGRAM_COUNTER(uap) = (cell)misc_signal_handler_impl;
+ signal_fpu_status = fpu_status(uap_fpu_status(uap));
+ uap_clear_fpu_status(uap);
+ UAP_PROGRAM_COUNTER(uap) =
+ (siginfo->si_code == FPE_INTDIV || siginfo->si_code == FPE_INTOVF)
+ ? (cell)factor::misc_signal_handler_impl
+ : (cell)factor::fp_signal_handler_impl;
+}
+
+void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap)
+{
+ SIGNAL_VM_PTR()->fpe_signal_handler(signal, siginfo, uap);
}
static void sigaction_safe(int signum, const struct sigaction *act, struct sigaction *oldact)
{
struct sigaction memory_sigaction;
struct sigaction misc_sigaction;
+ struct sigaction fpe_sigaction;
struct sigaction ignore_sigaction;
memset(&memory_sigaction,0,sizeof(struct sigaction));
sigaction_safe(SIGBUS,&memory_sigaction,NULL);
sigaction_safe(SIGSEGV,&memory_sigaction,NULL);
+ memset(&fpe_sigaction,0,sizeof(struct sigaction));
+ sigemptyset(&fpe_sigaction.sa_mask);
+ fpe_sigaction.sa_sigaction = fpe_signal_handler;
+ fpe_sigaction.sa_flags = SA_SIGINFO;
+
+ sigaction_safe(SIGFPE,&fpe_sigaction,NULL);
+
memset(&misc_sigaction,0,sizeof(struct sigaction));
sigemptyset(&misc_sigaction.sa_mask);
misc_sigaction.sa_sigaction = misc_signal_handler;
misc_sigaction.sa_flags = SA_SIGINFO;
sigaction_safe(SIGABRT,&misc_sigaction,NULL);
- sigaction_safe(SIGFPE,&misc_sigaction,NULL);
sigaction_safe(SIGQUIT,&misc_sigaction,NULL);
sigaction_safe(SIGILL,&misc_sigaction,NULL);
stdin_read = filedes[0];
stdin_write = filedes[1];
- start_thread(stdin_loop);
+ start_thread(stdin_loop,NULL);
}
VM_C_API void wait_for_stdin()
#define STRNCMP strncmp
#define STRDUP strdup
+#define FTELL ftello
#define FSEEK fseeko
#define FIXNUM_FORMAT "%ld"
#define print_native_string(string) print_string(string)
-void start_thread(void *(*start_routine)(void *));
+typedef pthread_t THREADHANDLE;
-void init_ffi();
-void ffi_dlopen(dll *dll);
-void *ffi_dlsym(dll *dll, symbol_char *symbol);
-void ffi_dlclose(dll *dll);
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
+inline static THREADHANDLE thread_id() { return pthread_self(); }
void unix_init_signals();
void signal_handler(int signal, siginfo_t* siginfo, void* uap);
s64 current_micros();
void sleep_micros(cell usec);
+void init_platform_globals();
+
+void register_vm_with_thread(factor_vm *vm);
+factor_vm *tls_vm();
void open_console();
}
char *getenv(char *name)
{
- not_implemented_error();
+ vm->not_implemented_error();
return 0; /* unreachable */
}
-PRIMITIVE(os_envs)
-{
- not_implemented_error();
-}
-
void c_to_factor_toplevel(cell quot)
{
- c_to_factor(quot);
+ c_to_factor(quot,vm);
}
void open_console() { }
#define ESP Esp
#define EIP Eip
+typedef struct DECLSPEC_ALIGN(16) _M128A {
+ ULONGLONG Low;
+ LONGLONG High;
+} M128A, *PM128A;
+
+/* The ExtendedRegisters field of the x86.32 CONTEXT structure uses this layout; however,
+ * this structure is only made available from winnt.h on x86.64 */
+typedef struct _XMM_SAVE_AREA32 {
+ WORD ControlWord; /* 000 */
+ WORD StatusWord; /* 002 */
+ BYTE TagWord; /* 004 */
+ BYTE Reserved1; /* 005 */
+ WORD ErrorOpcode; /* 006 */
+ DWORD ErrorOffset; /* 008 */
+ WORD ErrorSelector; /* 00c */
+ WORD Reserved2; /* 00e */
+ DWORD DataOffset; /* 010 */
+ WORD DataSelector; /* 014 */
+ WORD Reserved3; /* 016 */
+ DWORD MxCsr; /* 018 */
+ DWORD MxCsr_Mask; /* 01c */
+ M128A FloatRegisters[8]; /* 020 */
+ M128A XmmRegisters[16]; /* 0a0 */
+ BYTE Reserved4[96]; /* 1a0 */
+} XMM_SAVE_AREA32, *PXMM_SAVE_AREA32;
+
+#define X87SW(ctx) (ctx)->FloatSave.StatusWord
+#define MXCSR(ctx) ((XMM_SAVE_AREA32*)((ctx)->ExtendedRegisters))->MxCsr
+
}
#define ESP Rsp
#define EIP Rip
+#define X87SW(ctx) (ctx)->FloatSave.StatusWord
+#define MXCSR(ctx) (ctx)->MxCsr
+
}
namespace factor
{
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args){
+ return (void*) CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE)start_routine, args, 0, 0);
+}
+
+DWORD dwTlsIndex;
+
+void init_platform_globals()
+{
+ if ((dwTlsIndex = TlsAlloc()) == TLS_OUT_OF_INDEXES)
+ fatal_error("TlsAlloc failed - out of indexes",0);
+}
+
+void register_vm_with_thread(factor_vm *vm)
+{
+ if (! TlsSetValue(dwTlsIndex, vm))
+ fatal_error("TlsSetValue failed",0);
+}
+
+factor_vm *tls_vm()
+{
+ factor_vm *vm = (factor_vm*)TlsGetValue(dwTlsIndex);
+ assert(vm != NULL);
+ return vm;
+}
+
s64 current_micros()
{
FILETIME t;
- EPOCH_OFFSET) / 10;
}
-FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
+LONG factor_vm::exception_handler(PEXCEPTION_POINTERS pe)
{
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;
CONTEXT *c = (CONTEXT*)pe->ContextRecord;
else
signal_callstack_top = NULL;
- if(e->ExceptionCode == EXCEPTION_ACCESS_VIOLATION)
- {
+ switch (e->ExceptionCode)
+ {
+ case EXCEPTION_ACCESS_VIOLATION:
signal_fault_addr = e->ExceptionInformation[1];
- c->EIP = (cell)memory_signal_handler_impl;
- }
- /* If the Widcomm bluetooth stack is installed, the BTTray.exe process
- injects code into running programs. For some reason this results in
- random SEH exceptions with this (undocumented) exception code being
- raised. The workaround seems to be ignoring this altogether, since that
- is what happens if SEH is not enabled. Don't really have any idea what
- this exception means. */
- else if(e->ExceptionCode != 0x40010006)
- {
+ c->EIP = (cell)factor::memory_signal_handler_impl;
+ break;
+
+ case STATUS_FLOAT_DENORMAL_OPERAND:
+ case STATUS_FLOAT_DIVIDE_BY_ZERO:
+ case STATUS_FLOAT_INEXACT_RESULT:
+ case STATUS_FLOAT_INVALID_OPERATION:
+ case STATUS_FLOAT_OVERFLOW:
+ case STATUS_FLOAT_STACK_CHECK:
+ case STATUS_FLOAT_UNDERFLOW:
+ case STATUS_FLOAT_MULTIPLE_FAULTS:
+ case STATUS_FLOAT_MULTIPLE_TRAPS:
+ signal_fpu_status = fpu_status(X87SW(c) | MXCSR(c));
+ X87SW(c) = 0;
+ MXCSR(c) &= 0xffffffc0;
+ c->EIP = (cell)factor::fp_signal_handler_impl;
+ break;
+ case 0x40010006:
+ /* If the Widcomm bluetooth stack is installed, the BTTray.exe
+ process injects code into running programs. For some reason this
+ results in random SEH exceptions with this (undocumented)
+ exception code being raised. The workaround seems to be ignoring
+ this altogether, since that is what happens if SEH is not
+ enabled. Don't really have any idea what this exception means. */
+ break;
+ default:
signal_number = e->ExceptionCode;
- c->EIP = (cell)misc_signal_handler_impl;
+ c->EIP = (cell)factor::misc_signal_handler_impl;
+ break;
}
-
return EXCEPTION_CONTINUE_EXECUTION;
}
-void c_to_factor_toplevel(cell quot)
+FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe)
{
- if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)exception_handler))
- fatal_error("AddVectoredExceptionHandler failed", 0);
- c_to_factor(quot);
- RemoveVectoredExceptionHandler((void *)exception_handler);
+ return SIGNAL_VM_PTR()->exception_handler(pe);
+}
+
+bool handler_added = 0;
+
+void factor_vm::c_to_factor_toplevel(cell quot)
+{
+ if(!handler_added){
+ if(!AddVectoredExceptionHandler(0, (PVECTORED_EXCEPTION_HANDLER)factor::exception_handler))
+ fatal_error("AddVectoredExceptionHandler failed", 0);
+ handler_added = 1;
+ }
+ c_to_factor(quot,this);
+ RemoveVectoredExceptionHandler((void *)factor::exception_handler);
}
-void open_console()
+void factor_vm::open_console()
{
}
#define FACTOR_STDCALL __attribute__((stdcall))
-void c_to_factor_toplevel(cell quot);
FACTOR_STDCALL LONG exception_handler(PEXCEPTION_POINTERS pe);
-void open_console();
+
+// SSE traps raise these exception codes, which are defined in internal NT headers
+// but not winbase.h
+#define STATUS_FLOAT_MULTIPLE_FAULTS 0xC00002B4
+#define STATUS_FLOAT_MULTIPLE_TRAPS 0xC00002B5
+
+typedef HANDLE THREADHANDLE;
+
+THREADHANDLE start_thread(void *(*start_routine)(void *),void *args);
+inline static THREADHANDLE thread_id() { return GetCurrentThread(); }
+
+void init_platform_globals();
+void register_vm_with_thread(factor_vm *vm);
+factor_vm *tls_vm();
}
HMODULE hFactorDll;
-void init_ffi()
+void factor_vm::init_ffi()
{
hFactorDll = GetModuleHandle(FACTOR_DLL);
if(!hFactorDll)
fatal_error("GetModuleHandle(\"" FACTOR_DLL_NAME "\") failed", 0);
}
-void ffi_dlopen(dll *dll)
+void factor_vm::ffi_dlopen(dll *dll)
{
dll->dll = LoadLibraryEx((WCHAR *)alien_offset(dll->path), NULL, 0);
}
-void *ffi_dlsym(dll *dll, symbol_char *symbol)
+void *factor_vm::ffi_dlsym(dll *dll, symbol_char *symbol)
{
return (void *)GetProcAddress(dll ? (HMODULE)dll->dll : hFactorDll, symbol);
}
-void ffi_dlclose(dll *dll)
+void factor_vm::ffi_dlclose(dll *dll)
{
FreeLibrary((HMODULE)dll->dll);
dll->dll = NULL;
}
-bool windows_stat(vm_char *path)
+bool factor_vm::windows_stat(vm_char *path)
{
BY_HANDLE_FILE_INFORMATION bhfi;
HANDLE h = CreateFileW(path,
return ret;
}
-void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
+void factor_vm::windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length)
{
snwprintf(temp_path, length-1, L"%s.image", full_path);
- temp_path[sizeof(temp_path) - 1] = 0;
+ temp_path[length - 1] = 0;
}
/* You must free() this yourself. */
-const vm_char *default_image_path()
+const vm_char *factor_vm::default_image_path()
{
vm_char full_path[MAX_UNICODE_PATH];
vm_char *ptr;
if((ptr = wcsrchr(full_path, '.')))
*ptr = 0;
- snwprintf(temp_path, sizeof(temp_path)-1, L"%s.image", full_path);
- temp_path[sizeof(temp_path) - 1] = 0;
+ snwprintf(temp_path, MAX_UNICODE_PATH-1, L"%s.image", full_path);
+ temp_path[MAX_UNICODE_PATH - 1] = 0;
return safe_strdup(temp_path);
}
/* You must free() this yourself. */
-const vm_char *vm_executable_path()
+const vm_char *factor_vm::vm_executable_path()
{
vm_char full_path[MAX_UNICODE_PATH];
if(!GetModuleFileName(NULL, full_path, MAX_UNICODE_PATH))
return safe_strdup(full_path);
}
-
-PRIMITIVE(existsp)
+void factor_vm::primitive_existsp()
{
vm_char *path = untag_check<byte_array>(dpop())->data<vm_char>();
box_boolean(windows_stat(path));
}
-segment *alloc_segment(cell size)
+segment::segment(factor_vm *myvm_, cell size_)
{
+ myvm = myvm_;
+ size = size_;
+
char *mem;
DWORD ignore;
if((mem = (char *)VirtualAlloc(NULL, getpagesize() * 2 + size,
MEM_COMMIT, PAGE_EXECUTE_READWRITE)) == 0)
- out_of_memory();
+ myvm->out_of_memory();
if (!VirtualProtect(mem, getpagesize(), PAGE_NOACCESS, &ignore))
fatal_error("Cannot allocate low guard page", (cell)mem);
getpagesize(), PAGE_NOACCESS, &ignore))
fatal_error("Cannot allocate high guard page", (cell)mem);
- segment *block = (segment *)safe_malloc(sizeof(segment));
-
- block->start = (cell)mem + getpagesize();
- block->size = size;
- block->end = block->start + size;
-
- return block;
+ start = (cell)mem + getpagesize();
+ end = start + size;
}
-void dealloc_segment(segment *block)
+segment::~segment()
{
SYSTEM_INFO si;
GetSystemInfo(&si);
- if(!VirtualFree((void*)(block->start - si.dwPageSize), 0, MEM_RELEASE))
- fatal_error("dealloc_segment failed",0);
- free(block);
+ if(!VirtualFree((void*)(start - si.dwPageSize), 0, MEM_RELEASE))
+ fatal_error("Segment deallocation failed",0);
+}
+
+void factor_vm::sleep_micros(u64 usec)
+{
+ Sleep((DWORD)(usec / 1000));
}
long getpagesize()
return g_pagesize;
}
-void sleep_micros(u64 usec)
-{
- Sleep((DWORD)(usec / 1000));
-}
-
}
#define STRNCMP wcsncmp
#define STRDUP _wcsdup
#define MIN(a,b) ((a)>(b)?(b):(a))
-#define FSEEK fseek
+#define FTELL ftello64
+#define FSEEK fseeko64
#ifdef WIN64
#define CELL_FORMAT "%Iu"
/* Difference between Jan 1 00:00:00 1601 and Jan 1 00:00:00 1970 */
#define EPOCH_OFFSET 0x019db1ded53e8000LL
-void init_ffi();
-void ffi_dlopen(dll *dll);
-void *ffi_dlsym(dll *dll, symbol_char *symbol);
-void ffi_dlclose(dll *dll);
-
-void sleep_micros(u64 msec);
-
inline static void init_signals() {}
inline static void early_init() {}
-const vm_char *vm_executable_path();
-const vm_char *default_image_path();
-long getpagesize ();
s64 current_micros();
+long getpagesize();
}
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_getenv,
primitive_fputc,
primitive_fwrite,
primitive_fflush,
+ primitive_ftell,
primitive_fseek,
primitive_fclose,
primitive_wrapper,
primitive_inline_cache_stats,
primitive_optimized_p,
primitive_quot_compiled_p,
+ primitive_vm_ptr,
};
+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(getenv)
+PRIMITIVE_FORWARD(setenv)
+PRIMITIVE_FORWARD(existsp)
+PRIMITIVE_FORWARD(gc)
+PRIMITIVE_FORWARD(gc_stats)
+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(set_callstack)
+PRIMITIVE_FORWARD(exit)
+PRIMITIVE_FORWARD(data_room)
+PRIMITIVE_FORWARD(code_room)
+PRIMITIVE_FORWARD(micros)
+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(begin_scan)
+PRIMITIVE_FORWARD(next_object)
+PRIMITIVE_FORWARD(end_scan)
+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(clear_gc_stats)
+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(reset_inline_cache_stats)
+PRIMITIVE_FORWARD(inline_cache_stats)
+PRIMITIVE_FORWARD(optimized_p)
+PRIMITIVE_FORWARD(quot_compiled_p)
+PRIMITIVE_FORWARD(vm_ptr)
+
}
namespace factor
{
-extern "C" typedef void (*primitive_type)();
+#if defined(FACTOR_X86)
+ extern "C" __attribute__ ((regparm (1))) typedef void (*primitive_type)(void *myvm);
+ #define PRIMITIVE(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm)
+ #define PRIMITIVE_FORWARD(name) extern "C" __attribute__ ((regparm (1))) void primitive_##name(void *myvm) \
+ { \
+ PRIMITIVE_GETVM()->primitive_##name(); \
+ }
+#else
+ extern "C" typedef void (*primitive_type)(void *myvm);
+ #define PRIMITIVE(name) extern "C" void primitive_##name(void *myvm)
+ #define PRIMITIVE_FORWARD(name) extern "C" void primitive_##name(void *myvm) \
+ { \
+ PRIMITIVE_GETVM()->primitive_##name(); \
+ }
+#endif
extern const primitive_type primitives[];
-#define PRIMITIVE(name) extern "C" void primitive_##name()
+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(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(clear_gc_stats);
+PRIMITIVE(jit_compile);
+PRIMITIVE(load_locals);
+PRIMITIVE(check_datastack);
+PRIMITIVE(inline_cache_miss);
+PRIMITIVE(inline_cache_miss_tail);
+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);
+PRIMITIVE(quot_compiled_p);
+PRIMITIVE(vm_ptr);
}
namespace factor
{
-bool profiling_p;
-
-void init_profiler()
+void factor_vm::init_profiler()
{
profiling_p = false;
}
/* Allocates memory */
-code_block *compile_profiling_stub(cell word_)
+code_block *factor_vm::compile_profiling_stub(cell word_)
{
- gc_root<word> word(word_);
+ gc_root<word> word(word_,this);
- jit jit(WORD_TYPE,word.value());
+ jit jit(WORD_TYPE,word.value(),this);
jit.emit_with(userenv[JIT_PROFILING],word.value());
return jit.to_code_block();
}
/* Allocates memory */
-static void set_profiling(bool profiling)
+void factor_vm::set_profiling(bool profiling)
{
if(profiling == profiling_p)
return;
and allocate profiling blocks if necessary */
gc();
- gc_root<array> words(find_all_words());
+ gc_root<array> words(find_all_words(),this);
cell i;
cell length = array_capacity(words.untagged());
}
/* Update XTs in code heap */
- iterate_code_heap(relocate_code_block);
+ word_updater updater(this);
+ iterate_code_heap(updater);
}
-PRIMITIVE(profiling)
+void factor_vm::primitive_profiling()
{
set_profiling(to_boolean(dpop()));
}
namespace factor
{
-extern bool profiling_p;
-void init_profiler();
-code_block *compile_profiling_stub(cell word);
-PRIMITIVE(profiling);
-
}
slot and eq?. A primitive call is relatively expensive (two subroutine calls)
so this results in a big speedup for relatively little effort. */
-bool quotation_jit::primitive_call_p(cell i)
+bool quotation_jit::primitive_call_p(cell i, cell length)
{
- return (i + 2) == array_capacity(elements.untagged())
- && tagged<object>(array_nth(elements.untagged(),i)).type_p(FIXNUM_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_PRIMITIVE_WORD];
+ return (i + 2) == length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_PRIMITIVE_WORD];
}
-bool quotation_jit::fast_if_p(cell i)
+bool quotation_jit::fast_if_p(cell i, cell length)
{
- return (i + 3) == array_capacity(elements.untagged())
- && tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
+ return (i + 3) == length
&& tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 2) == userenv[JIT_IF_WORD];
+ && array_nth(elements.untagged(),i + 2) == parent_vm->userenv[JIT_IF_WORD];
}
-bool quotation_jit::fast_dip_p(cell i)
+bool quotation_jit::fast_dip_p(cell i, cell length)
{
- return (i + 2) <= array_capacity(elements.untagged())
- && tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_DIP_WORD];
+ return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DIP_WORD];
}
-bool quotation_jit::fast_2dip_p(cell i)
+bool quotation_jit::fast_2dip_p(cell i, cell length)
{
- return (i + 2) <= array_capacity(elements.untagged())
- && tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_2DIP_WORD];
+ return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_2DIP_WORD];
}
-bool quotation_jit::fast_3dip_p(cell i)
+bool quotation_jit::fast_3dip_p(cell i, cell length)
{
- return (i + 2) <= array_capacity(elements.untagged())
- && tagged<object>(array_nth(elements.untagged(),i)).type_p(QUOTATION_TYPE)
- && array_nth(elements.untagged(),i + 1) == userenv[JIT_3DIP_WORD];
+ return (i + 2) <= length && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_3DIP_WORD];
}
-bool quotation_jit::mega_lookup_p(cell i)
+bool quotation_jit::mega_lookup_p(cell i, cell length)
{
- return (i + 3) < array_capacity(elements.untagged())
- && tagged<object>(array_nth(elements.untagged(),i)).type_p(ARRAY_TYPE)
+ return (i + 4) <= length
&& tagged<object>(array_nth(elements.untagged(),i + 1)).type_p(FIXNUM_TYPE)
&& tagged<object>(array_nth(elements.untagged(),i + 2)).type_p(ARRAY_TYPE)
- && array_nth(elements.untagged(),i + 3) == userenv[MEGA_LOOKUP_WORD];
+ && array_nth(elements.untagged(),i + 3) == parent_vm->userenv[MEGA_LOOKUP_WORD];
+}
+
+bool quotation_jit::declare_p(cell i, cell length)
+{
+ return (i + 2) <= length
+ && array_nth(elements.untagged(),i + 1) == parent_vm->userenv[JIT_DECLARE_WORD];
}
bool quotation_jit::stack_frame_p()
switch(tagged<object>(obj).type())
{
case WORD_TYPE:
- if(untag<word>(obj)->subprimitive == F)
+ if(parent_vm->untag<word>(obj)->subprimitive == F)
return true;
break;
case QUOTATION_TYPE:
- if(fast_dip_p(i) || fast_2dip_p(i) || fast_3dip_p(i))
+ if(fast_dip_p(i,length) || fast_2dip_p(i,length) || fast_3dip_p(i,length))
return true;
break;
default:
set_position(0);
if(stack_frame)
- emit(userenv[JIT_PROLOG]);
+ emit(parent_vm->userenv[JIT_PROLOG]);
cell i;
cell length = array_capacity(elements.untagged());
{
set_position(i);
- gc_root<object> obj(array_nth(elements.untagged(),i));
+ gc_root<object> obj(array_nth(elements.untagged(),i),parent_vm);
switch(obj.type())
{
if(obj.as<word>()->subprimitive != F)
emit_subprimitive(obj.value());
/* The (execute) primitive is special-cased */
- else if(obj.value() == userenv[JIT_EXECUTE_WORD])
+ else if(obj.value() == parent_vm->userenv[JIT_EXECUTE_WORD])
{
if(i == length - 1)
{
- if(stack_frame) emit(userenv[JIT_EPILOG]);
+ if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
tail_call = true;
- emit(userenv[JIT_EXECUTE_JUMP]);
+ emit(parent_vm->userenv[JIT_EXECUTE_JUMP]);
}
else
- emit(userenv[JIT_EXECUTE_CALL]);
+ emit(parent_vm->userenv[JIT_EXECUTE_CALL]);
}
/* Everything else */
else
{
if(i == length - 1)
{
- if(stack_frame) emit(userenv[JIT_EPILOG]);
+ if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
tail_call = true;
/* Inline cache misses are special-cased.
The calling convention for tail
the inline cache miss primitive, and
we don't want to clobber the saved
address. */
- if(obj.value() == userenv[PIC_MISS_WORD]
- || obj.value() == userenv[PIC_MISS_TAIL_WORD])
+ if(obj.value() == parent_vm->userenv[PIC_MISS_WORD]
+ || obj.value() == parent_vm->userenv[PIC_MISS_TAIL_WORD])
{
word_special(obj.value());
}
break;
case FIXNUM_TYPE:
/* Primitive calls */
- if(primitive_call_p(i))
+ if(primitive_call_p(i,length))
{
- emit_with(userenv[JIT_PRIMITIVE],obj.value());
+ emit_with(parent_vm->userenv[JIT_PRIMITIVE],obj.value());
i++;
tail_call = true;
- break;
}
+ else
+ push(obj.value());
+ break;
case QUOTATION_TYPE:
/* 'if' preceeded by two literal quotations (this is why if and ? are
mutually recursive in the library, but both still work) */
- if(fast_if_p(i))
+ if(fast_if_p(i,length))
{
- if(stack_frame) emit(userenv[JIT_EPILOG]);
+ if(stack_frame) emit(parent_vm->userenv[JIT_EPILOG]);
tail_call = true;
if(compiling)
{
- jit_compile(array_nth(elements.untagged(),i),relocate);
- jit_compile(array_nth(elements.untagged(),i + 1),relocate);
+ parent_vm->jit_compile(array_nth(elements.untagged(),i),relocate);
+ parent_vm->jit_compile(array_nth(elements.untagged(),i + 1),relocate);
}
literal(array_nth(elements.untagged(),i));
literal(array_nth(elements.untagged(),i + 1));
- emit(userenv[JIT_IF]);
+ emit(parent_vm->userenv[JIT_IF]);
i += 2;
-
- break;
}
/* dip */
- else if(fast_dip_p(i))
+ else if(fast_dip_p(i,length))
{
if(compiling)
- jit_compile(obj.value(),relocate);
- emit_with(userenv[JIT_DIP],obj.value());
+ parent_vm->jit_compile(obj.value(),relocate);
+ emit_with(parent_vm->userenv[JIT_DIP],obj.value());
i++;
- break;
}
/* 2dip */
- else if(fast_2dip_p(i))
+ else if(fast_2dip_p(i,length))
{
if(compiling)
- jit_compile(obj.value(),relocate);
- emit_with(userenv[JIT_2DIP],obj.value());
+ parent_vm->jit_compile(obj.value(),relocate);
+ emit_with(parent_vm->userenv[JIT_2DIP],obj.value());
i++;
- break;
}
/* 3dip */
- else if(fast_3dip_p(i))
+ else if(fast_3dip_p(i,length))
{
if(compiling)
- jit_compile(obj.value(),relocate);
- emit_with(userenv[JIT_3DIP],obj.value());
+ parent_vm->jit_compile(obj.value(),relocate);
+ emit_with(parent_vm->userenv[JIT_3DIP],obj.value());
i++;
- break;
}
+ else
+ push(obj.value());
+ break;
case ARRAY_TYPE:
/* Method dispatch */
- if(mega_lookup_p(i))
+ if(mega_lookup_p(i,length))
{
emit_mega_cache_lookup(
array_nth(elements.untagged(),i),
array_nth(elements.untagged(),i + 2));
i += 3;
tail_call = true;
- break;
}
+ /* Non-optimizing compiler ignores declarations */
+ else if(declare_p(i,length))
+ i++;
+ else
+ push(obj.value());
+ break;
default:
push(obj.value());
break;
set_position(length);
if(stack_frame)
- emit(userenv[JIT_EPILOG]);
- emit(userenv[JIT_RETURN]);
+ emit(parent_vm->userenv[JIT_EPILOG]);
+ emit(parent_vm->userenv[JIT_RETURN]);
}
}
-void set_quot_xt(quotation *quot, code_block *code)
+void factor_vm::set_quot_xt(quotation *quot, code_block *code)
{
if(code->type != QUOTATION_TYPE)
critical_error("Bad param to set_quot_xt",(cell)code);
}
/* Allocates memory */
-void jit_compile(cell quot_, bool relocating)
+void factor_vm::jit_compile(cell quot_, bool relocating)
{
- gc_root<quotation> quot(quot_);
+ gc_root<quotation> quot(quot_,this);
if(quot->code) return;
- quotation_jit compiler(quot.value(),true,relocating);
+ quotation_jit compiler(quot.value(),true,relocating,this);
compiler.iterate_quotation();
code_block *compiled = compiler.to_code_block();
if(relocating) relocate_code_block(compiled);
}
-PRIMITIVE(jit_compile)
+void factor_vm::primitive_jit_compile()
{
jit_compile(dpop(),true);
}
/* push a new quotation on the stack */
-PRIMITIVE(array_to_quotation)
+void factor_vm::primitive_array_to_quotation()
{
quotation *quot = allot<quotation>(sizeof(quotation));
quot->array = dpeek();
drepl(tag<quotation>(quot));
}
-PRIMITIVE(quotation_xt)
+void factor_vm::primitive_quotation_xt()
{
quotation *quot = untag_check<quotation>(dpeek());
drepl(allot_cell((cell)quot->xt));
}
-void compile_all_words()
+void factor_vm::compile_all_words()
{
- gc_root<array> words(find_all_words());
+ gc_root<array> words(find_all_words(),this);
cell i;
cell length = array_capacity(words.untagged());
for(i = 0; i < length; i++)
{
- gc_root<word> word(array_nth(words.untagged(),i));
+ gc_root<word> word(array_nth(words.untagged(),i),this);
if(!word->code || !word_optimized_p(word.untagged()))
jit_compile_word(word.value(),word->def,false);
}
- iterate_code_heap(relocate_code_block);
+ /* Update XTs in code heap */
+ word_updater updater(this);
+ iterate_code_heap(updater);
}
/* Allocates memory */
-fixnum quot_code_offset_to_scan(cell quot_, cell offset)
+fixnum factor_vm::quot_code_offset_to_scan(cell quot_, cell offset)
{
- gc_root<quotation> quot(quot_);
- gc_root<array> array(quot->array);
+ gc_root<quotation> quot(quot_,this);
+ gc_root<array> array(quot->array,this);
- quotation_jit compiler(quot.value(),false,false);
+ quotation_jit compiler(quot.value(),false,false,this);
compiler.compute_position(offset);
compiler.iterate_quotation();
return compiler.get_position();
}
-VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack)
+cell factor_vm::lazy_jit_compile_impl(cell quot_, stack_frame *stack)
{
- gc_root<quotation> quot(quot_);
+ gc_root<quotation> quot(quot_,this);
stack_chain->callstack_top = stack;
jit_compile(quot.value(),true);
return quot.value();
}
-PRIMITIVE(quot_compiled_p)
+VM_ASM_API cell lazy_jit_compile_impl(cell quot_, stack_frame *stack, factor_vm *myvm)
+{
+ ASSERTVM();
+ return VM_PTR->lazy_jit_compile_impl(quot_,stack);
+}
+
+void factor_vm::primitive_quot_compiled_p()
{
tagged<quotation> quot(dpop());
- quot.untag_check();
+ quot.untag_check(this);
dpush(tag_boolean(quot->code != NULL));
}
gc_root<array> elements;
bool compiling, relocate;
- quotation_jit(cell quot, bool compiling_, bool relocate_)
- : jit(QUOTATION_TYPE,quot),
- elements(owner.as<quotation>().untagged()->array),
+ explicit quotation_jit(cell quot, bool compiling_, bool relocate_, factor_vm *vm)
+ : jit(QUOTATION_TYPE,quot,vm),
+ elements(owner.as<quotation>().untagged()->array,vm),
compiling(compiling_),
- relocate(relocate_) {};
+ relocate(relocate_){};
void emit_mega_cache_lookup(cell methods, fixnum index, cell cache);
- bool primitive_call_p(cell i);
- bool fast_if_p(cell i);
- bool fast_dip_p(cell i);
- bool fast_2dip_p(cell i);
- bool fast_3dip_p(cell i);
- bool mega_lookup_p(cell i);
+ bool primitive_call_p(cell i, cell length);
+ bool fast_if_p(cell i, cell length);
+ bool fast_dip_p(cell i, cell length);
+ bool fast_2dip_p(cell i, cell length);
+ bool fast_3dip_p(cell i, cell length);
+ bool mega_lookup_p(cell i, cell length);
+ bool declare_p(cell i, cell length);
bool stack_frame_p();
void iterate_quotation();
};
-void set_quot_xt(quotation *quot, code_block *code);
-void jit_compile(cell quot, bool relocate);
-fixnum quot_code_offset_to_scan(cell quot, cell offset);
-
-PRIMITIVE(jit_compile);
-
-void compile_all_words();
-
-PRIMITIVE(array_to_quotation);
-PRIMITIVE(quotation_xt);
-
-VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack);
-
-PRIMITIVE(quot_compiled_p);
+VM_ASM_API cell lazy_jit_compile_impl(cell quot, stack_frame *stack, factor_vm *myvm);
}
#include "master.hpp"
-factor::cell userenv[USER_ENV];
-
namespace factor
{
-cell T;
-
-PRIMITIVE(getenv)
+void factor_vm::primitive_getenv()
{
fixnum e = untag_fixnum(dpeek());
drepl(userenv[e]);
}
-PRIMITIVE(setenv)
+void factor_vm::primitive_setenv()
{
fixnum e = untag_fixnum(dpop());
cell value = dpop();
userenv[e] = value;
}
-PRIMITIVE(exit)
+void factor_vm::primitive_exit()
{
exit(to_fixnum(dpop()));
}
-PRIMITIVE(micros)
+void factor_vm::primitive_micros()
{
box_unsigned_8(current_micros());
}
-PRIMITIVE(sleep)
+void factor_vm::primitive_sleep()
{
sleep_micros(to_cell(dpop()));
}
-PRIMITIVE(set_slot)
+void factor_vm::primitive_set_slot()
{
fixnum slot = untag_fixnum(dpop());
object *obj = untag<object>(dpop());
write_barrier(obj);
}
-PRIMITIVE(load_locals)
+void factor_vm::primitive_load_locals()
{
fixnum count = untag_fixnum(dpop());
memcpy((cell *)(rs + sizeof(cell)),(cell *)(ds - sizeof(cell) * (count - 1)),sizeof(cell) * count);
rs += sizeof(cell) * count;
}
-static cell clone_object(cell obj_)
+cell factor_vm::clone_object(cell obj_)
{
- gc_root<object> obj(obj_);
+ gc_root<object> obj(obj_,this);
if(immediate_p(obj.value()))
return obj.value();
else
{
cell size = object_size(obj.value());
- object *new_obj = allot_object(obj.type(),size);
+ object *new_obj = allot_object(header(obj.type()),size);
memcpy(new_obj,obj.untagged(),size);
return tag_dynamic(new_obj);
}
}
-PRIMITIVE(clone)
+void factor_vm::primitive_clone()
{
drepl(clone_object(dpeek()));
}
JIT_EXECUTE_WORD,
JIT_EXECUTE_JUMP,
JIT_EXECUTE_CALL,
+ JIT_DECLARE_WORD,
/* Polymorphic inline cache generation in inline_cache.c */
PIC_LOAD = 47,
return (i >= FIRST_SAVE_ENV && i <= LAST_SAVE_ENV) || i == STACK_TRACES_ENV;
}
-/* Canonical T object. It's just a word */
-extern cell T;
-
-PRIMITIVE(getenv);
-PRIMITIVE(setenv);
-PRIMITIVE(exit);
-PRIMITIVE(micros);
-PRIMITIVE(sleep);
-PRIMITIVE(set_slot);
-PRIMITIVE(load_locals);
-PRIMITIVE(clone);
-
}
-/* TAGGED user environment data; see getenv/setenv prims */
-VM_C_API factor::cell userenv[USER_ENV];
+
namespace factor
{
+inline cell align_page(cell a)
+{
+ return align(a,getpagesize());
+}
+
+/* segments set up guard pages to check for under/overflow.
+size must be a multiple of the page size */
struct segment {
+ factor_vm *myvm;
cell start;
cell size;
cell end;
-};
-inline static cell align_page(cell a)
-{
- return align(a,getpagesize());
-}
+ explicit segment(factor_vm *myvm, cell size);
+ ~segment();
+};
}
{
#define DEFPUSHPOP(prefix,ptr) \
- inline static cell prefix##peek() { return *(cell *)ptr; } \
- inline static void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \
- inline static cell prefix##pop() \
+ inline cell prefix##peek() { return *(cell *)ptr; } \
+ inline void prefix##repl(cell tagged) { *(cell *)ptr = tagged; } \
+ inline cell prefix##pop() \
{ \
cell value = prefix##peek(); \
ptr -= sizeof(cell); \
return value; \
} \
- inline static void prefix##push(cell tagged) \
+ inline void prefix##push(cell tagged) \
{ \
ptr += sizeof(cell); \
prefix##repl(tagged); \
namespace factor
{
-cell string_nth(string* str, cell index)
+cell factor_vm::string_nth(string* str, cell index)
{
/* If high bit is set, the most significant 16 bits of the char
come from the aux vector. The least significant bit of the
}
}
-void set_string_nth_fast(string *str, cell index, cell ch)
+void factor_vm::set_string_nth_fast(string *str, cell index, cell ch)
{
str->data()[index] = ch;
}
-void set_string_nth_slow(string *str_, cell index, cell ch)
+void factor_vm::set_string_nth_slow(string *str_, cell index, cell ch)
{
- gc_root<string> str(str_);
+ gc_root<string> str(str_,this);
byte_array *aux;
}
/* allocates memory */
-void set_string_nth(string *str, cell index, cell ch)
+void factor_vm::set_string_nth(string *str, cell index, cell ch)
{
if(ch <= 0x7f)
set_string_nth_fast(str,index,ch);
}
/* Allocates memory */
-string *allot_string_internal(cell capacity)
+string *factor_vm::allot_string_internal(cell capacity)
{
string *str = allot<string>(string_size(capacity));
}
/* Allocates memory */
-void fill_string(string *str_, cell start, cell capacity, cell fill)
+void factor_vm::fill_string(string *str_, cell start, cell capacity, cell fill)
{
- gc_root<string> str(str_);
+ gc_root<string> str(str_,this);
if(fill <= 0x7f)
memset(&str->data()[start],fill,capacity - start);
}
/* Allocates memory */
-string *allot_string(cell capacity, cell fill)
+string *factor_vm::allot_string(cell capacity, cell fill)
{
- gc_root<string> str(allot_string_internal(capacity));
+ gc_root<string> str(allot_string_internal(capacity),this);
fill_string(str.untagged(),0,capacity,fill);
return str.untagged();
}
-PRIMITIVE(string)
+void factor_vm::primitive_string()
{
cell initial = to_cell(dpop());
cell length = unbox_array_size();
dpush(tag<string>(allot_string(length,initial)));
}
-static bool reallot_string_in_place_p(string *str, cell capacity)
+bool factor_vm::reallot_string_in_place_p(string *str, cell capacity)
{
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)
+string* factor_vm::reallot_string(string *str_, cell capacity)
{
- gc_root<string> str(str_);
+ gc_root<string> str(str_,this);
if(reallot_string_in_place_p(str.untagged(),capacity))
{
if(capacity < to_copy)
to_copy = capacity;
- gc_root<string> new_str(allot_string_internal(capacity));
+ gc_root<string> new_str(allot_string_internal(capacity),this);
memcpy(new_str->data(),str->data(),to_copy);
}
}
-PRIMITIVE(resize_string)
+void factor_vm::primitive_resize_string()
{
string* str = untag_check<string>(dpop());
cell capacity = unbox_array_size();
dpush(tag<string>(reallot_string(str,capacity)));
}
-PRIMITIVE(string_nth)
+void factor_vm::primitive_string_nth()
{
string *str = untag<string>(dpop());
cell index = untag_fixnum(dpop());
dpush(tag_fixnum(string_nth(str,index)));
}
-PRIMITIVE(set_string_nth_fast)
+void factor_vm::primitive_set_string_nth_fast()
{
string *str = untag<string>(dpop());
cell index = untag_fixnum(dpop());
set_string_nth_fast(str,index,value);
}
-PRIMITIVE(set_string_nth_slow)
+void factor_vm::primitive_set_string_nth_slow()
{
string *str = untag<string>(dpop());
cell index = untag_fixnum(dpop());
return sizeof(string) + size;
}
-string* allot_string_internal(cell capacity);
-string* allot_string(cell capacity, cell fill);
-PRIMITIVE(string);
-string *reallot_string(string *string, cell capacity);
-PRIMITIVE(resize_string);
-
-/* String getters and setters */
-cell string_nth(string* string, cell index);
-void set_string_nth(string* string, cell index, cell value);
-
-PRIMITIVE(string_nth);
-PRIMITIVE(set_string_nth_slow);
-PRIMITIVE(set_string_nth_fast);
-
}
namespace factor
{
-template <typename T> cell tag(T *value)
+template<typename Type> cell tag(Type *value)
{
- return RETAG(value,tag_for(T::type_number));
+ return RETAG(value,tag_for(Type::type_number));
}
inline static cell tag_dynamic(object *value)
return RETAG(value,tag_for(value->h.hi_tag()));
}
-template <typename T>
+template<typename Type>
struct tagged
{
cell value_;
cell value() const { return value_; }
- T *untagged() const { return (T *)(UNTAG(value_)); }
+ Type *untagged() const { return (Type *)(UNTAG(value_)); }
cell type() const {
cell tag = TAG(value_);
bool type_p(cell type_) const { return type() == type_; }
- T *untag_check() const {
- if(T::type_number != TYPE_COUNT && !type_p(T::type_number))
- type_error(T::type_number,value_);
+ Type *untag_check(factor_vm *myvm) const {
+ if(Type::type_number != TYPE_COUNT && !type_p(Type::type_number))
+ myvm->type_error(Type::type_number,value_);
return untagged();
}
explicit tagged(cell tagged) : value_(tagged) {
#ifdef FACTOR_DEBUG
- untag_check();
+ untag_check(SIGNAL_VM_PTR());
#endif
}
- explicit tagged(T *untagged) : value_(factor::tag(untagged)) {
+ explicit tagged(Type *untagged) : value_(factor::tag(untagged)) {
#ifdef FACTOR_DEBUG
- untag_check();
+ untag_check(SIGNAL_VM_PTR());
#endif
}
- T *operator->() const { return untagged(); }
+ Type *operator->() const { return untagged(); }
cell *operator&() const { return &value_; }
- const tagged<T>& operator=(const T *x) { value_ = tag(x); return *this; }
- const tagged<T>& operator=(const cell &x) { value_ = x; return *this; }
+ const tagged<Type> &operator=(const Type *x) { value_ = tag(x); return *this; }
+ const tagged<Type> &operator=(const cell &x) { value_ = x; return *this; }
- bool operator==(const tagged<T> &x) { return value_ == x.value_; }
- bool operator!=(const tagged<T> &x) { return value_ != x.value_; }
+ bool operator==(const tagged<Type> &x) { return value_ == x.value_; }
+ bool operator!=(const tagged<Type> &x) { return value_ != x.value_; }
- template<typename X> tagged<X> as() { return tagged<X>(value_); }
+ template<typename NewType> tagged<NewType> as() { return tagged<NewType>(value_); }
};
-template <typename T> T *untag_check(cell value)
+template<typename Type> Type *factor_vm::untag_check(cell value)
{
- return tagged<T>(value).untag_check();
+ return tagged<Type>(value).untag_check(this);
}
-template <typename T> T *untag(cell value)
+template<typename Type> Type *factor_vm::untag(cell value)
{
- return tagged<T>(value).untagged();
+ return tagged<Type>(value).untagged();
}
}
{
/* push a new tuple on the stack */
-tuple *allot_tuple(cell layout_)
+tuple *factor_vm::allot_tuple(cell layout_)
{
- gc_root<tuple_layout> layout(layout_);
- gc_root<tuple> t(allot<tuple>(tuple_size(layout.untagged())));
+ gc_root<tuple_layout> layout(layout_,this);
+ gc_root<tuple> t(allot<tuple>(tuple_size(layout.untagged())),this);
t->layout = layout.value();
return t.untagged();
}
-PRIMITIVE(tuple)
+void factor_vm::primitive_tuple()
{
- gc_root<tuple_layout> layout(dpop());
+ gc_root<tuple_layout> layout(dpop(),this);
tuple *t = allot_tuple(layout.value());
fixnum i;
for(i = tuple_size(layout.untagged()) - 1; i >= 0; i--)
}
/* push a new tuple on the stack, filling its slots from the stack */
-PRIMITIVE(tuple_boa)
+void factor_vm::primitive_tuple_boa()
{
- gc_root<tuple_layout> layout(dpop());
- gc_root<tuple> t(allot_tuple(layout.value()));
+ gc_root<tuple_layout> layout(dpop(),this);
+ gc_root<tuple> t(allot_tuple(layout.value()),this);
cell size = untag_fixnum(layout.untagged()->size) * sizeof(cell);
memcpy(t->data(),(cell *)(ds - (size - sizeof(cell))),size);
ds -= size;
return sizeof(tuple) + size * sizeof(cell);
}
-PRIMITIVE(tuple);
-PRIMITIVE(tuple_boa);
-PRIMITIVE(tuple_layout);
-
}
{
/* If memory allocation fails, bail out */
-void *safe_malloc(size_t size)
-{
- void *ptr = malloc(size);
- if(!ptr) fatal_error("Out of memory in safe_malloc", 0);
- return ptr;
-}
-
vm_char *safe_strdup(const vm_char *str)
{
vm_char *ptr = STRDUP(str);
cell cell;
if(scanf(CELL_HEX_FORMAT,&cell) < 0) exit(1);
return cell;
-};
+}
}
namespace factor
{
-
-void *safe_malloc(size_t size);
-vm_char *safe_strdup(const vm_char *str);
-
-void nl();
-void print_string(const char *str);
-void print_cell(cell x);
-void print_cell_hex(cell x);
-void print_cell_hex_pad(cell x);
-void print_fixnum(fixnum x);
-cell read_cell_hex();
-
+ vm_char *safe_strdup(const vm_char *str);
+ void print_string(const char *str);
+ void nl();
+ void print_cell(cell x);
+ void print_cell_hex(cell x);
+ void print_cell_hex_pad(cell x);
+ void print_fixnum(fixnum x);
+ cell read_cell_hex();
}
--- /dev/null
+#include "master.hpp"\r
+\r
+namespace factor\r
+{\r
+\r
+factor_vm::factor_vm() { }\r
+\r
+}\r
--- /dev/null
+namespace factor
+{
+
+struct factor_vm
+{
+ // First five fields accessed directly by assembler. See vm.factor
+ context *stack_chain;
+ zone nursery; /* new objects are allocated here */
+ cell cards_offset;
+ cell decks_offset;
+ cell userenv[USER_ENV]; /* TAGGED user environment data; see getenv/setenv prims */
+
+ // contexts
+ cell ds_size, rs_size;
+ context *unused_contexts;
+
+ void reset_datastack();
+ void reset_retainstack();
+ void fix_stacks();
+ void save_stacks();
+ context *alloc_context();
+ void dealloc_context(context *old_context);
+ void nest_stacks();
+ void unnest_stacks();
+ void init_stacks(cell ds_size_, cell rs_size_);
+ bool stack_to_array(cell bottom, cell top);
+ cell array_to_stack(array *array, cell bottom);
+ void primitive_datastack();
+ void primitive_retainstack();
+ void primitive_set_datastack();
+ void primitive_set_retainstack();
+ void primitive_check_datastack();
+
+ // run
+ /* Canonical T object. It's just a word */
+ cell T;
+
+ void primitive_getenv();
+ void primitive_setenv();
+ void primitive_exit();
+ void primitive_micros();
+ void primitive_sleep();
+ void primitive_set_slot();
+ void primitive_load_locals();
+ cell clone_object(cell obj_);
+ void primitive_clone();
+
+ // profiler
+ bool profiling_p;
+
+ void init_profiler();
+ code_block *compile_profiling_stub(cell word_);
+ void set_profiling(bool profiling);
+ void primitive_profiling();
+
+ // errors
+ /* Global variables used to pass fault handler state from signal handler to
+ user-space */
+ cell signal_number;
+ cell signal_fault_addr;
+ unsigned int signal_fpu_status;
+ stack_frame *signal_callstack_top;
+
+ void out_of_memory();
+ void critical_error(const char* msg, cell tagged);
+ void throw_error(cell error, stack_frame *callstack_top);
+ void not_implemented_error();
+ bool in_page(cell fault, cell area, cell area_size, int offset);
+ void memory_protection_error(cell addr, stack_frame *native_stack);
+ void signal_error(int signal, stack_frame *native_stack);
+ void divide_by_zero_error();
+ void fp_trap_error(unsigned int fpu_status, stack_frame *signal_callstack_top);
+ void primitive_call_clear();
+ void primitive_unimplemented();
+ void memory_signal_handler_impl();
+ void misc_signal_handler_impl();
+ void fp_signal_handler_impl();
+ void type_error(cell type, cell tagged);
+ void general_error(vm_error_type error, cell arg1, cell arg2, stack_frame *native_stack);
+
+ // bignum
+ int bignum_equal_p(bignum * x, bignum * y);
+ enum bignum_comparison bignum_compare(bignum * x, bignum * y);
+ bignum *bignum_add(bignum * x, bignum * y);
+ bignum *bignum_subtract(bignum * x, bignum * y);
+ bignum *bignum_multiply(bignum * x, bignum * y);
+ void bignum_divide(bignum * numerator, bignum * denominator, bignum * * quotient, bignum * * remainder);
+ bignum *bignum_quotient(bignum * numerator, bignum * denominator);
+ bignum *bignum_remainder(bignum * numerator, bignum * denominator);
+ cell bignum_to_cell(bignum * bignum);
+ fixnum bignum_to_fixnum(bignum * bignum);
+ s64 bignum_to_long_long(bignum * bignum);
+ u64 bignum_to_ulong_long(bignum * bignum);
+ double bignum_to_double(bignum * bignum);
+ bignum *double_to_bignum(double x);
+ int bignum_equal_p_unsigned(bignum * x, bignum * y);
+ enum bignum_comparison bignum_compare_unsigned(bignum * x, bignum * y);
+ bignum *bignum_add_unsigned(bignum * x, bignum * y, int negative_p);
+ bignum *bignum_subtract_unsigned(bignum * x, bignum * y);
+ bignum *bignum_multiply_unsigned(bignum * x, bignum * y, int negative_p);
+ bignum *bignum_multiply_unsigned_small_factor(bignum * x, bignum_digit_type y,int negative_p);
+ void bignum_destructive_add(bignum * bignum, bignum_digit_type n);
+ void bignum_destructive_scale_up(bignum * bignum, bignum_digit_type factor);
+ void bignum_divide_unsigned_large_denominator(bignum * numerator, bignum * denominator,
+ bignum * * quotient, bignum * * remainder, int q_negative_p, int r_negative_p);
+ void bignum_divide_unsigned_normalized(bignum * u, bignum * v, bignum * q);
+ bignum_digit_type bignum_divide_subtract(bignum_digit_type * v_start, bignum_digit_type * v_end,
+ bignum_digit_type guess, bignum_digit_type * u_start);
+ void bignum_divide_unsigned_medium_denominator(bignum * numerator,bignum_digit_type denominator,
+ bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ void bignum_destructive_normalization(bignum * source, bignum * target, int shift_left);
+ void bignum_destructive_unnormalization(bignum * bignum, int shift_right);
+ bignum_digit_type bignum_digit_divide(bignum_digit_type uh, bignum_digit_type ul,
+ bignum_digit_type v, bignum_digit_type * q) /* return value */;
+ bignum_digit_type bignum_digit_divide_subtract(bignum_digit_type v1, bignum_digit_type v2,
+ bignum_digit_type guess, bignum_digit_type * u);
+ void bignum_divide_unsigned_small_denominator(bignum * numerator, bignum_digit_type denominator,
+ bignum * * quotient, bignum * * remainder,int q_negative_p, int r_negative_p);
+ bignum_digit_type bignum_destructive_scale_down(bignum * bignum, bignum_digit_type denominator);
+ bignum * bignum_remainder_unsigned_small_denominator(bignum * n, bignum_digit_type d, int negative_p);
+ bignum *bignum_digit_to_bignum(bignum_digit_type digit, int negative_p);
+ bignum *allot_bignum(bignum_length_type length, int negative_p);
+ bignum * allot_bignum_zeroed(bignum_length_type length, int negative_p);
+ bignum *bignum_shorten_length(bignum * bignum, bignum_length_type length);
+ bignum *bignum_trim(bignum * bignum);
+ bignum *bignum_new_sign(bignum * x, int negative_p);
+ bignum *bignum_maybe_new_sign(bignum * x, int negative_p);
+ void bignum_destructive_copy(bignum * source, bignum * target);
+ bignum *bignum_bitwise_not(bignum * x);
+ bignum *bignum_arithmetic_shift(bignum * arg1, fixnum n);
+ bignum *bignum_bitwise_and(bignum * arg1, bignum * arg2);
+ bignum *bignum_bitwise_ior(bignum * arg1, bignum * arg2);
+ bignum *bignum_bitwise_xor(bignum * arg1, bignum * arg2);
+ bignum *bignum_magnitude_ash(bignum * arg1, fixnum n);
+ bignum *bignum_pospos_bitwise_op(int op, bignum * arg1, bignum * arg2);
+ bignum *bignum_posneg_bitwise_op(int op, bignum * arg1, bignum * arg2);
+ bignum *bignum_negneg_bitwise_op(int op, bignum * arg1, bignum * arg2);
+ void bignum_negate_magnitude(bignum * arg);
+ bignum *bignum_integer_length(bignum * x);
+ int bignum_logbitp(int shift, bignum * arg);
+ int bignum_unsigned_logbitp(int shift, bignum * bignum);
+ bignum *digit_stream_to_bignum(unsigned int n_digits, unsigned int (*producer)(unsigned int, factor_vm *), unsigned int radix, int negative_p);
+
+ //data_heap
+ bool secure_gc; /* Set by the -securegc command line argument */
+ bool gc_off; /* GC is off during heap walking */
+ data_heap *data;
+ /* A heap walk allows useful things to be done, like finding all
+ references to an object for debugging purposes. */
+ cell heap_scan_ptr;
+
+ void init_card_decks();
+ data_heap *grow_data_heap(data_heap *data, cell requested_bytes);
+ void clear_cards(cell from, cell to);
+ void clear_decks(cell from, cell to);
+ void clear_allot_markers(cell from, cell to);
+ void reset_generation(cell i);
+ void reset_generations(cell from, cell to);
+ void set_data_heap(data_heap *data_);
+ void init_data_heap(cell gens,cell young_size,cell aging_size,cell tenured_size,bool secure_gc_);
+ cell untagged_object_size(object *pointer);
+ cell unaligned_object_size(object *pointer);
+ void primitive_size();
+ cell binary_payload_start(object *pointer);
+ void primitive_data_room();
+ void begin_scan();
+ void end_scan();
+ void primitive_begin_scan();
+ cell next_object();
+ void primitive_next_object();
+ void primitive_end_scan();
+ template<typename Iterator> void each_object(Iterator &iterator);
+ cell find_all_words();
+ cell object_size(cell tagged);
+
+ //write barrier
+ cell allot_markers_offset;
+
+ inline card *addr_to_card(cell a)
+ {
+ return (card*)(((cell)(a) >> card_bits) + cards_offset);
+ }
+
+ inline cell card_to_addr(card *c)
+ {
+ return ((cell)c - cards_offset) << card_bits;
+ }
+
+ inline cell card_offset(card *c)
+ {
+ return *(c - (cell)data->cards + (cell)data->allot_markers);
+ }
+
+ inline card_deck *addr_to_deck(cell a)
+ {
+ return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
+ }
+
+ inline cell deck_to_addr(card_deck *c)
+ {
+ return ((cell)c - decks_offset) << deck_bits;
+ }
+
+ inline card *deck_to_card(card_deck *d)
+ {
+ return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
+ }
+
+ inline card *addr_to_allot_marker(object *a)
+ {
+ return (card *)(((cell)a >> card_bits) + allot_markers_offset);
+ }
+
+ /* the write barrier must be called any time we are potentially storing a
+ pointer from an older generation to a younger one */
+ inline void write_barrier(object *obj)
+ {
+ *addr_to_card((cell)obj) = card_mark_mask;
+ *addr_to_deck((cell)obj) = card_mark_mask;
+ }
+
+ /* we need to remember the first object allocated in the card */
+ inline void allot_barrier(object *address)
+ {
+ card *ptr = addr_to_allot_marker(address);
+ if(*ptr == invalid_allot_marker)
+ *ptr = ((cell)address & addr_card_mask);
+ }
+
+ // data_gc
+ /* used during garbage collection only */
+ gc_state *current_gc;
+ /* statistics */
+ gc_stats stats[max_gen_count];
+ u64 cards_scanned;
+ u64 decks_scanned;
+ u64 card_scan_time;
+ cell code_heap_scans;
+ /* What generation was being collected when trace_code_heap_roots() was last
+ called? Until the next call to add_code_block(), future
+ collections of younger generations don't have to touch the code
+ heap. */
+ cell last_code_heap_scan;
+
+ void init_data_gc();
+ object *copy_untagged_object_impl(object *pointer, cell size);
+ object *copy_object_impl(object *untagged);
+ bool should_copy_p(object *untagged);
+ object *resolve_forwarding(object *untagged);
+ template<typename Type> Type *copy_untagged_object(Type *untagged);
+ cell copy_object(cell pointer);
+ void trace_handle(cell *handle);
+ void trace_card(card *ptr, cell gen, cell here);
+ void trace_card_deck(card_deck *deck, cell gen, card mask, card unmask);
+ void trace_generation_cards(cell gen);
+ void trace_cards();
+ void trace_stack_elements(segment *region, cell top);
+ void trace_registered_locals();
+ void trace_registered_bignums();
+ void trace_roots();
+ void trace_contexts();
+ void update_code_heap_roots();
+ cell copy_next_from_nursery(cell scan);
+ cell copy_next_from_aging(cell scan);
+ cell copy_next_from_tenured(cell scan);
+ void copy_reachable_objects(cell scan, cell *end);
+ void free_unmarked_code_blocks();
+ void update_dirty_code_blocks();
+ void begin_gc(cell requested_bytes);
+ void end_gc();
+ void garbage_collection(cell gen, bool growing_data_heap, bool trace_contexts, cell requested_bytes);
+ void gc();
+ void primitive_gc();
+ void primitive_gc_stats();
+ void clear_gc_stats();
+ void primitive_become();
+ void inline_gc(cell *gc_roots_base, cell gc_roots_size);
+ inline object *allot_zone(zone *z, cell a);
+ object *allot_object(header header, cell size);
+ void primitive_clear_gc_stats();
+
+ template<typename Type> Type *allot(cell size)
+ {
+ return (Type *)allot_object(header(Type::type_number),size);
+ }
+
+ inline void check_data_pointer(object *pointer)
+ {
+ #ifdef FACTOR_DEBUG
+ if(!(current_gc && current_gc->growing_data_heap))
+ {
+ assert((cell)pointer >= data->seg->start
+ && (cell)pointer < data->seg->end);
+ }
+ #endif
+ }
+
+ inline void check_tagged_pointer(cell tagged)
+ {
+ #ifdef FACTOR_DEBUG
+ if(!immediate_p(tagged))
+ {
+ object *obj = untag<object>(tagged);
+ check_data_pointer(obj);
+ obj->h.hi_tag();
+ }
+ #endif
+ }
+
+ // local roots
+ /* If a runtime function needs to call another function which potentially
+ allocates memory, it must wrap any local variable references to Factor
+ objects in gc_root instances */
+ std::vector<cell> gc_locals;
+ std::vector<cell> gc_bignums;
+
+ // generic arrays
+ template<typename Array> Array *allot_array_internal(cell capacity);
+ template<typename Array> bool reallot_array_in_place_p(Array *array, cell capacity);
+ template<typename Array> Array *reallot_array(Array *array_, cell capacity);
+
+ //debug
+ bool fep_disabled;
+ bool full_output;
+
+ void print_chars(string* str);
+ void print_word(word* word, cell nesting);
+ void print_factor_string(string* str);
+ void print_array(array* array, cell nesting);
+ void print_tuple(tuple *tuple, cell nesting);
+ void print_nested_obj(cell obj, fixnum nesting);
+ void print_obj(cell obj);
+ void print_objects(cell *start, cell *end);
+ void print_datastack();
+ void print_retainstack();
+ void print_callstack();
+ void dump_cell(cell x);
+ void dump_memory(cell from, cell to);
+ void dump_zone(zone *z);
+ void dump_generations();
+ void dump_objects(cell type);
+ void find_data_references_step(cell *scan);
+ void find_data_references(cell look_for_);
+ void dump_code_heap();
+ void factorbug();
+ void primitive_die();
+
+ //arrays
+ array *allot_array(cell capacity, cell fill_);
+ void primitive_array();
+ cell allot_array_1(cell obj_);
+ cell allot_array_2(cell v1_, cell v2_);
+ cell allot_array_4(cell v1_, cell v2_, cell v3_, cell v4_);
+ void primitive_resize_array();
+ inline void set_array_nth(array *array, cell slot, cell value);
+
+ //strings
+ cell string_nth(string* str, cell index);
+ void set_string_nth_fast(string *str, cell index, cell ch);
+ void set_string_nth_slow(string *str_, cell index, cell ch);
+ void set_string_nth(string *str, cell index, cell ch);
+ string *allot_string_internal(cell capacity);
+ void fill_string(string *str_, cell start, cell capacity, cell fill);
+ string *allot_string(cell capacity, cell fill);
+ void primitive_string();
+ bool reallot_string_in_place_p(string *str, cell capacity);
+ string* reallot_string(string *str_, cell capacity);
+ void primitive_resize_string();
+ void primitive_string_nth();
+ void primitive_set_string_nth_fast();
+ void primitive_set_string_nth_slow();
+
+ //booleans
+ void box_boolean(bool value);
+ bool to_boolean(cell value);
+ inline cell tag_boolean(cell untagged);
+
+ //byte arrays
+ byte_array *allot_byte_array(cell size);
+ void primitive_byte_array();
+ void primitive_uninitialized_byte_array();
+ void primitive_resize_byte_array();
+
+ //tuples
+ tuple *allot_tuple(cell layout_);
+ void primitive_tuple();
+ void primitive_tuple_boa();
+
+ //words
+ word *allot_word(cell name_, cell vocab_, cell hashcode_);
+ void primitive_word();
+ void primitive_word_xt();
+ void update_word_xt(cell w_);
+ void primitive_optimized_p();
+ void primitive_wrapper();
+
+ //math
+ cell bignum_zero;
+ cell bignum_pos_one;
+ cell bignum_neg_one;
+
+ void primitive_bignum_to_fixnum();
+ void primitive_float_to_fixnum();
+ void primitive_fixnum_divint();
+ void primitive_fixnum_divmod();
+ bignum *fixnum_to_bignum(fixnum);
+ bignum *cell_to_bignum(cell);
+ bignum *long_long_to_bignum(s64 n);
+ bignum *ulong_long_to_bignum(u64 n);
+ inline fixnum sign_mask(fixnum x);
+ inline fixnum branchless_max(fixnum x, fixnum y);
+ inline fixnum branchless_abs(fixnum x);
+ void primitive_fixnum_shift();
+ void primitive_fixnum_to_bignum();
+ void primitive_float_to_bignum();
+ void primitive_bignum_eq();
+ void primitive_bignum_add();
+ void primitive_bignum_subtract();
+ void primitive_bignum_multiply();
+ void primitive_bignum_divint();
+ void primitive_bignum_divmod();
+ void primitive_bignum_mod();
+ void primitive_bignum_and();
+ void primitive_bignum_or();
+ void primitive_bignum_xor();
+ void primitive_bignum_shift();
+ void primitive_bignum_less();
+ void primitive_bignum_lesseq();
+ void primitive_bignum_greater();
+ void primitive_bignum_greatereq();
+ void primitive_bignum_not();
+ void primitive_bignum_bitp();
+ void primitive_bignum_log2();
+ unsigned int bignum_producer(unsigned int digit);
+ void primitive_byte_array_to_bignum();
+ cell unbox_array_size();
+ void primitive_fixnum_to_float();
+ void primitive_bignum_to_float();
+ void primitive_str_to_float();
+ void primitive_float_to_str();
+ 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_float_bits();
+ void primitive_bits_float();
+ void primitive_double_bits();
+ void primitive_bits_double();
+ fixnum to_fixnum(cell tagged);
+ cell to_cell(cell tagged);
+ void box_signed_1(s8 n);
+ void box_unsigned_1(u8 n);
+ void box_signed_2(s16 n);
+ void box_unsigned_2(u16 n);
+ void box_signed_4(s32 n);
+ void box_unsigned_4(u32 n);
+ void box_signed_cell(fixnum integer);
+ void box_unsigned_cell(cell cell);
+ void box_signed_8(s64 n);
+ s64 to_signed_8(cell obj);
+ void box_unsigned_8(u64 n);
+ u64 to_unsigned_8(cell obj);
+ void box_float(float flo);
+ float to_float(cell value);
+ void box_double(double flo);
+ double to_double(cell value);
+ inline void overflow_fixnum_add(fixnum x, fixnum y);
+ inline void overflow_fixnum_subtract(fixnum x, fixnum y);
+ inline void overflow_fixnum_multiply(fixnum x, fixnum y);
+ inline cell allot_integer(fixnum x);
+ inline cell allot_cell(cell x);
+ inline cell allot_float(double n);
+ inline bignum *float_to_bignum(cell tagged);
+ inline double bignum_to_float(cell tagged);
+ inline double untag_float(cell tagged);
+ inline double untag_float_check(cell tagged);
+ inline fixnum float_to_fixnum(cell tagged);
+ inline double fixnum_to_float(cell tagged);
+ template<typename Type> Type *untag_check(cell value);
+ template<typename Type> Type *untag(cell value);
+
+ //io
+ void init_c_io();
+ void io_error();
+ void primitive_fopen();
+ void primitive_fgetc();
+ void primitive_fread();
+ void primitive_fputc();
+ void primitive_fwrite();
+ void primitive_ftell();
+ void primitive_fseek();
+ void primitive_fflush();
+ void primitive_fclose();
+
+ //code_block
+ relocation_type relocation_type_of(relocation_entry r);
+ relocation_class relocation_class_of(relocation_entry r);
+ cell relocation_offset_of(relocation_entry r);
+ void flush_icache_for(code_block *block);
+ int number_of_parameters(relocation_type type);
+ void *object_xt(cell obj);
+ void *xt_pic(word *w, cell tagged_quot);
+ void *word_xt_pic(word *w);
+ void *word_xt_pic_tail(word *w);
+ void undefined_symbol();
+ void *get_rel_symbol(array *literals, cell index);
+ cell compute_relocation(relocation_entry rel, cell index, code_block *compiled);
+ template<typename Iterator> void iterate_relocations(code_block *compiled, Iterator &iter);
+ void store_address_2_2(cell *ptr, cell value);
+ void store_address_masked(cell *ptr, fixnum value, cell mask, fixnum shift);
+ void store_address_in_code_block(cell klass, cell offset, fixnum absolute_value);
+ void update_literal_references(code_block *compiled);
+ void trace_literal_references(code_block *compiled);
+ void relocate_code_block_step(relocation_entry rel, cell index, code_block *compiled);
+ void update_word_references(code_block *compiled);
+ void check_code_address(cell address);
+ void mark_code_block(code_block *compiled);
+ void mark_active_blocks(context *stacks);
+ void mark_object_code_block(object *object);
+ void relocate_code_block(code_block *compiled);
+ void fixup_labels(array *labels, code_block *compiled);
+ code_block *allot_code_block(cell size);
+ code_block *add_code_block(cell type,cell code_,cell labels_,cell relocation_,cell literals_);
+ inline bool stack_traces_p()
+ {
+ return userenv[STACK_TRACES_ENV] != F;
+ }
+
+ //code_heap
+ heap *code;
+ unordered_map<heap_block *, char *> forwarding;
+
+ void init_code_heap(cell size);
+ bool in_code_heap_p(cell ptr);
+ void jit_compile_word(cell word_, cell def_, bool relocate);
+ void trace_code_heap_roots();
+ void update_code_heap_words();
+ void primitive_modify_code_heap();
+ void primitive_code_room();
+ code_block *forward_xt(code_block *compiled);
+ void forward_object_xts();
+ void fixup_object_xts();
+ void compact_code_heap();
+ inline void check_code_pointer(cell ptr);
+
+ /* Apply a function to every code block */
+ template<typename Iterator> void iterate_code_heap(Iterator &iter)
+ {
+ heap_block *scan = code->first_block();
+
+ while(scan)
+ {
+ if(scan->status != B_FREE)
+ iter((code_block *)scan);
+ scan = code->next_block(scan);
+ }
+ }
+
+ //image
+ cell code_relocation_base;
+ cell data_relocation_base;
+
+ void init_objects(image_header *h);
+ void load_data_heap(FILE *file, image_header *h, vm_parameters *p);
+ void load_code_heap(FILE *file, image_header *h, vm_parameters *p);
+ bool save_image(const vm_char *filename);
+ void primitive_save_image();
+ void primitive_save_image_and_exit();
+ void data_fixup(cell *cell);
+ template<typename Type> void code_fixup(Type **handle);
+ void fixup_word(word *word);
+ void fixup_quotation(quotation *quot);
+ void fixup_alien(alien *d);
+ void fixup_callstack_object(callstack *stack);
+ void relocate_object(object *object);
+ void relocate_data();
+ void fixup_code_block(code_block *compiled);
+ void relocate_code();
+ void load_image(vm_parameters *p);
+
+ //callstack
+ template<typename Iterator> void iterate_callstack_object(callstack *stack_, Iterator &iterator);
+ void check_frame(stack_frame *frame);
+ callstack *allot_callstack(cell size);
+ stack_frame *fix_callstack_top(stack_frame *top, stack_frame *bottom);
+ stack_frame *capture_start();
+ void primitive_callstack();
+ void primitive_set_callstack();
+ code_block *frame_code(stack_frame *frame);
+ cell frame_type(stack_frame *frame);
+ cell frame_executing(stack_frame *frame);
+ stack_frame *frame_successor(stack_frame *frame);
+ cell frame_scan(stack_frame *frame);
+ void primitive_callstack_to_array();
+ stack_frame *innermost_stack_frame(callstack *stack);
+ stack_frame *innermost_stack_frame_quot(callstack *callstack);
+ void primitive_innermost_stack_frame_executing();
+ void primitive_innermost_stack_frame_scan();
+ void primitive_set_innermost_stack_frame_quot();
+ void save_callstack_bottom(stack_frame *callstack_bottom);
+ template<typename Iterator> void iterate_callstack(cell top, cell bottom, Iterator &iterator);
+
+ /* Every object has a regular representation in the runtime, which makes GC
+ much simpler. Every slot of the object until binary_payload_start is a pointer
+ to some other object. */
+ template<typename Iterator> void do_slots(cell obj, Iterator &iter)
+ {
+ cell scan = obj;
+ cell payload_start = binary_payload_start((object *)obj);
+ cell end = obj + payload_start;
+
+ scan += sizeof(cell);
+
+ while(scan < end)
+ {
+ iter((cell *)scan);
+ scan += sizeof(cell);
+ }
+ }
+
+ //alien
+ char *pinned_alien_offset(cell obj);
+ cell allot_alien(cell delegate_, cell displacement);
+ void primitive_displaced_alien();
+ void primitive_alien_address();
+ void *alien_pointer();
+ void primitive_dlopen();
+ void primitive_dlsym();
+ void primitive_dlclose();
+ void primitive_dll_validp();
+ void primitive_vm_ptr();
+ char *alien_offset(cell obj);
+ char *unbox_alien();
+ void box_alien(void *ptr);
+ void to_value_struct(cell src, void *dest, cell size);
+ void box_value_struct(void *src, cell size);
+ void box_small_struct(cell x, cell y, cell size);
+ void box_medium_struct(cell x1, cell x2, cell x3, cell x4, cell size);
+
+ //quotations
+ void primitive_jit_compile();
+ void primitive_array_to_quotation();
+ void primitive_quotation_xt();
+ void set_quot_xt(quotation *quot, code_block *code);
+ void jit_compile(cell quot_, bool relocating);
+ void compile_all_words();
+ fixnum quot_code_offset_to_scan(cell quot_, cell offset);
+ cell lazy_jit_compile_impl(cell quot_, stack_frame *stack);
+ void primitive_quot_compiled_p();
+
+ //dispatch
+ cell megamorphic_cache_hits;
+ cell megamorphic_cache_misses;
+
+ cell search_lookup_alist(cell table, cell klass);
+ cell search_lookup_hash(cell table, cell klass, cell hashcode);
+ cell nth_superclass(tuple_layout *layout, fixnum echelon);
+ cell nth_hashcode(tuple_layout *layout, fixnum echelon);
+ cell lookup_tuple_method(cell obj, cell methods);
+ cell lookup_hi_tag_method(cell obj, cell methods);
+ cell lookup_hairy_method(cell obj, cell methods);
+ cell lookup_method(cell obj, cell methods);
+ void primitive_lookup_method();
+ cell object_class(cell obj);
+ cell method_cache_hashcode(cell klass, array *array);
+ void update_method_cache(cell cache, cell klass, cell method);
+ void primitive_mega_cache_miss();
+ void primitive_reset_dispatch_stats();
+ void primitive_dispatch_stats();
+
+ //inline cache
+ cell max_pic_size;
+ cell cold_call_to_ic_transitions;
+ cell ic_to_pic_transitions;
+ cell pic_to_mega_transitions;
+ cell pic_counts[4]; /* PIC_TAG, PIC_HI_TAG, PIC_TUPLE, PIC_HI_TAG_TUPLE */
+
+ void init_inline_caching(int max_size);
+ void deallocate_inline_cache(cell return_address);
+ cell determine_inline_cache_type(array *cache_entries);
+ void update_pic_count(cell type);
+ code_block *compile_inline_cache(fixnum index,cell generic_word_,cell methods_,cell cache_entries_,bool tail_call_p);
+ void *megamorphic_call_stub(cell generic_word);
+ cell inline_cache_size(cell cache_entries);
+ cell add_inline_cache_entry(cell cache_entries_, cell klass_, cell method_);
+ void update_pic_transitions(cell pic_size);
+ void *inline_cache_miss(cell return_address);
+ void primitive_reset_inline_cache_stats();
+ void primitive_inline_cache_stats();
+
+ //factor
+ void default_parameters(vm_parameters *p);
+ bool factor_arg(const vm_char* str, const vm_char* arg, cell* value);
+ void init_parameters_from_args(vm_parameters *p, int argc, vm_char **argv);
+ void do_stage1_init();
+ void init_factor(vm_parameters *p);
+ void pass_args_to_factor(int argc, vm_char **argv);
+ void start_factor(vm_parameters *p);
+ void start_embedded_factor(vm_parameters *p);
+ void start_standalone_factor(int argc, vm_char **argv);
+ char *factor_eval_string(char *string);
+ void factor_eval_free(char *result);
+ void factor_yield();
+ void factor_sleep(long us);
+
+ // os-*
+ void primitive_existsp();
+ void init_ffi();
+ void ffi_dlopen(dll *dll);
+ void *ffi_dlsym(dll *dll, symbol_char *symbol);
+ void ffi_dlclose(dll *dll);
+ void c_to_factor_toplevel(cell quot);
+
+ // os-windows
+ #if defined(WINDOWS)
+ void sleep_micros(u64 usec);
+ const vm_char *vm_executable_path();
+ const vm_char *default_image_path();
+ void windows_image_path(vm_char *full_path, vm_char *temp_path, unsigned int length);
+ bool windows_stat(vm_char *path);
+
+ #if defined(WINNT)
+ void open_console();
+ LONG exception_handler(PEXCEPTION_POINTERS pe);
+ // next method here:
+ #endif
+ #else // UNIX
+ void memory_signal_handler(int signal, siginfo_t *siginfo, void *uap);
+ void misc_signal_handler(int signal, siginfo_t *siginfo, void *uap);
+ void fpe_signal_handler(int signal, siginfo_t *siginfo, void *uap);
+ stack_frame *uap_stack_pointer(void *uap);
+
+ #endif
+
+ #ifdef __APPLE__
+ void call_fault_handler(exception_type_t exception, exception_data_type_t code, MACH_EXC_STATE_TYPE *exc_state, MACH_THREAD_STATE_TYPE *thread_state, MACH_FLOAT_STATE_TYPE *float_state);
+ #endif
+
+ factor_vm();
+
+};
+
+#ifndef FACTOR_REENTRANT
+ #define FACTOR_SINGLE_THREADED_TESTING
+#endif
+
+#ifdef FACTOR_SINGLE_THREADED_SINGLETON
+/* calls are dispatched using the singleton vm ptr */
+ extern factor_vm *vm;
+ #define PRIMITIVE_GETVM() vm
+ #define PRIMITIVE_OVERFLOW_GETVM() vm
+ #define VM_PTR vm
+ #define ASSERTVM()
+ #define SIGNAL_VM_PTR() vm
+#endif
+
+#ifdef FACTOR_SINGLE_THREADED_TESTING
+/* calls are dispatched as per multithreaded, but checked against singleton */
+ extern factor_vm *vm;
+ #define ASSERTVM() assert(vm==myvm)
+ #define PRIMITIVE_GETVM() ((factor_vm*)myvm)
+ #define PRIMITIVE_OVERFLOW_GETVM() ASSERTVM(); myvm
+ #define VM_PTR myvm
+ #define SIGNAL_VM_PTR() tls_vm()
+#endif
+
+#ifdef FACTOR_REENTRANT_TLS
+/* uses thread local storage to obtain vm ptr */
+ #define PRIMITIVE_GETVM() tls_vm()
+ #define PRIMITIVE_OVERFLOW_GETVM() tls_vm()
+ #define VM_PTR tls_vm()
+ #define ASSERTVM()
+ #define SIGNAL_VM_PTR() tls_vm()
+#endif
+
+#ifdef FACTOR_REENTRANT
+ #define PRIMITIVE_GETVM() ((factor_vm*)myvm)
+ #define PRIMITIVE_OVERFLOW_GETVM() ((factor_vm*)myvm)
+ #define VM_PTR myvm
+ #define ASSERTVM()
+ #define SIGNAL_VM_PTR() tls_vm()
+#endif
+
+extern unordered_map<THREADHANDLE, factor_vm *> thread_vms;
+
+}
namespace factor
{
-word *allot_word(cell vocab_, cell name_)
+word *factor_vm::allot_word(cell name_, cell vocab_, cell hashcode_)
{
- gc_root<object> vocab(vocab_);
- gc_root<object> name(name_);
+ gc_root<object> vocab(vocab_,this);
+ gc_root<object> name(name_,this);
- gc_root<word> new_word(allot<word>(sizeof(word)));
+ gc_root<word> new_word(allot<word>(sizeof(word)),this);
- new_word->hashcode = tag_fixnum((rand() << 16) ^ rand());
+ new_word->hashcode = hashcode_;
new_word->vocabulary = vocab.value();
new_word->name = name.value();
new_word->def = userenv[UNDEFINED_ENV];
return new_word.untagged();
}
-/* <word> ( name vocabulary -- word ) */
-PRIMITIVE(word)
+/* (word) ( name vocabulary hashcode -- word ) */
+void factor_vm::primitive_word()
{
+ cell hashcode = dpop();
cell vocab = dpop();
cell name = dpop();
- dpush(tag<word>(allot_word(vocab,name)));
+ dpush(tag<word>(allot_word(name,vocab,hashcode)));
}
/* word-xt ( word -- start end ) */
-PRIMITIVE(word_xt)
+void factor_vm::primitive_word_xt()
{
- word *w = untag_check<word>(dpop());
- code_block *code = (profiling_p ? w->profiling : w->code);
- dpush(allot_cell((cell)code->xt()));
- dpush(allot_cell((cell)code + code->size));
+ gc_root<word> w(dpop(),this);
+ w.untag_check(this);
+
+ if(profiling_p)
+ {
+ dpush(allot_cell((cell)w->profiling->xt()));
+ dpush(allot_cell((cell)w->profiling + w->profiling->size));
+ }
+ else
+ {
+ dpush(allot_cell((cell)w->code->xt()));
+ dpush(allot_cell((cell)w->code + w->code->size));
+ }
}
/* Allocates memory */
-void update_word_xt(cell w_)
+void factor_vm::update_word_xt(cell w_)
{
- gc_root<word> w(w_);
+ gc_root<word> w(w_,this);
if(profiling_p)
{
if(!w->profiling)
- w->profiling = compile_profiling_stub(w.value());
+ {
+ /* Note: can't do w->profiling = ... since if LHS
+ evaluates before RHS, since in that case if RHS does a
+ GC, we will have an invalid pointer on the LHS */
+ code_block *profiling = compile_profiling_stub(w.value());
+ w->profiling = profiling;
+ }
w->xt = w->profiling->xt();
}
w->xt = w->code->xt();
}
-PRIMITIVE(optimized_p)
+void factor_vm::primitive_optimized_p()
{
drepl(tag_boolean(word_optimized_p(untag_check<word>(dpeek()))));
}
-PRIMITIVE(wrapper)
+void factor_vm::primitive_wrapper()
{
wrapper *new_wrapper = allot<wrapper>(sizeof(wrapper));
new_wrapper->object = dpeek();
namespace factor
{
-word *allot_word(cell vocab, cell name);
-
-PRIMITIVE(word);
-PRIMITIVE(word_xt);
-void update_word_xt(cell word);
-
inline bool word_optimized_p(word *word)
{
return word->code->type == WORD_TYPE;
}
-PRIMITIVE(optimized_p);
-
-PRIMITIVE(wrapper);
-
}
using namespace factor;
-cell cards_offset;
-cell decks_offset;
-
-namespace factor
-{
- cell allot_markers_offset;
-}
the offset of the first object is set by the allocator. */
-VM_C_API factor::cell cards_offset;
-VM_C_API factor::cell decks_offset;
-
namespace factor
{
static const cell card_size = (1<<card_bits);
static const cell addr_card_mask = (card_size-1);
-inline static card *addr_to_card(cell a)
-{
- return (card*)(((cell)(a) >> card_bits) + cards_offset);
-}
-
-inline static cell card_to_addr(card *c)
-{
- return ((cell)c - cards_offset) << card_bits;
-}
-
-inline static cell card_offset(card *c)
-{
- return *(c - (cell)data->cards + (cell)data->allot_markers);
-}
-
typedef u8 card_deck;
static const cell deck_bits = (card_bits + 10);
static const cell deck_size = (1<<deck_bits);
static const cell addr_deck_mask = (deck_size-1);
-
-inline static card_deck *addr_to_deck(cell a)
-{
- return (card_deck *)(((cell)a >> deck_bits) + decks_offset);
-}
-
-inline static cell deck_to_addr(card_deck *c)
-{
- return ((cell)c - decks_offset) << deck_bits;
-}
-
-inline static card *deck_to_card(card_deck *d)
-{
- return (card *)((((cell)d - decks_offset) << (deck_bits - card_bits)) + cards_offset);
-}
-
static const cell invalid_allot_marker = 0xff;
-extern cell allot_markers_offset;
-
-inline static card *addr_to_allot_marker(object *a)
-{
- return (card *)(((cell)a >> card_bits) + allot_markers_offset);
-}
-
-/* the write barrier must be called any time we are potentially storing a
-pointer from an older generation to a younger one */
-inline static void write_barrier(object *obj)
-{
- *addr_to_card((cell)obj) = card_mark_mask;
- *addr_to_deck((cell)obj) = card_mark_mask;
-}
-
-/* we need to remember the first object allocated in the card */
-inline static void allot_barrier(object *address)
-{
- card *ptr = addr_to_allot_marker(address);
- if(*ptr == invalid_allot_marker)
- *ptr = ((cell)address & addr_card_mask);
-}
-
}
projects / factor.git / commitdiff
