From 656a4bf1ed6bfa476233d16044771fc750a50948 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 5 May 2005 02:34:55 +0000 Subject: [PATCH] float and double types in FFI, minor cleanups here and there to kick off 0.75 --- TODO.FACTOR.txt | 79 ++++++++++++------------ library/alien/c-types.factor | 86 +++++++++++++++++++-------- library/alien/compiler.factor | 23 +------ library/alien/dataflow.factor | 24 ++++++++ library/alien/structs.factor | 19 ++---- library/bootstrap/boot-stage1.factor | 5 ++ library/bootstrap/boot-stage2.factor | 47 +++++++++++++-- library/bootstrap/boot-stage3.factor | 34 ----------- library/bootstrap/boot-stage4.factor | 2 - library/bootstrap/primitives.factor | 1 - library/compiler/x86/alien.factor | 27 +++++++-- library/compiler/x86/assembler.factor | 10 ++++ library/generic/tuple.factor | 5 +- library/ui/text.factor | 4 ++ library/unix/sockets.factor | 15 +++-- library/unix/syscalls-freebsd.factor | 6 +- library/unix/syscalls-linux.factor | 4 -- library/unix/syscalls-macosx.factor | 2 +- library/unix/syscalls.factor | 14 +---- library/vocabularies.factor | 6 +- native/factor.c | 24 +------- native/float.c | 17 ++++++ native/float.h | 5 ++ native/misc.c | 5 -- native/misc.h | 1 - native/platform.h | 20 +++++++ native/primitives.c | 1 - 27 files changed, 279 insertions(+), 207 deletions(-) create mode 100644 library/alien/dataflow.factor diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index 862c6a0025..7f4bc14afa 100644 --- a/TODO.FACTOR.txt +++ b/TODO.FACTOR.txt @@ -1,22 +1,55 @@ -+ plugin: - - if external factor is down, don't add tons of random shit to the dictionary +- faster layout +- rotating cube demo +- out parameter cleanup +- SDL_Rect** type +- get all-tests to run with -no-compile +- fix i/o on generic x86/ppc unix +- alien primitives need a more general input type +- 2map, sequence= slow with lists +- nappend: instead of using push, enlarge the sequence with set-length + then add set the elements with set-nth +- ensure-capacity: don't be generic +- vector's ensure-capacity will crash if not given fixnums! +- generic each some? all? member? memq? all=? index? subseq? map +- index and index* are very slow with lists +- unsafe-sbuf>string +- generic subseq +- GENERIC: map + - list impl same as now +- generic parser::scan +- .factor-rc loading errors are not reported properly +- code walker & exceptions +- string sub-primitives +- generational gc +- if two tasks write to a unix stream, the buffer can overflow +- rename prettyprint to pprint +- reader syntax for arrays, byte arrays, displaced aliens +- add a socket timeout +- make-matrix is slow and ugly +- move 2repeat somewhere else +- virtual hosts +- keep alive +- dipping seq-2nmap, seq-2each +- array sort +- tiled window manager + ++ plugin: + - word preview for parsing words + ui: -- faster layout - faster repaint - console with presentations - ui browser - auto-updating inspector, mirrors abstraction - mouse enter onto overlapping with interior, but not child, gadget +- rollovers broken in inspector - menu dragging - fix up the min thumb size hack - frame gap -- tiled window manager -- rotating cube demo + ffi: @@ -26,18 +59,11 @@ - ffi unicode strings: null char security hole - utf16 string boxing - value type structs -- out parameter cleanup - bitfields in C structs -- SDL_Rect** type - setting struct members that are not * -- char[14], etc members -- generalize char255 -- FFI float types + compiler: -- get all-tests to run with -no-compile -- fix i/o on generic x86/ppc unix -- alien primitives need a more general input type - [ [ dup call ] dup call ] infer hangs - more accurate types for various words - declarations @@ -53,50 +79,29 @@ + sequences -- 2map, sequence= slow with lists -- nappend: instead of using push, enlarge the sequence with set-length - then add set the elements with set-nth -- ensure-capacity: don't be generic -- vector's ensure-capacity will crash if not given fixnums! -- dipping seq-2nmap, seq-2each -- generic each some? all? member? memq? all=? index? subseq? map -- index and index* are very slow with lists - list map, subset: not tail recursive - phase out sbuf-append, index-of, substring -- unsafe-sbuf>string -- generic subseq -- GENERIC: map - - list impl same as now -- generic parser::scan -- array sort + kernel: - powerpc has weird callstack residue -- .factor-rc loading errors are not reported properly - instances: do not use make-list - unions containing tuples do not work properly - need G: combinations - method doc strings -- code walker & exceptions -- string sub-primitives - clean up metaclasses - vectors: ensure its ok with bignum indices - code gc -- generational gc - doc comments of generics - M: object should not inhibit delegation - renumber types appopriately + i/o: -- if two tasks write to a unix stream, the buffer can overflow - faster stream-copy -- rename prettyprint to pprint - reading and writing byte arrays - merge unix and win32 io where appropriate - unix io: handle \n\r and \n\0 -- reader syntax for arrays, byte arrays, displaced aliens - separate words for writing characters and strings - perhaps: GENERIC: set-style ( style stream -- ) @@ -104,14 +109,11 @@ GENERIC: stream-write-char - stream server can hang because of exception handler limitations - better i/o scheduler -- add a socket timeout - unify unparse and prettyprint - utf16, utf8 encoding + nice to have libraries: -- make-matrix is slow and ugly -- move 2repeat somewhere else - regexps - XML - real Unicode support (strings are already 16 bits and can be extended @@ -119,8 +121,3 @@ predicates, comparison, case conversion, sorting...) - full Win32 binding - Cairo binding - -+ http: - -- virtual hosts -- keep alive diff --git a/library/alien/c-types.factor b/library/alien/c-types.factor index cad6855ab7..69c940e7a4 100644 --- a/library/alien/c-types.factor +++ b/library/alien/c-types.factor @@ -1,15 +1,17 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. IN: alien -USING: assembler errors hashtables kernel namespaces parser -strings ; +USING: assembler errors generic hashtables kernel lists math +namespaces parser sequences strings words ; : ( -- type ) [ [ "No setter" throw ] "setter" set [ "No getter" throw ] "getter" set "no boxer" "boxer" set + #box "box-op" set "no unboxer" "unboxer" set + #unbox "unbox-op" set 0 "width" set ] extend ; @@ -23,10 +25,33 @@ SYMBOL: c-types : c-size ( name -- size ) c-type [ "width" get ] bind ; -: define-c-type ( quot name -- ) - c-types get [ >r swap extend r> set ] bind ; inline - -global [ c-types set ] bind +: define-deref ( hash name vocab -- ) + >r "*" swap append r> create + "getter" rot hash 0 swons define-compound ; + +: define-c-type ( quot name vocab -- ) + >r >r swap extend r> 2dup r> define-deref + c-types get set-hash ; inline + +: ( type -- byte-array ) + c-size cell / ceiling ; + +: ( n type -- byte-array ) + c-size * cell / ceiling ; + +: define-out ( name -- ) + #! Out parameter constructor for integral types. + dup "alien" constructor-word + swap c-type [ + [ + "width" get , \ , 0 , "setter" get % + ] make-list + ] bind define-compound ; + +: define-primitive-type ( quot name -- ) + [ "alien" define-c-type ] keep define-out ; + +global [ c-types nest drop ] bind [ [ alien-unsigned-cell ] "getter" set @@ -37,7 +62,7 @@ global [ c-types set ] bind cell "align" set "box_alien" "boxer" set "unbox_alien" "unboxer" set -] "void*" define-c-type +] "void*" define-primitive-type [ [ alien-signed-8 ] "getter" set @@ -46,7 +71,7 @@ global [ c-types set ] bind 8 "align" set "box_signed_8" "boxer" set "unbox_signed_8" "unboxer" set -] "longlong" define-c-type +] "longlong" define-primitive-type [ [ alien-unsigned-8 ] "getter" set @@ -55,7 +80,7 @@ global [ c-types set ] bind 8 "align" set "box_unsinged_8" "boxer" set "unbox_unsigned_8" "unboxer" set -] "ulonglong" define-c-type +] "ulonglong" define-primitive-type [ [ alien-signed-4 ] "getter" set @@ -64,7 +89,7 @@ global [ c-types set ] bind 4 "align" set "box_signed_4" "boxer" set "unbox_signed_4" "unboxer" set -] "int" define-c-type +] "int" define-primitive-type [ [ alien-unsigned-4 ] "getter" set @@ -73,7 +98,7 @@ global [ c-types set ] bind 4 "align" set "box_unsigned_4" "boxer" set "unbox_unsigned_4" "unboxer" set -] "uint" define-c-type +] "uint" define-primitive-type [ [ alien-signed-2 ] "getter" set @@ -82,7 +107,7 @@ global [ c-types set ] bind 2 "align" set "box_signed_2" "boxer" set "unbox_signed_2" "unboxer" set -] "short" define-c-type +] "short" define-primitive-type [ [ alien-unsigned-2 ] "getter" set @@ -91,7 +116,7 @@ global [ c-types set ] bind 2 "align" set "box_unsigned_2" "boxer" set "unbox_unsigned_2" "unboxer" set -] "ushort" define-c-type +] "ushort" define-primitive-type [ [ alien-signed-1 ] "getter" set @@ -100,7 +125,7 @@ global [ c-types set ] bind 1 "align" set "box_signed_1" "boxer" set "unbox_signed_1" "unboxer" set -] "char" define-c-type +] "char" define-primitive-type [ [ alien-unsigned-1 ] "getter" set @@ -109,7 +134,7 @@ global [ c-types set ] bind 1 "align" set "box_unsigned_1" "boxer" set "unbox_unsigned_1" "unboxer" set -] "uchar" define-c-type +] "uchar" define-primitive-type [ [ alien-unsigned-4 ] "getter" set @@ -118,14 +143,7 @@ global [ c-types set ] bind cell "align" set "box_c_string" "boxer" set "unbox_c_string" "unboxer" set -] "char*" define-c-type - -! This is not the best way to do it. -[ - [ alien-value-string ] "getter" set - 256 "width" set - cell "align" set -] "uchar256" define-c-type +] "char*" define-primitive-type [ [ alien-unsigned-4 ] "getter" set @@ -134,7 +152,7 @@ global [ c-types set ] bind cell "align" set "box_utf16_string" "boxer" set "unbox_utf16_string" "unboxer" set -] "ushort*" define-c-type +] "ushort*" define-primitive-type [ [ alien-unsigned-4 0 = not ] "getter" set @@ -143,7 +161,25 @@ global [ c-types set ] bind cell "align" set "box_boolean" "boxer" set "unbox_boolean" "unboxer" set -] "bool" define-c-type +] "bool" define-primitive-type + +[ + cell "width" set + cell "align" set + "box_float" "boxer" set + #box-float "box-op" set + "unbox_float" "unboxer" set + #unbox-float "unbox-op" set +] "float" define-primitive-type + +[ + cell 2 * "width" set + cell 2 * "align" set + "box_double" "boxer" set + #box-double "box-op" set + "unbox_double" "unboxer" set + #unbox-double "unbox-op" set +] "double" define-primitive-type : alias-c-type ( old new -- ) c-types get [ >r get r> set ] bind ; diff --git a/library/alien/compiler.factor b/library/alien/compiler.factor index 553bac6470..d89d4bffe6 100644 --- a/library/alien/compiler.factor +++ b/library/alien/compiler.factor @@ -54,25 +54,6 @@ M: alien-error error. ( error -- ) #! "libraries" namespace. throw ; -! Linear IR nodes - -SYMBOL: #cleanup ( unwind stack by parameter ) - -SYMBOL: #unbox ( move top of datastack to C stack ) - -! for register parameter passing; move top of C stack to a -! register. no-op on x86, generates code on PowerPC. -SYMBOL: #parameter - -! for increasing stack space on PowerPC; unused on x86. -SYMBOL: #parameters - -SYMBOL: #box ( move EAX to datastack ) - -! These are set in the alien-invoke dataflow IR node. -SYMBOL: alien-returns -SYMBOL: alien-parameters - : set-alien-returns ( returns node -- ) [ dup alien-returns set ] bind "void" = [ @@ -125,7 +106,7 @@ DEFER: alien-global 0 swap [ c-size cell align + ] each ; : unbox-parameter ( n parameter -- ) - c-type [ "unboxer" get ] bind cons #unbox swons , ; + c-type [ "unboxer" get cons "unbox-op" get ] bind swons , ; : linearize-parameters ( node -- count ) #! Generate code for boxing a list of C types, then generate @@ -144,7 +125,7 @@ DEFER: alien-global [ alien-returns get ] bind dup "void" = [ drop ] [ - c-type [ "boxer" get ] bind #box swons , + c-type [ "boxer" get "box-op" get ] bind swons , ] ifte ; : linearize-alien-invoke ( node -- ) diff --git a/library/alien/dataflow.factor b/library/alien/dataflow.factor new file mode 100644 index 0000000000..7e44a3db4f --- /dev/null +++ b/library/alien/dataflow.factor @@ -0,0 +1,24 @@ +IN: alien + +! Linear IR nodes + +SYMBOL: #cleanup ( unwind stack by parameter ) + +SYMBOL: #unbox ( move top of datastack to C stack ) +SYMBOL: #unbox-float +SYMBOL: #unbox-double + +! for register parameter passing; move top of C stack to a +! register. no-op on x86, generates code on PowerPC. +SYMBOL: #parameter + +! for increasing stack space on PowerPC; unused on x86. +SYMBOL: #parameters + +SYMBOL: #box ( move EAX to datastack ) +SYMBOL: #box-float +SYMBOL: #box-double + +! These are set in the alien-invoke dataflow IR node. +SYMBOL: alien-returns +SYMBOL: alien-parameters diff --git a/library/alien/structs.factor b/library/alien/structs.factor index b295916017..efaba1eed2 100644 --- a/library/alien/structs.factor +++ b/library/alien/structs.factor @@ -2,7 +2,7 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: alien USING: assembler compiler errors generic hashtables kernel lists -math namespaces parser strings words ; +math namespaces parser sequences strings words ; ! Some code for interfacing with C structures. @@ -34,19 +34,19 @@ math namespaces parser strings words ; #! Make a word where foo is the structure name that #! allocates a Factor heap-local instance of this structure. #! Used for C functions that expect you to pass in a struct. - "struct-name" get constructor-word + "struct-name" get "in" get constructor-word swap bytes>cells [ ] cons define-compound ; : array-constructor ( width -- ) #! Make a word ( n -- byte-array ). - "struct-name" get "-array" cat2 constructor-word + "struct-name" get "-array" append "in" get constructor-word swap bytes>cells [ * ] cons define-compound ; : define-nth ( width -- ) #! Make a word foo-nth ( n alien -- dsplaced-alien ). - "struct-name" get "-nth" cat2 create-in + "struct-name" get "-nth" append create-in swap [ swap >r * r> ] cons define-compound ; @@ -60,8 +60,8 @@ math namespaces parser strings words ; "width" set cell "align" set [ swap ] "getter" set - ] "struct-name" get define-c-type - "void*" c-type "struct-name" get "*" cat2 + ] "struct-name" get "in" get define-c-type + "void*" c-type "struct-name" get "*" append c-types get set-hash ; : BEGIN-STRUCT: ( -- offset ) @@ -81,10 +81,3 @@ math namespaces parser strings words ; : END-UNION ( max -- ) define-struct-type ; parsing - -BEGIN-STRUCT: int-box - FIELD: int i -END-STRUCT - -: box-int ( n -- box ) - [ set-int-box-i ] keep ; diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 1d9af6e217..cb4b756e6d 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -80,6 +80,11 @@ hashtables ; "/library/compiler/simplifier.factor" "/library/compiler/generator.factor" "/library/compiler/compiler.factor" + + "/library/alien/dataflow.factor" + "/library/alien/c-types.factor" + "/library/alien/enums.factor" + "/library/alien/structs.factor" ] pull-in "delegate" [ "generic" ] search diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index 69fd82895a..d829b7f0fb 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/library/bootstrap/boot-stage2.factor @@ -1,8 +1,10 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -USING: generic hashtables kernel lists memory parser stdio words ; +USING: alien assembler command-line compiler generic hashtables +kernel lists memory namespaces parser sequences stdio unparser +words ; -"Bootstrap stage 2..." print +"Making the image happy..." print ! Rehash hashtables [ hashtable? ] instances @@ -22,13 +24,14 @@ recrossref drop ] ifte ; +! These are loaded here until bootstrap gets some fixes t [ - "/library/alien/c-types.factor" "/library/alien/compiler.factor" - "/library/alien/enums.factor" - "/library/alien/structs.factor" + "/library/io/buffer.factor" ] pull-in +"Loading compiler backend..." print + cpu "x86" = [ "/library/compiler/x86/assembler.factor" "/library/compiler/x86/stack.factor" @@ -44,4 +47,38 @@ cpu "ppc" = [ "/library/compiler/ppc/alien.factor" ] pull-in +"Compiling base..." print + +unix? [ + "sdl" "libSDL.so" "cdecl" add-library + "sdl-gfx" "libSDL_gfx.so" "cdecl" add-library + "sdl-ttf" "libSDL_ttf.so" "cdecl" add-library +] when + +win32? [ + "kernel32" "kernel32.dll" "stdcall" add-library + "user32" "user32.dll" "stdcall" add-library + "gdi32" "gdi32.dll" "stdcall" add-library + "winsock" "ws2_32.dll" "stdcall" add-library + "mswsock" "mswsock.dll" "stdcall" add-library + "libc" "msvcrt.dll" "cdecl" add-library + "sdl" "SDL.dll" "cdecl" add-library + "sdl-gfx" "SDL_gfx.dll" "cdecl" add-library + "sdl-ttf" "SDL_ttf.dll" "cdecl" add-library +] when + +default-cli-args +parse-command-line +init-assembler + +: compile? "compile" get supported-cpu? and ; + +compile? [ + \ car compile + \ = compile + \ length compile + \ unparse compile + \ scan compile +] when + "/library/bootstrap/boot-stage3.factor" run-resource diff --git a/library/bootstrap/boot-stage3.factor b/library/bootstrap/boot-stage3.factor index 13885d381a..a8574307e2 100644 --- a/library/bootstrap/boot-stage3.factor +++ b/library/bootstrap/boot-stage3.factor @@ -5,40 +5,6 @@ lists namespaces parser sequences stdio unparser words ; "Bootstrap stage 3..." print -unix? [ - "sdl" "libSDL.so" "cdecl" add-library - "sdl-gfx" "libSDL_gfx.so" "cdecl" add-library - "sdl-ttf" "libSDL_ttf.so" "cdecl" add-library -] when - -win32? [ - "kernel32" "kernel32.dll" "stdcall" add-library - "user32" "user32.dll" "stdcall" add-library - "gdi32" "gdi32.dll" "stdcall" add-library - "winsock" "ws2_32.dll" "stdcall" add-library - "mswsock" "mswsock.dll" "stdcall" add-library - "libc" "msvcrt.dll" "cdecl" add-library - "sdl" "SDL.dll" "cdecl" add-library - "sdl-gfx" "SDL_gfx.dll" "cdecl" add-library - "sdl-ttf" "SDL_ttf.dll" "cdecl" add-library -] when - -default-cli-args -parse-command-line -init-assembler - -"/library/io/buffer.factor" run-resource - -: compile? "compile" get supported-cpu? and ; - -compile? [ - \ car compile - \ = compile - \ length compile - \ unparse compile - \ scan compile -] when - t [ "/library/math/constants.factor" "/library/math/pow.factor" diff --git a/library/bootstrap/boot-stage4.factor b/library/bootstrap/boot-stage4.factor index 540478aa35..622047d1e8 100644 --- a/library/bootstrap/boot-stage4.factor +++ b/library/bootstrap/boot-stage4.factor @@ -13,7 +13,6 @@ words ; #! quotation. init-assembler init-error-handler - init-random default-cli-args parse-command-line "null-stdio" get [ << null-stream f >> stdio set ] when ; @@ -25,7 +24,6 @@ words ; [ boot warm-boot - garbage-collection run-user-init "shell" get shell 0 exit diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor index faebd0d088..ac7e021b19 100644 --- a/library/bootstrap/primitives.factor +++ b/library/bootstrap/primitives.factor @@ -147,7 +147,6 @@ vocabularies get [ [ "room" "memory" [ [ ] [ integer integer integer integer ] ] ] [ "os-env" "kernel" [ [ string ] [ object ] ] ] [ "millis" "kernel" [ [ ] [ integer ] ] ] - [ "init-random" "math" [ [ ] [ ] ] ] [ "(random-int)" "math" [ [ ] [ integer ] ] ] [ "type" "kernel" [ [ object ] [ fixnum ] ] ] [ "cwd" "files" [ [ ] [ string ] ] ] diff --git a/library/compiler/x86/alien.factor b/library/compiler/x86/alien.factor index 1e4eb82882..2983f38290 100644 --- a/library/compiler/x86/alien.factor +++ b/library/compiler/x86/alien.factor @@ -16,9 +16,18 @@ math memory namespaces words ; drop ] "generator" set-word-prop +: UNBOX cdr dup f dlsym CALL f t rel-dlsym ; + #unbox [ - cdr dup f dlsym CALL f t rel-dlsym - EAX PUSH + UNBOX EAX PUSH +] "generator" set-word-prop + +#unbox-float [ + UNBOX ESP 4 SUB [ ESP ] FSTPS +] "generator" set-word-prop + +#unbox-double [ + UNBOX ESP 8 SUB [ ESP ] FSTPL ] "generator" set-word-prop #parameter [ @@ -26,10 +35,18 @@ math memory namespaces words ; drop ] "generator" set-word-prop +: BOX dup f dlsym CALL f t rel-dlsym EAX POP ; + #box [ - EAX PUSH - dup f dlsym CALL f t rel-dlsym - ESP 4 ADD + EAX PUSH BOX +] "generator" set-word-prop + +#box-float [ + ESP 4 SUB [ ESP ] FSTPS BOX +] "generator" set-word-prop + +#box-double [ + ESP 8 SUB [ ESP ] FSTPL BOX ECX POP ] "generator" set-word-prop #cleanup [ diff --git a/library/compiler/x86/assembler.factor b/library/compiler/x86/assembler.factor index baeae5d748..16df112dab 100644 --- a/library/compiler/x86/assembler.factor +++ b/library/compiler/x86/assembler.factor @@ -272,3 +272,13 @@ M: operand CMP HEX: 39 2-operand ; : LEA ( dst src -- ) HEX: 8d compile-byte swap register 1-operand ; + +( x87 Floating Point Unit ) + +: FSTPS ( operand -- ) + HEX: d9 compile-byte HEX: 1c compile-byte + BIN: 100 1-operand ; + +: FSTPL ( operand -- ) + HEX: dd compile-byte HEX: 1c compile-byte + BIN: 100 1-operand ; diff --git a/library/generic/tuple.factor b/library/generic/tuple.factor index 14327df770..6eb933b821 100644 --- a/library/generic/tuple.factor +++ b/library/generic/tuple.factor @@ -86,11 +86,8 @@ UNION: arrayed array tuple ; 2dup length 2 + "tuple-size" set-word-prop 4 -rot simple-slots ; -: constructor-word ( string -- word ) - "<" swap ">" append3 create-in ; - : define-constructor ( word def -- ) - >r [ word-name constructor-word ] keep [ + >r [ word-name "in" get constructor-word ] keep [ dup literal, "tuple-size" word-prop , \ make-tuple , ] make-list r> append define-compound ; diff --git a/library/ui/text.factor b/library/ui/text.factor index 471cbe04e7..42089c9fbc 100644 --- a/library/ui/text.factor +++ b/library/ui/text.factor @@ -55,6 +55,10 @@ global [ [ dup CHAR: \0 = [ drop CHAR: \s ] when ] seq-map ] when ; +BEGIN-STRUCT: int-box + FIELD: int i +END-STRUCT + : size-string ( font text -- w h ) >r lookup-font r> filter-nulls dup empty? [ drop TTF_FontHeight 0 swap diff --git a/library/unix/sockets.factor b/library/unix/sockets.factor index 98976df0db..1ccae97b2d 100644 --- a/library/unix/sockets.factor +++ b/library/unix/sockets.factor @@ -38,12 +38,12 @@ USING: alien generic kernel math unix-internals ; : server-sockaddr ( port -- sockaddr ) init-sockaddr INADDR_ANY htonl over set-sockaddr-in-addr ; -: sockopt ( fd opt -- ) - SOL_SOCKET swap 1 box-int "int" c-size setsockopt io-error ; +: sockopt ( fd level opt -- ) + 1 "int" c-size setsockopt io-error ; : server-socket ( port -- fd ) server-sockaddr [ - dup SO_REUSEADDR sockopt + dup SOL_SOCKET SO_REUSEADDR sockopt swap dupd "sockaddr-in" c-size bind dup 0 >= [ drop 1 listen ] [ ( fd n - n) nip ] ifte ] with-socket-fd ; @@ -75,6 +75,9 @@ M: accept-task io-task-events ( task -- events ) dup sockaddr-in-addr inet-ntoa swap sockaddr-in-port ntohs ; +: ( fd -- stream ) + dup f ; + IN: streams C: client-stream ( fd host port -- stream ) @@ -82,13 +85,13 @@ C: client-stream ( fd host port -- stream ) [ set-client-stream-host ] keep [ >r - dup SO_OOBINLINE sockopt - dup f r> set-delegate + dup SOL_SOCKET SO_OOBINLINE sockopt + r> set-delegate ] keep ; : ( host port -- stream ) #! Connect to a port number on a TCP/IP host. - [ client-socket ] 2keep ; + client-socket ; : ( port -- server ) #! Starts listening for TCP connections on localhost:port. diff --git a/library/unix/syscalls-freebsd.factor b/library/unix/syscalls-freebsd.factor index bf270fbc58..2e383e3d58 100644 --- a/library/unix/syscalls-freebsd.factor +++ b/library/unix/syscalls-freebsd.factor @@ -13,14 +13,10 @@ IN: unix-internals : POLLIN HEX: 0001 ; : POLLPRI HEX: 0002 ; : POLLOUT HEX: 0004 ; -: POLLRDNORM HEX: 0040 ; -: POLLWRNORM POLLOUT ; -: POLLRDBAND HEX: 0080 ; -: POLLWRBAND HEX: 0100 ; : SOL_SOCKET HEX: ffff ; : SO_REUSEADDR HEX: 4 ; -: SO_OOBINLINE HEX: ff ; +: SO_OOBINLINE HEX: 100 ; : INADDR_ANY 0 ; diff --git a/library/unix/syscalls-linux.factor b/library/unix/syscalls-linux.factor index e4ebe2f8af..aa19c9e358 100644 --- a/library/unix/syscalls-linux.factor +++ b/library/unix/syscalls-linux.factor @@ -13,10 +13,6 @@ IN: unix-internals : POLLIN HEX: 0001 ; : POLLPRI HEX: 0002 ; : POLLOUT HEX: 0004 ; -: POLLRDNORM HEX: 0040 ; -: POLLWRNORM HEX: 0100 ; -: POLLRDBAND HEX: 0080 ; -: POLLWRBAND HEX: 0200 ; : SOL_SOCKET 1 ; : SO_REUSEADDR 2 ; diff --git a/library/unix/syscalls-macosx.factor b/library/unix/syscalls-macosx.factor index 251d594a08..65d0bdaf6d 100644 --- a/library/unix/syscalls-macosx.factor +++ b/library/unix/syscalls-macosx.factor @@ -16,7 +16,7 @@ IN: unix-internals : SOL_SOCKET HEX: ffff ; : SO_REUSEADDR HEX: 4 ; -: SO_OOBINLINE HEX: ff ; +: SO_OOBINLINE HEX: 100 ; : INADDR_ANY 0 ; diff --git a/library/unix/syscalls.factor b/library/unix/syscalls.factor index 153f308f5b..8e78b6c4c0 100644 --- a/library/unix/syscalls.factor +++ b/library/unix/syscalls.factor @@ -43,23 +43,15 @@ END-STRUCT : poll ( pollfds nfds timeout -- n ) "int" "libc" "poll" [ "pollfd*" "uint" "int" ] alien-invoke ; -BEGIN-STRUCT: uint* - FIELD: uint s -END-STRUCT - -BEGIN-STRUCT: VOID* ( ugly ) - FIELD: void* s -END-STRUCT - BEGIN-STRUCT: hostent FIELD: char* name - FIELD: VOID** aliases + FIELD: void* aliases FIELD: int addrtype FIELD: int length - FIELD: VOID** addr-list + FIELD: void* addr-list END-STRUCT -: hostent-addr hostent-addr-list VOID*-s uint*-s ; +: hostent-addr hostent-addr-list *void* *uint ; : gethostbyname ( name -- hostent ) "hostent*" "libc" "gethostbyname" [ "char*" ] alien-invoke ; diff --git a/library/vocabularies.factor b/library/vocabularies.factor index 3411984990..4aa66170c9 100644 --- a/library/vocabularies.factor +++ b/library/vocabularies.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2004, 2005 Slava Pestov. ! See http://factor.sf.net/license.txt for BSD license. -IN: words USING: hashtables kernel lists namespaces strings ; +IN: words USING: hashtables kernel lists namespaces strings +sequences ; SYMBOL: vocabularies @@ -77,6 +78,9 @@ SYMBOL: vocabularies (create) dup reveal ] ?ifte ; +: constructor-word ( string vocab -- word ) + >r "<" swap ">" append3 r> create ; + : forget ( word -- ) #! Remove a word definition. dup uncrossref diff --git a/native/factor.c b/native/factor.c index 2fd33ceb27..2d431e3f18 100644 --- a/native/factor.c +++ b/native/factor.c @@ -3,6 +3,7 @@ void init_factor(char* image, CELL ds_size, CELL cs_size, CELL data_size, CELL code_size) { + srand((unsigned)time(NULL)); /* initialize random number generator */ init_ffi(); init_arena(data_size); init_compiler(code_size); @@ -10,28 +11,9 @@ void init_factor(char* image, CELL ds_size, CELL cs_size, init_stacks(ds_size,cs_size); init_c_io(); init_signals(); - init_errors(); - -#if defined(FACTOR_X86) - userenv[CPU_ENV] = tag_object(from_c_string("x86")); -#elif defined(FACTOR_PPC) - userenv[CPU_ENV] = tag_object(from_c_string("ppc")); -#else - userenv[CPU_ENV] = tag_object(from_c_string("unknown")); -#endif - -#ifdef WIN32 - userenv[OS_ENV] = tag_object(from_c_string("win32")); -#elif defined(__FreeBSD__) - userenv[OS_ENV] = tag_object(from_c_string("freebsd")); -#elif defined(linux) - userenv[OS_ENV] = tag_object(from_c_string("linux")); -#elif defined(__APPLE__) - userenv[OS_ENV] = tag_object(from_c_string("macosx")); -#else - userenv[OS_ENV] = tag_object(from_c_string("unix")); -#endif + userenv[CPU_ENV] = tag_object(from_c_string(FACTOR_CPU_STRING)); + userenv[OS_ENV] = tag_object(from_c_string(FACTOR_OS_STRING)); } INLINE bool factor_arg(const char* str, const char* arg, CELL* value) diff --git a/native/float.c b/native/float.c index 676689ef86..4bba27a313 100644 --- a/native/float.c +++ b/native/float.c @@ -196,3 +196,20 @@ void primitive_fsqrt(void) maybe_garbage_collection(); drepl(tag_float(sqrt(to_float(dpeek())))); } + +#define DEFBOX(name,type) \ +void name (type flo) \ +{ \ + dpush(tag_float(flo)); \ +} + +#define DEFUNBOX(name,type) \ +type name(void) \ +{ \ + return to_float(dpop()); \ +} + +DEFBOX(box_float,float) +DEFUNBOX(unbox_float,float) +DEFBOX(box_double,double) +DEFUNBOX(unbox_double,double) diff --git a/native/float.h b/native/float.h index d8ceae9092..255bb2523e 100644 --- a/native/float.h +++ b/native/float.h @@ -48,3 +48,8 @@ void primitive_fpow(void); void primitive_fsin(void); void primitive_fsinh(void); void primitive_fsqrt(void); + +void box_float(float flo); +float unbox_float(void); +void box_double(double flo); +double unbox_double(void); diff --git a/native/misc.c b/native/misc.c index 5076ad3bd1..71ebf1e98d 100644 --- a/native/misc.c +++ b/native/misc.c @@ -47,11 +47,6 @@ void primitive_millis(void) dpush(tag_bignum(s48_long_long_to_bignum(current_millis()))); } -void primitive_init_random(void) -{ - srand((unsigned)time(NULL)); -} - void primitive_random_int(void) { maybe_garbage_collection(); diff --git a/native/misc.h b/native/misc.h index 6c8327ea12..ca5f63a0cd 100644 --- a/native/misc.h +++ b/native/misc.h @@ -3,7 +3,6 @@ void primitive_os_env(void); void primitive_eq(void); s64 current_millis(void); void primitive_millis(void); -void primitive_init_random(void); void primitive_random_int(void); #ifdef WIN32 F_STRING *last_error(); diff --git a/native/platform.h b/native/platform.h index d3ad6b30bf..1a0d17e931 100644 --- a/native/platform.h +++ b/native/platform.h @@ -10,3 +10,23 @@ #else #define MANGLE(sym) sym #endif + +#if defined(FACTOR_X86) + #define FACTOR_CPU_STRING "x86" +#elif defined(FACTOR_PPC) + #define FACTOR_CPU_STRING "ppc" +#else + #define FACTOR_CPU_STRING "unknown" +#endif + +#ifdef WIN32 + #define FACTOR_OS_STRING "win32" +#elif defined(__FreeBSD__) + #define FACTOR_OS_STRING "freebsd" +#elif defined(linux) + #define FACTOR_OS_STRING "linux" +#elif defined(__APPLE__) + #define FACTOR_OS_STRING "macosx" +#else + #define FACTOR_OS_STRING "unix" +#endif diff --git a/native/primitives.c b/native/primitives.c index 6b673a0767..c26f24d3f9 100644 --- a/native/primitives.c +++ b/native/primitives.c @@ -113,7 +113,6 @@ void* primitives[] = { primitive_room, primitive_os_env, primitive_millis, - primitive_init_random, primitive_random_int, primitive_type, primitive_cwd,