home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Professional / OS2PRO194.ISO / os2 / prgramer / forth_32 / threads.4th < prev   
Encoding:
Text File  |  1993-03-19  |  1.8 KB  |  55 lines
  1. \ THREADS.4TH  -  Thread creation under Forth/2   03/18/93
  2. \ Copyright (c) 1993  BLUE STAR SYSTEMS
  3. \
  4. \ These are some preliminary words to run threads under Forth/2 using
  5. \ the OS/2 function CreateThread.  Any output they do shows up in the 
  6. \ Forth/2 screen, but the output is harmless.
  7. \
  8. \ You can THREAD just about any word which operates independently and
  9. \ does not require any stack parameters.
  10.  
  11. decimal
  12.  
  13. variable ThreadInfo   \ Information to be passed to thread, USER area
  14.        4 allot        \   and execution address of thread
  15.  
  16. variable ThreadID
  17. variable ThreadArg              \ Allot parameter space after this
  18. 8192 constant ThreadStackSize
  19. variable ThreadStack  ThreadStackSize allot
  20.  
  21. : usleep ( msec    -- )  SYS$SLEEP SYSCALL 2drop ;  \ Put thread to sleep
  22. : sleep  ( seconds -- )  1000 * usleep ;
  23.  
  24.  
  25. : StartThread ( tick_addr -- ) CFA @  ThreadInfo W+ !  'USER @ ThreadInfo !
  26.               ThreadInfo ThreadArg !
  27.               ThreadStackSize
  28.               0                \ Flags: 0=Start now, 1=Start suspended
  29.               ThreadArg
  30.             ' ThreadProc CFA @
  31.               ThreadID           SYS$CREATETHREAD SYSCALL
  32.               6 DROPS ;
  33.  
  34.  
  35. : KillThread  ( pid -- )  SYS$KillThread SYSCALL 2drop ;
  36.  
  37. \ THREAD   Usage:  THREAD <name>  starts <name> running as a separate thread
  38.  
  39. : THREAD   State @ IF  [COMPILE] '  COMPILE StartThread
  40.            ELSE  [COMPILE] '  StartThread  THEN ;  IMMEDIATE
  41.  
  42.  
  43. \ Examples
  44.  
  45. : Bunny            5 sleep ." It keeps going, and going..."
  46.            50 0 do 2 sleep cr   ." and going, and going..."
  47.                    loop ;
  48.  
  49. variable TimeLength
  50. : Timer ( -- )      TimeLength @ sleep  ." It's time! " ;
  51. : Alarm ( secs -- ) TimeLength !  THREAD Timer ;
  52.  
  53. \ Try  THREAD bunny    or  10 Alarm    Do a bunch of them!
  54.  
  55.