Menu
▾
▴
win32forth-cvs
|
From: George H. <geo...@us...> - 2006-09-26 08:44:09
|
Update of /cvsroot/win32forth/win32forth-stc/demos In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv18614/win32forth-stc/demos Added Files: pardemo.f taskdemo.f Log Message: gah:Added multithr and multi-task demos --- NEW FILE: taskdemo.f --- \ $Id: taskdemo.f,v 1.1 2006/09/26 08:44:05 georgeahubert Exp $ \ needs task.f \ task demo code \ -------------------- Demonstrations -------------------- \ demo1 code, fairly complex example. \ creates several running tasks and waits for them to complete. \ each task runs and produces output on a line number passed as a parameter \ and waits between printing numbers based on the line it's on. \ wait-eachtask is notable -- it waits on all the tasks. as each task completes \ it then rewaits on those that are still running until none are left. make-lock console-lock \ a simple console lock, the console is not thread-safe : c-lock console-lock lock getxy ; \ lock console, save where the cursor is : c-unlock gotoxy console-lock unlock ; \ unlock, restore cursor 4 newuser location : my-task { y -- } \ prints a counter from 1 to 99 with a wait \ that depends on which line it is running y location ! \ show that user & local variables work c-lock 1 location @ gotoxy ." Task " tcb @ task>id @ . tab ." running at line " location @ 1+ . c-unlock 100 1 do location @ 15 * task-sleep \ sleep depends on line number, bigger=longer c-lock 40 location @ gotoxy i . c-unlock loop c-lock 50 location @ gotoxy ." Exiting..." c-unlock 1 ; \ my exit code 15 value taskcount \ number of tasks to start create taskblocks 15 cells allot \ cells to hold task blocks ptrs create taskhndls 15 cells allot \ cells to hold task handles for wait function : make-tasks ( n -- ) \ create the task blocks to taskcount taskcount 0 do i 1 + \ line number for my-task ['] my-task task-block \ create the task block taskblocks i cells+ ! \ save in the taskblocks area loop ; : run-tasks ( -- ) \ run all the tasks taskcount 0 do \ for each task taskblocks i cells+ @ \ get the task-block dup run-task drop \ run the tasks task>handle @ taskhndls i cells+ ! \ save all the task handles created loop ; winerrmsg on 0 value taskwaits : wait-eachtask ( -- ) \ wait for each task taskcount to taskwaits begin taskwaits while INFINITE false taskhndls \ wait for 1 or more tasks to end taskwaits call WaitForMultipleObjects \ wait on handles list dup WAIT_FAILED = if getlastwinerr then \ note the error WAIT_OBJECT_0 + dup>r taskblocks +cells @ task>id @ \ get the task id console-lock lock ." Task " . ." completed" cr console-lock unlock -1 +to taskwaits \ 1 fewer task, clean up the list taskhndls taskwaits cells+ @ \ get last handle in list taskhndls r@ cells+ ! \ store in signaled event ptr taskblocks taskwaits cells+ @ \ get last block in list taskblocks r> cells+ ! \ store in signaled block repeat ." All tasks completed" cr ; : start-tasks ( n -- ) make-tasks run-tasks console-lock lock 0 25 gotoxy ." Main task is waiting for " taskcount . ." tasks" cr console-lock unlock wait-eachtask ." All tasks ended" cr ; : demo1 cls ." Demo1: Creating free running tasks " taskcount start-tasks ; cr .( Type Demo1 to start Demo1) cr \ demo2 creates 2 tasks that read the same file, but at varying speeds, showing \ that file i/o is thread safe 4 newuser fhndl : t2-openfile ( addr len -- ) r/o open-file abort" File open error!" fhndl ! ; : my-task2 { speed -- } console-lock lock tcb @ task>id @ ." Task" . ." is running with a delay of" speed . cr console-lock unlock s" src\task.f" Prepend<home>\ t2-openfile begin pad 256 fhndl @ read-line abort" IO Error!" tcb @ task-stop? not and while console-lock lock ." Task" tcb @ task>id @ . pad swap type cr console-lock unlock speed task-sleep repeat fhndl @ close-file ; 0 value task-slow 0 value task-fast 100 constant task-slow-speed 30 constant task-fast-speed : demo2 cls ." Multithread file I/O, press any key to stop" cr task-slow-speed ['] my-task2 task-block to task-slow task-fast-speed ['] my-task2 task-block to task-fast task-slow run-task drop task-fast run-task drop key drop task-slow stop-task task-fast stop-task ." Ended" ; .( Type Demo2 to start Demo2, any key to stop) cr --- NEW FILE: pardemo.f --- \ needs multithr.f \ 10-4-99 : ascii char state @ if postpone literal then ; immediate \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ \ Timing Routines \ \ \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ create TIME-BUF here 0 w, \ +0 year 0 w, \ +2 month 0 w, \ +4 day of week 0 w, \ +6 day of month 0 w, \ +8 hour 0 w, \ +10 minute 0 w, \ +12 second 0 w, \ +14 milliseconds here swap - constant TIME-LEN create date$ 32 allot create time$ 32 allot : get-local-time ( -- ) \ get the local computer date and time time-buf call GetLocalTime drop ; : time&date ( -- sec min hour day month year ) get-local-time time-buf 12 + w@ \ seconds time-buf 10 + w@ \ minutes time-buf 8 + w@ \ hours time-buf 6 + w@ \ day of month time-buf 2 + w@ \ month of year time-buf w@ ; \ year : .#" ( n1 n2 -- a1 n3 ) >r 0 <# r> 0 ?do # loop #> ; : >date" ( time_structure -- ) >r 31 date$ null \ z" ddddd',' MMMM dd yyyy" r> null LOCALE_USER_DEFAULT call GetDateFormat date$ swap 1- ; : .date ( -- ) get-local-time time-buf >date" type ; : >month,day,year" ( time_structure -- ) >r 31 date$ z" ddddd',' MMMM dd yyyy" r> null LOCALE_USER_DEFAULT call GetDateFormat date$ swap 1- ; : .month,day,year ( -- ) get-local-time time-buf >month,day,year" type ; : >time" ( time_structure -- ) >r 31 time$ null r> null LOCALE_USER_DEFAULT call GetTimeFormat time$ swap 1- ; : .time ( -- ) get-local-time time-buf >time" type ; : >am/pm" ( time_structure -- ) >r 31 time$ z" h':'mmtt" r> null LOCALE_USER_DEFAULT call GetTimeFormat time$ swap 1- ; : .am/pm ( -- ) get-local-time time-buf >am/pm" type ; : ms@ ( -- ms ) get-local-time time-buf dup 8 + w@ 60 * \ hours over 10 + w@ + 60 * \ minutes over 12 + w@ + 1000 * \ seconds swap 14 + w@ + ; \ milli-seconds 0 value start-time : time-reset ( -- ) ms@ to start-time ; ' time-reset alias timer-reset : .elapsed ( -- ) ." Elapsed time: " ms@ start-time - 1000 /mod 60 /mod 60 /mod 2 .#" type ." :" 2 .#" type ." :" 2 .#" type ." ." 3 .#" type ; : elapse ( -<commandline>- ) time-reset interpret cr .elapsed ; anew pardemo.f \ 10-4-99 create-thread-user: thread-area-cnt1 0e fvalue ft0 : value-ft0 ms@ 0e fto ft0 begin 1e ft0 f+ fto ft0 ms@ over 100 + > until drop ; value-ft0 \ 191700e fto ft0 ft0 fvalue ft1 ft0 f>d drop value t1 t1 value t2 0 value h_ev_wake_cnt1_integer 0 value h_ev_wake_cnt1_float 0 value h_ev_wake_cnt2_integer 0 value h_ev_wake_cnt2_float 0 value h_ev_wake_cnt3-7_float 0 value h_ev_init_cnt1_integer 0 value h_ev_init_cnt1_float 0 value h_ev_init_cnt2_integer 0 value h_ev_init_cnt2_float 0 value h_ev_init_cnt3-7_float : cnt1_integer thread-area-cnt1 init-thread-user begin h_ev_wake_cnt1_integer event-wait ft0 f>d drop to t1 h_ev_init_cnt1_integer event-set time-reset begin pause -1 t1 + to t1 t1 0< \ int until h_ev_wake_cnt1_integer event-reset again ; create-thread-user: thread-area-fcnt1 : cnt1_float thread-area-cnt1 init-thread-user begin h_ev_wake_cnt1_float event-wait ft0 fto ft1 h_ev_init_cnt1_float event-set time-reset begin pause -1e ft1 f+ fto ft1 ft1 f0< \ floats until h_ev_wake_cnt1_float event-reset again ; create-thread-user: thread-area-cnt2 : cnt2_integer thread-area-cnt2 init-thread-user begin h_ev_wake_cnt2_integer event-wait ft0 f>d drop to t2 h_ev_init_cnt2_integer event-set begin pause -1 t2 + to t2 t2 0< until h_ev_wake_cnt2_integer event-reset again ; create-thread-user: thread-area-fcnt2 ft0 fvalue ft2 create-thread-user: thread-area-fcnt3 ft0 fvalue ft3 create-thread-user: thread-area-fcnt4 ft0 fvalue ft4 create-thread-user: thread-area-fcnt5 ft0 fvalue ft5 create-thread-user: thread-area-fcnt6 ft0 fvalue ft6 create-thread-user: thread-area-fcnt7 ft0 fvalue ft7 : cnt2_float thread-area-fcnt2 init-thread-user begin h_ev_wake_cnt2_float event-wait ft0 fto ft2 h_ev_init_cnt2_float event-set begin pause -1e ft2 f+ fto ft2 ft2 f0< \ floats until h_ev_wake_cnt2_float event-reset again ; : cnt3_float thread-area-fcnt3 init-thread-user begin h_ev_wake_cnt3-7_float event-wait ft0 fto ft3 begin pause -1e ft3 f+ fto ft3 ft3 f0< \ floats until h_ev_wake_cnt3-7_float event-reset again ; : cnt4_float thread-area-fcnt4 init-thread-user begin h_ev_wake_cnt3-7_float event-wait ft0 fto ft4 begin pause -1e ft4 f+ fto ft4 ft4 f0< \ floats until h_ev_wake_cnt3-7_float event-reset again ; : cnt5_float thread-area-fcnt5 init-thread-user begin h_ev_wake_cnt3-7_float event-wait ft0 fto ft5 begin pause -1e ft5 f+ fto ft5 ft5 f0< \ floats until h_ev_wake_cnt3-7_float event-reset again ; : cnt6_float thread-area-fcnt6 init-thread-user begin h_ev_wake_cnt3-7_float event-wait ft0 fto ft6 begin pause -1e ft6 f+ fto ft6 ft6 f0< \ floats until h_ev_wake_cnt3-7_float event-reset again ; : cnt7_float thread-area-fcnt7 init-thread-user begin h_ev_wake_cnt3-7_float event-wait ft0 fto ft7 h_ev_init_cnt3-7_float event-set begin pause -1e ft7 f+ fto ft7 ft7 f0< \ floats until h_ev_wake_cnt3-7_float event-reset again ; \ cnt2_integer abort false value no-mon : mon-integer h_ev_init_cnt1_integer event-wait h_ev_init_cnt2_integer event-wait no-mon if begin t1 0< t2 0< and pause until else begin 9 9 at-xy space t1 . space t2 . pause t1 0< t2 0< and until then .elapsed ; : mon-float h_ev_init_cnt1_float event-wait h_ev_init_cnt2_float event-wait no-mon if begin ft1 f0< ft2 f0< and pause until else begin 9 9 at-xy space ft1 fdup f0< f. space ft2 fdup f0< f. and pause until then .elapsed ; : mon-7float h_ev_init_cnt1_float event-wait h_ev_init_cnt2_float event-wait h_ev_init_cnt3-7_float event-wait no-mon if begin ft1 f0< ft2 f0< ft3 f0< ft4 f0< ft5 f0< ft6 f0< ft7 f0< and and and and and and pause until else begin 0 9 at-xy space ft1 fdup f0< f. space ft2 fdup f0< f. space ft3 fdup f0< f. space ft4 fdup f0< f. space ft5 fdup f0< f. space ft6 fdup f0< f. space ft7 fdup f0< f. and and and and and and pause until then .elapsed cr ; \ events need to be made in runtime for W9x : init-events ( - ) z" cnt_ready" make-event-set drop z" wake_all" make-event-set to h_ev_wake_all z" wake_cnt1_integer" make-event-reset to h_ev_wake_cnt1_integer z" wake_cnt2_integer" make-event-reset to h_ev_wake_cnt2_integer z" wake_cnt1_float" make-event-reset to h_ev_wake_cnt1_float z" wake_cnt2_float" make-event-reset to h_ev_wake_cnt2_float z" wake_cnt3-7_float" make-event-reset to h_ev_wake_cnt3-7_float z" init_cnt1_integer" make-event-reset to h_ev_init_cnt1_integer z" init_cnt2_integer" make-event-reset to h_ev_init_cnt2_integer z" init_cnt1_float" make-event-reset to h_ev_init_cnt1_float z" init_cnt2_float" make-event-reset to h_ev_init_cnt2_float z" init_cnt3-7_float" make-event-reset to h_ev_init_cnt3-7_float ; : resume ( - ) no-mon if cr ." Moment..." else cr ." Press any key...." key drop cls 9 8 at-xy then ; true value init : pardemo init if false to init init-events \ initialize all events one time thread-area-cnt1 ['] cnt1_integer start \ start all threads they are thread-area-cnt2 ['] cnt2_integer start \ event driven. thread-area-fcnt1 ['] cnt1_float start thread-area-fcnt2 ['] cnt2_float start thread-area-fcnt3 ['] cnt3_float start thread-area-fcnt4 ['] cnt4_float start thread-area-fcnt5 ['] cnt5_float start thread-area-fcnt6 ['] cnt6_float start thread-area-fcnt7 ['] cnt7_float start then begin ." Monitor on [Y/N]?" key upc ascii Y <> if true to no-mon else false to no-mon then cls 9 7 at-xy ." Number to count for each counter is: " ft0 f. 9 8 at-xy ." Running 1 counter using an integer. Moment... " -1 to t2 h_ev_init_cnt1_integer event-reset \ for synchronizing mon-integer h_ev_init_cnt2_integer event-set h_ev_wake_cnt1_integer event-set \ (re)starts cnt1_integer mon-integer resume ." Running 2 counters using integers " h_ev_init_cnt1_integer event-reset h_ev_init_cnt2_integer event-reset h_ev_wake_cnt1_integer event-set h_ev_wake_cnt2_integer event-set mon-integer resume ." Running 2 counters using floats " h_ev_init_cnt1_float event-reset h_ev_init_cnt2_float event-reset h_ev_wake_cnt1_float event-set h_ev_wake_cnt2_float event-set mon-float resume ." Running 7 counters using floats " h_ev_init_cnt1_float event-reset h_ev_init_cnt2_float event-reset h_ev_init_cnt3-7_float event-reset h_ev_wake_cnt1_float event-set h_ev_wake_cnt2_float event-set h_ev_wake_cnt3-7_float event-set mon-7float cr cr ." Note the elapsed time. Again [Y/N]?" key upc ascii Y <> until cr ." pardemo restarts" ; pardemo \s PII/400 results: Results: old version: Number to count for each counter is: 1917.00 Running 1 counter using an integer. Moment... Elapsed time: 00:00:09.560 Moment...Running 2 counters using integers Elapsed time: 00:00:09.550 Moment...Running 2 counters using floats Elapsed time: 00:00:09.560 Moment...Running 7 counters using floats Elapsed time: 00:00:09.500 Results: new version: Number to count for each counter is: 191700. Running 1 counter using an integer. Moment... Elapsed time: 00:00:04.500 Moment...Running 2 counters using integers Elapsed time: 00:00:06.980 Moment...Running 2 counters using floats Elapsed time: 00:00:08.680 Moment...Running 7 counters using floats Elapsed time: 00:00:23.670 Note: The version of 7 counters can be improoved. |
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X