diff --git a/core/alien/alien-docs.factor b/core/alien/alien-docs.factor index 089091bec5..8fee0e8c3e 100755 --- a/core/alien/alien-docs.factor +++ b/core/alien/alien-docs.factor @@ -1,5 +1,5 @@ USING: byte-arrays arrays help.syntax help.markup -alien.syntax alien.c-types compiler definitions math libc +alien.syntax compiler definitions math libc debugger parser io io.backend system bit-arrays float-arrays ; IN: alien @@ -156,36 +156,6 @@ ARTICLE: "aliens" "Alien addresses" $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. See " { $link "c-types-specs" } "." ; -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 } " or " { $link malloc-object } "." -$nl -"Arrays of C structures can be created by calling " { $link } " or " { $link malloc-array } ". Elements can be read and written using words named " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } "; these words are automatically generated by " { $link POSTPONE: C-STRUCT: } "." ; - -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 structure objects can be allocated by calling " { $link } " or " { $link malloc-object } "." -$nl -"Arrays of C unions can be created by calling " { $link } " or " { $link malloc-array } ". Elements can be read and written using words named " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } "; these words are automatically generated by " { $link POSTPONE: C-UNION: } "." ; - 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 } @@ -253,211 +223,6 @@ $nl { $subsection dlsym } { $subsection dlclose } ; -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:" -{ $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" } } -} -"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." -$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." ; - -ARTICLE: "c-byte-arrays" "Passing data in byte arrays" -"Instances of the " { $link byte-array } ", " { $link bit-array } " and " { $link float-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 } " 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 } -{ $subsection } -{ $warning -"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the function does not store a pointer to the byte array in some global structure, or retain it in any way after returning." -$nl -"Long-lived data for use by C libraries can be allocated manually, just as when programming in C. See " { $link "malloc" } "." } -{ $see-also "c-arrays" } ; - -ARTICLE: "malloc" "Manual memory management" -"Sometimes data passed to C functions must be allocated at a fixed address, and so garbage collector managed byte arrays cannot be used. See the warning at the bottom of " { $link "c-byte-arrays" } " for a description 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 } -"The return value of the above three words must always be checked for a memory allocation failure:" -{ $subsection check-ptr } -"You must always free pointers returned by any of the above words when the block of memory is no longer in use:" -{ $subsection free } -"You can unsafely copy a range of bytes from one memory location to another:" -{ $subsection memcpy } -"A wrapper for temporarily allocating a block of memory:" -{ $subsection with-malloc } ; - -ARTICLE: "c-strings" "C strings" -"The C library interface defines two types of C strings:" -{ $table - { "C type" "Notes" } - { { $snippet "char*" } "8-bit per character null-terminated ASCII" } - { { $snippet "ushort*" } "16-bit per character null-terminated UCS-2" } -} -"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. 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." -"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>char-alien } -{ $subsection string>u16-alien } -{ $subsection malloc-char-string } -{ $subsection malloc-u16-string } -"The first two allocate " { $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 } "." -$nl -"Finally, a set of words can be used to read and write " { $snippet "char*" } " and " { $snippet "ushort*" } " strings at arbitrary addresses:" -{ $subsection alien>char-string } -{ $subsection alien>u16-string } -{ $subsection memory>string } -{ $subsection string>memory } ; - -ARTICLE: "c-arrays-factor" "Converting C arrays to and from Factor arrays" -"Each primitive C type has a pair of words, " { $snippet ">" { $emphasis "type" } "-array" } " and " { $snippet { $emphasis "type" } "-array>" } ", for converting an array of Factor objects to and from a " { $link byte-array } " of C values. This set of words consists of:" -{ $subsection >c-bool-array } -{ $subsection >c-char-array } -{ $subsection >c-double-array } -{ $subsection >c-float-array } -{ $subsection >c-int-array } -{ $subsection >c-long-array } -{ $subsection >c-longlong-array } -{ $subsection >c-short-array } -{ $subsection >c-uchar-array } -{ $subsection >c-uint-array } -{ $subsection >c-ulong-array } -{ $subsection >c-ulonglong-array } -{ $subsection >c-ushort-array } -{ $subsection >c-void*-array } -{ $subsection c-bool-array> } -{ $subsection c-char*-array> } -{ $subsection c-char-array> } -{ $subsection c-double-array> } -{ $subsection c-float-array> } -{ $subsection c-int-array> } -{ $subsection c-long-array> } -{ $subsection c-longlong-array> } -{ $subsection c-short-array> } -{ $subsection c-uchar-array> } -{ $subsection c-uint-array> } -{ $subsection c-ulong-array> } -{ $subsection c-ulonglong-array> } -{ $subsection c-ushort*-array> } -{ $subsection c-ushort-array> } -{ $subsection c-void*-array> } ; - -ARTICLE: "c-arrays-get/set" "Reading and writing elements in C arrays" -"Each C type has a pair of words, " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } ", for reading and writing values of this type stored in an array. This set of words includes but is not limited to:" -{ $subsection char-nth } -{ $subsection set-char-nth } -{ $subsection uchar-nth } -{ $subsection set-uchar-nth } -{ $subsection short-nth } -{ $subsection set-short-nth } -{ $subsection ushort-nth } -{ $subsection set-ushort-nth } -{ $subsection int-nth } -{ $subsection set-int-nth } -{ $subsection uint-nth } -{ $subsection set-uint-nth } -{ $subsection long-nth } -{ $subsection set-long-nth } -{ $subsection ulong-nth } -{ $subsection set-ulong-nth } -{ $subsection longlong-nth } -{ $subsection set-longlong-nth } -{ $subsection ulonglong-nth } -{ $subsection set-ulonglong-nth } -{ $subsection float-nth } -{ $subsection set-float-nth } -{ $subsection double-nth } -{ $subsection set-double-nth } -{ $subsection void*-nth } -{ $subsection set-void*-nth } -{ $subsection char*-nth } -{ $subsection ushort*-nth } ; - -ARTICLE: "c-arrays" "C arrays" -"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "." -$nl -"C type specifiers for array types are documented in " { $link "c-types-specs" } "." -{ $subsection "c-arrays-factor" } -{ $subsection "c-arrays-get/set" } ; - -ARTICLE: "c-out-params" "Output parameters in C" -"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 } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -{ $subsection } -"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* } -{ $subsection *char* } -{ $subsection *ushort* } -"Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link } " and " { $link *void* } " may be used." ; - -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. Also Factor's garbage collector can move objects in memory, which means that special support has to be provided for passing blocks of memory to C code." -{ $subsection "c-types-specs" } -{ $subsection "c-byte-arrays" } -{ $subsection "malloc" } -{ $subsection "c-strings" } -{ $subsection "c-arrays" } -{ $subsection "c-out-params" } -"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" } -{ $subsection "reading-writing-memory" } ; - ARTICLE: "embedding-api" "Factor embedding API" "The Factor embedding API is defined in " { $snippet "vm/master.h" } "." $nl diff --git a/core/alien/arrays/arrays-docs.factor b/core/alien/arrays/arrays-docs.factor new file mode 100755 index 0000000000..f3f27d0739 --- /dev/null +++ b/core/alien/arrays/arrays-docs.factor @@ -0,0 +1,73 @@ +IN: alien.arrays +USING: help.syntax help.markup byte-arrays alien.c-types ; + +ARTICLE: "c-arrays-factor" "Converting C arrays to and from Factor arrays" +"Each primitive C type has a pair of words, " { $snippet ">" { $emphasis "type" } "-array" } " and " { $snippet { $emphasis "type" } "-array>" } ", for converting an array of Factor objects to and from a " { $link byte-array } " of C values. This set of words consists of:" +{ $subsection >c-bool-array } +{ $subsection >c-char-array } +{ $subsection >c-double-array } +{ $subsection >c-float-array } +{ $subsection >c-int-array } +{ $subsection >c-long-array } +{ $subsection >c-longlong-array } +{ $subsection >c-short-array } +{ $subsection >c-uchar-array } +{ $subsection >c-uint-array } +{ $subsection >c-ulong-array } +{ $subsection >c-ulonglong-array } +{ $subsection >c-ushort-array } +{ $subsection >c-void*-array } +{ $subsection c-bool-array> } +{ $subsection c-char*-array> } +{ $subsection c-char-array> } +{ $subsection c-double-array> } +{ $subsection c-float-array> } +{ $subsection c-int-array> } +{ $subsection c-long-array> } +{ $subsection c-longlong-array> } +{ $subsection c-short-array> } +{ $subsection c-uchar-array> } +{ $subsection c-uint-array> } +{ $subsection c-ulong-array> } +{ $subsection c-ulonglong-array> } +{ $subsection c-ushort*-array> } +{ $subsection c-ushort-array> } +{ $subsection c-void*-array> } ; + +ARTICLE: "c-arrays-get/set" "Reading and writing elements in C arrays" +"Each C type has a pair of words, " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } ", for reading and writing values of this type stored in an array. This set of words includes but is not limited to:" +{ $subsection char-nth } +{ $subsection set-char-nth } +{ $subsection uchar-nth } +{ $subsection set-uchar-nth } +{ $subsection short-nth } +{ $subsection set-short-nth } +{ $subsection ushort-nth } +{ $subsection set-ushort-nth } +{ $subsection int-nth } +{ $subsection set-int-nth } +{ $subsection uint-nth } +{ $subsection set-uint-nth } +{ $subsection long-nth } +{ $subsection set-long-nth } +{ $subsection ulong-nth } +{ $subsection set-ulong-nth } +{ $subsection longlong-nth } +{ $subsection set-longlong-nth } +{ $subsection ulonglong-nth } +{ $subsection set-ulonglong-nth } +{ $subsection float-nth } +{ $subsection set-float-nth } +{ $subsection double-nth } +{ $subsection set-double-nth } +{ $subsection void*-nth } +{ $subsection set-void*-nth } +{ $subsection char*-nth } +{ $subsection ushort*-nth } ; + +ARTICLE: "c-arrays" "C arrays" +"C arrays are allocated in the same manner as other C data; see " { $link "c-byte-arrays" } " and " { $link "malloc" } "." +$nl +"C type specifiers for array types are documented in " { $link "c-types-specs" } "." +{ $subsection "c-arrays-factor" } +{ $subsection "c-arrays-get/set" } ; diff --git a/core/alien/c-types/c-types-docs.factor b/core/alien/c-types/c-types-docs.factor old mode 100644 new mode 100755 index 55b788d5e3..f6418295f7 --- a/core/alien/c-types/c-types-docs.factor +++ b/core/alien/c-types/c-types-docs.factor @@ -1,8 +1,10 @@ -USING: alien alien.c-types help.syntax help.markup libc -kernel.private byte-arrays math strings ; +IN: alien.c-types +USING: alien help.syntax help.markup libc kernel.private +byte-arrays math strings hashtables alien.syntax +bit-arrays float-arrays debugger ; HELP: -{ $values { "type" "a hashtable" } } +{ $values { "type" hashtable } } { $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 @@ -14,12 +16,12 @@ HELP: c-types { $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" "a hashtable" } } +{ $values { "name" string } { "type" hashtable } } { $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" "an integer" } } +{ $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:" @@ -28,7 +30,7 @@ HELP: heap-size { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; HELP: stack-size -{ $values { "type" string } { "size" "an integer" } } +{ $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." } ; @@ -78,13 +80,31 @@ HELP: alien>u16-string ( c-ptr -- string ) { $values { "c-ptr" c-ptr } { "string" string } } { $description "Reads a null-terminated UCS-2 string from the specified address." } ; -HELP: memory>string ( base len -- string ) -{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "string" string } } -{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new Factor string." } ; +HELP: memory>byte-array ( base len -- string ) +{ $values { "base" 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: string>memory ( string base -- ) +HELP: memory>char-string ( base len -- string ) +{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "string" string } } +{ $description "Reads " { $snippet "len" } " bytes starting from " { $snippet "base" } " and stores them in a new string." } ; + +HELP: memory>u16-string ( base len -- string ) +{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "string" string } } +{ $description "Reads " { $snippet "len" } " UCS2 characters starting from " { $snippet "base" } " and stores them in a new string." } ; + +HELP: byte-array>memory ( string base -- ) +{ $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: string>char-memory ( string base -- ) { $values { "string" string } { "base" c-ptr } } -{ $description "Writes the string to memory starting from the " { $snippet "base" } " address." } +{ $description "Writes a string to memory starting from the " { $snippet "base" } " address." } +{ $warning "This word is unsafe. Improper use can corrupt memory." } ; + +HELP: string>u16-memory ( string base -- ) +{ $values { "string" string } { "base" c-ptr } } +{ $description "Writes a string to memory starting from the " { $snippet "base" } " address." } { $warning "This word is unsafe. Improper use can corrupt memory." } ; HELP: malloc-array @@ -151,3 +171,143 @@ HELP: define-out { $values { "name" "a word name" } { "vocab" "a vocabulary name" } } { $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." } ; + +ARTICLE: "c-out-params" "Output parameters in C" +"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 } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +{ $subsection } +"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* } +{ $subsection *char* } +{ $subsection *ushort* } +"Note that while structure and union types do not get these words defined for them, there is no loss of generality since " { $link } " 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:" +{ $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" } } +} +"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." +$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." ; + +ARTICLE: "c-byte-arrays" "Passing data in byte arrays" +"Instances of the " { $link byte-array } ", " { $link bit-array } " and " { $link float-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 } " 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 } +{ $subsection } +{ $warning +"The Factor garbage collector can move byte arrays around, and it is only safe to pass byte arrays to C functions if the function does not store a pointer to the byte array in some global structure, or retain it in any way after returning." +$nl +"Long-lived data for use by C libraries can be allocated manually, just as when programming in C. See " { $link "malloc" } "." } +{ $see-also "c-arrays" } ; + +ARTICLE: "malloc" "Manual memory management" +"Sometimes data passed to C functions must be allocated at a fixed address, and so garbage collector managed byte arrays cannot be used. See the warning at the bottom of " { $link "c-byte-arrays" } " for a description 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 } +"The return value of the above three words must always be checked for a memory allocation failure:" +{ $subsection check-ptr } +"You must always free pointers returned by any of the above words when the block of memory is no longer in use:" +{ $subsection free } +"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 } +"A wrapper for temporarily allocating a block of memory:" +{ $subsection with-malloc } ; + +ARTICLE: "c-strings" "C strings" +"The C library interface defines two types of C strings:" +{ $table + { "C type" "Notes" } + { { $snippet "char*" } "8-bit per character null-terminated ASCII" } + { { $snippet "ushort*" } "16-bit per character null-terminated UCS-2" } +} +"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. 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." +"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>char-alien } +{ $subsection string>u16-alien } +{ $subsection malloc-char-string } +{ $subsection malloc-u16-string } +"The first two allocate " { $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 } "." +$nl +"Finally, a set of words can be used to read and write " { $snippet "char*" } " and " { $snippet "ushort*" } " strings at arbitrary addresses:" +{ $subsection alien>char-string } +{ $subsection alien>u16-string } +{ $subsection memory>char-string } +{ $subsection memory>u16-string } +{ $subsection string>char-memory } +{ $subsection string>u16-memory } ; + +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. Also Factor's garbage collector can move objects in memory, which means that special support has to be provided for passing blocks of memory to C code." +{ $subsection "c-types-specs" } +{ $subsection "c-byte-arrays" } +{ $subsection "malloc" } +{ $subsection "c-strings" } +{ $subsection "c-arrays" } +{ $subsection "c-out-params" } +"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" } +{ $subsection "reading-writing-memory" } ; diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 6d9c2cec14..1ecfa37ee6 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -138,6 +138,28 @@ M: c-type stack-size c-type-size ; : malloc-u16-string ( string -- alien ) string>u16-alien malloc-byte-array ; +: memory>byte-array ( alien len -- byte-array ) + dup [ -rot memcpy ] keep ; + +: memory>char-string ( alien len -- string ) + memory>byte-array >string ; + +DEFER: c-ushort-array> + +: memory>u16-string ( alien len -- string ) + [ memory>byte-array ] keep 2/ c-ushort-array> >string ; + +: byte-array>memory ( byte-array base -- ) + swap dup length memcpy ; + +: string>char-memory ( string base -- ) + >r >byte-array r> byte-array>memory ; + +DEFER: >c-ushort-array + +: string>u16-memory ( string base -- ) + >r >c-ushort-array r> byte-array>memory ; + : (define-nth) ( word type quot -- ) >r heap-size [ rot * ] swap add* r> append define-inline ; diff --git a/core/alien/structs/structs-docs.factor b/core/alien/structs/structs-docs.factor old mode 100644 new mode 100755 index 704a260825..fe19f29766 --- a/core/alien/structs/structs-docs.factor +++ b/core/alien/structs/structs-docs.factor @@ -1,6 +1,37 @@ -USING: alien.structs alien.c-types strings help.markup -sequences io arrays ; +IN: alien.structs +USING: alien.c-types strings help.markup help.syntax +alien.syntax sequences io arrays ; M: string slot-specs c-type struct-type-fields ; M: array ($instance) first ($instance) " array" write ; + +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 } " or " { $link malloc-object } "." +$nl +"Arrays of C structures can be created by calling " { $link } " or " { $link malloc-array } ". Elements can be read and written using words named " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } "; these words are automatically generated by " { $link POSTPONE: C-STRUCT: } "." ; + +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 structure objects can be allocated by calling " { $link } " or " { $link malloc-object } "." +$nl +"Arrays of C unions can be created by calling " { $link } " or " { $link malloc-array } ". Elements can be read and written using words named " { $snippet { $emphasis "type" } "-nth" } " and " { $snippet "set-" { $emphasis "type" } "-nth" } "; these words are automatically generated by " { $link POSTPONE: C-UNION: } "." ; diff --git a/core/alien/syntax/syntax-docs.factor b/core/alien/syntax/syntax-docs.factor index 09169e63b4..6565ea0e2c 100755 --- a/core/alien/syntax/syntax-docs.factor +++ b/core/alien/syntax/syntax-docs.factor @@ -88,8 +88,6 @@ HELP: typedef { $description "Alises 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." } ; -{ typedef POSTPONE: TYPEDEF: POSTPONE: TYPEDEF-IF: } related-words -{ POSTPONE: TYPEDEF: typedef POSTPONE: TYPEDEF-IF: } related-words { POSTPONE: TYPEDEF-IF: POSTPONE: TYPEDEF: typedef } related-words HELP: c-struct? diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor old mode 100644 new mode 100755 index 1805ee05b5..2eabe9b0bc --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -64,6 +64,7 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" ARTICLE: "assocs-mutation" "Storing keys and values in assocs" "Utility operations built up from the " { $link "assocs-protocol" } ":" { $subsection delete-at* } +{ $subsection delete-any } { $subsection rename-at } { $subsection change-at } { $subsection at+ } @@ -220,6 +221,12 @@ HELP: delete-at* { $description "Removes an entry from the assoc and outputs the previous value together with a boolean indicating whether it was present." } { $side-effects "assoc" } ; +HELP: delete-any +{ $values { "assoc" assoc } { "key" "a key" } { "value" "a value" } } +{ $description "Removes an undetermined entry from the assoc and outputs it." } +{ $errors "Throws an error if the assoc is empty." } +{ $notes "This word is useful when using an assoc as an unordered queue which requires constant-time membership tests. Entries are enqueued with " { $link set-at } " and dequeued with " { $link delete-any } "." } ; + HELP: rename-at { $values { "newkey" object } { "key" object } { "assoc" assoc } } { $description "Removes the values associated to " { $snippet "key" } " and re-adds it as " { $snippet "newkey" } ". Does nothing if the assoc does not contain " { $snippet "key" } "." } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 1983608624..d8cf01e1bd 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -77,8 +77,11 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : rename-at ( newkey key assoc -- ) tuck delete-at* [ -rot set-at ] [ 3drop ] if ; -: delete-any ( assoc -- element ) - [ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ; +: delete-any ( assoc -- key value ) + [ + [ 2drop t ] assoc-find + [ "Assoc is empty" throw ] unless over + ] keep delete-at ; : assoc-empty? ( assoc -- ? ) assoc-size zero? ; diff --git a/core/bootstrap/image/image.factor b/core/bootstrap/image/image.factor index 7b199a5e46..43a8d9752a 100755 --- a/core/bootstrap/image/image.factor +++ b/core/bootstrap/image/image.factor @@ -427,32 +427,22 @@ M: curry ' "Writing image to " write dup write "..." print flush [ (write-image) ] with-stream ; -: prepare-profile ( arch -- ) - "resource:core/bootstrap/layouts/layouts.factor" run-file - "resource:core/cpu/" swap { - { "x86.32" "x86/32" } - { "x86.64" "x86/64" } - { "linux-ppc" "ppc/linux" } - { "macosx-ppc" "ppc/macosx" } - { "arm" "arm" } - } at "/bootstrap.factor" 3append ?resource-path run-file ; - -: prepare-image ( arch -- ) - dup architecture set prepare-profile +: prepare-image ( -- ) bootstrapping? on load-help? off - 800000 image set 20000 objects set ; + 800000 image set + 20000 objects set ; PRIVATE> : make-image ( arch -- ) - [ + architecture [ prepare-image begin-image "resource:/core/bootstrap/stage1.factor" run-file end-image image get image-name write-image - ] with-scope ; + ] with-variable ; : my-arch ( -- arch ) cpu dup "ppc" = [ os "-" rot 3append ] when ; @@ -460,7 +450,7 @@ PRIVATE> : make-images ( -- ) { "x86.32" - ! "x86.64" + "x86.64" "linux-ppc" "macosx-ppc" ! "arm" } [ make-image ] each ; diff --git a/core/bootstrap/primitives.factor b/core/bootstrap/primitives.factor index 3e93a868ca..a88729f539 100755 --- a/core/bootstrap/primitives.factor +++ b/core/bootstrap/primitives.factor @@ -5,22 +5,32 @@ USING: alien arrays byte-arrays generic hashtables hashtables.private io kernel math namespaces parser sequences strings vectors words quotations assocs layouts classes tuples kernel.private vocabs vocabs.loader source-files definitions -slots classes.union compiler.units ; +slots classes.union compiler.units bootstrap.image.private +io.files ; "Creating primitives and basic runtime structures..." print flush -load-help? off crossref off -! Bring up a bare cross-compiling vocabulary. -"syntax" vocab vocab-words bootstrap-syntax set - "resource:core/bootstrap/syntax.factor" parse-file +"resource:core/cpu/" architecture get { + { "x86.32" "x86/32" } + { "x86.64" "x86/64" } + { "linux-ppc" "ppc/linux" } + { "macosx-ppc" "ppc/macosx" } + { "arm" "arm" } + } at "/bootstrap.factor" 3append parse-file + +! Now we have ( syntax-quot arch-quot ) on the stack + +! Bring up a bare cross-compiling vocabulary. +"syntax" vocab vocab-words bootstrap-syntax set H{ } clone dictionary set H{ } clone changed-words set [ drop ] recompile-hook set +call call ! Create some empty vocabs where the below primitives and @@ -558,8 +568,6 @@ builtins get num-tags get tail f union-class define-class { "alien>u16-string" "alien" } { "string>u16-alien" "alien" } { "(throw)" "kernel.private" } - { "string>memory" "alien" } - { "memory>string" "alien" } { "alien-address" "alien" } { "slot" "slots.private" } { "set-slot" "slots.private" } diff --git a/core/bootstrap/stage2.factor b/core/bootstrap/stage2.factor index d035744cd0..0163422f47 100755 --- a/core/bootstrap/stage2.factor +++ b/core/bootstrap/stage2.factor @@ -54,6 +54,7 @@ IN: bootstrap.stage2 ] each ] when ] with-compiler-errors + :errors f error set-global f error-continuation set-global diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 9378642951..1e6d4f8a17 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -44,7 +44,7 @@ IN: compiler : compile-loop ( assoc -- ) dup assoc-empty? [ drop ] [ - dup delete-any (compile) + dup delete-any drop (compile) yield compile-loop ] if ; diff --git a/extra/catalyst-talk/authors.txt b/core/compiler/constants/authors.txt old mode 100644 new mode 100755 similarity index 100% rename from extra/catalyst-talk/authors.txt rename to core/compiler/constants/authors.txt diff --git a/core/compiler/constants/summary.txt b/core/compiler/constants/summary.txt new file mode 100755 index 0000000000..bf51e9a486 --- /dev/null +++ b/core/compiler/constants/summary.txt @@ -0,0 +1 @@ +VM memory layout constants diff --git a/core/compiler/errors/authors.txt b/core/compiler/errors/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/compiler/errors/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/compiler/errors/summary.txt b/core/compiler/errors/summary.txt new file mode 100755 index 0000000000..01d106bcad --- /dev/null +++ b/core/compiler/errors/summary.txt @@ -0,0 +1 @@ +Compiler warning and error reporting diff --git a/core/compiler/test/optimizer.factor b/core/compiler/test/optimizer.factor index ecb5525fd0..b59c0d5f33 100755 --- a/core/compiler/test/optimizer.factor +++ b/core/compiler/test/optimizer.factor @@ -287,3 +287,7 @@ TUPLE: silly-tuple a b ; [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ; [ t ] [ \ node-successor-f-bug compiled? ] unit-test + +: construct-empty-bug construct-empty ; + +[ ] [ [ construct-empty ] dataflow optimize drop ] unit-test diff --git a/core/compiler/units/authors.txt b/core/compiler/units/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/compiler/units/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/compiler/units/summary.txt b/core/compiler/units/summary.txt new file mode 100755 index 0000000000..3e989e8901 --- /dev/null +++ b/core/compiler/units/summary.txt @@ -0,0 +1 @@ +Compilation units group word definitions for compilation diff --git a/core/cpu/arm/allot/authors.txt b/core/cpu/arm/allot/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/arm/allot/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/arm/architecture/authors.txt b/core/cpu/arm/architecture/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/arm/architecture/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/arm/assembler/authors.txt b/core/cpu/arm/assembler/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/arm/assembler/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/arm/intrinsics/authors.txt b/core/cpu/arm/intrinsics/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/arm/intrinsics/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/ppc/intrinsics/authors.txt b/core/cpu/ppc/intrinsics/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/ppc/intrinsics/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/ppc/linux/bootstrap.factor b/core/cpu/ppc/linux/bootstrap.factor old mode 100644 new mode 100755 index a84bff5141..3900ca7f88 --- a/core/cpu/ppc/linux/bootstrap.factor +++ b/core/cpu/ppc/linux/bootstrap.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser layouts system ; +USING: parser layouts system kernel ; IN: bootstrap.ppc : c-area-size 10 bootstrap-cells ; : lr-save bootstrap-cell ; -"resource:core/cpu/ppc/bootstrap.factor" run-file +<< "resource:core/cpu/ppc/bootstrap.factor" parse-file parsed >> +call diff --git a/core/cpu/ppc/macosx/bootstrap.factor b/core/cpu/ppc/macosx/bootstrap.factor old mode 100644 new mode 100755 index 016e445522..db5e3a343f --- a/core/cpu/ppc/macosx/bootstrap.factor +++ b/core/cpu/ppc/macosx/bootstrap.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2007 Slava Pestov. +! Copyright (C) 2007, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: parser layouts system ; +USING: parser layouts system kernel ; IN: bootstrap.ppc : c-area-size 14 bootstrap-cells ; : lr-save 2 bootstrap-cells ; -"resource:core/cpu/ppc/bootstrap.factor" run-file +<< "resource:core/cpu/ppc/bootstrap.factor" parse-file parsed >> +call diff --git a/core/cpu/x86/32/authors.txt b/core/cpu/x86/32/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/x86/32/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/x86/32/bootstrap.factor b/core/cpu/x86/32/bootstrap.factor index 4ce4b1684d..16083a8628 100755 --- a/core/cpu/x86/32/bootstrap.factor +++ b/core/cpu/x86/32/bootstrap.factor @@ -14,4 +14,5 @@ IN: bootstrap.x86 : fixnum>slot@ arg0 1 SAR ; : rex-length 0 ; -"resource:core/cpu/x86/bootstrap.factor" run-file +<< "resource:core/cpu/x86/bootstrap.factor" parse-file parsed >> +call diff --git a/core/cpu/x86/64/bootstrap.factor b/core/cpu/x86/64/bootstrap.factor old mode 100644 new mode 100755 index 1227369ae8..93bf7cca17 --- a/core/cpu/x86/64/bootstrap.factor +++ b/core/cpu/x86/64/bootstrap.factor @@ -14,4 +14,5 @@ IN: bootstrap.x86 : fixnum>slot@ ; : rex-length 1 ; -"resource:core/cpu/x86/bootstrap.factor" run-file +<< "resource:core/cpu/x86/bootstrap.factor" parse-file parsed >> +call diff --git a/core/cpu/x86/allot/authors.txt b/core/cpu/x86/allot/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/x86/allot/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/x86/architecture/authors.txt b/core/cpu/x86/architecture/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/x86/architecture/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/x86/assembler/authors.txt b/core/cpu/x86/assembler/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/x86/assembler/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/cpu/x86/intrinsics/authors.txt b/core/cpu/x86/intrinsics/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/cpu/x86/intrinsics/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/float-arrays/authors.txt b/core/float-arrays/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/float-arrays/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/hashtables/hashtables-docs.factor b/core/hashtables/hashtables-docs.factor old mode 100644 new mode 100755 index 3719c2f9e0..7b6c2d1dc9 --- a/core/hashtables/hashtables-docs.factor +++ b/core/hashtables/hashtables-docs.factor @@ -35,8 +35,10 @@ $nl "Utility words to create a new hashtable from a single key/value pair:" { $subsection associate } { $subsection ?set-at } -"Removing duplicate elements from a sequence in linear time, using a hashtable:" +"The final two words pertain to sequences but use a hashtable internally. Removing duplicate elements from a sequence in linear time, using a hashtable:" { $subsection prune } +"Test if a sequence contains duplicates in linear time:" +{ $subsection all-unique? } { $subsection "hashtables.private" } ; ABOUT: "hashtables" @@ -133,6 +135,15 @@ HELP: prune { $example "USE: hashtables" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" } } ; +HELP: all-unique? +{ $values { "seq" sequence } { "?" "a boolean" } } +{ $description "Tests whether a sequence contains any repeated elements." } +{ $example + "USE: combinators.lib" + "{ 0 1 1 2 3 5 } all-unique? ." + "f" +} ; + HELP: rehash { $values { "hash" hashtable } } { $description "Rebuild the hashtable. This word should be called if the hashcodes of the hashtable's keys have changed, or if the hashing algorithms themselves have changed, neither of which should occur during normal operation." } ; diff --git a/core/hashtables/hashtables-tests.factor b/core/hashtables/hashtables-tests.factor index 7dc252fd3e..40d079402c 100755 --- a/core/hashtables/hashtables-tests.factor +++ b/core/hashtables/hashtables-tests.factor @@ -160,3 +160,6 @@ H{ } "x" set H{ { 1 "one" } { 2 "two" } } { 1 2 3 } clone [ substitute ] keep ] unit-test + +[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test +[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test diff --git a/core/hashtables/hashtables.factor b/core/hashtables/hashtables.factor old mode 100644 new mode 100755 index 004cc9fa90..e477aa59ed --- a/core/hashtables/hashtables.factor +++ b/core/hashtables/hashtables.factor @@ -195,4 +195,7 @@ M: hashtable assoc-like dup length over length rot [ >r 2dup r> (prune) ] each nip ; +: all-unique? ( seq -- ? ) + dup prune [ length ] 2apply = ; + INSTANCE: hashtable assoc diff --git a/core/heaps/authors.txt b/core/heaps/authors.txt new file mode 100755 index 0000000000..1229a590fa --- /dev/null +++ b/core/heaps/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Ryan Murphy diff --git a/core/heaps/summary.txt b/core/heaps/summary.txt new file mode 100755 index 0000000000..afed9806ab --- /dev/null +++ b/core/heaps/summary.txt @@ -0,0 +1 @@ +Maxheap and minheap implementations of priority queues diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index 9049104cfc..f6d5a36d3d 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays generic assocs hashtables inference kernel math namespaces sequences words parser math.intervals -effects classes inference.dataflow inference.backend ; +effects classes inference.dataflow inference.backend +combinators ; IN: inference.class ! Class inference @@ -181,8 +182,11 @@ M: pair constraint-satisfied? ] if* ; : default-output-classes ( word -- classes ) - "inferred-effect" word-prop effect-out - dup [ class? ] all? [ drop f ] unless ; + "inferred-effect" word-prop { + { [ dup not ] [ drop f ] } + { [ dup effect-out [ class? ] all? not ] [ drop f ] } + { [ t ] [ effect-out ] } + } cond ; : compute-output-classes ( node word -- classes intervals ) dup node-param "output-classes" word-prop dup diff --git a/core/inference/inference-docs.factor b/core/inference/inference-docs.factor index 508b0a6510..5f7e926b6a 100755 --- a/core/inference/inference-docs.factor +++ b/core/inference/inference-docs.factor @@ -1,5 +1,5 @@ USING: help.syntax help.markup kernel sequences words io -effects inference.dataflow inference.backend +effects inference.dataflow inference.backend classes math combinators inference.transforms inference.state ; IN: inference @@ -93,8 +93,8 @@ $nl ABOUT: "inference" HELP: inference-error -{ $values { "msg" "an object" } } -{ $description "Throws an " { $link inference-error } "." } +{ $values { "class" class } } +{ $description "Creates an instance of " { $snippet "class" } ", wraps it in an " { $link inference-error } " and throws the result." } { $error-description "Thrown by " { $link infer } " and " { $link dataflow } " when the stack effect of a quotation cannot be inferred." $nl diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 2223dd56b6..72935f1405 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -475,10 +475,6 @@ t over set-effect-terminated? \ string>u16-alien { string } { byte-array } "inferred-effect" set-word-prop -\ string>memory { string c-ptr } { } "inferred-effect" set-word-prop - -\ memory>string { c-ptr integer } { string } "inferred-effect" set-word-prop - \ alien-address { alien } { integer } "inferred-effect" set-word-prop \ alien-address make-flushable diff --git a/core/inference/state/authors.txt b/core/inference/state/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/inference/state/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/inference/state/summary.txt b/core/inference/state/summary.txt new file mode 100755 index 0000000000..6b782f6e21 --- /dev/null +++ b/core/inference/state/summary.txt @@ -0,0 +1 @@ +Variables for holding stack effect inference state diff --git a/core/inference/transforms/transforms-docs.factor b/core/inference/transforms/transforms-docs.factor old mode 100644 new mode 100755 index b695406653..a6f0c8e0bf --- a/core/inference/transforms/transforms-docs.factor +++ b/core/inference/transforms/transforms-docs.factor @@ -1,5 +1,5 @@ -USING: help.markup help.syntax inference.transforms -combinators words ; +IN: inference.transforms +USING: help.markup help.syntax combinators words kernel ; HELP: define-transform { $values { "word" word } { "quot" "a quotation taking " { $snippet "n" } " inputs from the stack and producing another quotation as output" } { "n" "a non-negative integer" } } @@ -12,3 +12,8 @@ HELP: define-transform $nl "The " { $link cond } " word compiles to efficient code because it is transformed using " { $link cond>quot } ":" { $code "\\ cond [ cond>quot ] 1 define-transform" } } ; + +HELP: duplicated-slots-error +{ $values { "names" "a sequence of setter words" } } +{ $description "Throws a " { $link duplicated-slots-error } "." } +{ $error-description "Thrown by stack effect inference if a " { $link set-slots } " form is given an array of slot setters that includes duplicates. Since writing to the same slot multiple times has no useful effect, this is a programmer error, so it is caught at compile time." } ; diff --git a/core/inference/transforms/transforms-tests.factor b/core/inference/transforms/transforms-tests.factor old mode 100644 new mode 100755 index 9a62a1faca..152da8c757 --- a/core/inference/transforms/transforms-tests.factor +++ b/core/inference/transforms/transforms-tests.factor @@ -1,6 +1,6 @@ IN: temporary USING: sequences inference.transforms tools.test math kernel -quotations tools.test.inference ; +quotations tools.test.inference inference ; : compose-n-quot >quotation ; : compose-n compose-n-quot call ; @@ -20,3 +20,15 @@ quotations tools.test.inference ; [ 512 ] [ 1 { { 1+ 8 } } bitfield-quot call ] unit-test \ construct-empty must-infer + +TUPLE: a-tuple x y z ; + +: set-slots-test ( x y z -- ) + { set-a-tuple-x set-a-tuple-y } set-slots ; + +\ set-slots-test must-infer + +: set-slots-test-2 + { set-a-tuple-x set-a-tuple-x } set-slots ; + +[ [ set-slots-test-2 ] infer ] unit-test-fails diff --git a/core/inference/transforms/transforms.factor b/core/inference/transforms/transforms.factor index c4eeb98145..fd15b7da98 100755 --- a/core/inference/transforms/transforms.factor +++ b/core/inference/transforms/transforms.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel words sequences generic math namespaces quotations assocs combinators math.bitfields inference.backend -inference.dataflow inference.state tuples.private effects ; +inference.dataflow inference.state tuples.private effects +inspector hashtables ; IN: inference.transforms : pop-literals ( n -- rstate seq ) @@ -59,7 +60,18 @@ M: pair (bitfield-quot) ( spec -- quot ) \ get-slots [ [get-slots] ] 1 define-transform -\ set-slots [ [get-slots] ] 1 define-transform +TUPLE: duplicated-slots-error names ; + +M: duplicated-slots-error summary + drop "Calling set-slots with duplicate slot setters" ; + +: duplicated-slots-error ( names -- * ) + \ duplicated-slots-error construct-boa throw ; + +\ set-slots [ + dup all-unique? + [ [get-slots] ] [ duplicated-slots-error ] if +] 1 define-transform \ construct-boa [ dup +inlined+ depends-on diff --git a/core/io/encodings/authors.txt b/core/io/encodings/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/io/encodings/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/io/encodings/summary.txt b/core/io/encodings/summary.txt new file mode 100755 index 0000000000..ae6a19b334 --- /dev/null +++ b/core/io/encodings/summary.txt @@ -0,0 +1 @@ +Common support for ASCII, UTF8 and UTF16 character encodings diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index f832742034..2920122ec2 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -372,7 +372,7 @@ HELP: 2keep { $description "Call a quotation with two values on the stack, restoring the values when the quotation returns." } ; HELP: 3keep -{ $values { "quot" "a quotation with stack effect " { $snippet "( x y -- )" } } { "x" object } { "y" object } { "z" object } } +{ $values { "quot" "a quotation with stack effect " { $snippet "( x y z -- )" } } { "x" object } { "y" object } { "z" object } } { $description "Call a quotation with three values on the stack, restoring the values when the quotation returns." } ; HELP: 2apply diff --git a/core/libc/libc.factor b/core/libc/libc.factor index 88c5070d1f..2006850839 100644 --- a/core/libc/libc.factor +++ b/core/libc/libc.factor @@ -2,7 +2,7 @@ ! Copyright (C) 2007 Slava Pestov ! Copyright (C) 2007 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. -USING: alien assocs init inspector kernel namespaces ; +USING: alien assocs continuations init inspector kernel namespaces ; IN: libc "void" "libc" "memcpy" { "void*" "void*" "ulong" } alien-invoke ; : with-malloc ( size quot -- ) - swap 1 calloc swap keep free ; inline + swap 1 calloc [ swap keep ] [ free ] [ ] cleanup ; inline diff --git a/core/refs/authors.txt b/core/refs/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/core/refs/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/refs/summary.txt b/core/refs/summary.txt new file mode 100755 index 0000000000..a8a5a4a119 --- /dev/null +++ b/core/refs/summary.txt @@ -0,0 +1 @@ +References to keys and values in assocs diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index 0b1b2d43bf..8bbf329491 100755 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -68,7 +68,7 @@ uses definitions ; : reset-checksums ( -- ) source-files get [ swap ?resource-path dup exists? - [ file-lines record-checksum ] [ 2drop ] if + [ file-lines swap record-checksum ] [ 2drop ] if ] assoc-each ; M: pathname where pathname-string 1 2array ; diff --git a/extra/alarms/authors.txt b/extra/alarms/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/alarms/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/arrays/lib/authors.txt b/extra/arrays/lib/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/arrays/lib/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/asn1/ldap/authors.txt b/extra/asn1/ldap/authors.txt new file mode 100755 index 0000000000..7c29e7c401 --- /dev/null +++ b/extra/asn1/ldap/authors.txt @@ -0,0 +1 @@ +Elie Chaftari diff --git a/extra/assoc-heaps/authors.txt b/extra/assoc-heaps/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/assoc-heaps/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/assoc-heaps/summary.txt b/extra/assoc-heaps/summary.txt new file mode 100755 index 0000000000..07ae2e33f8 --- /dev/null +++ b/extra/assoc-heaps/summary.txt @@ -0,0 +1 @@ +Priority search queues diff --git a/extra/assocs/lib/lib.factor b/extra/assocs/lib/lib.factor old mode 100644 new mode 100755 index 50da66e669..849f88023f --- a/extra/assocs/lib/lib.factor +++ b/extra/assocs/lib/lib.factor @@ -7,17 +7,13 @@ IN: assocs.lib : >set ( seq -- hash ) [ dup ] H{ } map>assoc ; -: ref-hash ( table key -- value ) swap at ; +: ref-at ( table key -- value ) swap at ; -! set-hash with alternative stack effects +: put-at* ( table key value -- ) swap rot set-at ; -: put-hash* ( table key value -- ) spin set-at ; +: put-at ( table key value -- table ) swap pick set-at ; -: put-hash ( table key value -- table ) swap pick set-at ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: set-hash-stack ( value key seq -- ) +: set-assoc-stack ( value key seq -- ) dupd [ key? ] with find-last nip set-at ; : at-default ( key assoc -- value/key ) diff --git a/extra/automata/ui/authors.txt b/extra/automata/ui/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/automata/ui/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/benchmark/bootstrap1/authors.txt b/extra/benchmark/bootstrap1/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/bootstrap1/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/bootstrap2/authors.txt b/extra/benchmark/bootstrap2/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/bootstrap2/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/continuations/authors.txt b/extra/benchmark/continuations/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/continuations/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/dispatch1/authors.txt b/extra/benchmark/dispatch1/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/dispatch1/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/dispatch2/authors.txt b/extra/benchmark/dispatch2/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/dispatch2/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/dispatch3/authors.txt b/extra/benchmark/dispatch3/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/dispatch3/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/dispatch4/authors.txt b/extra/benchmark/dispatch4/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/dispatch4/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/empty-loop/authors.txt b/extra/benchmark/empty-loop/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/empty-loop/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/fib1/authors.txt b/extra/benchmark/fib1/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/fib1/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/fib2/authors.txt b/extra/benchmark/fib2/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/fib2/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/fib3/authors.txt b/extra/benchmark/fib3/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/fib3/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/fib4/authors.txt b/extra/benchmark/fib4/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/fib4/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/fib5/authors.txt b/extra/benchmark/fib5/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/fib5/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/iteration/authors.txt b/extra/benchmark/iteration/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/iteration/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/mandel/authors.txt b/extra/benchmark/mandel/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/mandel/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/nsieve-bits/authors.txt b/extra/benchmark/nsieve-bits/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/nsieve-bits/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/nsieve/authors.txt b/extra/benchmark/nsieve/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/nsieve/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/partial-sums/authors.txt b/extra/benchmark/partial-sums/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/partial-sums/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/raytracer/authors.txt b/extra/benchmark/raytracer/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/raytracer/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/recursive/authors.txt b/extra/benchmark/recursive/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/recursive/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/reverse-complement/authors.txt b/extra/benchmark/reverse-complement/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/reverse-complement/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/ring/authors.txt b/extra/benchmark/ring/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/ring/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/sha1/authors.txt b/extra/benchmark/sha1/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/sha1/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/sort/authors.txt b/extra/benchmark/sort/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/sort/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/spectral-norm/authors.txt b/extra/benchmark/spectral-norm/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/spectral-norm/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/sum-file/authors.txt b/extra/benchmark/sum-file/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/sum-file/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/typecheck1/authors.txt b/extra/benchmark/typecheck1/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/typecheck1/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/typecheck2/authors.txt b/extra/benchmark/typecheck2/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/typecheck2/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/typecheck3/authors.txt b/extra/benchmark/typecheck3/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/typecheck3/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/benchmark/typecheck4/authors.txt b/extra/benchmark/typecheck4/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/benchmark/typecheck4/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/boids/ui/authors.txt b/extra/boids/ui/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/boids/ui/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cairo-demo/authors.txt b/extra/cairo-demo/authors.txt new file mode 100755 index 0000000000..4a2736dd93 --- /dev/null +++ b/extra/cairo-demo/authors.txt @@ -0,0 +1 @@ +Sampo Vuori diff --git a/extra/calendar/authors.txt b/extra/calendar/authors.txt index 7c1b2f2279..1901f27a24 100644 --- a/extra/calendar/authors.txt +++ b/extra/calendar/authors.txt @@ -1 +1 @@ -Doug Coleman +Slava Pestov diff --git a/extra/calendar/backend/authors.txt b/extra/calendar/backend/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/calendar/backend/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/calendar/calendar.factor b/extra/calendar/calendar.factor index 8c1c2fb3a6..a1fe0a55ea 100755 --- a/extra/calendar/calendar.factor +++ b/extra/calendar/calendar.factor @@ -333,16 +333,18 @@ M: integer year. ( n -- ) M: timestamp year. ( timestamp -- ) timestamp-year year. ; -: pad-00 number>string 2 CHAR: 0 pad-left write ; +: pad-00 number>string 2 CHAR: 0 pad-left ; + +: write-00 pad-00 write ; : (timestamp>string) ( timestamp -- ) dup day-of-week day-abbreviations3 nth write ", " write dup timestamp-day number>string write bl dup timestamp-month month-abbreviations nth write bl dup timestamp-year number>string write bl - dup timestamp-hour pad-00 ":" write - dup timestamp-minute pad-00 ":" write - timestamp-second >fixnum pad-00 ; + dup timestamp-hour write-00 ":" write + dup timestamp-minute write-00 ":" write + timestamp-second >fixnum write-00 ; : timestamp>string ( timestamp -- str ) [ (timestamp>string) ] string-out ; @@ -357,11 +359,11 @@ M: timestamp year. ( timestamp -- ) : (timestamp>rfc3339) ( timestamp -- ) dup timestamp-year number>string write CHAR: - write1 - dup timestamp-month pad-00 CHAR: - write1 - dup timestamp-day pad-00 CHAR: T write1 - dup timestamp-hour pad-00 CHAR: : write1 - dup timestamp-minute pad-00 CHAR: : write1 - timestamp-second >fixnum pad-00 CHAR: Z write1 ; + dup timestamp-month write-00 CHAR: - write1 + dup timestamp-day write-00 CHAR: T write1 + dup timestamp-hour write-00 CHAR: : write1 + dup timestamp-minute write-00 CHAR: : write1 + timestamp-second >fixnum write-00 CHAR: Z write1 ; : timestamp>rfc3339 ( timestamp -- str ) >gmt [ (timestamp>rfc3339) ] string-out ; @@ -390,8 +392,8 @@ M: timestamp year. ( timestamp -- ) [ timestamp-month month-abbreviations nth write ] keep bl [ timestamp-day number>string 2 32 pad-left write ] keep bl dup now [ timestamp-year ] 2apply = [ - [ timestamp-hour pad-00 ] keep ":" write - timestamp-minute pad-00 + [ timestamp-hour write-00 ] keep ":" write + timestamp-minute write-00 ] [ timestamp-year number>string 5 32 pad-left write ] if diff --git a/extra/calendar/model/model.factor b/extra/calendar/model/model.factor new file mode 100755 index 0000000000..855b0cd815 --- /dev/null +++ b/extra/calendar/model/model.factor @@ -0,0 +1,15 @@ +! Copyright (C) 2008 Slava Pestov +! See http://factorcode.org/license.txt for BSD license. +USING: calendar namespaces models threads init ; +IN: calendar.model + +SYMBOL: time + +: (time-thread) ( -- ) + now time get set-model + 1000 sleep (time-thread) ; + +: time-thread ( -- ) [ (time-thread) ] in-thread ; + +f time set-global +[ time-thread ] "calendar.model" add-init-hook diff --git a/extra/calendar/summary.txt b/extra/calendar/summary.txt index e2d2488d59..4cc85fd2b9 100644 --- a/extra/calendar/summary.txt +++ b/extra/calendar/summary.txt @@ -1 +1 @@ -Date and time classes +Timestamp model updated every second diff --git a/extra/calendar/unix/authors.txt b/extra/calendar/unix/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/calendar/unix/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/calendar/windows/authors.txt b/extra/calendar/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/calendar/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/catalyst-talk/catalyst-talk.factor b/extra/catalyst-talk/catalyst-talk.factor deleted file mode 100644 index f76ef4db9e..0000000000 --- a/extra/catalyst-talk/catalyst-talk.factor +++ /dev/null @@ -1,121 +0,0 @@ -USING: slides help.markup math arrays hashtables namespaces -sequences kernel sequences parser ; -IN: catalyst-talk - -: catalyst-slides -{ - { $slide "What is Factor?" - "Originally scripting for a Java game" - "Language dev more fun than game dev" - "Start with ideas which were mostly dead" - "Throw in features from crazy languages" - "Develop practical libraries and tools" - } - { $slide "Factor: a stack language" - "Implicit parameter passing" - { "Each " { $emphasis "word" } " is a function call" } - { $code ": sq dup * ;" } - { $code "2 3 + sq ." } - "Minimal syntax and semantics = easy meta-programming" - { "Related languages: Forth, Joy, PostScript" } - } - { $slide "Factor: a functional language" - { { $emphasis "Quotations" } " can be passed around, constructed..." } - { $code "[ sq 3 + ]" } - { { $emphasis "Combinators" } " are words which take quotations, eg " { $link if } } - { "For FP buffs: " { $link each } ", " { $link map } ", " { $link reduce } ", " { $link accumulate } ", " { $link interleave } ", " { $link subset } } - { $code "{ 42 69 666 } [ sq 3 + ] map ." } - } - { $slide "Factor: an object-oriented language" - { "Everything is an " { $emphasis "object" } } - { "An object is an instance of a " { $emphasis "class" } } - "Methods" - "Generic words" - "For CLOS buffs: we allow custom method combination, classes are objects too, there's a MOP" - } - - STRIP-TEASE: - $slide "Primary school geometry recap" - { $code - "GENERIC: area ( shape -- meters^2 )" - "TUPLE: square dimension ;" - "M: square area square-dimension sq ;" - "TUPLE: circle radius ;" - "M: circle area circle-radius sq pi * ;" - "TUPLE: rectangle width height ;" - "M: rectangle area" - " dup rectangle-width" - " swap rectangle-height" - " * ;" - } - ; - - { $slide "Geometry example" - { $code "10 area ." } - { $code "18 area ." } - { $code "20 40 area ." } - } -! { $slide "Factor: a meta language" -! "Writing code which writes code" -! "Extensible parser: define new syntax" -! "Compiler transforms" -! "Here's an inefficient word:" -! { $code -! ": fib ( x -- y )" -! " dup 1 > [" -! " 1 - dup fib swap 1 - fib +" -! " ] when ;" -! } -! } -! { $slide "Memoization" -! { { $link POSTPONE: : } " is just another word" } -! "What if we could define a word which caches its results?" -! { "The " { $vocab-link "memoize" } " library provides such a feature" } -! { "Just change " { $link POSTPONE: : } " to " { $link POSTPONE: MEMO: } } -! { $code -! "MEMO: fib ( x -- y )" -! " dup 1 > [" -! " 1 - dup fib swap 1 - fib +" -! " ] when ;" -! } -! } - { $slide "Factor: a tool-building language" - "Tools are not monolithic, but are themselves just sets of words" - "Examples: parser, compiler, etc" - "Parser: turns strings into objects" - { $code "\"1\" contents parse" } - "Prettyprinter: turns objects into strings" - { $code "\"2\" [ . ] with-stream" } - } - { $slide "Factor: an interactive language" - { "Let's hack " { $vocab-link "tetris" } } - "Editor integration" - { $code "\\ tetrominoes edit" } - "Inspector" - { $code "\\ tetrominoes get inspect" } - } - { $slide "C library interface" - "No need to write C glue code!" - "Callbacks from C to Factor" - "Factor can be embedded in C apps" - { "Example: " { $vocab-link "ogg.vorbis" } } - { "Other bindings: OpenGL, OpenAL, X11, Win32, Cocoa, OpenSSL, memory mapped files, ..." } - } - { $slide "Native libraries" - "XML, HTTP, SMTP, Unicode, calendar, ..." - "Lazy lists, pattern matching, packed arrays, ..." - } - { $slide "Factor: a fun language" - { "Let's play " - { $vocab-link "space-invaders" } - } - { $url "http://factorcode.org" } - { $url "http://factor-language.blogspot.com" } - "irc.freenode.net #concatenative" - "Have fun!" - } -} ; - -: catalyst-talk catalyst-slides slides-window ; - -MAIN: catalyst-talk diff --git a/extra/catalyst-talk/summary.txt b/extra/catalyst-talk/summary.txt deleted file mode 100644 index f2efe74db6..0000000000 --- a/extra/catalyst-talk/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Slides for a talk at Catalyst IT NZ, July 2007 diff --git a/extra/cel-shading/cel-shading.factor b/extra/cel-shading/cel-shading.factor index 20b392195a..c89fd0e244 100644 --- a/extra/cel-shading/cel-shading.factor +++ b/extra/cel-shading/cel-shading.factor @@ -1,51 +1,15 @@ -USING: arrays bunny io io.files kernel - math math.functions math.vectors multiline - namespaces - opengl opengl.gl - prettyprint - sequences ui ui.gadgets ui.gestures ui.render ; +USING: arrays bunny combinators.lib io io.files kernel + math math.functions multiline + opengl opengl.gl opengl-demo-support + sequences ui ui.gadgets ui.render ; IN: cel-shading -: NEAR-PLANE 1.0 64.0 / ; inline -: FAR-PLANE 4.0 ; inline -: FOV 2.0 sqrt 1+ ; inline -: MOUSE-MOTION-SCALE 0.5 ; inline -: MOUSE-DISTANCE-SCALE 1.0 64.0 / ; inline -: KEY-ROTATE-STEP 1.0 ; inline -: KEY-DISTANCE-STEP 1.0 64.0 / ; inline -: DIMS { 640 480 } ; inline - -: FOV-RATIO ( -- fov ) DIMS dup first2 min v/n ; - -SYMBOL: last-drag-loc - -TUPLE: cel-shading-gadget yaw pitch distance model program ; +TUPLE: cel-shading-gadget model program ; : ( -- cel-shading-gadget ) - cel-shading-gadget construct-gadget - 0.0 over set-cel-shading-gadget-yaw - 0.0 over set-cel-shading-gadget-pitch - 0.375 over set-cel-shading-gadget-distance - maybe-download read-model over set-cel-shading-gadget-model ; - -: yaw-cel-shading-gadget ( yaw gadget -- ) - [ [ cel-shading-gadget-yaw + ] keep set-cel-shading-gadget-yaw ] keep relayout-1 ; - -: pitch-cel-shading-gadget ( pitch gadget -- ) - [ [ cel-shading-gadget-pitch + ] keep set-cel-shading-gadget-pitch ] keep relayout-1 ; - -: zoom-cel-shading-gadget ( distance gadget -- ) - [ [ cel-shading-gadget-distance + ] keep set-cel-shading-gadget-distance ] keep relayout-1 ; - -M: cel-shading-gadget pref-dim* ( gadget -- dim ) - drop DIMS ; - -: -+ ( x -- -x x ) - dup neg swap ; - -: cel-shading-frustum ( -- -x x -y y near far ) - FOV-RATIO NEAR-PLANE FOV / v*n - first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ; + 0.0 0.0 0.375 + maybe-download read-model + { set-delegate set-cel-shading-gadget-model } cel-shading-gadget construct ; STRING: cel-shading-vertex-shader-source varying vec3 position, normal; @@ -90,11 +54,11 @@ main() ; : cel-shading-program ( -- program ) - cel-shading-vertex-shader-source check-gl-shader - cel-shading-fragment-shader-source check-gl-shader - 2array check-gl-program ; + cel-shading-vertex-shader-source cel-shading-fragment-shader-source + ; M: cel-shading-gadget graft* ( gadget -- ) + "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions 0.0 0.0 0.0 1.0 glClearColor GL_CULL_FACE glEnable GL_DEPTH_TEST glEnable @@ -104,19 +68,13 @@ M: cel-shading-gadget ungraft* ( gadget -- ) cel-shading-gadget-program delete-gl-program ; : cel-shading-draw-setup ( gadget -- gadget ) - GL_PROJECTION glMatrixMode - glLoadIdentity - cel-shading-frustum glFrustum - GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear - GL_MODELVIEW glMatrixMode - glLoadIdentity - [ >r 0.0 0.0 r> cel-shading-gadget-distance neg glTranslatef ] keep - [ cel-shading-gadget-pitch 1.0 0.0 0.0 glRotatef ] keep - [ cel-shading-gadget-yaw 0.0 1.0 0.0 glRotatef ] keep - [ cel-shading-gadget-program [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ] keep - [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ] keep - [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ] keep - "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] keep ; + [ demo-gadget-set-matrices ] keep + [ cel-shading-gadget-program + { [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ] + [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ] + [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ] + [ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] } call-with + ] keep ; M: cel-shading-gadget draw-gadget* ( gadget -- ) dup cel-shading-gadget-program [ @@ -125,27 +83,6 @@ M: cel-shading-gadget draw-gadget* ( gadget -- ) cel-shading-gadget-model first3 draw-bunny ] with-gl-program ; -: reset-last-drag-rel ( -- ) - { 0 0 } last-drag-loc set ; -: last-drag-rel ( -- rel ) - drag-loc [ last-drag-loc get v- ] keep last-drag-loc set ; - -: drag-yaw-pitch ( -- yaw pitch ) - last-drag-rel MOUSE-MOTION-SCALE v*n first2 ; - -cel-shading-gadget H{ - { T{ key-down f f "LEFT" } [ KEY-ROTATE-STEP neg swap yaw-cel-shading-gadget ] } - { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP swap yaw-cel-shading-gadget ] } - { T{ key-down f f "DOWN" } [ KEY-ROTATE-STEP neg swap pitch-cel-shading-gadget ] } - { T{ key-down f f "UP" } [ KEY-ROTATE-STEP swap pitch-cel-shading-gadget ] } - { T{ key-down f f "=" } [ KEY-DISTANCE-STEP neg swap zoom-cel-shading-gadget ] } - { T{ key-down f f "-" } [ KEY-DISTANCE-STEP swap zoom-cel-shading-gadget ] } - - { T{ button-down f f 1 } [ drop reset-last-drag-rel ] } - { T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-cel-shading-gadget ] keep yaw-cel-shading-gadget ] } - { T{ mouse-scroll } [ scroll-direction get second MOUSE-DISTANCE-SCALE * swap zoom-cel-shading-gadget ] } -} set-gestures - : cel-shading-window ( -- ) [ "Cel Shading" open-window ] with-ui ; diff --git a/extra/cfdg/gl/authors.txt b/extra/cfdg/gl/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/gl/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/aqua-star/authors.txt b/extra/cfdg/models/aqua-star/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/aqua-star/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/chiaroscuro/authors.txt b/extra/cfdg/models/chiaroscuro/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/chiaroscuro/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/flower6/authors.txt b/extra/cfdg/models/flower6/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/flower6/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/game1-turn6/authors.txt b/extra/cfdg/models/game1-turn6/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/game1-turn6/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/lesson/authors.txt b/extra/cfdg/models/lesson/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/lesson/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/sierpinski/authors.txt b/extra/cfdg/models/sierpinski/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/sierpinski/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cfdg/models/snowflake/authors.txt b/extra/cfdg/models/snowflake/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/cfdg/models/snowflake/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/cocoa/plists/authors.txt b/extra/cocoa/plists/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/cocoa/plists/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/colors/hsv/authors.txt b/extra/colors/hsv/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/colors/hsv/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/combinators/cleave/authors.txt b/extra/combinators/cleave/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/combinators/cleave/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/combinators/lib/authors.txt b/extra/combinators/lib/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/combinators/lib/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/combinators/lib/lib-docs.factor b/extra/combinators/lib/lib-docs.factor old mode 100644 new mode 100755 index ac05160b31..02c3556742 --- a/extra/combinators/lib/lib-docs.factor +++ b/extra/combinators/lib/lib-docs.factor @@ -83,15 +83,6 @@ HELP: count "50" } ; -HELP: all-unique? -{ $values { "seq" sequence } { "?" "a boolean" } } -{ $description "Tests whether a sequence contains any repeated elements." } -{ $example - "USE: combinators.lib" - "{ 0 1 1 2 3 5 } all-unique? ." - "f" -} ; - HELP: && { $values { "quots" "a sequence of quotations with stack effect " { $snippet "( ... -- ... ? )" } } { "?" "a boolean" } } { $description "Calls each quotation in turn; outputs " { $link f } " if one of the quotations output " { $link f } ", otherwise outputs " { $link t } ". As soon as a quotation outputs " { $link f } ", evaluation stops and subsequent quotations are not called." } ; diff --git a/extra/combinators/lib/lib-tests.factor b/extra/combinators/lib/lib-tests.factor old mode 100644 new mode 100755 index 0d76e6f50d..deeb105758 --- a/extra/combinators/lib/lib-tests.factor +++ b/extra/combinators/lib/lib-tests.factor @@ -7,8 +7,6 @@ IN: temporary [ 50 ] [ 100 [1,b] [ even? ] count ] unit-test [ 50 ] [ 100 [1,b] [ odd? ] count ] unit-test [ 328350 ] [ 100 [ sq ] sigma ] unit-test -[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test -[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test : infers? [ infer drop ] curry catch not ; diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index aae4c5d9ab..9f0f7df1ce 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -98,8 +98,6 @@ MACRO: nfirst ( n -- ) : count ( seq quot -- n ) [ 1 0 ? ] compose sigma ; inline -: all-unique? ( seq -- ? ) [ prune ] keep [ length ] 2apply = ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! short circuiting words ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -173,14 +171,24 @@ MACRO: parallel-call ( quots -- ) ! map-call and friends ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: (make-call-with) ( quots -- quot ) + [ [ keep ] curry ] map concat [ drop ] append ; + +MACRO: call-with ( quots -- ) + (make-call-with) ; + MACRO: map-call-with ( quots -- ) - [ [ [ keep ] curry ] map concat ] keep length [ nip narray ] curry compose ; + [ (make-call-with) ] keep length [ narray ] curry compose ; + +: (make-call-with2) ( quots -- quot ) + [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat + [ 2drop ] append ; + +MACRO: call-with2 ( quots -- ) + (make-call-with2) ; MACRO: map-call-with2 ( quots -- ) - dup >r - [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat - [ 2drop ] append - r> length [ narray ] curry append ; + dup >r (make-call-with2) r> length [ narray ] curry append ; MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ; diff --git a/extra/contributors/summary.txt b/extra/contributors/summary.txt index ca6fc06710..f0b8e5b603 100644 --- a/extra/contributors/summary.txt +++ b/extra/contributors/summary.txt @@ -1 +1 @@ -Contributor patch count tally from darcs demo +Contributor patch counts from git diff --git a/extra/crypto/barrett/authors.txt b/extra/crypto/barrett/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/barrett/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/common/authors.txt b/extra/crypto/common/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/common/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/hmac/authors.txt b/extra/crypto/hmac/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/hmac/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/md5/authors.txt b/extra/crypto/md5/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/md5/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/rc4/authors.txt b/extra/crypto/rc4/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/rc4/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/rsa/authors.txt b/extra/crypto/rsa/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/rsa/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/sha1/authors.txt b/extra/crypto/sha1/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/sha1/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/sha2/authors.txt b/extra/crypto/sha2/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/sha2/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/timing/authors.txt b/extra/crypto/timing/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/timing/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/crypto/xor/authors.txt b/extra/crypto/xor/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/crypto/xor/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/delegate/authors.txt b/extra/delegate/authors.txt new file mode 100755 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/delegate/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/delegate/protocols/authors.txt b/extra/delegate/protocols/authors.txt new file mode 100755 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/delegate/protocols/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/editors/gvim/backend/authors.txt b/extra/editors/gvim/backend/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/editors/gvim/backend/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/editors/gvim/unix/authors.txt b/extra/editors/gvim/unix/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/editors/gvim/unix/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/editors/gvim/windows/authors.txt b/extra/editors/gvim/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/editors/gvim/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/factory/commands/authors.txt b/extra/factory/commands/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/factory/commands/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/factory/load/authors.txt b/extra/factory/load/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/factory/load/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/faq/authors.txt b/extra/faq/authors.txt new file mode 100755 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/faq/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/faq/summary.txt b/extra/faq/summary.txt new file mode 100755 index 0000000000..c33f8cffeb --- /dev/null +++ b/extra/faq/summary.txt @@ -0,0 +1 @@ +The Factor FAQ diff --git a/extra/furnace/sessions/authors.txt b/extra/furnace/sessions/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/furnace/sessions/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/furnace/summary.txt b/extra/furnace/summary.txt new file mode 100755 index 0000000000..5696506f79 --- /dev/null +++ b/extra/furnace/summary.txt @@ -0,0 +1 @@ +Action-based web framework diff --git a/extra/furnace/validator/authors.txt b/extra/furnace/validator/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/furnace/validator/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/generic/lib/authors.txt b/extra/generic/lib/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/generic/lib/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/geom/dim/authors.txt b/extra/geom/dim/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/geom/dim/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/geom/pos/authors.txt b/extra/geom/pos/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/geom/pos/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/geom/rect/authors.txt b/extra/geom/rect/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/geom/rect/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/graphics/bitmap/authors.txt b/extra/graphics/bitmap/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/graphics/bitmap/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/graphics/viewer/authors.txt b/extra/graphics/viewer/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/graphics/viewer/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hardware-info/backend/authors.txt b/extra/hardware-info/backend/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/hardware-info/backend/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hardware-info/linux/authors.txt b/extra/hardware-info/linux/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/hardware-info/linux/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hardware-info/macosx/authors.txt b/extra/hardware-info/macosx/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/hardware-info/macosx/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hardware-info/windows/authors.txt b/extra/hardware-info/windows/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/hardware-info/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hardware-info/windows/ce/authors.txt b/extra/hardware-info/windows/ce/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/hardware-info/windows/ce/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/hardware-info/windows/nt/authors.txt b/extra/hardware-info/windows/nt/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/hardware-info/windows/nt/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/help/cookbook/authors.txt b/extra/help/cookbook/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/help/cookbook/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/help/tutorial/authors.txt b/extra/help/tutorial/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/help/tutorial/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/html/elements/authors.txt b/extra/html/elements/authors.txt new file mode 100755 index 0000000000..a8fb961d36 --- /dev/null +++ b/extra/html/elements/authors.txt @@ -0,0 +1,2 @@ +Chris Double +Slava Pestov diff --git a/extra/html/parser/analyzer/authors.txt b/extra/html/parser/analyzer/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/html/parser/analyzer/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/html/parser/authors.txt b/extra/html/parser/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/html/parser/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/html/parser/printer/authors.txt b/extra/html/parser/printer/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/html/parser/printer/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/html/parser/utils/authors.txt b/extra/html/parser/utils/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/html/parser/utils/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/http/mime/authors.txt b/extra/http/mime/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/http/mime/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/http/server/authors.txt b/extra/http/server/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/http/server/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/http/server/responders/authors.txt b/extra/http/server/responders/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/http/server/responders/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/inverse/summary.txt b/extra/inverse/summary.txt new file mode 100755 index 0000000000..77e8f77495 --- /dev/null +++ b/extra/inverse/summary.txt @@ -0,0 +1 @@ +Invertible quotations diff --git a/extra/io/buffers/buffers-tests.factor b/extra/io/buffers/buffers-tests.factor old mode 100644 new mode 100755 index b19918292e..6fcdc86423 --- a/extra/io/buffers/buffers-tests.factor +++ b/extra/io/buffers/buffers-tests.factor @@ -1,9 +1,9 @@ IN: temporary -USING: alien io.buffers kernel kernel.private libc +USING: alien alien.c-types io.buffers kernel kernel.private libc sequences tools.test namespaces ; : buffer-set ( string buffer -- ) - 2dup buffer-ptr string>memory + 2dup buffer-ptr string>char-memory >r length r> buffer-reset ; : string>buffer ( string -- buffer ) diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor old mode 100644 new mode 100755 index 5d6eaebe6f..54198a7dcc --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2004, 2005 Mackenzie Straight. -! Copyright (C) 2006, 2007 Slava Pestov. +! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: io.buffers -USING: alien alien.syntax kernel kernel.private libc math -sequences strings hints ; +USING: alien alien.c-types alien.syntax kernel kernel.private +libc math sequences strings hints ; TUPLE: buffer size ptr fill pos ; @@ -39,14 +39,14 @@ TUPLE: buffer size ptr fill pos ; : (buffer>) ( n buffer -- string ) [ dup buffer-fill swap buffer-pos - min ] keep - buffer@ swap memory>string ; + buffer@ swap memory>char-string ; : buffer> ( n buffer -- string ) [ (buffer>) ] 2keep buffer-consume ; : (buffer>>) ( buffer -- string ) dup buffer-pos over buffer-ptr - over buffer-fill rot buffer-pos - memory>string ; + over buffer-fill rot buffer-pos - memory>char-string ; : buffer>> ( buffer -- string ) dup (buffer>>) 0 rot buffer-reset ; @@ -87,7 +87,7 @@ HINTS: search-buffer-until { fixnum fixnum simple-alien string } ; : >buffer ( string buffer -- ) over length over check-overflow - [ buffer-end string>memory ] 2keep + [ buffer-end string>char-memory ] 2keep [ buffer-fill swap length + ] keep set-buffer-fill ; : ch>buffer ( ch buffer -- ) diff --git a/extra/io/mmap/authors.txt b/extra/io/mmap/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/mmap/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/mmap/summary.txt b/extra/io/mmap/summary.txt new file mode 100755 index 0000000000..07d36c45be --- /dev/null +++ b/extra/io/mmap/summary.txt @@ -0,0 +1 @@ +Memory-mapped files diff --git a/extra/io/monitor/authors.txt b/extra/io/monitor/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/monitor/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/monitor/monitor.factor b/extra/io/monitor/monitor.factor index c74a449181..23b336c929 100755 --- a/extra/io/monitor/monitor.factor +++ b/extra/io/monitor/monitor.factor @@ -1,11 +1,19 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.backend ; +USING: io.backend kernel continuations ; IN: io.monitor -HOOK: io-backend ( path -- monitor ) +HOOK: io-backend ( path recursive? -- monitor ) -HOOK: next-change io-backend ( monitor -- path ) +HOOK: close-monitor io-backend ( monitor -- ) -: with-monitor ( directory quot -- ) +HOOK: next-change io-backend ( monitor -- path changes ) + +SYMBOL: +change-file+ +SYMBOL: +change-name+ +SYMBOL: +change-size+ +SYMBOL: +change-attributes+ +SYMBOL: +change-modified+ + +: with-monitor ( path recursive? quot -- ) >r r> over [ close-monitor ] curry [ ] cleanup ; diff --git a/extra/io/monitor/summary.txt b/extra/io/monitor/summary.txt new file mode 100755 index 0000000000..96d49e5ec8 --- /dev/null +++ b/extra/io/monitor/summary.txt @@ -0,0 +1 @@ +File alteration monitoring diff --git a/extra/io/paths/authors.txt b/extra/io/paths/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/paths/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/server/authors.txt b/extra/io/server/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/server/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/sniffer/authors.txt b/extra/io/sniffer/authors.txt new file mode 100755 index 0000000000..7a1ef51c6f --- /dev/null +++ b/extra/io/sniffer/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Elie Chaftari diff --git a/extra/io/sniffer/backend/authors.txt b/extra/io/sniffer/backend/authors.txt new file mode 100755 index 0000000000..7a1ef51c6f --- /dev/null +++ b/extra/io/sniffer/backend/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Elie Chaftari diff --git a/extra/io/sniffer/bsd/authors.txt b/extra/io/sniffer/bsd/authors.txt new file mode 100755 index 0000000000..7a1ef51c6f --- /dev/null +++ b/extra/io/sniffer/bsd/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Elie Chaftari diff --git a/extra/io/sniffer/filter/authors.txt b/extra/io/sniffer/filter/authors.txt new file mode 100755 index 0000000000..7a1ef51c6f --- /dev/null +++ b/extra/io/sniffer/filter/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Elie Chaftari diff --git a/extra/io/sniffer/filter/backend/authors.txt b/extra/io/sniffer/filter/backend/authors.txt new file mode 100755 index 0000000000..7a1ef51c6f --- /dev/null +++ b/extra/io/sniffer/filter/backend/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Elie Chaftari diff --git a/extra/io/sniffer/filter/bsd/authors.txt b/extra/io/sniffer/filter/bsd/authors.txt new file mode 100755 index 0000000000..7a1ef51c6f --- /dev/null +++ b/extra/io/sniffer/filter/bsd/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Elie Chaftari diff --git a/extra/io/sockets/headers/authors.txt b/extra/io/sockets/headers/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/sockets/headers/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/sockets/headers/bsd/authors.txt b/extra/io/sockets/headers/bsd/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/sockets/headers/bsd/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/sockets/headers/bsd/bsd.factor b/extra/io/sockets/headers/bsd/bsd.factor old mode 100644 new mode 100755 index c67cc95b7d..06634c28c8 --- a/extra/io/sockets/headers/bsd/bsd.factor +++ b/extra/io/sockets/headers/bsd/bsd.factor @@ -13,7 +13,7 @@ C-STRUCT: bpfh : bpfh. ( bpfh -- ) [ bpfh-timestamp "Timestamp: " write - "timeval" heap-size memory>string >byte-array . + "timeval" heap-size memory>byte-array . ] keep [ bpfh-caplen "caplen: " write . ] keep [ bpfh-datalen "datalen: " write . ] keep diff --git a/extra/io/sockets/headers/headers.factor b/extra/io/sockets/headers/headers.factor old mode 100644 new mode 100755 index 3a46f295d5..c697b60973 --- a/extra/io/sockets/headers/headers.factor +++ b/extra/io/sockets/headers/headers.factor @@ -9,6 +9,10 @@ C-STRUCT: etherneth { { "char" 6 } "smac" } { "ushort" "type" } ; +: >mac-address ( byte-array -- string ) + 6 memory>byte-array + [ >hex 2 48 pad-left ] { } map-as ":" join ; + : etherneth. ( etherneth -- ) [ etherneth-dmac "Dest MAC: " write >mac-address . ] keep [ etherneth-smac "Source MAC: " write >mac-address . ] keep diff --git a/extra/io/sockets/impl/authors.txt b/extra/io/sockets/impl/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/sockets/impl/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/sockets/impl/impl.factor b/extra/io/sockets/impl/impl.factor index ce4d5ad566..d7ac18ee20 100755 --- a/extra/io/sockets/impl/impl.factor +++ b/extra/io/sockets/impl/impl.factor @@ -32,7 +32,7 @@ GENERIC: inet-pton ( str addrspec -- data ) M: inet4 inet-ntop ( data addrspec -- str ) - drop 4 memory>string [ number>string ] { } map-as "." join ; + drop 4 memory>byte-array [ number>string ] { } map-as "." join ; M: inet4 inet-pton ( str addrspec -- data ) drop "." split [ string>number ] B{ } map-as ; @@ -60,7 +60,7 @@ M: inet4 parse-sockaddr swap sockaddr-in-port ntohs (port) ; M: inet6 inet-ntop ( data addrspec -- str ) - drop 16 memory>string 2 [ be> >hex ] map ":" join ; + drop 16 memory>byte-array 2 [ be> >hex ] map ":" join ; M: inet6 inet-pton ( str addrspec -- data ) drop "::" split1 @@ -132,8 +132,3 @@ M: object host-name ( -- name ) 256 dup dup length gethostname zero? [ "gethostname failed" throw ] unless alien>char-string ; - -: >mac-address ( byte-array -- string ) - 6 memory>string >byte-array - [ >hex 2 48 pad-left ] { } map-as ":" join ; - diff --git a/extra/io/streams/null/authors.txt b/extra/io/streams/null/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/streams/null/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/bsd/authors.txt b/extra/io/unix/bsd/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/bsd/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/epoll/authors.txt b/extra/io/unix/epoll/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/epoll/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/kqueue/authors.txt b/extra/io/unix/kqueue/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/kqueue/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/launcher/authors.txt b/extra/io/unix/launcher/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/launcher/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/linux/authors.txt b/extra/io/unix/linux/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/linux/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/mmap/authors.txt b/extra/io/unix/mmap/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/mmap/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/unix/select/authors.txt b/extra/io/unix/select/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/unix/select/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/windows/ce/backend/authors.txt b/extra/io/windows/ce/backend/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/extra/io/windows/ce/backend/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/extra/io/windows/ce/backend/backend.factor b/extra/io/windows/ce/backend/backend.factor index 142447fe0c..e90a9f16e2 100755 --- a/extra/io/windows/ce/backend/backend.factor +++ b/extra/io/windows/ce/backend/backend.factor @@ -8,7 +8,7 @@ IN: io.windows.ce.backend win32-error-string swap set-port-error ; M: windows-ce-io io-multiplex ( ms -- ) (sleep) ; -M: windows-ce-io add-completion ( port -- ) drop ; +M: windows-ce-io add-completion ( handle -- ) drop ; GENERIC: wince-read ( port port-handle -- ) diff --git a/extra/io/windows/ce/files/authors.txt b/extra/io/windows/ce/files/authors.txt new file mode 100755 index 0000000000..5674120196 --- /dev/null +++ b/extra/io/windows/ce/files/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/extra/io/windows/ce/sockets/authors.txt b/extra/io/windows/ce/sockets/authors.txt new file mode 100755 index 0000000000..5674120196 --- /dev/null +++ b/extra/io/windows/ce/sockets/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index cc19976bc5..5f87088804 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -78,7 +78,7 @@ M: windows-ce-io ( addrspec -- datagram ) packet-size receive-buffer make-WSABUF ; : packet-data ( len -- byte-array ) - receive-buffer swap memory>string >byte-array ; + receive-buffer swap memory>byte-array ; packet-size receive-buffer set-global diff --git a/extra/io/windows/launcher/authors.txt b/extra/io/windows/launcher/authors.txt new file mode 100755 index 0000000000..5674120196 --- /dev/null +++ b/extra/io/windows/launcher/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/extra/io/windows/mmap/authors.txt b/extra/io/windows/mmap/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/windows/mmap/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/windows/nt/backend/authors.txt b/extra/io/windows/nt/backend/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/extra/io/windows/nt/backend/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 82d609c371..3b10ddd935 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -43,28 +43,17 @@ M: windows-nt-io normalize-pathname ( string -- string ) SYMBOL: io-hash -TUPLE: io-callback continuation port ; +TUPLE: io-callback port continuation ; C: io-callback : (make-overlapped) ( -- overlapped-ext ) - "OVERLAPPED" malloc-object dup free-always - 0 over set-OVERLAPPED-internal - 0 over set-OVERLAPPED-internal-high - 0 over set-OVERLAPPED-offset-high - 0 over set-OVERLAPPED-offset - f over set-OVERLAPPED-event ; + "OVERLAPPED" malloc-object dup free-always ; : make-overlapped ( port -- overlapped-ext ) >r (make-overlapped) r> port-handle win32-file-ptr [ over set-OVERLAPPED-offset ] when* ; -: port-overlapped ( port -- overlapped ) - port-handle win32-file-overlapped ; - -: set-port-overlapped ( overlapped port -- ) - port-handle set-win32-file-overlapped ; - : ( handle existing -- handle ) f 1 CreateIoCompletionPort dup win32-error=0/f ; @@ -90,21 +79,16 @@ M: windows-nt-io add-completion ( handle -- ) drop t ] if ; -: get-overlapped-result ( port -- bytes-transferred ) - dup - port-handle - dup win32-file-handle - swap win32-file-overlapped - 0 [ - 0 - GetOverlappedResult overlapped-error? drop - ] keep *uint ; +: get-overlapped-result ( overlapped port -- bytes-transferred ) + dup port-handle win32-file-handle rot 0 + [ 0 GetOverlappedResult overlapped-error? drop ] keep *uint ; -: save-callback ( port -- ) +: save-callback ( overlapped port -- ) [ - [ ] keep port-handle win32-file-overlapped + swap + dup alien? [ "bad overlapped in save-callback" throw ] unless io-hash get-global set-at stop - ] curry callcc0 ; + ] callcc0 2drop ; : wait-for-overlapped ( ms -- overlapped ? ) >r master-completion-port get-global r> ! port ms @@ -113,8 +97,9 @@ M: windows-nt-io add-completion ( handle -- ) f ! overlapped [ roll GetQueuedCompletionStatus ] keep *void* swap zero? ; -: lookup-callback ( GetQueuedCompletion-args -- callback ) - io-hash get-global delete-at* drop ; +: lookup-callback ( overlapped -- callback ) + io-hash get-global delete-at* drop + dup io-callback? [ "no callback in io-hash" throw ] unless ; : handle-overlapped ( timeout -- ? ) wait-for-overlapped [ diff --git a/extra/io/windows/nt/files/authors.txt b/extra/io/windows/nt/files/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/extra/io/windows/nt/files/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/extra/io/windows/nt/files/files.factor b/extra/io/windows/nt/files/files.factor index 375f35176c..06edd8b3ee 100755 --- a/extra/io/windows/nt/files/files.factor +++ b/extra/io/windows/nt/files/files.factor @@ -17,22 +17,19 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) 2drop ] if* ; -: finish-flush ( port -- ) +: finish-flush ( overlapped port -- ) dup pending-error - dup get-overlapped-result + tuck get-overlapped-result dup pick update-file-ptr swap buffer-consume ; -: save-overlapped-and-callback ( fileargs port -- ) - swap FileArgs-lpOverlapped over set-port-overlapped - save-callback ; - : (flush-output) ( port -- ) dup touch-port dup make-FileArgs tuck setup-write WriteFile dupd overlapped-error? [ - [ save-overlapped-and-callback ] keep + >r FileArgs-lpOverlapped r> + [ save-callback ] 2keep [ finish-flush ] keep dup buffer-empty? [ drop ] [ (flush-output) ] if ] [ @@ -45,9 +42,9 @@ M: windows-nt-io FileArgs-overlapped ( port -- overlapped ) M: port port-flush dup buffer-empty? [ dup flush-output ] unless drop ; -: finish-read ( port -- ) +: finish-read ( overlapped port -- ) dup pending-error - dup get-overlapped-result dup zero? [ + tuck get-overlapped-result dup zero? [ drop t swap set-port-eof? ] [ dup pick n>buffer @@ -59,7 +56,8 @@ M: port port-flush dup make-FileArgs tuck setup-read ReadFile dupd overlapped-error? [ - [ save-overlapped-and-callback ] keep + >r FileArgs-lpOverlapped r> + [ save-callback ] 2keep finish-read ] [ 2drop diff --git a/extra/io/windows/nt/launcher/authors.txt b/extra/io/windows/nt/launcher/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/extra/io/windows/nt/launcher/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/extra/io/windows/nt/monitor/authors.txt b/extra/io/windows/nt/monitor/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/windows/nt/monitor/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/windows/nt/monitor/monitor.factor b/extra/io/windows/nt/monitor/monitor.factor index 2b3b87b2bd..bd3debecad 100755 --- a/extra/io/windows/nt/monitor/monitor.factor +++ b/extra/io/windows/nt/monitor/monitor.factor @@ -1,74 +1,99 @@ ! Copyright (C) 2008 Doug Coleman, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: alien.c-types destructors io.windows kernel math windows -windows.kernel32 windows.types libc assocs alien namespaces -continuations io.monitor ; +USING: alien.c-types destructors io.windows +io.windows.nt.backend kernel math windows windows.kernel32 +windows.types libc assocs alien namespaces continuations +io.monitor io.nonblocking io.buffers io.files io sequences +hashtables sorting arrays ; IN: io.windows.nt.monitor -TUPLE: monitor handle buffer queue closed? ; +TUPLE: monitor path recursive? queue closed? ; : open-directory ( path -- handle ) + FILE_LIST_DIRECTORY + share-mode + f + OPEN_EXISTING + FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor + f + CreateFile + dup invalid-handle? + dup close-later + dup add-completion + f ; + +M: windows-nt-io ( path recursive? -- monitor ) [ - FILE_LIST_DIRECTORY - share-mode - f - OPEN_EXISTING - FILE_FLAG_BACKUP_SEMANTICS FILE_FLAG_OVERLAPPED bitor - f - CreateFile dup invalid-handle? dup close-later + >r dup open-directory monitor r> { + set-monitor-path + set-delegate + set-monitor-recursive? + } monitor construct ] with-destructors ; -: buffer-size 65536 ; inline - -M: windows-nt-io ( path -- monitor ) - [ - open-directory - buffer-size malloc dup free-later f - ] with-destructors - f monitor construct-boa ; - : check-closed ( monitor -- ) - monitor-closed? [ "Monitor closed" throw ] when ; + port-type closed eq? [ "Monitor closed" throw ] when ; -: close-monitor ( monitor -- ) - dup check-closed - dup monitor-buffer free - dup monitor-handle CloseHandle drop - t swap set-monitor-closed? ; +M: windows-nt-io close-monitor ( monitor -- ) stream-close ; -: fill-buffer ( monitor -- bytes ) +: begin-reading-changes ( monitor -- overlapped ) + dup port-handle win32-file-handle + over buffer-ptr + pick buffer-size + roll monitor-recursive? 1 0 ? + FILE_NOTIFY_CHANGE_ALL + 0 + (make-overlapped) + [ f ReadDirectoryChangesW win32-error=0/f ] keep ; + +: read-changes ( monitor -- bytes ) [ - dup monitor-handle - swap monitor-buffer - buffer-size - TRUE - FILE_NOTIFY_CHANGE_ALL - 0 [ - f - f - ReadDirectoryChangesW win32-error=0/f - ] keep *uint + dup begin-reading-changes swap [ save-callback ] 2keep + get-overlapped-result ] with-destructors ; -: (changed-files) ( buffer -- ) - dup { - FILE_NOTIFY_INFORMATION-NextEntryOffset +: parse-action-flag ( action mask symbol -- action ) + >r over bitand 0 > [ r> , ] [ r> drop ] if ; + +: parse-action ( action -- changes ) + [ + FILE_NOTIFY_CHANGE_FILE +change-file+ parse-action-flag + FILE_NOTIFY_CHANGE_DIR_NAME +change-name+ parse-action-flag + FILE_NOTIFY_CHANGE_ATTRIBUTES +change-attributes+ parse-action-flag + FILE_NOTIFY_CHANGE_SIZE +change-size+ parse-action-flag + FILE_NOTIFY_CHANGE_LAST_WRITE +change-modified+ parse-action-flag + FILE_NOTIFY_CHANGE_LAST_ACCESS +change-attributes+ parse-action-flag + FILE_NOTIFY_CHANGE_EA +change-attributes+ parse-action-flag + FILE_NOTIFY_CHANGE_CREATION +change-attributes+ parse-action-flag + FILE_NOTIFY_CHANGE_SECURITY +change-attributes+ parse-action-flag + FILE_NOTIFY_CHANGE_FILE_NAME +change-name+ parse-action-flag + drop + ] { } make ; + +: changed-file ( directory buffer -- changes path ) + { FILE_NOTIFY_INFORMATION-FileName FILE_NOTIFY_INFORMATION-FileNameLength - } get-slots memory>string dup set - dup zero? [ 2drop ] [ - swap (changed-files) - ] if ; + FILE_NOTIFY_INFORMATION-Action + } get-slots >r memory>u16-string path+ r> parse-action swap ; -: changed-files ( buffer len -- assoc ) - [ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc ; +: (changed-files) ( directory buffer -- ) + 2dup changed-file namespace [ append ] change-at + dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero? + [ 3drop ] [ swap (changed-files) ] if ; + +: changed-files ( directory buffer len -- assoc ) + [ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc ; : fill-queue ( monitor -- ) - dup monitor-buffer - over fill-buffer changed-files + dup monitor-path over buffer-ptr pick read-changes + changed-files swap set-monitor-queue ; -M: windows-nt-io next-change ( monitor -- path ) +M: windows-nt-io next-change ( monitor -- path changes ) dup check-closed - dup monitor-queue dup assoc-empty? - [ drop dup fill-queue next-change ] [ nip delete-any ] if ; + dup monitor-queue dup assoc-empty? [ + drop dup fill-queue next-change + ] [ + nip delete-any prune natural-sort >array + ] if ; diff --git a/extra/io/windows/nt/nt.factor b/extra/io/windows/nt/nt.factor index 000d1362b6..5bdefd7713 100755 --- a/extra/io/windows/nt/nt.factor +++ b/extra/io/windows/nt/nt.factor @@ -1,12 +1,13 @@ -! Copyright (C) 2004, 2007 Mackenzie Straight, Doug Coleman. +! Copyright (C) 2004, 2008 Mackenzie Straight, Doug Coleman, +! Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USE: io.windows USE: io.windows.nt.backend USE: io.windows.nt.files -USE: io.windows.nt.sockets USE: io.windows.nt.launcher +USE: io.windows.nt.monitor +USE: io.windows.nt.sockets USE: io.windows.mmap USE: io.backend -USE: namespaces T{ windows-nt-io } set-io-backend diff --git a/extra/io/windows/nt/sockets/authors.txt b/extra/io/windows/nt/sockets/authors.txt new file mode 100755 index 0000000000..026f4cd0de --- /dev/null +++ b/extra/io/windows/nt/sockets/authors.txt @@ -0,0 +1,3 @@ +Doug Coleman +Slava Pestov +Mackenzie Straight diff --git a/extra/io/windows/nt/sockets/sockets.factor b/extra/io/windows/nt/sockets/sockets.factor index a6c44a0b86..6c7db33ee3 100755 --- a/extra/io/windows/nt/sockets/sockets.factor +++ b/extra/io/windows/nt/sockets/sockets.factor @@ -44,12 +44,11 @@ TUPLE: ConnectEx-args port "stdcall" alien-indirect drop winsock-error-string [ throw ] when* ; -: check-connect-error ( ConnectEx -- ) - ConnectEx-args-port duplex-stream-in get-overlapped-result drop ; - : connect-continuation ( ConnectEx -- ) - [ ConnectEx-args-port duplex-stream-in save-callback ] keep - check-connect-error ; + dup ConnectEx-args-lpOverlapped* + swap ConnectEx-args-port duplex-stream-in + [ save-callback ] 2keep + get-overlapped-result drop ; M: windows-nt-io (client) ( addrspec -- duplex-stream ) [ @@ -64,10 +63,6 @@ M: windows-nt-io (client) ( addrspec -- duplex-stream ) dup ConnectEx-args-s* dup handle>duplex-stream over set-ConnectEx-args-port - [ - dup ConnectEx-args-lpOverlapped* - swap ConnectEx-args-port duplex-stream-in set-port-overlapped - ] keep dup connect-continuation ConnectEx-args-port [ duplex-stream-in pending-error ] keep @@ -93,8 +88,7 @@ TUPLE: AcceptEx-args port over set-AcceptEx-args-sAcceptSocket* 0 over set-AcceptEx-args-dwReceiveDataLength* f over set-AcceptEx-args-lpdwBytesReceived* - (make-overlapped) over set-AcceptEx-args-lpOverlapped* - dup AcceptEx-args-lpOverlapped* swap AcceptEx-args-port set-port-overlapped ; + (make-overlapped) swap set-AcceptEx-args-lpOverlapped* ; : (accept) ( AcceptEx -- ) \ AcceptEx-args >tuple*< @@ -102,10 +96,12 @@ TUPLE: AcceptEx-args port winsock-error-string [ throw ] when* ; : make-accept-continuation ( AcceptEx -- ) - AcceptEx-args-port save-callback ; + dup AcceptEx-args-lpOverlapped* + swap AcceptEx-args-port save-callback ; : check-accept-error ( AcceptEx -- ) - AcceptEx-args-port get-overlapped-result drop ; + dup AcceptEx-args-lpOverlapped* + swap AcceptEx-args-port get-overlapped-result drop ; : extract-remote-host ( AcceptEx -- addrspec ) [ @@ -166,6 +162,11 @@ TUPLE: WSARecvFrom-args port s* lpBuffers* dwBufferCount* lpNumberOfBytesRecvd* lpFlags* lpFrom* lpFromLen* lpOverlapped* lpCompletionRoutine* ; +: make-receive-buffer ( -- WSABUF ) + "WSABUF" malloc-object dup free-always + default-buffer-size get over set-WSABUF-len + default-buffer-size get malloc dup free-always over set-WSABUF-buf ; + : init-WSARecvFrom ( datagram WSARecvFrom -- ) [ set-WSARecvFrom-args-port ] 2keep [ @@ -176,33 +177,26 @@ TUPLE: WSARecvFrom-args port 2dup >r malloc dup free-always r> set-WSARecvFrom-args-lpFrom* >r malloc-int dup free-always r> set-WSARecvFrom-args-lpFromLen* ] keep - "WSABUF" malloc-object dup free-always - 2dup swap set-WSARecvFrom-args-lpBuffers* - default-buffer-size get [ malloc dup free-always ] keep - pick set-WSABUF-len - swap set-WSABUF-buf + make-receive-buffer over set-WSARecvFrom-args-lpBuffers* 1 over set-WSARecvFrom-args-dwBufferCount* 0 malloc-int dup free-always over set-WSARecvFrom-args-lpFlags* 0 malloc-int dup free-always over set-WSARecvFrom-args-lpNumberOfBytesRecvd* - (make-overlapped) [ over set-WSARecvFrom-args-lpOverlapped* ] keep - swap WSARecvFrom-args-port set-port-overlapped ; + (make-overlapped) swap set-WSARecvFrom-args-lpOverlapped* ; -: make-WSARecvFrom-continuation ( WSARecvFrom -- ) - WSARecvFrom-args-port save-callback ; +: WSARecvFrom-continuation ( WSARecvFrom -- n ) + dup WSARecvFrom-args-lpOverlapped* + swap WSARecvFrom-args-port [ save-callback ] 2keep + get-overlapped-result ; : call-WSARecvFrom ( WSARecvFrom -- ) \ WSARecvFrom-args >tuple*< WSARecvFrom socket-error* ; -: WSARecvFrom-continuation ( WSARecvFrom -- n ) - [ make-WSARecvFrom-continuation ] keep - WSARecvFrom-args-port get-overlapped-result ; - : parse-WSARecvFrom ( n WSARecvFrom -- packet addrspec ) [ WSARecvFrom-args-lpBuffers* WSABUF-buf - swap memory>string >byte-array + swap memory>byte-array ] keep [ WSARecvFrom-args-lpFrom* ] keep WSARecvFrom-args-port datagram-port-addr parse-sockaddr ; @@ -222,35 +216,36 @@ TUPLE: WSASendTo-args port s* lpBuffers* dwBufferCount* lpNumberOfBytesSent* dwFlags* lpTo* iToLen* lpOverlapped* lpCompletionRoutine* ; +: make-send-buffer ( packet -- WSABUF ) + "WSABUF" malloc-object dup free-always + over malloc-byte-array dup free-always over set-WSABUF-buf + swap length over set-WSABUF-len ; + : init-WSASendTo ( packet addrspec datagram WSASendTo -- ) [ set-WSASendTo-args-port ] 2keep [ - >r delegate port-handle delegate win32-file-handle r> - set-WSASendTo-args-s* - ] keep [ + >r port-handle win32-file-handle r> set-WSASendTo-args-s* + ] keep + [ >r make-sockaddr/size >r malloc-byte-array dup free-always r> r> [ set-WSASendTo-args-iToLen* ] keep set-WSASendTo-args-lpTo* - ] keep [ - "WSABUF" malloc-object dup free-always - dup rot set-WSASendTo-args-lpBuffers* - swap [ malloc-byte-array dup free-always ] keep length - rot [ set-WSABUF-len ] keep - set-WSABUF-buf + ] keep + [ + >r make-send-buffer r> set-WSASendTo-args-lpBuffers* ] keep 1 over set-WSASendTo-args-dwBufferCount* 0 over set-WSASendTo-args-dwFlags* - (make-overlapped) [ over set-WSASendTo-args-lpOverlapped* ] keep - swap WSASendTo-args-port set-port-overlapped ; - -: make-WSASendTo-continuation ( WSASendTo -- ) - WSASendTo-args-port save-callback ; + 0 over set-WSASendTo-args-lpNumberOfBytesSent* + (make-overlapped) swap set-WSASendTo-args-lpOverlapped* ; : WSASendTo-continuation ( WSASendTo -- ) - [ make-WSASendTo-continuation ] keep - WSASendTo-args-port get-overlapped-result drop ; + dup WSASendTo-args-lpOverlapped* + swap WSASendTo-args-port + [ save-callback ] 2keep + get-overlapped-result drop ; : call-WSASendTo ( WSASendTo -- ) \ WSASendTo-args >tuple*< diff --git a/extra/io/windows/pipes/authors.txt b/extra/io/windows/pipes/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/io/windows/pipes/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index efac6cb1cc..03cb3be9ae 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -15,10 +15,9 @@ M: windows-io destruct-handle CloseHandle drop ; M: windows-io destruct-socket closesocket drop ; -TUPLE: win32-file handle ptr overlapped ; +TUPLE: win32-file handle ptr ; -: ( handle ptr -- obj ) - f win32-file construct-boa ; +C: win32-file : ( in out -- stream ) >r f r> f handle>duplex-stream ; diff --git a/extra/jamshred/authors.txt b/extra/jamshred/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/jamshred/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/jamshred/game/authors.txt b/extra/jamshred/game/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/jamshred/game/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/jamshred/gl/authors.txt b/extra/jamshred/gl/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/jamshred/gl/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/jamshred/oint/authors.txt b/extra/jamshred/oint/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/jamshred/oint/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/jamshred/player/authors.txt b/extra/jamshred/player/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/jamshred/player/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/jamshred/tunnel/authors.txt b/extra/jamshred/tunnel/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/jamshred/tunnel/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/json/authors.txt b/extra/json/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/json/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/json/summary.txt b/extra/json/summary.txt new file mode 100755 index 0000000000..33c7c9780c --- /dev/null +++ b/extra/json/summary.txt @@ -0,0 +1 @@ +JSON reader and writer diff --git a/extra/koszul/authors.txt b/extra/koszul/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/koszul/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/koszul/summary.txt b/extra/koszul/summary.txt new file mode 100755 index 0000000000..33ad2754b8 --- /dev/null +++ b/extra/koszul/summary.txt @@ -0,0 +1 @@ +Lie algebra cohomology diff --git a/extra/lazy-lists/examples/authors.txt b/extra/lazy-lists/examples/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/lazy-lists/examples/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/lcd/lcd.factor b/extra/lcd/lcd.factor old mode 100644 new mode 100755 index 192e4053d4..605ac4cd59 --- a/extra/lcd/lcd.factor +++ b/extra/lcd/lcd.factor @@ -1,19 +1,19 @@ USING: sequences kernel math io ; IN: lcd -: lcd-digit ( digit row -- str ) - { - " _ _ _ _ _ _ _ _ " - " | | | _| _| |_| |_ |_ | |_| |_| " - " |_| | |_ _| | _| |_| | |_| | " +: lcd-digit ( row digit -- str ) + dup CHAR: : = [ drop 10 ] [ CHAR: 0 - ] if swap { + " _ _ _ _ _ _ _ _ " + " | | | _| _| |_| |_ |_ | |_| |_| * " + " |_| | |_ _| | _| |_| | |_| | * " } nth >r 4 * dup 4 + r> subseq ; -: lcd-row ( num row -- ) - swap [ CHAR: 0 - swap lcd-digit write ] with each ; +: lcd-row ( num row -- string ) + [ swap lcd-digit ] curry { } map-as concat ; -: lcd ( digit-str -- ) - 3 [ lcd-row nl ] with each ; +: lcd ( digit-str -- string ) + 3 [ lcd-row ] with map "\n" join ; -: lcd-demo ( -- ) "31337" lcd ; +: lcd-demo ( -- ) "31337" lcd print ; MAIN: lcd-demo diff --git a/extra/ldap/libldap/authors.txt b/extra/ldap/libldap/authors.txt new file mode 100755 index 0000000000..7c29e7c401 --- /dev/null +++ b/extra/ldap/libldap/authors.txt @@ -0,0 +1 @@ +Elie Chaftari diff --git a/extra/line-art/authors.txt b/extra/line-art/authors.txt new file mode 100644 index 0000000000..6a0dc7293a --- /dev/null +++ b/extra/line-art/authors.txt @@ -0,0 +1 @@ +Joe Groff \ No newline at end of file diff --git a/extra/line-art/line-art.factor b/extra/line-art/line-art.factor new file mode 100644 index 0000000000..9eb3dc2dda --- /dev/null +++ b/extra/line-art/line-art.factor @@ -0,0 +1,254 @@ +USING: arrays bunny combinators.lib continuations io io.files kernel + math math.functions math.vectors multiline + namespaces + opengl opengl.gl opengl-demo-support + prettyprint + sequences ui ui.gadgets ui.gestures ui.render ; +IN: line-art + +TUPLE: line-art-gadget + model step1-program step2-program + framebuffer color-texture normal-texture depth-texture framebuffer-dim ; + +: ( -- line-art-gadget ) + 40.0 -5.0 0.275 + maybe-download read-model + { set-delegate set-line-art-gadget-model } line-art-gadget construct ; + +STRING: line-art-step1-vertex-shader-source +varying vec3 normal; + +void +main() +{ + gl_Position = ftransform(); + normal = gl_Normal; +} + +; + +STRING: line-art-step1-fragment-shader-source +varying vec3 normal; +uniform vec4 color; + +void +main() +{ + gl_FragData[0] = color; + gl_FragData[1] = vec4(normal, 1); +} + +; + +STRING: line-art-step2-vertex-shader-source +varying vec2 coord; + +void +main() +{ + gl_Position = ftransform(); + coord = (gl_Vertex * vec4(0.5) + vec4(0.5)).xy; +} + +; + +STRING: line-art-step2-fragment-shader-source +uniform sampler2D colormap, normalmap, depthmap; +uniform vec4 line_color; +varying vec2 coord; + +const float DEPTH_RATIO_THRESHOLD = 1.001, NORMAL_DOT_THRESHOLD = 1.0, SAMPLE_SPREAD = 1.0/512.0; + +bool +is_normal_border(vec3 norm1, vec3 norm2) +{ + return dot(norm1, norm2) < NORMAL_DOT_THRESHOLD; +} + +float +depth_sample(vec2 c) +{ + return texture2D(depthmap, c).x; +} +bool +are_depths_border(vec3 depths) +{ + return any(lessThan(depths, vec3(1.0/DEPTH_RATIO_THRESHOLD))) + || any(greaterThan(depths, vec3(DEPTH_RATIO_THRESHOLD))); +} + +vec3 +normal_sample(vec2 c) +{ + return texture2D(normalmap, c).xyz; +} + +float +min6(float a, float b, float c, float d, float e, float f) +{ + return min(min(min(min(min(a, b), c), d), e), f); +} + +float +border_factor(vec2 c) +{ + vec2 coord1 = c + vec2(-SAMPLE_SPREAD, -SAMPLE_SPREAD), + coord2 = c + vec2( SAMPLE_SPREAD, -SAMPLE_SPREAD), + coord3 = c + vec2(-SAMPLE_SPREAD, SAMPLE_SPREAD), + coord4 = c + vec2( SAMPLE_SPREAD, SAMPLE_SPREAD); + + vec4 depths = vec4(depth_sample(coord1), + depth_sample(coord2), + depth_sample(coord3), + depth_sample(coord4)); + if (depths == vec4(1, 1, 1, 1)) + return 0.0; + + vec3 ratios1 = depths.xxx/depths.yzw, ratios2 = depths.yyz/depths.zww; + + if (are_depths_border(ratios1) || are_depths_border(ratios2)) + return 1.0; + + vec3 normal1 = normal_sample(coord1), + normal2 = normal_sample(coord2), + normal3 = normal_sample(coord3), + normal4 = normal_sample(coord4); + + float normal_border = 1.0 - min6( + dot(normal1, normal2), + dot(normal1, normal3), + dot(normal1, normal4), + dot(normal2, normal3), + dot(normal2, normal4), + dot(normal3, normal4) + ); + + return normal_border; +} + +void +main() +{ + gl_FragColor = mix(texture2D(colormap, coord), line_color, border_factor(coord)); +} + +; + +: (line-art-step1-program) ( -- step1 ) + line-art-step1-vertex-shader-source line-art-step1-fragment-shader-source + ; +: (line-art-step2-program) ( -- step2 ) + line-art-step2-vertex-shader-source line-art-step2-fragment-shader-source + ; + +: (line-art-framebuffer-texture) ( dim iformat xformat -- texture ) + swapd >r >r >r + GL_TEXTURE0 glActiveTexture + gen-texture GL_TEXTURE_2D over glBindTexture + GL_TEXTURE_2D GL_TEXTURE_WRAP_S GL_CLAMP glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_WRAP_T GL_CLAMP glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_NEAREST glTexParameteri + GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_NEAREST glTexParameteri + GL_TEXTURE_2D 0 r> r> first2 0 r> GL_UNSIGNED_BYTE f glTexImage2D ; + +: (line-art-color-texture) ( dim -- texture ) + GL_RGBA16F_ARB GL_RGBA (line-art-framebuffer-texture) ; + +: (line-art-normal-texture) ( dim -- texture ) + GL_RGBA16F_ARB GL_RGBA (line-art-framebuffer-texture) ; + +: (line-art-depth-texture) ( dim -- texture ) + GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT (line-art-framebuffer-texture) ; + +: (attach-framebuffer-texture) ( texture attachment -- ) + swap >r >r GL_FRAMEBUFFER_EXT r> GL_TEXTURE_2D r> 0 glFramebufferTexture2DEXT gl-error ; + +: (line-art-framebuffer) ( color-texture normal-texture depth-texture -- framebuffer ) + 3array gen-framebuffer dup [ + swap GL_COLOR_ATTACHMENT0_EXT + GL_COLOR_ATTACHMENT1_EXT + GL_DEPTH_ATTACHMENT_EXT 3array [ (attach-framebuffer-texture) ] 2each + check-framebuffer + ] with-framebuffer ; + +: line-art-remake-framebuffer-if-needed ( gadget -- ) + dup { rect-dim rect-dim line-art-gadget-framebuffer-dim } get-slots = [ 2drop ] [ + swap >r + dup (line-art-color-texture) gl-error + swap dup (line-art-normal-texture) gl-error + swap dup (line-art-depth-texture) gl-error + swap >r + [ (line-art-framebuffer) ] 3keep + r> r> { set-line-art-gadget-framebuffer + set-line-art-gadget-color-texture + set-line-art-gadget-normal-texture + set-line-art-gadget-depth-texture + set-line-art-gadget-framebuffer-dim } set-slots + ] if ; + +M: line-art-gadget graft* ( gadget -- ) + "2.0" { "GL_ARB_draw_buffers" + "GL_ARB_shader_objects" + "GL_ARB_multitexture" + "GL_ARB_texture_float" } + require-gl-version-or-extensions + { "GL_EXT_framebuffer_object" } require-gl-extensions + GL_CULL_FACE glEnable + GL_DEPTH_TEST glEnable + (line-art-step1-program) over set-line-art-gadget-step1-program + (line-art-step2-program) swap set-line-art-gadget-step2-program ; + +M: line-art-gadget ungraft* ( gadget -- ) + dup line-art-gadget-framebuffer [ + { [ line-art-gadget-step1-program delete-gl-program ] + [ line-art-gadget-step2-program delete-gl-program ] + [ line-art-gadget-framebuffer delete-framebuffer ] + [ line-art-gadget-color-texture delete-texture ] + [ line-art-gadget-normal-texture delete-texture ] + [ line-art-gadget-depth-texture delete-texture ] + [ f swap set-line-art-gadget-framebuffer-dim ] + [ f swap set-line-art-gadget-framebuffer ] } call-with + ] [ drop ] if ; + +: line-art-draw-setup ( gadget -- gadget ) + 0.0 0.0 0.0 1.0 glClearColor + GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear + dup demo-gadget-set-matrices + dup line-art-remake-framebuffer-if-needed + gl-error ; + +: line-art-clear-framebuffer ( -- ) + GL_COLOR_ATTACHMENT0_EXT glDrawBuffer + 0.2 0.2 0.2 1.0 glClearColor + GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear + GL_COLOR_ATTACHMENT1_EXT glDrawBuffer + 0.0 0.0 0.0 0.0 glClearColor + GL_COLOR_BUFFER_BIT glClear ; + +M: line-art-gadget draw-gadget* ( gadget -- ) + line-art-draw-setup + dup line-art-gadget-framebuffer [ + line-art-clear-framebuffer + { GL_COLOR_ATTACHMENT0_EXT GL_COLOR_ATTACHMENT1_EXT } set-draw-buffers + dup line-art-gadget-step1-program dup [ + "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f + 0.0 -0.12 0.0 glTranslatef + dup line-art-gadget-model first3 draw-bunny + ] with-gl-program + ] with-framebuffer + init-matrices + dup line-art-gadget-color-texture GL_TEXTURE_2D GL_TEXTURE0 bind-texture-unit + dup line-art-gadget-normal-texture GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit + dup line-art-gadget-depth-texture GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit + line-art-gadget-step2-program dup [ + { [ "colormap" glGetUniformLocation 0 glUniform1i ] + [ "normalmap" glGetUniformLocation 1 glUniform1i ] + [ "depthmap" glGetUniformLocation 2 glUniform1i ] + [ "line_color" glGetUniformLocation 0.2 0.0 0.0 1.0 glUniform4f ] } call-with + { -1.0 -1.0 } { 1.0 1.0 } rect-vertices + ] with-gl-program ; + +: line-art-window ( -- ) + [ "Line Art" open-window ] with-ui ; + +MAIN: line-art-window diff --git a/extra/line-art/summary.txt b/extra/line-art/summary.txt new file mode 100644 index 0000000000..06d16da2bf --- /dev/null +++ b/extra/line-art/summary.txt @@ -0,0 +1 @@ +Stanford Bunny rendered with cartoon-style lines instead of shading \ No newline at end of file diff --git a/extra/line-art/tags.txt b/extra/line-art/tags.txt new file mode 100644 index 0000000000..0db7e8e629 --- /dev/null +++ b/extra/line-art/tags.txt @@ -0,0 +1,3 @@ +demos +opengl +glsl \ No newline at end of file diff --git a/extra/lint/summary.txt b/extra/lint/summary.txt new file mode 100755 index 0000000000..943869d7d2 --- /dev/null +++ b/extra/lint/summary.txt @@ -0,0 +1 @@ +Finds potential mistakes in code diff --git a/extra/lsys/strings/authors.txt b/extra/lsys/strings/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/lsys/strings/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/lsys/strings/interpret/authors.txt b/extra/lsys/strings/interpret/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/lsys/strings/interpret/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/lsys/strings/rewrite/authors.txt b/extra/lsys/strings/rewrite/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/lsys/strings/rewrite/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/lsys/tortoise/authors.txt b/extra/lsys/tortoise/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/lsys/tortoise/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/lsys/tortoise/graphics/authors.txt b/extra/lsys/tortoise/graphics/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/lsys/tortoise/graphics/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/lsys/ui/authors.txt b/extra/lsys/ui/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/lsys/ui/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/macros/zoo/authors.txt b/extra/macros/zoo/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/macros/zoo/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/mad/api/authors.txt b/extra/mad/api/authors.txt new file mode 100755 index 0000000000..bbc876e7b6 --- /dev/null +++ b/extra/mad/api/authors.txt @@ -0,0 +1 @@ +Adam Wendt diff --git a/extra/mad/player/authors.txt b/extra/mad/player/authors.txt new file mode 100755 index 0000000000..bbc876e7b6 --- /dev/null +++ b/extra/mad/player/authors.txt @@ -0,0 +1 @@ +Adam Wendt diff --git a/extra/math/miller-rabin/authors.txt b/extra/math/miller-rabin/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/math/miller-rabin/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/math/miller-rabin/miller-rabin.factor b/extra/math/miller-rabin/miller-rabin.factor old mode 100644 new mode 100755 index e2d012ec0a..8b0d98283c --- a/extra/math/miller-rabin/miller-rabin.factor +++ b/extra/math/miller-rabin/miller-rabin.factor @@ -1,5 +1,6 @@ USING: combinators combinators.lib io locals kernel math -math.functions math.ranges namespaces random sequences ; +math.functions math.ranges namespaces random sequences +hashtables ; IN: math.miller-rabin SYMBOL: a diff --git a/extra/math/primes/list/authors.txt b/extra/math/primes/list/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/math/primes/list/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/minneapolis-talk/authors.txt b/extra/minneapolis-talk/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/minneapolis-talk/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/catalyst-talk/deploy.factor b/extra/minneapolis-talk/deploy.factor similarity index 100% rename from extra/catalyst-talk/deploy.factor rename to extra/minneapolis-talk/deploy.factor diff --git a/extra/minneapolis-talk/minneapolis-talk.factor b/extra/minneapolis-talk/minneapolis-talk.factor new file mode 100755 index 0000000000..19cdcab2fb --- /dev/null +++ b/extra/minneapolis-talk/minneapolis-talk.factor @@ -0,0 +1,182 @@ +USING: slides help.markup math arrays hashtables namespaces +sequences kernel sequences parser memoize ; +IN: minneapolis-talk + +: minneapolis-slides +{ + { $slide "What is Factor?" + "Dynamically typed, stack language" + "Have our cake and eat it too" + "Research -vs- production" + "High level -vs- performance" + "Interactive -vs- stand-alone apps" + } + { $slide "The view from 10,000 feet" + "Influenced by Forth, Lisp, Joy, Smalltalk, even Java..." + "Vocabularies: modules" + "Words: named functions, classes, variables" + "Combinators: higher-order functions" + "Quotations: anonymous functions" + } + { $slide "Stack-based programming" + { "Most languages are " { $emphasis "applicative" } } + "Words pop inputs from the stack and push outputs on the stack" + "Literals are pushed on the stack" + { $code "{ 1 2 } { 7 } append reverse sum ." } + } + { $slide "Stack-based programming" + "With the stack you can omit unnecessary names" + "You can still name things: lexical/dynamic variables, sequences, associations, objects, ..." + } + { $slide "Functional programming" + "A quotation is a sequence of literals and words" + "Combinators replace imperative-style loops" + "A simple example:" + { $code "10 [ \"Hello world\" print ] times" } + { "Partial application: " { $link curry } } + { $code "{ 3 1 3 3 7 } [ 5 + ] map ." } + { $code "{ 3 1 3 3 7 } 5 [ + ] curry map ." } + } + { $slide "Word definitions" + { $code ": name ( inputs -- outputs )" + " definition ;" } + "Stack effect comments document stack inputs and outputs." + "Example from previous slide:" + { $code ": add-each ( seq n -- newseq )" + " [ + ] curry map ;" } + { $code "{ 3 1 3 3 7 } 5 add-each ." } + } + { $slide "Object-oriented programming" + { "Define a tuple class and a constructor:" + { $code + "TUPLE: person name address ;" + "C: person" + } } + { "Create an instance:" + { $code + "\"Cosmo Kramer\"" + "\"100 Blah blah St, New York\"" + "" + } } + } + { $slide "Object-oriented programming" + "We can inspect it and edit objects" + "We can reshape the class!" + { $code "TUPLE: person" "name address age phone-number ;" } + { $code "TUPLE: person" "name address phone-number age ;" } + } + { $slide "An example" + { $code + "TUPLE: square dimension ;" + "C: square" + "" + "TUPLE: circle radius ;" + "C: circle" + "" + "TUPLE: rectangle width height ;" + "C: rectangle" + } + } + STRIP-TEASE: + $slide "An example" + { $code + "USE: math.constants" + "GENERIC: area ( shape -- meters^2 )" + "M: square area square-dimension sq ;" + "M: circle area circle-radius sq pi * ;" + "M: rectangle area" + " dup rectangle-width" + " swap rectangle-height * ;" + } + ; + + { $slide "An example" + { $code "10 area ." } + { $code "18 area ." } + { $code "20 40 area ." } + } + { $slide "Meta language" + "Here's fibonacci:" + { $code + ": fib ( x -- y )" + " dup 1 > [" + " 1 - dup fib swap 1 - fib +" + " ] when ;" + } + "It is slow:" + { $code + "35 [ fib ] map ." + } + "Let's profile it!" + } + { $slide "Memoization" + { { $link POSTPONE: : } " is just another word" } + "What if we could define a word which caches its results?" + { "The " { $vocab-link "memoize" } " library provides such a feature" } + { "Just change " { $link POSTPONE: : } " to " { $link POSTPONE: MEMO: } } + } + { $slide "Memoization" + { $code + "USE: memoize" + "" + "MEMO: fib ( x -- y )" + " dup 1 > [" + " 1 - dup fib swap 1 - fib +" + " ] when ;" + } + "It is faster:" + { $code + "35 [ fib ] map ." + } + } + { $slide "The Factor UI" + "Written in Factor" + "Renders with OpenGL" + "Backends for Windows, X11, Cocoa" + "You can call Windows, X11, Cocoa APIs directly too" + "OpenGL 2.1 shaders, OpenAL 3D audio..." + } + { $slide "Live coding demo" + + } + { $slide "C library interface" + "Efficient" + "No need to write C code" + "Supports floats, structs, unions, ..." + "Function pointers, callbacks" + } + { $slide "Live coding demo" + + } + { $slide "Deployment" + { "Let's play " { $vocab-link "tetris" } } + } + { $slide "Implementation" + "Portable: Windows, Mac OS X, Linux" + "Non-optimizing compiler" + "Optimizing compiler: x86, x86-64, PowerPC, ARM" + "Generational garbage collector" + "Non-blocking I/O" + } + { $slide "Some statistics" + "VM: 11,800 lines of C" + "Core library: 22,600 lines of Factor" + "Docs, tests, extra libraries: 117,000 lines of Factor" + } + { $slide "But wait, there's more!" + "Web server and framework, syntax highlighting, Ogg Theora video, SMTP, embedded Prolog, efficient unboxed arrays, XML, Unicode 5.0, memory mapped files, regular expressions, LDAP, database access, coroutines, Factor->JavaScript compiler, JSON, pattern matching, advanced math, parser generators, serialization, RSS/Atom, ..." + } + { $slide "Community" + "Factor development began in 2003" + "About a dozen contributors" + "Handful of \"core contributors\"" + { "Web site: " { $url "http://factorcode.org" } } + "IRC: #concatenative on irc.freenode.net" + "Mailing list: factor-talk@lists.sf.net" + } + { $slide "Questions?" } +} ; + +: minneapolis-talk minneapolis-slides slides-window ; + +MAIN: minneapolis-talk diff --git a/extra/minneapolis-talk/minneapolis-talk.txt b/extra/minneapolis-talk/minneapolis-talk.txt new file mode 100755 index 0000000000..5310accf5b --- /dev/null +++ b/extra/minneapolis-talk/minneapolis-talk.txt @@ -0,0 +1,116 @@ +- how to create a small module +- editor integration +- presentations +- module system +- copy and paste factoring, inverse +- help system +- tetris +- memoization +- editing inspector demo +- dynamic scope, lexical scope + +Factor: contradictions? +----------------------- + +Have our cake and eat it too + +Research -vs- practical +High level -vs- fast +Interactive -vs- deployment + +Factor from 10,000 feet +----------------------- + +word: named function +vocabulary: module +quotation: anonymous function +classes, objects, etc. + +The stack +--------- + +- Stack -vs- applicative +- Pass by reference, dynamically typed +- Stack languages: you can omit names where they're not needed +- More compositional style +- If you need to name things for clarity, you can: + lexical vars, dynamic vars, sequences, assocs, objects... + +Functional programming +---------------------- + +Quotations +Curry +Continuations + +Object-oriented programming +--------------------------- + +Generic words: sort of like open classes +Tuple reshaping +Editing inspector + +Meta programming +---------------- + +Simple, orthogonal core + +Why use a stack at all? +----------------------- + +Nice idioms: 10 days ago +Copy and paste factoring +Easy meta-programming +Sequence operations correspond to functional operations: +- curry is adding at the front +- compose is append + +UI +-- + +Written in Factor +renders with OpenGL +Windows, X11, Cocoa backends +You can call Windows, X11, Cocoa APIs directly +OpenGL 2.1 shaders, OpenAL 3D audio... + +Tools +----- + +Edit +Usages +Profiler +Easy to make your own tools + +Implementation +-------------- + +Two compilers +Generational garbage collector +Non-blocking I/O + +Hands on +-------- + +Community +--------- + +Factor started in 2003 +About a dozen contributors +Handful of "core contributors" +Web site: http://factorcode.org +IRC: #concatenative on irc.freenode.net +Mailing list: factor-talk@lists.sf.net + +C library interface +------------------- + +Efficient +No need to write C code +Supports floats, structs, unions, ... +Function pointers, callbacks +Here is an example + +TerminateProcess + +process-handle TerminateProcess diff --git a/extra/minneapolis-talk/summary.txt b/extra/minneapolis-talk/summary.txt new file mode 100755 index 0000000000..7fcc7abc88 --- /dev/null +++ b/extra/minneapolis-talk/summary.txt @@ -0,0 +1 @@ +Slides for a talk at Ruby.mn, Minneapolis MN, January 2008 diff --git a/extra/catalyst-talk/tags.txt b/extra/minneapolis-talk/tags.txt similarity index 100% rename from extra/catalyst-talk/tags.txt rename to extra/minneapolis-talk/tags.txt diff --git a/extra/nehe/2/authors.txt b/extra/nehe/2/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/nehe/2/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/nehe/3/authors.txt b/extra/nehe/3/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/nehe/3/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/nehe/4/authors.txt b/extra/nehe/4/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/nehe/4/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/nehe/5/authors.txt b/extra/nehe/5/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/nehe/5/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/network-clipboard/authors.txt b/extra/network-clipboard/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/network-clipboard/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/new-slots/authors.txt b/extra/new-slots/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/new-slots/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/openal/backend/authors.txt b/extra/openal/backend/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/openal/backend/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/openal/example/authors.txt b/extra/openal/example/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/openal/example/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/openal/macosx/authors.txt b/extra/openal/macosx/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/openal/macosx/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/openal/other/authors.txt b/extra/openal/other/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/openal/other/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/opengl-demo-support/authors.txt b/extra/opengl-demo-support/authors.txt new file mode 100644 index 0000000000..6a0dc7293a --- /dev/null +++ b/extra/opengl-demo-support/authors.txt @@ -0,0 +1 @@ +Joe Groff \ No newline at end of file diff --git a/extra/opengl-demo-support/opengl-demo-support.factor b/extra/opengl-demo-support/opengl-demo-support.factor new file mode 100644 index 0000000000..ecc6458d41 --- /dev/null +++ b/extra/opengl-demo-support/opengl-demo-support.factor @@ -0,0 +1,74 @@ +USING: arrays combinators.lib kernel math math.functions math.vectors namespaces + opengl opengl.gl sequences ui ui.gadgets ui.gestures ui.render ; +IN: opengl-demo-support + +: NEAR-PLANE 1.0 64.0 / ; inline +: FAR-PLANE 4.0 ; inline +: FOV 2.0 sqrt 1+ ; inline +: MOUSE-MOTION-SCALE 0.5 ; inline +: MOUSE-DISTANCE-SCALE 1.0 64.0 / ; inline +: KEY-ROTATE-STEP 1.0 ; inline +: KEY-DISTANCE-STEP 1.0 64.0 / ; inline +: DIMS { 640 480 } ; inline + +: FOV-RATIO ( -- fov ) DIMS dup first2 min v/n ; + +SYMBOL: last-drag-loc + +TUPLE: demo-gadget yaw pitch distance ; + +: ( yaw pitch distance -- gadget ) + demo-gadget construct-gadget + [ { set-demo-gadget-yaw set-demo-gadget-pitch set-demo-gadget-distance } set-slots ] keep ; + +: yaw-demo-gadget ( yaw gadget -- ) + [ [ demo-gadget-yaw + ] keep set-demo-gadget-yaw ] keep relayout-1 ; + +: pitch-demo-gadget ( pitch gadget -- ) + [ [ demo-gadget-pitch + ] keep set-demo-gadget-pitch ] keep relayout-1 ; + +: zoom-demo-gadget ( distance gadget -- ) + [ [ demo-gadget-distance + ] keep set-demo-gadget-distance ] keep relayout-1 ; + +M: demo-gadget pref-dim* ( gadget -- dim ) + drop DIMS ; + +: -+ ( x -- -x x ) + dup neg swap ; + +: demo-gadget-frustum ( -- -x x -y y near far ) + FOV-RATIO NEAR-PLANE FOV / v*n + first2 [ -+ ] 2apply NEAR-PLANE FAR-PLANE ; + +: demo-gadget-set-matrices ( gadget -- ) + GL_PROJECTION glMatrixMode + glLoadIdentity + demo-gadget-frustum glFrustum + GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear + GL_MODELVIEW glMatrixMode + glLoadIdentity + { [ >r 0.0 0.0 r> demo-gadget-distance neg glTranslatef ] + [ demo-gadget-pitch 1.0 0.0 0.0 glRotatef ] + [ demo-gadget-yaw 0.0 1.0 0.0 glRotatef ] } call-with ; + +: reset-last-drag-rel ( -- ) + { 0 0 } last-drag-loc set ; +: last-drag-rel ( -- rel ) + drag-loc [ last-drag-loc get v- ] keep last-drag-loc set ; + +: drag-yaw-pitch ( -- yaw pitch ) + last-drag-rel MOUSE-MOTION-SCALE v*n first2 ; + +demo-gadget H{ + { T{ key-down f f "LEFT" } [ KEY-ROTATE-STEP neg swap yaw-demo-gadget ] } + { T{ key-down f f "RIGHT" } [ KEY-ROTATE-STEP swap yaw-demo-gadget ] } + { T{ key-down f f "DOWN" } [ KEY-ROTATE-STEP neg swap pitch-demo-gadget ] } + { T{ key-down f f "UP" } [ KEY-ROTATE-STEP swap pitch-demo-gadget ] } + { T{ key-down f f "=" } [ KEY-DISTANCE-STEP neg swap zoom-demo-gadget ] } + { T{ key-down f f "-" } [ KEY-DISTANCE-STEP swap zoom-demo-gadget ] } + + { T{ button-down f f 1 } [ drop reset-last-drag-rel ] } + { T{ drag f 1 } [ drag-yaw-pitch rot [ pitch-demo-gadget ] keep yaw-demo-gadget ] } + { T{ mouse-scroll } [ scroll-direction get second MOUSE-DISTANCE-SCALE * swap zoom-demo-gadget ] } +} set-gestures + diff --git a/extra/opengl-demo-support/summary.txt b/extra/opengl-demo-support/summary.txt new file mode 100644 index 0000000000..eca681450f --- /dev/null +++ b/extra/opengl-demo-support/summary.txt @@ -0,0 +1 @@ +Common support for OpenGL demos \ No newline at end of file diff --git a/extra/opengl-demo-support/tags.txt b/extra/opengl-demo-support/tags.txt new file mode 100644 index 0000000000..a6797bf627 --- /dev/null +++ b/extra/opengl-demo-support/tags.txt @@ -0,0 +1 @@ +opengl diff --git a/extra/opengl/camera/authors.txt b/extra/opengl/camera/authors.txt new file mode 100755 index 0000000000..bbc876e7b6 --- /dev/null +++ b/extra/opengl/camera/authors.txt @@ -0,0 +1 @@ +Adam Wendt diff --git a/extra/opengl/gl/unix/authors.txt b/extra/opengl/gl/unix/authors.txt new file mode 100755 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/opengl/gl/unix/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/opengl/gl/windows/authors.txt b/extra/opengl/gl/windows/authors.txt new file mode 100755 index 0000000000..f13c9c1e77 --- /dev/null +++ b/extra/opengl/gl/windows/authors.txt @@ -0,0 +1 @@ +Joe Groff diff --git a/extra/opengl/opengl-docs.factor b/extra/opengl/opengl-docs.factor index 58b86f09b3..cc8221baa1 100644 --- a/extra/opengl/opengl-docs.factor +++ b/extra/opengl/opengl-docs.factor @@ -37,6 +37,10 @@ HELP: gl-rect { $values { "loc" "a pair of integers" } { "ext" "a pair of integers" } } { $description "Draws the outline of a rectangle with top-left corner " { $snippet "loc" } " and bottom-right corner " { $snippet "ext" } "." } ; +HELP: rect-vertices +{ $values { "lower-left" "A pair of numbers indicating the lower-left coordinates of the rectangle." } { "upper-right" "The upper-right coordinates of the rectangle." } } +{ $description "Emits" { $link glVertex2d } " calls outlining the axis-aligned rectangle from " { $snippet "lower-left" } " to " { $snippet "upper-right" } " on the z=0 plane in counterclockwise order." } ; + HELP: gl-fill-poly { $values { "points" "a sequence of pairs of integers" } } { $description "Draws a filled polygon." } ; @@ -53,6 +57,58 @@ HELP: gen-texture { $values { "id" integer } } { $description "Wrapper for " { $link glGenTextures } " to handle the common case of generating a single texture ID." } ; +HELP: gen-framebuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glGenFramebuffersEXT } " to handle the common case of generating a single framebuffer ID." } ; + +HELP: gen-renderbuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ; + +HELP: gen-buffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ; + +HELP: delete-texture +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glDeleteTextures } " to handle the common case of deleting a single texture ID." } ; + +HELP: delete-framebuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glDeleteFramebuffersEXT } " to handle the common case of deleting a single framebuffer ID." } ; + +HELP: delete-renderbuffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ; + +HELP: delete-buffer +{ $values { "id" integer } } +{ $description "Wrapper for " { $link glDeleteBuffers } " to handle the common case of deleting a single buffer ID." } ; + +{ gen-texture delete-texture } related-words +{ gen-framebuffer delete-framebuffer } related-words +{ gen-renderbuffer delete-renderbuffer } related-words +{ gen-buffer delete-buffer } related-words + +HELP: framebuffer-incomplete? +{ $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } } +{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " to see if it is incomplete, i.e., it is not ready to be rendered to." } ; + +HELP: check-framebuffer +{ $description "Checks the framebuffer currently bound by " { $link glBindFramebufferEXT } " or " { $link with-framebuffer } " with " { $link framebuffer-incomplete? } ", and throws a descriptive error if the framebuffer is incomplete." } ; + +HELP: with-framebuffer +{ $values { "id" "The id of a framebuffer object." } { "quot" "a quotation" } } +{ $description "Binds framebuffer " { $snippet "id" } " in the dynamic extent of " { $snippet "quot" } ", restoring the window framebuffer when finished." } ; + +HELP: bind-texture-unit +{ $values { "id" "The id of a texture object." } { "target" "The texture target (e.g., " { $snippet "GL_TEXTURE_2D" } ")" } { "unit" "The texture unit to bind (e.g., " { $snippet "GL_TEXTURE0" } ")" } } +{ $description "Binds texture " { $snippet "id" } " to texture target " { $snippet "target" } " of texture unit " { $snippet "unit" } ". Equivalent to " { $snippet "unit glActiveTexture target id glBindTexture" } "." } ; + +HELP: set-draw-buffers +{ $values { "buffers" "A sequence of buffer words (e.g. " { $snippet "GL_BACK" } ", " { $snippet "GL_COLOR_ATTACHMENT0_EXT" } ")"} } +{ $description "Wrapper for " { $link glDrawBuffers } ". Sets up the buffers named in the sequence for simultaneous drawing." } ; + HELP: do-attribs { $values { "bits" integer } { "quot" quotation } } { $description "Wraps a quotation in " { $link glPushAttrib } "/" { $link glPopAttrib } " calls." } ; @@ -148,11 +204,11 @@ HELP: gl-shader-info-log HELP: gl-program { $class-description { $snippet "gl-program" } " is a predicate class comprising values returned by OpenGL to represent proram objects. The following words are provided for creating and manipulating these objects:" { $list - { { $link } " - Link a set of shaders into a GLSL program" } + { { $link } ", " { $link } " - Link a set of shaders into a GLSL program" } { { $link gl-program-ok? } " - Check whether a program object linked successfully" } { { $link check-gl-program } " - Throw an error unless a program object linked successfully" } { { $link gl-program-info-log } " - Retrieve the info log of messages generated by the GLSL linker" } - { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL linker" } + { { $link gl-program-shaders } " - Retrieve the set of shader objects composing the GLSL program" } { { $link delete-gl-program } " - Invalidate a program object and all its attached shaders" } { { $link with-gl-program } " - Use a program object" } } @@ -162,6 +218,12 @@ HELP: { $values { "shaders" "A sequence of " { $link gl-shader } " objects." } } { $description "Creates a new GLSL program object, attaches all the shader objects in the " { $snippet "shaders" } " sequence, and attempts to link them. The returned object can be checked for validity by " { $link check-gl-program } " or " { $link gl-program-ok? } ". Errors and warnings generated by the GLSL linker will be collected in the info log, available from " { $link gl-program-info-log } ".\n\nWhen the program object and its attached shaders are no longer needed, it should be deleted using " { $link delete-gl-program } "." } ; +HELP: +{ $values { "vertex-shader-source" "A string containing GLSL vertex shader source" } { "fragment-shader-source" "A string containing GLSL fragment shader source" } } +{ $description "Wrapper for " { $link } " for the simple case of compiling a single vertex shader and fragment shader and linking them into a GLSL program. Throws an exception if compiling or linking fails." } ; + +{ } related-words + HELP: gl-program-ok? { $values { "program" "A " { $link gl-program } " object" } } { $description "Returns a boolean value indicating whether the given program object linked successfully. Link errors and warnings are available in the program's info log, which can be gotten using " { $link gl-program-info-log } "." } ; @@ -180,21 +242,80 @@ HELP: delete-gl-program HELP: with-gl-program { $values { "program" "A " { $link gl-program } " object" } { "quot" "A quotation" } } -{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in " { $snippet "quot" } ". The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ; +{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ; + +HELP: gl-version +{ $values { "version" "The version string from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ; + +HELP: gl-vendor-version +{ $values { "version" "The vendor-specific version information from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ; + +HELP: has-gl-version? +{ $values { "version" "A version string" } { "?" "A boolean value" } } +{ $description "Compares the version string returned by " { $link gl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ; + +HELP: require-gl-version +{ $values { "version" "A version string" } } +{ $description "Throws an exception if " { $link has-gl-version? } " returns false for " { $snippet "version" } "." } ; + +HELP: glsl-version +{ $values { "version" "The GLSL version string from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that removes the vendor-specific information from the version string." } ; + +HELP: glsl-vendor-version +{ $values { "version" "The vendor-specific GLSL version information from the OpenGL implementation" } } +{ $description "Wrapper for " { $snippet "GL_SHADING_LANGUAGE_VERSION glGetString" } " that returns only the vendor-specific information from the version string." } ; + +HELP: has-glsl-version? +{ $values { "version" "A version string" } { "?" "A boolean value" } } +{ $description "Compares the version string returned by " { $link glsl-version } " to " { $snippet "version" } ". Returns true if the implementation version meets or exceeds " { $snippet "version" } "." } ; + +HELP: require-glsl-version +{ $values { "version" "A version string" } } +{ $description "Throws an exception if " { $link has-glsl-version? } " returns false for " { $snippet "version" } "." } ; + +HELP: gl-extensions +{ $values { "seq" "A sequence of strings naming the implementation-supported OpenGL extensions" } } +{ $description "Wrapper for " { $snippet "GL_EXTENSIONS glGetString" } " that returns a sequence of extension names supported by the OpenGL implementation." } ; + +HELP: has-gl-extensions? +{ $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 } "." } ; + +HELP: require-gl-extensions +{ $values { "extensions" "A sequence of extension name strings" } } +{ $description "Throws an exception if " { $link has-gl-extensions? } " returns false for " { $snippet "extensions" } "." } ; + +HELP: require-gl-version-or-extensions +{ $values { "version" "A version string" } { "extensions" "A sequence of extension name strings" } } +{ $description "Throws an exception if neither " { $link has-gl-version? } " nor " { $link has-gl-extensions? } " returns true for " { $snippet "version" } " or " { $snippet "extensions" } ", respectively. Intended for use when required OpenGL functionality can be verified either by a minimum version, or a set of equivalent extensions." } ; + +{ require-gl-version require-glsl-version require-gl-extensions require-gl-version-or-extensions has-gl-version? has-glsl-version? has-gl-extensions? gl-version glsl-version gl-extensions } related-words ARTICLE: "gl-utilities" "OpenGL utility words" "In addition to the full OpenGL API, the " { $vocab-link "opengl" } " vocabulary includes some utility words to give OpenGL a more Factor-like feel." $nl +"Checking implementation capabilities:" +{ $subsection require-gl-version } +{ $subsection require-gl-extensions } +{ $subsection require-glsl-version } +{ $subsection require-gl-version-or-extensions } "Wrappers:" { $subsection gl-color } { $subsection gl-vertex } { $subsection gl-translate } +{ $subsection gen-texture } +{ $subsection bind-texture-unit } "Combinators:" { $subsection do-state } { $subsection do-enabled } { $subsection do-attribs } { $subsection do-matrix } { $subsection with-translation } +{ $subsection with-framebuffer } +{ $subsection with-gl-program } { $subsection make-dlist } "Rendering geometric shapes:" { $subsection gl-line } diff --git a/extra/opengl/opengl.factor b/extra/opengl/opengl.factor old mode 100644 new mode 100755 index 80c9b80ea7..4ea91b867b --- a/extra/opengl/opengl.factor +++ b/extra/opengl/opengl.factor @@ -1,9 +1,11 @@ ! Copyright (C) 2005, 2007 Slava Pestov. ! Portions copyright (C) 2007 Eduardo Cavazos. +! Portions copyright (C) 2008 Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: alien alien.c-types kernel libc math namespaces sequences -math.vectors math.constants math.functions opengl.gl opengl.glu -combinators arrays ; +USING: alien alien.c-types continuations kernel libc math macros +namespaces math.vectors math.constants math.functions +math.parser opengl.gl opengl.glu combinators arrays sequences +splitting words byte-arrays ; IN: opengl : coordinates [ first2 ] 2apply ; @@ -93,8 +95,62 @@ IN: opengl ] 2each 2drop ] do-state ; +: (gen-gl-object) ( quot -- id ) + >r 1 0 r> keep *uint ; inline : gen-texture ( -- id ) - 1 0 [ glGenTextures ] keep *uint ; + [ glGenTextures ] (gen-gl-object) ; +: gen-framebuffer ( -- id ) + [ glGenFramebuffersEXT ] (gen-gl-object) ; +: gen-renderbuffer ( -- id ) + [ glGenRenderbuffersEXT ] (gen-gl-object) ; +: gen-buffer ( -- id ) + [ glGenBuffers ] (gen-gl-object) ; + +: (delete-gl-object) ( id quot -- ) + >r 1 swap r> call ; inline +: delete-texture ( id -- ) + [ glDeleteTextures ] (delete-gl-object) ; +: delete-framebuffer ( id -- ) + [ glDeleteFramebuffersEXT ] (delete-gl-object) ; +: delete-renderbuffer ( id -- ) + [ glDeleteRenderbuffersEXT ] (delete-gl-object) ; +: delete-buffer ( id -- ) + [ glDeleteBuffers ] (delete-gl-object) ; + +: framebuffer-incomplete? ( -- status/f ) + GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT + dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ; + +: framebuffer-error ( status -- * ) + { { GL_FRAMEBUFFER_COMPLETE_EXT [ "framebuffer complete" ] } + { GL_FRAMEBUFFER_UNSUPPORTED_EXT [ "framebuffer configuration unsupported" ] } + { GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT [ "framebuffer incomplete (incomplete attachment)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT [ "framebuffer incomplete (missing attachment)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT [ "framebuffer incomplete (dimension mismatch)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT [ "framebuffer incomplete (format mismatch)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT [ "framebuffer incomplete (draw buffer(s) have no attachment)" ] } + { GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT [ "framebuffer incomplete (read buffer has no attachment)" ] } + [ drop gl-error "unknown framebuffer error" ] } case throw ; + +: check-framebuffer ( -- ) + framebuffer-incomplete? [ framebuffer-error ] when* ; + +: with-framebuffer ( id quot -- ) + GL_FRAMEBUFFER_EXT rot glBindFramebufferEXT + [ GL_FRAMEBUFFER_EXT 0 glBindFramebufferEXT ] [ ] cleanup ; inline + +: bind-texture-unit ( id target unit -- ) + glActiveTexture swap glBindTexture gl-error ; + +: framebuffer-attachment ( attachment -- id ) + GL_FRAMEBUFFER_EXT swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME_EXT + 0 [ glGetFramebufferAttachmentParameterivEXT ] keep *uint ; + +: (set-draw-buffers) ( buffers -- ) + dup length swap >c-uint-array glDrawBuffers ; + +MACRO: set-draw-buffers ( buffers -- ) + [ dup word? [ execute ] [ ] if ] map [ (set-draw-buffers) ] curry ; : do-attribs ( bits quot -- ) swap glPushAttrib call glPopAttrib ; inline @@ -120,7 +176,7 @@ TUPLE: sprite loc dim dim2 dlist texture ; GL_UNSIGNED_BYTE r> glTexImage2D ] do-attribs ] keep ; - + : gen-dlist ( -- id ) 1 glGenLists ; : make-dlist ( type quot -- id ) @@ -154,6 +210,14 @@ TUPLE: sprite loc dim dim2 dlist texture ; swap sprite-loc v- gl-translate GL_TEXTURE_2D 0 glBindTexture ; +: rect-vertices ( lower-left upper-right -- ) + GL_QUADS [ + over first2 glVertex2d + dup first pick second glVertex2d + dup first2 glVertex2d + swap first swap second glVertex2d + ] do-state ; + : make-sprite-dlist ( sprite -- id ) GL_MODELVIEW [ GL_COMPILE [ draw-sprite ] make-dlist @@ -167,7 +231,7 @@ TUPLE: sprite loc dim dim2 dlist texture ; : free-sprite ( sprite -- ) dup sprite-dlist delete-dlist - sprite-texture 1 swap glDeleteTextures ; + sprite-texture delete-texture ; : free-sprites ( sprites -- ) [ [ free-sprite ] when* ] each ; @@ -191,10 +255,13 @@ TUPLE: sprite loc dim dim2 dlist texture ; : c-true? ( int -- ? ) zero? not ; inline : with-gl-shader-source-ptr ( string quot -- ) - swap dup length 1+ [ tuck string>memory swap call ] with-malloc ; inline + swap >byte-array malloc-byte-array [ + swap call + ] keep free ; inline : ( source kind -- shader ) - glCreateShader dup rot [ 1 swap f glShaderSource ] with-gl-shader-source-ptr + glCreateShader dup rot + [ 1 swap f glShaderSource ] with-gl-shader-source-ptr [ glCompileShader ] keep gl-error ; @@ -211,19 +278,27 @@ TUPLE: sprite loc dim dim2 dlist texture ; GL_VERTEX_SHADER ; inline : (vertex-shader?) ( object -- ? ) - dup (gl-shader?) [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ] [ drop f ] if ; + dup (gl-shader?) + [ GL_SHADER_TYPE gl-shader-get-int GL_VERTEX_SHADER = ] + [ drop f ] if ; : ( source -- fragment-shader ) GL_FRAGMENT_SHADER ; inline : (fragment-shader?) ( object -- ? ) - dup (gl-shader?) [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ] [ drop f ] if ; + dup (gl-shader?) + [ GL_SHADER_TYPE gl-shader-get-int GL_FRAGMENT_SHADER = ] + [ drop f ] if ; : gl-shader-info-log-length ( shader -- log-length ) GL_INFO_LOG_LENGTH gl-shader-get-int ; inline : gl-shader-info-log ( shader -- log ) - dup gl-shader-info-log-length dup [ [ 0 swap glGetShaderInfoLog ] keep alien>char-string ] with-malloc ; + dup gl-shader-info-log-length + dup [ + 0 over glGetShaderInfoLog + alien>char-string + ] with-malloc ; : check-gl-shader ( shader -- shader* ) dup gl-shader-ok? [ dup gl-shader-info-log throw ] unless ; @@ -241,7 +316,7 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; [ dupd glAttachShader ] each [ glLinkProgram ] keep gl-error ; - + : (gl-program?) ( object -- ? ) dup integer? [ glIsProgram c-true? ] [ drop f ] if ; @@ -266,19 +341,86 @@ PREDICATE: gl-shader fragment-shader (fragment-shader?) ; GL_ATTACHED_SHADERS gl-program-get-int ; inline : gl-program-shaders ( program -- shaders ) - dup gl-program-shaders-length - [ dup "GLuint" [ 0 swap glGetAttachedShaders ] keep ] keep - c-uint-array> ; + dup gl-program-shaders-length [ + dup "GLuint" 0 over glGetAttachedShaders + ] keep c-uint-array> ; -: delete-gl-program-only ( program -- ) glDeleteProgram ; inline +: delete-gl-program-only ( program -- ) + glDeleteProgram ; inline -: detach-gl-program-shader ( program shader -- ) glDetachShader ; inline +: detach-gl-program-shader ( program shader -- ) + glDetachShader ; inline : delete-gl-program ( program -- ) - dup gl-program-shaders [ 2dup detach-gl-program-shader delete-gl-shader ] each - delete-gl-program-only ; + dup gl-program-shaders [ + 2dup detach-gl-program-shader delete-gl-shader + ] each delete-gl-program-only ; : with-gl-program ( program quot -- ) - swap glUseProgram call 0 glUseProgram ; inline + swap glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline PREDICATE: integer gl-program (gl-program?) ; + +: ( vertex-shader-source fragment-shader-source -- program ) + >r check-gl-shader + r> check-gl-shader + 2array check-gl-program ; + +: (require-gl) ( thing require-quot make-error-quot -- ) + >r dupd call + [ r> 2drop ] + [ r> " " make throw ] + if ; inline + +: gl-extensions ( -- seq ) + GL_EXTENSIONS glGetString " " split ; +: has-gl-extensions? ( extensions -- ? ) + gl-extensions subseq? ; +: (make-gl-extensions-error) ( required-extensions -- ) + gl-extensions swap seq-diff + "Required OpenGL extensions not supported:\n" % + [ " " % % "\n" % ] each ; +: require-gl-extensions ( extensions -- ) + [ has-gl-extensions? ] + [ (make-gl-extensions-error) ] + (require-gl) ; + +: version-seq ( version-string -- version-seq ) + "." split [ string>number ] map ; + +: version<=> ( version1 version2 -- n ) + swap version-seq swap version-seq <=> ; + +: (gl-version) ( -- version vendor ) + GL_VERSION glGetString " " split1 ; +: gl-version ( -- version ) + (gl-version) drop ; +: gl-vendor-version ( -- version ) + (gl-version) nip ; +: has-gl-version? ( version -- ? ) + gl-version version<=> 0 <= ; +: (make-gl-version-error) ( required-version -- ) + "Required OpenGL version " % % " not supported (" % gl-version % " available)" % ; +: require-gl-version ( version -- ) + [ has-gl-version? ] + [ (make-gl-version-error) ] + (require-gl) ; + +: (glsl-version) ( -- version vendor ) + GL_SHADING_LANGUAGE_VERSION glGetString " " split1 ; +: glsl-version ( -- version ) + (glsl-version) drop ; +: glsl-vendor-version ( -- version ) + (glsl-version) nip ; +: has-glsl-version? ( version -- ? ) + glsl-version version<=> 0 <= ; +: require-glsl-version ( version -- ) + [ has-glsl-version? ] + [ "Required GLSL version " % % " not supported (" % glsl-version % " available)" % ] + (require-gl) ; + +: require-gl-version-or-extensions ( version extensions -- ) + 2array [ first2 has-gl-extensions? swap has-gl-version? or ] + [ dup first (make-gl-version-error) "\n" % + second (make-gl-extensions-error) "\n" % ] + (require-gl) ; diff --git a/extra/openssl/summary.txt b/extra/openssl/summary.txt new file mode 100755 index 0000000000..42db29f294 --- /dev/null +++ b/extra/openssl/summary.txt @@ -0,0 +1 @@ +OpenSSL binding diff --git a/extra/optimizer/debugger/authors.txt b/extra/optimizer/debugger/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/optimizer/debugger/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/oracle/liboci/authors.txt b/extra/oracle/liboci/authors.txt new file mode 100755 index 0000000000..7c29e7c401 --- /dev/null +++ b/extra/oracle/liboci/authors.txt @@ -0,0 +1 @@ +Elie Chaftari diff --git a/extra/random-tester/authors.txt b/extra/random-tester/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/random-tester/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/random-tester/databank/authors.txt b/extra/random-tester/databank/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/random-tester/databank/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/random-tester/random/authors.txt b/extra/random-tester/random/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/random-tester/random/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/random-tester/safe-words/authors.txt b/extra/random-tester/safe-words/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/random-tester/safe-words/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/random-tester/utils/authors.txt b/extra/random-tester/utils/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/random-tester/utils/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/raptor/authors.txt b/extra/raptor/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/raptor/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/raptor/cron/authors.txt b/extra/raptor/cron/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/raptor/cron/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/regexp/authors.txt b/extra/regexp/authors.txt new file mode 100755 index 0000000000..5674120196 --- /dev/null +++ b/extra/regexp/authors.txt @@ -0,0 +1,2 @@ +Doug Coleman +Slava Pestov diff --git a/extra/rss/authors.txt b/extra/rss/authors.txt new file mode 100755 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/rss/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/rss/summary.txt b/extra/rss/summary.txt new file mode 100755 index 0000000000..b65787ab67 --- /dev/null +++ b/extra/rss/summary.txt @@ -0,0 +1 @@ +RSS 1.0, 2.0 and Atom feed parser diff --git a/extra/slides/summary.txt b/extra/slides/summary.txt new file mode 100755 index 0000000000..c3be28003e --- /dev/null +++ b/extra/slides/summary.txt @@ -0,0 +1 @@ +Bare-bones tools for giving presentations and demonstrations with the Factor UI diff --git a/extra/springies/models/2snake/authors.txt b/extra/springies/models/2snake/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/2snake/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/models/2x2snake/authors.txt b/extra/springies/models/2x2snake/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/2x2snake/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/models/3snake/authors.txt b/extra/springies/models/3snake/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/3snake/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/models/ball/authors.txt b/extra/springies/models/ball/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/ball/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/models/belt-tire/authors.txt b/extra/springies/models/belt-tire/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/belt-tire/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/models/nifty/authors.txt b/extra/springies/models/nifty/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/nifty/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/models/urchin/authors.txt b/extra/springies/models/urchin/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/models/urchin/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/springies/ui/authors.txt b/extra/springies/ui/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/springies/ui/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/sqlite/authors.txt b/extra/sqlite/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/sqlite/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/sqlite/lib/authors.txt b/extra/sqlite/lib/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/sqlite/lib/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/sqlite/tuple-db/authors.txt b/extra/sqlite/tuple-db/authors.txt new file mode 100755 index 0000000000..44b06f94bc --- /dev/null +++ b/extra/sqlite/tuple-db/authors.txt @@ -0,0 +1 @@ +Chris Double diff --git a/extra/state-machine/authors.txt b/extra/state-machine/authors.txt new file mode 100755 index 0000000000..f990dd0ed2 --- /dev/null +++ b/extra/state-machine/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/store/blob/authors.txt b/extra/store/blob/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/store/blob/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/strings/lib/authors.txt b/extra/strings/lib/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/strings/lib/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/structs/authors.txt b/extra/structs/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/structs/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/tar/authors.txt b/extra/tar/authors.txt new file mode 100755 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/tar/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/tetris/board/authors.txt b/extra/tetris/board/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/tetris/board/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/tetris/game/authors.txt b/extra/tetris/game/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/tetris/game/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/tetris/gl/authors.txt b/extra/tetris/gl/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/tetris/gl/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/tetris/piece/authors.txt b/extra/tetris/piece/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/tetris/piece/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/tetris/tetromino/authors.txt b/extra/tetris/tetromino/authors.txt new file mode 100755 index 0000000000..e9c193bac7 --- /dev/null +++ b/extra/tetris/tetromino/authors.txt @@ -0,0 +1 @@ +Alex Chapman diff --git a/extra/tools/browser/authors.txt b/extra/tools/browser/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/browser/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/completion/completion.factor b/extra/tools/completion/completion.factor old mode 100644 new mode 100755 index bb15a3fa87..539b348706 --- a/extra/tools/completion/completion.factor +++ b/extra/tools/completion/completion.factor @@ -60,13 +60,14 @@ vectors words assocs combinators sorting ; dupd fuzzy score max ; : completion ( short candidate -- result ) - [ second swap complete ] keep first 2array ; + [ second >lower swap complete ] keep first 2array ; : completions ( short candidates -- seq ) over empty? [ nip [ first ] map ] [ - >r >lower r> [ completion ] with map rank-completions + >r >lower r> [ completion ] with map + rank-completions ] if ; : string-completions ( short strs -- seq ) diff --git a/extra/tools/deploy/backend/authors.txt b/extra/tools/deploy/backend/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/deploy/backend/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/deploy/backend/backend.factor b/extra/tools/deploy/backend/backend.factor index b7b3da7411..83e0ea5ec3 100755 --- a/extra/tools/deploy/backend/backend.factor +++ b/extra/tools/deploy/backend/backend.factor @@ -9,50 +9,77 @@ quotations io.launcher words.private tools.deploy.config bootstrap.image ; IN: tools.deploy.backend -: boot-image-name ( -- string ) - "boot." my-arch ".image" 3append ; - -: stage1 ( -- ) - #! If stage1 image doesn't exist, create one. - boot-image-name resource-path exists? - [ my-arch make-image ] unless ; - : (copy-lines) ( stream -- stream ) dup stream-readln [ print flush (copy-lines) ] when* ; : copy-lines ( stream -- ) [ (copy-lines) ] [ stream-close ] [ ] cleanup ; -: ?append swap [ append ] [ drop ] if ; +: run-with-output ( descriptor -- ) + + dup duplex-stream-out stream-close + copy-lines ; -: profile-string ( config -- string ) +: boot-image-name ( -- string ) + "boot." my-arch ".image" 3append ; + +: make-boot-image ( -- ) + #! If stage1 image doesn't exist, create one. + boot-image-name resource-path exists? + [ my-arch make-image ] unless ; + +: ?, [ , ] [ drop ] if ; + +: bootstrap-profile ( config -- profile ) [ - "" - deploy-math? get " math" ?append - deploy-compiler? get " compiler" ?append - deploy-ui? get " ui" ?append - native-io? " io" ?append + [ + "math" deploy-math? get ?, + "compiler" deploy-compiler? get ?, + "ui" deploy-ui? get ?, + "io" native-io? ?, + ] { } make ] bind ; -: deploy-command-line ( vm image vocab config -- vm flags ) +: staging-image-name ( profile -- name ) + "staging." swap bootstrap-profile "-" join ".image" 3append ; + +: staging-command-line ( config -- flags ) [ - "-include=" swap profile-string append , + "-i=" boot-image-name append , - "-deploy-vocab=" swap append , + "-output-image=" over staging-image-name append , - "-output-image=" swap append , + "-include=" swap bootstrap-profile " " join append , "-no-stack-traces" , "-no-user-init" , ] { } make ; -: stage2 ( vm image vocab config -- ) - deploy-command-line - >r "-i=" boot-image-name append 2array r> append dup . - - dup duplex-stream-out stream-close - copy-lines ; +: run-factor ( vm flags -- ) + dup . swap add* run-with-output ; inline + +: make-staging-image ( vm config -- ) + staging-command-line run-factor ; + +: deploy-command-line ( image vocab config -- flags ) + [ + "-i=" swap staging-image-name append , + + "-run=tools.deploy.shaker" , + + "-deploy-vocab=" swap append , + + "-output-image=" swap append , + + "-no-stack-traces" , + ] { } make ; + +: make-deploy-image ( vm image vocab config -- ) + dup staging-image-name exists? [ + >r pick r> tuck make-staging-image + ] unless + deploy-command-line run-factor ; SYMBOL: deploy-implementation diff --git a/extra/tools/deploy/config/authors.txt b/extra/tools/deploy/config/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/deploy/config/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/deploy/macosx/authors.txt b/extra/tools/deploy/macosx/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/deploy/macosx/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/deploy/macosx/macosx.factor b/extra/tools/deploy/macosx/macosx.factor index 7efb34a6ae..1bbf198ea0 100755 --- a/extra/tools/deploy/macosx/macosx.factor +++ b/extra/tools/deploy/macosx/macosx.factor @@ -72,13 +72,12 @@ T{ macosx-deploy-implementation } deploy-implementation set-global -> selectFile:inFileViewerRootedAtPath: drop ; M: macosx-deploy-implementation deploy* ( vocab -- ) - stage1 ".app deploy tool" assert.app "." resource-path cd dup deploy-config [ bundle-name rm [ bundle-name create-app-dir ] keep [ bundle-name deploy.app-image ] keep - namespace stage2 + namespace make-deploy-image bundle-name show-in-finder ] bind ; diff --git a/extra/tools/deploy/shaker/authors.txt b/extra/tools/deploy/shaker/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/deploy/shaker/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/deploy/windows/authors.txt b/extra/tools/deploy/windows/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/deploy/windows/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/deploy/windows/windows.factor b/extra/tools/deploy/windows/windows.factor index 01a7009ecd..00dbc2e4df 100755 --- a/extra/tools/deploy/windows/windows.factor +++ b/extra/tools/deploy/windows/windows.factor @@ -34,11 +34,10 @@ TUPLE: windows-deploy-implementation ; T{ windows-deploy-implementation } deploy-implementation set-global M: windows-deploy-implementation deploy* - stage1 "." resource-path cd dup deploy-config [ [ deploy-name get create-exe-dir ] keep [ deploy-name get image-name ] keep - [ namespace stage2 ] keep + [ namespace make-deploy-image ] keep open-in-explorer ] bind ; diff --git a/extra/tools/interpreter/debug/authors.txt b/extra/tools/interpreter/debug/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/interpreter/debug/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/test/inference/authors.txt b/extra/tools/test/inference/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/test/inference/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/tools/test/ui/authors.txt b/extra/tools/test/ui/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/tools/test/ui/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/ui/freetype/freetype.factor b/extra/ui/freetype/freetype.factor old mode 100644 new mode 100755 index 48164c08f6..8fc320e34c --- a/extra/ui/freetype/freetype.factor +++ b/extra/ui/freetype/freetype.factor @@ -3,7 +3,7 @@ USING: alien alien.c-types arrays io kernel libc math math.vectors namespaces opengl opengl.gl prettyprint assocs sequences io.files io.styles continuations freetype -ui.gadgets.worlds ui.render ui.backend io.mmap ; +ui.gadgets.worlds ui.render ui.backend byte-arrays ; IN: ui.freetype TUPLE: freetype-renderer ; @@ -63,18 +63,23 @@ M: freetype-renderer free-fonts ( world -- ) : ttf-path ( name -- string ) "/fonts/" swap ".ttf" 3append resource-path ; -: (open-face) ( mapped-file -- face ) +: (open-face) ( path length -- face ) #! We use FT_New_Memory_Face, not FT_New_Face, since #! FT_New_Face only takes an ASCII path name and causes #! problems on localized versions of Windows - freetype swap dup mapped-file-address swap length 0 f - [ FT_New_Memory_Face freetype-error ] keep *void* ; + freetype -rot 0 f [ + FT_New_Memory_Face freetype-error + ] keep *void* ; : open-face ( font style -- face ) - ttf-name ttf-path dup file-length - (open-face) ; + ttf-name ttf-path + dup file-contents >byte-array malloc-byte-array + swap file-length + (open-face) ; -: dpi 72 ; inline +SYMBOL: dpi + +72 dpi set-global : ft-floor -6 shift ; inline @@ -101,7 +106,8 @@ M: freetype-renderer free-fonts ( world -- ) : (open-font) ( font -- open-font ) first3 >r open-face dup 0 r> 6 shift - dpi dpi FT_Set_Char_Size freetype-error ; + dpi get-global dpi get-global FT_Set_Char_Size + freetype-error ; M: freetype-renderer open-font ( font -- open-font ) freetype drop open-fonts get [ (open-font) ] cache ; diff --git a/extra/ui/gadgets/canvas/authors.txt b/extra/ui/gadgets/canvas/authors.txt new file mode 100755 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/ui/gadgets/canvas/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/ui/gadgets/handler/authors.txt b/extra/ui/gadgets/handler/authors.txt new file mode 100755 index 0000000000..6cfd5da273 --- /dev/null +++ b/extra/ui/gadgets/handler/authors.txt @@ -0,0 +1 @@ +Eduardo Cavazos diff --git a/extra/ui/gadgets/labels/labels.factor b/extra/ui/gadgets/labels/labels.factor index 2ac0240ed1..5e5801dd02 100755 --- a/extra/ui/gadgets/labels/labels.factor +++ b/extra/ui/gadgets/labels/labels.factor @@ -40,7 +40,7 @@ M: label gadget-text* label-string % ; TUPLE: label-control ; M: label-control model-changed - swap model-value over set-label-text relayout ; + swap model-value over set-label-string relayout ; : ( model -- gadget ) ""