From 151c6fac3cad2f90df4c92ef15b49b0ba106a7fe Mon Sep 17 00:00:00 2001 From: Mackenzie Straight Date: Mon, 7 Feb 2005 23:04:49 +0000 Subject: [PATCH] Threading/IO updates --- library/bootstrap/init.factor | 1 + library/io/win32-io-internals.factor | 68 +++++++++++++++++----------- library/lists.factor | 27 +++++++++++ library/threads.factor | 12 +++-- library/ui/console.factor | 2 +- library/win32/win32-errors.factor | 1 + 6 files changed, 79 insertions(+), 32 deletions(-) diff --git a/library/bootstrap/init.factor b/library/bootstrap/init.factor index c9df175781..bc0854d8aa 100644 --- a/library/bootstrap/init.factor +++ b/library/bootstrap/init.factor @@ -36,6 +36,7 @@ USE: words : boot ( -- ) #! Initialize an interpreter with the basic services. init-namespaces + init-threads init-stdio "HOME" os-env [ "." ] unless* "~" set init-search-path ; diff --git a/library/io/win32-io-internals.factor b/library/io/win32-io-internals.factor index 2796a6506f..2f25cc2a50 100644 --- a/library/io/win32-io-internals.factor +++ b/library/io/win32-io-internals.factor @@ -26,16 +26,8 @@ ! ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. IN: win32-io-internals -USE: alien -USE: errors -USE: kernel -USE: kernel-internals -USE: lists -USE: math -USE: namespaces -USE: prettyprint -USE: vectors -USE: win32-api +USING: alien errors kernel kernel-internals lists math namespaces threads + vectors win32-api ; SYMBOL: completion-port SYMBOL: io-queue @@ -45,20 +37,11 @@ SYMBOL: callbacks : handle-io-error ( -- ) #! If a write or read call fails unexpectedly, throw an error. GetLastError [ - ERROR_IO_PENDING ERROR_HANDLE_EOF ERROR_SUCCESS + ERROR_IO_PENDING ERROR_HANDLE_EOF ERROR_SUCCESS WAIT_TIMEOUT ] contains? [ win32-throw-error ] unless ; -: win32-init-stdio ( -- ) - INVALID_HANDLE_VALUE NULL NULL 1 CreateIoCompletionPort - completion-port set - - [ - 32 callbacks set - f free-list set - ] extend io-queue set ; - : add-completion ( handle -- ) completion-port get NULL 1 CreateIoCompletionPort drop ; @@ -125,10 +108,43 @@ END-STRUCT callbacks get vector-nth cdr ] bind ; -: win32-next-io-task ( -- quot ) - completion-port get dup >r - dup >r INFINITE GetQueuedCompletionStatus - [ handle-io-error ] unless - r> r> indirect-pointer-value swap indirect-pointer-value - overlapped-ext-user-data get-io-callback call ; +: (wait-for-io) ( timeout -- ? overlapped len ) + >r completion-port get + [ 0 swap set-indirect-pointer-value ] keep + + + pick over r> -rot >r >r GetQueuedCompletionStatus r> r> ; + +: overlapped>callback ( overlapped -- callback ) + indirect-pointer-value dup 0 = [ + drop f + ] [ + overlapped-ext-user-data get-io-callback + ] ifte ; + +: wait-for-io ( timeout -- callback len ) + (wait-for-io) rot [ handle-io-error ] unless + overlapped>callback swap indirect-pointer-value ; + +: win32-next-io-task ( -- ) + INFINITE wait-for-io swap call ; + +: win32-io-thread ( -- ) + 10 wait-for-io swap [ + [ schedule-thread call ] callcc0 + ] [ + drop yield + ] ifte* + win32-io-thread ; + +: win32-init-stdio ( -- ) + INVALID_HANDLE_VALUE NULL NULL 1 CreateIoCompletionPort + completion-port set + + [ + 32 callbacks set + f free-list set + ] extend io-queue set + + [ win32-io-thread ] in-thread ; diff --git a/library/lists.factor b/library/lists.factor index f1cea1f255..00591dcd22 100644 --- a/library/lists.factor +++ b/library/lists.factor @@ -166,3 +166,30 @@ M: cons hashcode ( cons -- hash ) car hashcode ; #! Make a list of elements that occur in list2 but not #! list1. [ over contains? not ] subset nip ; + +TUPLE: dlist first last ; +TUPLE: dlist-node next prev data ; + +C: dlist ; +C: dlist-node + [ set-dlist-node-next ] keep + [ set-dlist-node-prev ] keep + [ set-dlist-node-data ] keep ; + +: dlist-push-end ( data dlist -- ) + [ dlist-last f ] keep + [ dlist-last [ dupd set-dlist-node-next ] when* ] keep + 2dup set-dlist-last + dup dlist-first [ 2drop ] [ set-dlist-first ] ifte ; + +: dlist-empty? ( dlist -- ? ) + dlist-first f = ; + +: (dlist-pop-front) ( dlist -- data ) + [ dlist-first dlist-node-data ] keep + [ dup dlist-first dlist-node-next swap set-dlist-first ] keep + dup dlist-first [ drop ] [ f swap set-dlist-last ] ifte ; + +: dlist-pop-front ( dlist -- data ) + dup dlist-empty? [ drop f ] [ (dlist-pop-front) ] ifte ; + diff --git a/library/threads.factor b/library/threads.factor index 70089b39da..30f719c8d6 100644 --- a/library/threads.factor +++ b/library/threads.factor @@ -2,20 +2,21 @@ ! See http://factor.sf.net/license.txt for BSD license. IN: threads USING: io-internals kernel kernel-internals lists namespaces ; - + ! Core of the multitasker. Used by io-internals.factor and ! in-thread.factor. : run-queue ( -- queue ) 9 getenv ; : set-run-queue ( queue -- ) 9 setenv ; +: init-threads ( -- ) + set-run-queue ; + : next-thread ( -- quot ) - #! Get and remove the next quotation from the run queue. - run-queue dup [ uncons set-run-queue ] when ; + run-queue dlist-pop-front ; : schedule-thread ( quot -- ) - #! Add a quotation to the run queue. - run-queue cons set-run-queue ; + run-queue dlist-push-end ; : (yield) ( -- ) #! If there is a quotation in the run queue, call it, @@ -37,3 +38,4 @@ USING: io-internals kernel kernel-internals lists namespaces ; #! eventually be restored by a future call to (yield) or #! yield. [ schedule-thread (yield) ] callcc0 ; + diff --git a/library/ui/console.factor b/library/ui/console.factor index e27a85a356..50828c8299 100644 --- a/library/ui/console.factor +++ b/library/ui/console.factor @@ -363,7 +363,7 @@ M: alien handle-event ( event -- ? ) : console-loop ( -- ) redraw-console get [ draw-console redraw-console off ] when - check-event [ console-loop ] when ; + yield check-event [ console-loop ] when ; : console-quit ( -- ) input-continuation get [ f swap call ] when* diff --git a/library/win32/win32-errors.factor b/library/win32/win32-errors.factor index ae237be8ee..bdeabdb0a0 100644 --- a/library/win32/win32-errors.factor +++ b/library/win32/win32-errors.factor @@ -43,6 +43,7 @@ USE: words CONSTANT: ERROR_SUCCESS 0 ; CONSTANT: ERROR_HANDLE_EOF 38 ; CONSTANT: ERROR_IO_PENDING 997 ; +CONSTANT: WAIT_TIMEOUT 258 ; : FORMAT_MESSAGE_ALLOCATE_BUFFER HEX: 00000100 ; : FORMAT_MESSAGE_IGNORE_INSERTS HEX: 00000200 ;