diff --git a/core/flow-chart/flow-chart.factor b/core/flow-chart/flow-chart.factor new file mode 100644 index 0000000000..5b6cb5f4f5 --- /dev/null +++ b/core/flow-chart/flow-chart.factor @@ -0,0 +1,74 @@ +USING: kernel words math inference.dataflow sequences +optimizer.def-use combinators.private namespaces arrays +math.parser assocs prettyprint io strings inference hashtables ; +IN: flow-chart + +GENERIC: flow-chart* ( n word -- value nodes ) + +M: word flow-chart* + 2drop f f ; + +M: compound flow-chart* + word-def swap 1+ [ drop ] map + [ dataflow-with compute-def-use ] keep + first dup used-by prune [ t eq? not ] subset ; + +GENERIC: node-word ( node -- word ) + +M: #call node-word node-param ; + +M: #if node-word drop \ if ; + +M: #dispatch node-word drop \ dispatch ; + +DEFER: flow-chart + +: flow-chart-node ( value node -- ) + [ node-in-d index ] keep + node-word flow-chart , ; + +SYMBOL: pruned + +SYMBOL: nesting + +SYMBOL: max-nesting + +2 max-nesting set + +: flow-chart ( n word -- seq ) + [ + 2dup 2array , + nesting dup inc get max-nesting get > [ + 2drop pruned , + ] [ + flow-chart* dup length 5 > [ + 2drop pruned , + ] [ + [ flow-chart-node ] curry* each + ] if + ] if + ] { } make ; + +: th ( n -- ) + dup number>string write + 100 mod dup 20 > [ 10 mod ] when + H{ { 1 "st" } { 2 "nd" } { 3 "rd" } } at "th" or write ; + +: chart-heading. ( pair -- ) + first2 >r 1+ th " argument to " write r> . ; + +GENERIC# show-chart 1 ( seq n -- ) + +: indent CHAR: \s write ; + +M: sequence show-chart + dup indent + >r unclip chart-heading. r> + 2 + [ show-chart ] curry each ; + +M: word show-chart + dup indent + "... pruned" print ; + +: flow-chart. ( n word -- ) + flow-chart 2 show-chart ; diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 441dcfbee3..2bbcab8f93 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -19,17 +19,17 @@ HOOK: make-directory io-backend ( path -- ) HOOK: delete-directory io-backend ( path -- ) +: path-separator? ( ch -- ? ) windows? "/\\" "/" ? member? ; + HOOK: root-directory? io-backend ( path -- ? ) -M: object root-directory? ( path -- ? ) "/" = ; +M: object root-directory? ( path -- ? ) path-separator? ; -! Words for accessing filesystem meta-data. - -: path-separator? ( ch -- ? ) - "/\\" member? ; +: trim-path-separators ( str -- newstr ) + [ path-separator? ] right-trim ; : path+ ( str1 str2 -- str ) - >r [ path-separator? ] right-trim "/" r> + >r trim-path-separators "/" r> [ path-separator? ] left-trim 3append ; : stat ( path -- directory? permissions length modified ) @@ -39,12 +39,15 @@ M: object root-directory? ( path -- ? ) "/" = ; : directory? ( path -- ? ) stat 3drop ; +: special-directory? ( name -- ? ) + { "." ".." } member? ; + : fixup-directory ( path seq -- newseq ) [ dup string? [ tuck path+ directory? 2array ] [ nip ] if ] curry* map - [ first { "." ".." } member? not ] subset ; + [ first special-directory? not ] subset ; : directory ( path -- seq ) normalize-directory dup (directory) fixup-directory ; @@ -62,17 +65,19 @@ TUPLE: no-parent-directory path ; \ no-parent-directory construct-boa throw ; : parent-directory ( path -- parent ) - { - { [ dup root-directory? ] [ ] } - { [ dup "/\\" split ".." over member? "." rot member? or ] - [ no-parent-directory ] } - { [ t ] [ dup last-path-separator - [ 1+ head ] [ 2drop "." ] if ] } - } cond ; + trim-path-separators + dup empty? [ drop "/" ] [ + dup root-directory? [ ] [ + dup last-path-separator drop [ + 1+ cut + special-directory? + [ no-parent-directory ] when + ] when* + ] if + ] if ; : file-name ( path -- string ) - dup last-path-separator - [ 1+ tail ] [ drop ] if ; + dup last-path-separator [ 1+ tail ] [ drop ] if ; : resource-path ( path -- newpath ) \ resource-path get [ image parent-directory ] unless* @@ -82,8 +87,7 @@ TUPLE: no-parent-directory path ; "resource:" ?head [ resource-path ] when ; : make-directories ( path -- ) - normalize-pathname - { + normalize-pathname trim-path-separators { { [ dup "." = ] [ ] } { [ dup root-directory? ] [ ] } { [ dup empty? ] [ ] } @@ -94,19 +98,6 @@ TUPLE: no-parent-directory path ; ] } } cond drop ; -TUPLE: pathname string ; - -C: pathname - -M: pathname <=> [ pathname-string ] compare ; - -: home ( -- dir ) - { - { [ winnt? ] [ "USERPROFILE" os-env ] } - { [ wince? ] [ "" resource-path ] } - { [ unix? ] [ "HOME" os-env ] } - } cond ; - : copy-file ( from to -- ) dup parent-directory make-directories [ @@ -121,3 +112,16 @@ M: pathname <=> [ pathname-string ] compare ; >r dup directory swap r> [ >r >r first r> over path+ r> rot path+ copy-file ] 2curry each ; + +: home ( -- dir ) + { + { [ winnt? ] [ "USERPROFILE" os-env ] } + { [ wince? ] [ "" resource-path ] } + { [ unix? ] [ "HOME" os-env ] } + } cond ; + +TUPLE: pathname string ; + +C: pathname + +M: pathname <=> [ pathname-string ] compare ; diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index e9dc4f3e55..a7a112b58a 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -145,7 +145,7 @@ SYMBOL: load-help? : update-roots ( vocabs -- ) [ dup find-vocab-root swap vocab set-vocab-root ] each ; -: to-refresh ( prefix -- seq ) +: to-refresh ( prefix -- modified-sources modified-docs ) child-vocabs dup update-roots dup modified-sources swap modified-docs ; diff --git a/extra/io/server/server.factor b/extra/io/server/server.factor old mode 100644 new mode 100755 index 6b42d1dc8a..6389c2c024 --- a/extra/io/server/server.factor +++ b/extra/io/server/server.factor @@ -80,7 +80,8 @@ SYMBOL: log-stream : datagram-loop ( quot datagram -- ) [ - [ receive dup log-datagram >r swap call r> ] keep send + [ receive dup log-datagram >r swap call r> ] keep + pick [ send ] [ 3drop ] keep ] 2keep datagram-loop ; inline : spawn-datagrams ( quot addrspec -- ) @@ -91,4 +92,4 @@ SYMBOL: log-stream : with-datagrams ( seq service quot -- ) [ [ swap spawn-datagrams ] curry concurrency:parallel-each - ] with-logging ; inline + ] curry with-logging ; inline diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor old mode 100644 new mode 100755 index 9c0ef54195..f9d642d661 --- a/extra/io/unix/files/files.factor +++ b/extra/io/unix/files/files.factor @@ -4,9 +4,6 @@ USING: io.backend io.nonblocking io.unix.backend io.files io unix kernel math continuations ; IN: io.unix.files -M: unix-io root-directory? ( path -- ? ) - "/" = ; - : open-read ( path -- fd ) O_RDONLY file-mode open dup io-error ; diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 61a6f706f6..45da3bf1c7 100644 --- a/extra/io/unix/launcher/launcher.factor +++ b/extra/io/unix/launcher/launcher.factor @@ -1,36 +1,13 @@ USING: io io.launcher io.unix.backend io.nonblocking sequences kernel namespaces math system alien.c-types -debugger continuations combinators.lib threads ; +debugger continuations ; IN: io.unix.launcher ! Search unix first USE: unix -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Factor friendly versions of the exec functions - -: >argv ( seq -- alien ) [ malloc-char-string ] map f add >c-void*-array ; - -: execv* ( pathname argv -- int ) [ malloc-char-string ] [ >argv ] bi* execv ; -: execvp* ( filename argv -- int ) [ malloc-char-string ] [ >argv ] bi* execvp ; - -: execve* ( pathname argv envp -- int ) - [ malloc-char-string ] [ >argv ] [ >argv ] tri* execve ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Wait for a pid to finish without freezing up all the Factor threads. -! Need to find a less kludgy way to do this. - -: wait-for-pid ( pid -- ) - dup "int" WNOHANG waitpid - 0 = [ 100 sleep wait-for-pid ] [ drop ] if ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - : with-fork ( child parent -- pid ) fork [ zero? -rot if ] keep ; inline diff --git a/extra/io/windows/ce/sockets/sockets.factor b/extra/io/windows/ce/sockets/sockets.factor index 659f481188..da64b25933 100755 --- a/extra/io/windows/ce/sockets/sockets.factor +++ b/extra/io/windows/ce/sockets/sockets.factor @@ -8,89 +8,16 @@ IN: io.windows.ce M: windows-ce-io WSASocket-flags ( -- DWORD ) 0 ; -TUPLE: WSAArgs - s - lpBuffers - dwBufferCount - lpNumberOfBytesRet - lpFlags - lpOverlapped - lpCompletionRoutine ; -C: WSAArgs - -: make-WSAArgs ( port -- ) - [ port-handle win32-file-handle ] keep - 1 "DWORD" f f f ; - -: setup-WSARecv ( -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine ) - [ WSAArgs-s ] keep - [ - WSAArgs-lpBuffers [ buffer-capacity ] keep - buffer-end - "WSABUF" - [ windows.winsock:set-WSABUF-buf ] keep - [ windows.winsock:set-WSABUF-len ] keep - ] keep - [ WSAArgs-dwBufferCount ] keep - [ WSAArgs-lpNumberOfBytesRet ] keep - [ WSAArgs-lpFlags ] keep - [ WSAArgs-lpOverlapped ] keep - WSAArgs-lpCompletionRoutine ; - -! M: win32-socket wince-read ( port port-handle -- ) - ! drop dup make-WSAArgs dup setup-WSARecv WSARecv zero? [ - ! drop port-errored - ! ] [ - ! WSAArgs-lpNumberOfBytesRet *uint dup zero? [ - ! drop - ! t swap set-port-eof? - ! ] [ - ! swap n>buffer - ! ] if - ! ] if ; - M: win32-socket wince-read ( port port-handle -- ) win32-file-handle over buffer-end pick buffer-capacity 0 windows.winsock:recv dup windows.winsock:SOCKET_ERROR = [ drop port-errored ] [ - dup zero? [ - drop - t swap set-port-eof? - ] [ - swap n>buffer - ] if + dup zero? + [ drop t swap set-port-eof? ] [ swap n>buffer ] if ] if ; -: setup-WSASend ( -- s lpBuffers dwBufferCount lpNumberOfBytesRet lpFlags lpOverlapped lpCompletionRoutine ) - [ WSAArgs-s ] keep - [ - WSAArgs-lpBuffers [ buffer-length ] keep - buffer@ - "WSABUF" - [ windows.winsock:set-WSABUF-buf ] keep - [ windows.winsock:set-WSABUF-len ] keep - ] keep - [ WSAArgs-dwBufferCount ] keep - [ WSAArgs-lpNumberOfBytesRet ] keep - [ WSAArgs-lpFlags ] keep - [ WSAArgs-lpOverlapped ] keep - WSAArgs-lpCompletionRoutine ; - -! M: win32-socket wince-write ( port port-handle -- ) - ! drop dup make-WSAArgs dup setup-WSASend WSASend zero? [ - ! drop port-errored - ! ] [ - ! FileArgs-lpNumberOfBytesRet *uint ! *DWORD - ! over delegate [ buffer-consume ] keep - ! buffer-length 0 > [ - ! flush-output - ! ] [ - ! drop - ! ] if - ! ] if ; - M: win32-socket wince-write ( port port-handle -- ) win32-file-handle over buffer@ pick buffer-length 0 windows.winsock:send @@ -100,8 +27,9 @@ M: win32-socket wince-write ( port port-handle -- ) : do-connect ( addrspec -- socket ) [ tcp-socket dup ] keep make-sockaddr/size - f f f f windows.winsock:WSAConnect zero? - [ windows.winsock:winsock-error ] unless ; + f f f f + windows.winsock:WSAConnect + windows.winsock:winsock-error!=0/f ; M: windows-ce-io (client) ( addrspec -- duplex-stream ) do-connect dup handle>duplex-stream ; @@ -121,7 +49,8 @@ M: windows-ce-io accept ( server -- client ) swap server-port-addr sockaddr-type heap-size dup [ swap f 0 - windows.winsock:WSAAccept dup windows.winsock:INVALID_SOCKET = + windows.winsock:WSAAccept + dup windows.winsock:INVALID_SOCKET = [ windows.winsock:winsock-error ] when ] keep ] keep server-port-addr parse-sockaddr swap @@ -132,39 +61,55 @@ M: windows-ce-io ( addrspec -- datagram ) windows.winsock:SOCK_DGRAM server-fd f ] keep ; +: packet-size 65536 ; inline + +: receive-buffer ( -- buf ) + \ receive-buffer get-global expired? [ + packet-size malloc \ receive-buffer set-global + ] when + \ receive-buffer get-global ; + +: make-WSABUF ( len buf -- ptr ) + "WSABUF" + [ windows.winsock:set-WSABUF-buf ] keep + [ windows.winsock:set-WSABUF-len ] keep ; + +: receive-WSABUF ( -- buf ) + packet-size receive-buffer make-WSABUF ; + +: packet-data ( len -- byte-array ) + receive-buffer swap memory>string >byte-array ; + +packet-size receive-buffer set-global + M: windows-ce-io receive ( datagram -- packet addrspec ) dup check-datagram-port [ port-handle win32-file-handle - "WSABUF" - default-buffer-size get over windows.winsock:set-WSABUF-len - default-buffer-size get over windows.winsock:set-WSABUF-buf - [ - 1 - 0 [ - 0 - 64 "char" [ - 64 - f - f - windows.winsock:WSARecvFrom zero? - [ windows.winsock:winsock-error ] unless - ] keep - ] keep *uint - ] keep - ] keep - ! sockaddr count buf datagram - >r windows.winsock:WSABUF-buf swap memory>string swap r> - datagram-port-addr parse-sockaddr ; + receive-WSABUF + 1 + 0 [ + 0 + 64 "char" [ + 64 + f + f + windows.winsock:WSARecvFrom + windows.winsock:winsock-error!=0/f + ] keep + ] keep *uint packet-data swap + ] keep datagram-port-addr parse-sockaddr ; + +: send-WSABUF ( byte-array -- ptr ) + dup length packet-size > [ "UDP packet too long" throw ] when + dup length receive-buffer rot pick memcpy + receive-buffer make-WSABUF ; M: windows-ce-io send ( packet addrspec datagram -- ) 3dup check-datagram-send port-handle win32-file-handle - rot dup length "WSABUF" - [ windows.winsock:set-WSABUF-len ] keep - [ windows.winsock:set-WSABUF-buf ] keep - + rot send-WSABUF rot make-sockaddr/size >r >r 1 0 0 r> r> f f - windows.winsock:WSASendTo zero? - [ windows.winsock:winsock-error ] unless ; + windows.winsock:WSASendTo + windows.winsock:winsock-error!=0/f ; diff --git a/extra/io/windows/nt/backend/backend.factor b/extra/io/windows/nt/backend/backend.factor index 16e01b6103..c3a6bfd78b 100755 --- a/extra/io/windows/nt/backend/backend.factor +++ b/extra/io/windows/nt/backend/backend.factor @@ -8,6 +8,14 @@ IN: io.windows.nt.backend : unicode-prefix ( -- seq ) "\\\\?\\" ; inline +M: windows-nt-io root-directory? ( path -- ? ) + dup length 2 = [ + dup first Letter? + swap second CHAR: : = and + ] [ + drop f + ] if ; + M: windows-nt-io normalize-pathname ( string -- string ) dup string? [ "pathname must be a string" throw ] unless "/" split "\\" join diff --git a/extra/io/windows/windows-tests.factor b/extra/io/windows/nt/nt-tests.factor similarity index 69% rename from extra/io/windows/windows-tests.factor rename to extra/io/windows/nt/nt-tests.factor index 4c090590df..9dfef6796d 100755 --- a/extra/io/windows/windows-tests.factor +++ b/extra/io/windows/nt/nt-tests.factor @@ -5,12 +5,12 @@ IN: temporary [ "c:\\" ] [ "c:\\foo\\" parent-directory ] unit-test [ "c:\\" ] [ "c:\\foo" parent-directory ] unit-test ! { "c:" "c:\\" "c:/" } [ directory ] each -- all do the same thing -[ "c:\\" ] [ "c:\\" parent-directory ] unit-test -[ "Z:\\" ] [ "Z:\\" parent-directory ] unit-test +[ "c:" ] [ "c:\\" parent-directory ] unit-test +[ "Z:" ] [ "Z:\\" parent-directory ] unit-test [ "c:" ] [ "c:" parent-directory ] unit-test [ "Z:" ] [ "Z:" parent-directory ] unit-test -[ t ] [ "c:\\" root-directory? ] unit-test -[ t ] [ "Z:\\" root-directory? ] unit-test +[ t ] [ "c:\\" trim-path-separators root-directory? ] unit-test +[ t ] [ "Z:\\" trim-path-separators root-directory? ] unit-test [ f ] [ "c:\\foo" root-directory? ] unit-test [ f ] [ "." root-directory? ] unit-test [ f ] [ ".." root-directory? ] unit-test diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index 16b7c4847f..2bf0570b09 100755 --- a/extra/io/windows/windows.factor +++ b/extra/io/windows/windows.factor @@ -1,9 +1,8 @@ -USING: alien alien.c-types arrays destructors io -io.backend io.buffers io.files io.nonblocking io.sockets -io.sockets.impl windows.errors strings io.streams.duplex -kernel math namespaces sequences windows -windows.kernel32 windows.winsock windows.winsock.private ; -USE: prettyprint +USING: alien alien.c-types arrays destructors io io.backend +io.buffers io.files io.nonblocking io.sockets io.binary +io.sockets.impl windows.errors strings io.streams.duplex kernel +math namespaces sequences windows windows.kernel32 +windows.winsock windows.winsock.private ; IN: io.windows TUPLE: windows-nt-io ; @@ -16,15 +15,6 @@ M: windows-io (handle-destructor) ( obj -- ) M: windows-io (socket-destructor) ( obj -- ) destructor-obj closesocket drop ; -M: windows-io root-directory? ( path -- ? ) - [ path-separator? ] right-trim - dup length 2 = [ - dup first Letter? - swap second CHAR: : = and - ] [ - drop f - ] if ; - TUPLE: win32-file handle ptr overlapped ; : ( handle ptr -- obj ) @@ -67,9 +57,18 @@ M: win32-file close-handle ( handle -- ) : (open-append) ( path -- handle ) normalize-pathname GENERIC_WRITE OPEN_ALWAYS open-file ; +: set-file-pointer ( handle length -- ) + dupd d>w/w FILE_BEGIN SetFilePointer + INVALID_SET_FILE_POINTER = [ + CloseHandle "SetFilePointer failed" throw + ] when drop ; + : open-append ( path -- handle length ) - dup file-length dup - [ >r (open-append) r> ] [ drop open-write ] if ; + dup file-length dup [ + >r (open-append) r> 2dup set-file-pointer + ] [ + drop open-write + ] if ; TUPLE: FileArgs hFile lpBuffer nNumberOfBytesToRead lpNumberOfBytesRet lpOverlapped ; @@ -160,13 +159,13 @@ USE: namespaces : listen-backlog ( -- n ) HEX: 7fffffff ; inline : listen-on-socket ( socket -- ) - listen-backlog listen winsock-error!=0/f ; + listen-backlog listen winsock-return-check ; M: win32-socket stream-close ( stream -- ) win32-file-handle closesocket drop ; M: windows-io addrinfo-error ( n -- ) - winsock-error!=0/f ; + winsock-return-check ; : tcp-socket ( addrspec -- socket ) protocol-family SOCK_STREAM open-socket ; diff --git a/extra/network-clipboard/network-clipboard.factor b/extra/network-clipboard/network-clipboard.factor new file mode 100644 index 0000000000..208de386bd --- /dev/null +++ b/extra/network-clipboard/network-clipboard.factor @@ -0,0 +1,99 @@ +! Copyright (C) 2007 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: io.server io.sockets io strings parser byte-arrays +namespaces ui.clipboards ui.gadgets.panes ui.gadgets.scrollers +ui.gadgets.buttons ui.gadgets.tracks ui.gadgets ui.operations +ui.commands ui kernel splitting combinators continuations +sequences io.streams.duplex models ; +IN: network-clipboard + +: clipboard-port 4444 ; + +: get-request + clipboard get clipboard-contents write ; + +: contents ( -- str ) + [ 1024 read dup ] [ ] [ drop ] unfold concat ; + +: set-request + contents clipboard get set-clipboard-contents ; + +: clipboard-server ( -- ) + clipboard-port internet-server "clip-server" [ + readln { + { "GET" [ get-request ] } + { "SET" [ set-request ] } + } case + ] with-server ; + +\ clipboard-server H{ + { +nullary+ t } + { +listener+ t } +} define-command + +: ( -- datagram ) + "0.0.0.0" 0 ; + +: with-client ( addrspec quot -- ) + >r r> with-stream ; inline + +: send-text ( text host -- ) + clipboard-port [ write ] with-client ; + +TUPLE: host name ; + +C: host + +M: string host-name ; + +: send-clipboard ( host -- ) + host-name + "SET\n" clipboard get clipboard-contents append swap send-text ; + +[ host? ] \ send-clipboard H{ } define-operation + +: ask-text ( text host -- ) + clipboard-port + [ write flush contents ] with-client ; + +: receive-clipboard ( host -- ) + host-name + "GET\n" swap ask-text + clipboard get set-clipboard-contents ; + +[ host? ] \ receive-clipboard H{ } define-operation + +: hosts. ( seq -- ) + "Hosts:" print + [ dup write-object nl ] each ; + +TUPLE: network-clipboard-tool ; + +\ network-clipboard-tool "toolbar" f { + { f clipboard-server } +} define-command-map + +: ( model -- gadget ) + \ network-clipboard-tool construct-empty [ + toolbar, + [ hosts. ] 1 track, + ] { 0 1 } build-track ; + +SYMBOL: network-clipboards + +{ } network-clipboards set-global + +: set-network-clipboards ( seq -- ) + network-clipboards get set-model ; + +: add-network-clipboard ( host -- ) + network-clipboards get [ swap add ] change-model ; + +: network-clipboard-tool ( -- ) + [ + network-clipboards get + + "Network clipboard" open-window + ] with-ui ; + +MAIN: network-clipboard-tool diff --git a/extra/webapps/planet/planet.factor b/extra/webapps/planet/planet.factor index 3f7fed6446..75302eb59c 100644 --- a/extra/webapps/planet/planet.factor +++ b/extra/webapps/planet/planet.factor @@ -1,7 +1,7 @@ USING: sequences rss arrays concurrency kernel sorting html.elements io assocs namespaces math threads vocabs html furnace http.server.templating calendar math.parser splitting -continuations debugger system ; +continuations debugger system http.server.responders ; IN: webapps.planet TUPLE: posting author title date link body ; @@ -92,7 +92,7 @@ SYMBOL: cached-postings cached-postings get 4 head print-posting-summaries ; : planet-factor ( -- ) - [ + serving-html [ "resource:extra/webapps/planet/planet.fhtml" run-template-file ] with-html-stream ; diff --git a/extra/windows/kernel32/kernel32.factor b/extra/windows/kernel32/kernel32.factor old mode 100644 new mode 100755 index e11f6ed081..cdf87c5cca --- a/extra/windows/kernel32/kernel32.factor +++ b/extra/windows/kernel32/kernel32.factor @@ -96,6 +96,7 @@ TYPEDEF: FILE_NOTIFY_INFORMATION* PFILE_NOTIFY_INFORMATION : INVALID_HANDLE_VALUE -1 ; inline : INVALID_FILE_SIZE HEX: FFFFFFFF ; inline +: INVALID_SET_FILE_POINTER HEX: ffffffff ; inline : FILE_BEGIN 0 ; inline : FILE_CURRENT 1 ; inline diff --git a/extra/windows/winsock/winsock.factor b/extra/windows/winsock/winsock.factor index f87ebab0d8..7cad474cac 100755 --- a/extra/windows/winsock/winsock.factor +++ b/extra/windows/winsock/winsock.factor @@ -413,6 +413,11 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi ] when ; : winsock-error!=0/f ( n/f -- ) + { 0 f } member? [ + winsock-error-string throw + ] unless ; + +: winsock-return-check ( n/f -- ) dup { 0 f } member? [ drop ] [ @@ -433,5 +438,5 @@ FUNCTION: void GetAcceptExSockaddrs ( void* a, int b, int c, int d, void* e, voi SOCKET_ERROR = [ winsock-error ] when ; : init-winsock ( -- ) - HEX: 0202 WSAStartup winsock-error!=0/f ; + HEX: 0202 WSAStartup winsock-return-check ;