steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Replace memory>string and string>memory with four primitives and update io.windows.nt.monitor

db4
Slava Pestov 2008-01-26 23:38:30 -04:00
parent 62ded50c8b
commit a09e216582
25 changed files with 421 additions and 312 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

237
core/alien/alien-docs.factor
View File

@ -1,5 +1,5 @@
USING: byte-arrays arrays help.syntax help.markup 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 ; debugger parser io io.backend system bit-arrays float-arrays ;
IN: alien IN: alien
@ -156,36 +156,6 @@ ARTICLE: "aliens" "Alien addresses"
$nl $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" } "." ; "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 <c-object> } " or " { $link malloc-object } "."
$nl
"Arrays of C structures can be created by calling " { $link <c-array> } " 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 <c-object> } " or " { $link malloc-object } "."
$nl
"Arrays of C unions can be created by calling " { $link <c-array> } " 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" 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:" "Numerical values can be read from memory addresses and converted to Factor objects using the various typed memory accessor words:"
{ $subsection alien-signed-1 } { $subsection alien-signed-1 }
@ -253,211 +223,6 @@ $nl
{ $subsection dlsym } { $subsection dlsym }
{ $subsection dlclose } ; { $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 <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
{ $subsection <c-object> }
{ $subsection <c-array> }
{ $warning
"The Factor garbage collector can move byte arrays around, and 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 <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*> }
"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 <void*> } " 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" ARTICLE: "embedding-api" "Factor embedding API"
"The Factor embedding API is defined in " { $snippet "vm/master.h" } "." "The Factor embedding API is defined in " { $snippet "vm/master.h" } "."
$nl $nl

73
core/alien/arrays/arrays-docs.factor Executable file
View File

@ -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" } ;

182
core/alien/c-types/c-types-docs.factor Normal file → Executable file
View File

@ -1,8 +1,10 @@
USING: alien alien.c-types help.syntax help.markup libc IN: alien.c-types
kernel.private byte-arrays math strings ; USING: alien help.syntax help.markup libc kernel.private
byte-arrays math strings hashtables alien.syntax
bit-arrays float-arrays debugger ;
HELP: <c-type> HELP: <c-type>
{ $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" } "." } ; { $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 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." } ; { $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 HELP: c-type
{ $values { "name" string } { "type" "a hashtable" } } { $values { "name" string } { "type" hashtable } }
{ $description "Looks up a C type by name." } { $description "Looks up a C type by name." }
{ $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ; { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
HELP: heap-size 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." } { $description "Outputs the number of bytes needed for a heap-allocated value of this C type." }
{ $examples { $examples
"On a 32-bit system, you will get the following output:" "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." } ; { $errors "Throws a " { $link no-c-type } " error if the type does not exist." } ;
HELP: stack-size 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." } { $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." } ; { $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 } } { $values { "c-ptr" c-ptr } { "string" string } }
{ $description "Reads a null-terminated UCS-2 string from the specified address." } ; { $description "Reads a null-terminated UCS-2 string from the specified address." } ;
HELP: memory>string ( base len -- string ) HELP: memory>byte-array ( base len -- string )
{ $values { "base" c-ptr } { "len" "a non-negative integer" } { "string" 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 Factor string." } ; { $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 } } { $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." } ; { $warning "This word is unsafe. Improper use can corrupt memory." } ;
HELP: malloc-array HELP: malloc-array
@ -151,3 +171,143 @@ HELP: define-out
{ $values { "name" "a word name" } { "vocab" "a vocabulary name" } } { $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." } { $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." } ; { $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 <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*> }
"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 <void*> } " and " { $link *void* } " may be used." ;
ARTICLE: "c-types-specs" "C type specifiers"
"C types are identified by strings, and type names occur as parameters to the " { $link alien-invoke } ", " { $link alien-indirect } " and " { $link alien-callback } " words, as well as " { $link POSTPONE: C-STRUCT: } ", " { $link POSTPONE: C-UNION: } " and " { $link POSTPONE: TYPEDEF: } "."
$nl
"The following numerical types are available; a " { $snippet "u" } " prefix denotes an unsigned type:"
{ $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 <byte-array> } " word. However in most cases, instead of computing a size in bytes directly, it is easier to use a higher-level word which expects C type and outputs a byte array large enough to hold that type:"
{ $subsection <c-object> }
{ $subsection <c-array> }
{ $warning
"The Factor garbage collector can move byte arrays around, and 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" } ;

22
core/alien/c-types/c-types.factor
View File

@ -138,6 +138,28 @@ M: c-type stack-size c-type-size ;
: malloc-u16-string ( string -- alien ) : malloc-u16-string ( string -- alien )
string>u16-alien malloc-byte-array ; string>u16-alien malloc-byte-array ;
: memory>byte-array ( alien len -- byte-array )
dup <byte-array> [ -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 -- ) : (define-nth) ( word type quot -- )
>r heap-size [ rot * ] swap add* r> append define-inline ; >r heap-size [ rot * ] swap add* r> append define-inline ;

35
core/alien/structs/structs-docs.factor Normal file → Executable file
View File

@ -1,6 +1,37 @@
USING: alien.structs alien.c-types strings help.markup IN: alien.structs
sequences io arrays ; USING: alien.c-types strings help.markup help.syntax
alien.syntax sequences io arrays ;
M: string slot-specs c-type struct-type-fields ; M: string slot-specs c-type struct-type-fields ;
M: array ($instance) first ($instance) " array" write ; 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 <c-object> } " or " { $link malloc-object } "."
$nl
"Arrays of C structures can be created by calling " { $link <c-array> } " 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 <c-object> } " or " { $link malloc-object } "."
$nl
"Arrays of C unions can be created by calling " { $link <c-array> } " 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: } "." ;

7
core/assocs/assocs-docs.factor Normal file → Executable file
View File

@ -64,6 +64,7 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs"
ARTICLE: "assocs-mutation" "Storing keys and values in assocs" ARTICLE: "assocs-mutation" "Storing keys and values in assocs"
"Utility operations built up from the " { $link "assocs-protocol" } ":" "Utility operations built up from the " { $link "assocs-protocol" } ":"
{ $subsection delete-at* } { $subsection delete-at* }
{ $subsection delete-any }
{ $subsection rename-at } { $subsection rename-at }
{ $subsection change-at } { $subsection change-at }
{ $subsection 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." } { $description "Removes an entry from the assoc and outputs the previous value together with a boolean indicating whether it was present." }
{ $side-effects "assoc" } ; { $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 HELP: rename-at
{ $values { "newkey" object } { "key" object } { "assoc" assoc } } { $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" } "." } { $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" } "." }

7
core/assocs/assocs.factor
View File

@ -77,8 +77,11 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
: rename-at ( newkey key assoc -- ) : rename-at ( newkey key assoc -- )
tuck delete-at* [ -rot set-at ] [ 3drop ] if ; tuck delete-at* [ -rot set-at ] [ 3drop ] if ;
: delete-any ( assoc -- element ) : delete-any ( assoc -- key value )
[ [ 2drop t ] assoc-find 2drop dup ] keep delete-at ; [
[ 2drop t ] assoc-find
[ "Assoc is empty" throw ] unless over
] keep delete-at ;
: assoc-empty? ( assoc -- ? ) : assoc-empty? ( assoc -- ? )
assoc-size zero? ; assoc-size zero? ;

22
core/bootstrap/primitives.factor
View File

@ -5,22 +5,32 @@ USING: alien arrays byte-arrays generic hashtables
hashtables.private io kernel math namespaces parser sequences hashtables.private io kernel math namespaces parser sequences
strings vectors words quotations assocs layouts classes tuples strings vectors words quotations assocs layouts classes tuples
kernel.private vocabs vocabs.loader source-files definitions 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 "Creating primitives and basic runtime structures..." print flush
load-help? off
crossref 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/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 dictionary set
H{ } clone changed-words set H{ } clone changed-words set
[ drop ] recompile-hook set [ drop ] recompile-hook set
call
call call
! Create some empty vocabs where the below primitives and ! 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" } { "alien>u16-string" "alien" }
{ "string>u16-alien" "alien" } { "string>u16-alien" "alien" }
{ "(throw)" "kernel.private" } { "(throw)" "kernel.private" }
{ "string>memory" "alien" }
{ "memory>string" "alien" }
{ "alien-address" "alien" } { "alien-address" "alien" }
{ "slot" "slots.private" } { "slot" "slots.private" }
{ "set-slot" "slots.private" } { "set-slot" "slots.private" }

13
core/hashtables/hashtables-docs.factor Normal file → Executable file
View File

@ -35,8 +35,10 @@ $nl
"Utility words to create a new hashtable from a single key/value pair:" "Utility words to create a new hashtable from a single key/value pair:"
{ $subsection associate } { $subsection associate }
{ $subsection ?set-at } { $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 } { $subsection prune }
"Test if a sequence contains duplicates in linear time:"
{ $subsection all-unique? }
{ $subsection "hashtables.private" } ; { $subsection "hashtables.private" } ;
ABOUT: "hashtables" ABOUT: "hashtables"
@ -133,6 +135,15 @@ HELP: prune
{ $example "USE: hashtables" "{ 1 1 t 3 t } prune ." "V{ 1 t 3 }" } { $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 HELP: rehash
{ $values { "hash" hashtable } } { $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." } ; { $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." } ;

3
core/hashtables/hashtables-tests.factor
View File

@ -160,3 +160,6 @@ H{ } "x" set
H{ { 1 "one" } { 2 "two" } } H{ { 1 "one" } { 2 "two" } }
{ 1 2 3 } clone [ substitute ] keep { 1 2 3 } clone [ substitute ] keep
] unit-test ] unit-test
[ f ] [ { 0 1 1 2 3 5 } all-unique? ] unit-test
[ t ] [ { 0 1 2 3 4 5 } all-unique? ] unit-test

3
core/hashtables/hashtables.factor Normal file → Executable file
View File

@ -195,4 +195,7 @@ M: hashtable assoc-like
dup length <hashtable> over length <vector> dup length <hashtable> over length <vector>
rot [ >r 2dup r> (prune) ] each nip ; rot [ >r 2dup r> (prune) ] each nip ;
: all-unique? ( seq -- ? )
dup prune [ length ] 2apply = ;
INSTANCE: hashtable assoc INSTANCE: hashtable assoc

4
extra/io/buffers/buffers-tests.factor Normal file → Executable file
View File

@ -1,9 +1,9 @@
IN: temporary 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 ; sequences tools.test namespaces ;
: buffer-set ( string buffer -- ) : buffer-set ( string buffer -- )
2dup buffer-ptr string>memory 2dup buffer-ptr string>char-memory
>r length r> buffer-reset ; >r length r> buffer-reset ;
: string>buffer ( string -- buffer ) : string>buffer ( string -- buffer )

12
extra/io/buffers/buffers.factor Normal file → Executable file
View File

@ -1,9 +1,9 @@
! Copyright (C) 2004, 2005 Mackenzie Straight. ! 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. ! See http://factorcode.org/license.txt for BSD license.
IN: io.buffers IN: io.buffers
USING: alien alien.syntax kernel kernel.private libc math USING: alien alien.c-types alien.syntax kernel kernel.private
sequences strings hints ; libc math sequences strings hints ;
TUPLE: buffer size ptr fill pos ; TUPLE: buffer size ptr fill pos ;
@ -39,14 +39,14 @@ TUPLE: buffer size ptr fill pos ;
: (buffer>) ( n buffer -- string ) : (buffer>) ( n buffer -- string )
[ dup buffer-fill swap buffer-pos - min ] keep [ dup buffer-fill swap buffer-pos - min ] keep
buffer@ swap memory>string ; buffer@ swap memory>char-string ;
: buffer> ( n buffer -- string ) : buffer> ( n buffer -- string )
[ (buffer>) ] 2keep buffer-consume ; [ (buffer>) ] 2keep buffer-consume ;
: (buffer>>) ( buffer -- string ) : (buffer>>) ( buffer -- string )
dup buffer-pos over buffer-ptr <displaced-alien> dup buffer-pos over buffer-ptr <displaced-alien>
over buffer-fill rot buffer-pos - memory>string ; over buffer-fill rot buffer-pos - memory>char-string ;
: buffer>> ( buffer -- string ) : buffer>> ( buffer -- string )
dup (buffer>>) 0 rot buffer-reset ; dup (buffer>>) 0 rot buffer-reset ;
@ -87,7 +87,7 @@ HINTS: search-buffer-until { fixnum fixnum simple-alien string } ;
: >buffer ( string buffer -- ) : >buffer ( string buffer -- )
over length over check-overflow over length over check-overflow
[ buffer-end string>memory ] 2keep [ buffer-end string>char-memory ] 2keep
[ buffer-fill swap length + ] keep set-buffer-fill ; [ buffer-fill swap length + ] keep set-buffer-fill ;
: ch>buffer ( ch buffer -- ) : ch>buffer ( ch buffer -- )

16
extra/io/monitor/monitor.factor
View File

@ -1,11 +1,19 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io.backend ; USING: io.backend kernel continuations ;
IN: io.monitor IN: io.monitor
HOOK: <monitor> io-backend ( path -- monitor ) HOOK: <monitor> 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 <monitor> r> over [ close-monitor ] curry [ ] cleanup ; >r <monitor> r> over [ close-monitor ] curry [ ] cleanup ;

2
extra/io/sockets/headers/bsd/bsd.factor Normal file → Executable file
View File

@ -13,7 +13,7 @@ C-STRUCT: bpfh
: bpfh. ( bpfh -- ) : bpfh. ( bpfh -- )
[ [
bpfh-timestamp "Timestamp: " write bpfh-timestamp "Timestamp: " write
"timeval" heap-size memory>string >byte-array . "timeval" heap-size memory>byte-array .
] keep ] keep
[ bpfh-caplen "caplen: " write . ] keep [ bpfh-caplen "caplen: " write . ] keep
[ bpfh-datalen "datalen: " write . ] keep [ bpfh-datalen "datalen: " write . ] keep

4
extra/io/sockets/headers/headers.factor Normal file → Executable file
View File

@ -9,6 +9,10 @@ C-STRUCT: etherneth
{ { "char" 6 } "smac" } { { "char" 6 } "smac" }
{ "ushort" "type" } ; { "ushort" "type" } ;
: >mac-address ( byte-array -- string )
6 memory>byte-array
[ >hex 2 48 pad-left ] { } map-as ":" join ;
: etherneth. ( etherneth -- ) : etherneth. ( etherneth -- )
[ etherneth-dmac "Dest MAC: " write >mac-address . ] keep [ etherneth-dmac "Dest MAC: " write >mac-address . ] keep
[ etherneth-smac "Source MAC: " write >mac-address . ] keep [ etherneth-smac "Source MAC: " write >mac-address . ] keep

9
extra/io/sockets/impl/impl.factor
View File

@ -32,7 +32,7 @@ GENERIC: inet-pton ( str addrspec -- data )
M: inet4 inet-ntop ( data addrspec -- str ) 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 ) M: inet4 inet-pton ( str addrspec -- data )
drop "." split [ string>number ] B{ } map-as ; drop "." split [ string>number ] B{ } map-as ;
@ -60,7 +60,7 @@ M: inet4 parse-sockaddr
swap sockaddr-in-port ntohs (port) <inet4> ; swap sockaddr-in-port ntohs (port) <inet4> ;
M: inet6 inet-ntop ( data addrspec -- str ) M: inet6 inet-ntop ( data addrspec -- str )
drop 16 memory>string 2 <groups> [ be> >hex ] map ":" join ; drop 16 memory>byte-array 2 <groups> [ be> >hex ] map ":" join ;
M: inet6 inet-pton ( str addrspec -- data ) M: inet6 inet-pton ( str addrspec -- data )
drop "::" split1 drop "::" split1
@ -132,8 +132,3 @@ M: object host-name ( -- name )
256 <byte-array> dup dup length gethostname 256 <byte-array> dup dup length gethostname
zero? [ "gethostname failed" throw ] unless zero? [ "gethostname failed" throw ] unless
alien>char-string ; alien>char-string ;
: >mac-address ( byte-array -- string )
6 memory>string >byte-array
[ >hex 2 48 pad-left ] { } map-as ":" join ;

2
extra/io/windows/ce/sockets/sockets.factor
View File

@ -78,7 +78,7 @@ M: windows-ce-io <datagram> ( addrspec -- datagram )
packet-size receive-buffer make-WSABUF ; packet-size receive-buffer make-WSABUF ;
: packet-data ( len -- byte-array ) : packet-data ( len -- byte-array )
receive-buffer swap memory>string >byte-array ; receive-buffer swap memory>byte-array ;
packet-size <byte-array> receive-buffer set-global packet-size <byte-array> receive-buffer set-global

57
extra/io/windows/nt/monitor/monitor.factor
View File

@ -2,10 +2,10 @@
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types destructors io.windows kernel math windows USING: alien.c-types destructors io.windows kernel math windows
windows.kernel32 windows.types libc assocs alien namespaces windows.kernel32 windows.types libc assocs alien namespaces
continuations io.monitor ; continuations io.monitor sequences hashtables sorting arrays ;
IN: io.windows.nt.monitor IN: io.windows.nt.monitor
TUPLE: monitor handle buffer queue closed? ; TUPLE: monitor handle recursive? buffer queue closed? ;
: open-directory ( path -- handle ) : open-directory ( path -- handle )
[ [
@ -20,9 +20,9 @@ TUPLE: monitor handle buffer queue closed? ;
: buffer-size 65536 ; inline : buffer-size 65536 ; inline
M: windows-nt-io <monitor> ( path -- monitor ) M: windows-nt-io <monitor> ( path recursive? -- monitor )
[ [
open-directory >r open-directory r>
buffer-size malloc dup free-later f buffer-size malloc dup free-later f
] with-destructors ] with-destructors
f monitor construct-boa ; f monitor construct-boa ;
@ -30,7 +30,7 @@ M: windows-nt-io <monitor> ( path -- monitor )
: check-closed ( monitor -- ) : check-closed ( monitor -- )
monitor-closed? [ "Monitor closed" throw ] when ; monitor-closed? [ "Monitor closed" throw ] when ;
: close-monitor ( monitor -- ) M: windows-nt-io close-monitor ( monitor -- )
dup check-closed dup check-closed
dup monitor-buffer free dup monitor-buffer free
dup monitor-handle CloseHandle drop dup monitor-handle CloseHandle drop
@ -39,9 +39,9 @@ M: windows-nt-io <monitor> ( path -- monitor )
: fill-buffer ( monitor -- bytes ) : fill-buffer ( monitor -- bytes )
[ [
dup monitor-handle dup monitor-handle
swap monitor-buffer over monitor-buffer
buffer-size buffer-size
TRUE roll monitor-recursive? 1 0 ?
FILE_NOTIFY_CHANGE_ALL FILE_NOTIFY_CHANGE_ALL
0 <uint> [ 0 <uint> [
f f
@ -50,25 +50,52 @@ M: windows-nt-io <monitor> ( path -- monitor )
] keep *uint ] keep *uint
] with-destructors ; ] with-destructors ;
: (changed-files) ( buffer -- ) : parse-action-flag ( action mask symbol -- action )
dup { >r over bitand 0 > [ r> , ] [ r> drop ] if ;
FILE_NOTIFY_INFORMATION-NextEntryOffset
: 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 ( buffer -- changes path )
{
FILE_NOTIFY_INFORMATION-FileName FILE_NOTIFY_INFORMATION-FileName
FILE_NOTIFY_INFORMATION-FileNameLength FILE_NOTIFY_INFORMATION-FileNameLength
} get-slots memory>string dup set FILE_NOTIFY_INFORMATION-Action
} get-slots parse-action -rot memory>u16-string ;
: (changed-files) ( buffer -- )
dup changed-file namespace [ append ] change-at
dup FILE_NOTIFY_INFORMATION-NextEntryOffset
dup zero? [ 2drop ] [ dup zero? [ 2drop ] [
swap <displaced-alien> (changed-files) swap <displaced-alien> (changed-files)
] if ; ] if ;
: changed-files ( buffer len -- assoc ) : changed-files ( buffer len -- assoc )
[ zero? [ drop ] [ (changed-files) ] if ] H{ } make-assoc ; [
zero? [ drop ] [ (changed-files) ] if
] H{ } make-assoc ;
: fill-queue ( monitor -- ) : fill-queue ( monitor -- )
dup monitor-buffer dup monitor-buffer
over fill-buffer changed-files over fill-buffer changed-files
swap set-monitor-queue ; 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 check-closed
dup monitor-queue dup assoc-empty? dup monitor-queue dup assoc-empty? [
[ drop dup fill-queue next-change ] [ nip delete-any ] if ; drop dup fill-queue next-change
] [
nip delete-any prune natural-sort >array
] if ;

7
extra/io/windows/nt/nt.factor
View File

@ -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. ! See http://factorcode.org/license.txt for BSD license.
USE: io.windows USE: io.windows
USE: io.windows.nt.backend USE: io.windows.nt.backend
USE: io.windows.nt.files USE: io.windows.nt.files
USE: io.windows.nt.sockets
USE: io.windows.nt.launcher USE: io.windows.nt.launcher
USE: io.windows.nt.monitor
USE: io.windows.nt.sockets
USE: io.windows.mmap USE: io.windows.mmap
USE: io.backend USE: io.backend
USE: namespaces
T{ windows-nt-io } set-io-backend T{ windows-nt-io } set-io-backend

2
extra/io/windows/nt/sockets/sockets.factor
View File

@ -202,7 +202,7 @@ TUPLE: WSARecvFrom-args port
: parse-WSARecvFrom ( n WSARecvFrom -- packet addrspec ) : parse-WSARecvFrom ( n WSARecvFrom -- packet addrspec )
[ [
WSARecvFrom-args-lpBuffers* WSABUF-buf WSARecvFrom-args-lpBuffers* WSABUF-buf
swap memory>string >byte-array swap memory>byte-array
] keep ] keep
[ WSARecvFrom-args-lpFrom* ] keep [ WSARecvFrom-args-lpFrom* ] keep
WSARecvFrom-args-port datagram-port-addr parse-sockaddr ; WSARecvFrom-args-port datagram-port-addr parse-sockaddr ;

2
extra/opengl/opengl.factor Normal file → Executable file
View File

@ -191,7 +191,7 @@ TUPLE: sprite loc dim dim2 dlist texture ;
: c-true? ( int -- ? ) zero? not ; inline : c-true? ( int -- ? ) zero? not ; inline
: with-gl-shader-source-ptr ( string quot -- ) : with-gl-shader-source-ptr ( string quot -- )
swap dup length 1+ [ tuck string>memory <void*> swap call ] with-malloc ; inline swap dup length 1+ [ tuck string>char-memory <void*> swap call ] with-malloc ; inline
: <gl-shader> ( source kind -- shader ) : <gl-shader> ( 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

2
vm/primitives.c
View File

@ -150,8 +150,6 @@ void *primitives[] = {
primitive_alien_to_u16_string, primitive_alien_to_u16_string,
primitive_string_to_u16_alien, primitive_string_to_u16_alien,
primitive_throw, primitive_throw,
primitive_char_string_to_memory,
primitive_memory_to_char_string,
primitive_alien_address, primitive_alien_address,
primitive_slot, primitive_slot,
primitive_set_slot, primitive_set_slot,

6
vm/types.c
View File

@ -363,12 +363,6 @@ DEFINE_PRIMITIVE(resize_string)
} \ } \
return s; \ return s; \
} \ } \
DEFINE_PRIMITIVE(memory_to_##type##_string) \
{ \
CELL length = to_cell(dpop()); \
const type *string = unbox_alien(); \
dpush(tag_object(memory_to_##type##_string(string,length))); \
} \
F_STRING *from_##type##_string(const type *str) \ F_STRING *from_##type##_string(const type *str) \
{ \ { \
CELL length = 0; \ CELL length = 0; \

4
vm/types.h
View File

@ -154,26 +154,22 @@ F_STRING *reallot_string(F_STRING *string, CELL capacity, u16 fill);
DECLARE_PRIMITIVE(resize_string); DECLARE_PRIMITIVE(resize_string);
F_STRING *memory_to_char_string(const char *string, CELL length); F_STRING *memory_to_char_string(const char *string, CELL length);
DECLARE_PRIMITIVE(memory_to_char_string);
F_STRING *from_char_string(const char *c_string); F_STRING *from_char_string(const char *c_string);
DLLEXPORT void box_char_string(const char *c_string); DLLEXPORT void box_char_string(const char *c_string);
DECLARE_PRIMITIVE(alien_to_char_string); DECLARE_PRIMITIVE(alien_to_char_string);
F_STRING *memory_to_u16_string(const u16 *string, CELL length); F_STRING *memory_to_u16_string(const u16 *string, CELL length);
DECLARE_PRIMITIVE(memory_to_u16_string);
F_STRING *from_u16_string(const u16 *c_string); F_STRING *from_u16_string(const u16 *c_string);
DLLEXPORT void box_u16_string(const u16 *c_string); DLLEXPORT void box_u16_string(const u16 *c_string);
DECLARE_PRIMITIVE(alien_to_u16_string); DECLARE_PRIMITIVE(alien_to_u16_string);
void char_string_to_memory(F_STRING *s, char *string); void char_string_to_memory(F_STRING *s, char *string);
DECLARE_PRIMITIVE(char_string_to_memory);
F_BYTE_ARRAY *string_to_char_alien(F_STRING *s, bool check); F_BYTE_ARRAY *string_to_char_alien(F_STRING *s, bool check);
char* to_char_string(F_STRING *s, bool check); char* to_char_string(F_STRING *s, bool check);
DLLEXPORT char *unbox_char_string(void); DLLEXPORT char *unbox_char_string(void);
DECLARE_PRIMITIVE(string_to_char_alien); DECLARE_PRIMITIVE(string_to_char_alien);
void u16_string_to_memory(F_STRING *s, u16 *string); void u16_string_to_memory(F_STRING *s, u16 *string);
DECLARE_PRIMITIVE(u16_string_to_memory);
F_BYTE_ARRAY *string_to_u16_alien(F_STRING *s, bool check); F_BYTE_ARRAY *string_to_u16_alien(F_STRING *s, bool check);
u16* to_u16_string(F_STRING *s, bool check); u16* to_u16_string(F_STRING *s, bool check);
DLLEXPORT u16 *unbox_u16_string(void); DLLEXPORT u16 *unbox_u16_string(void);