home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FORTHCMP.ZIP / HANOIMT.4TH < prev    next >
Encoding:
Text File  |  1992-03-30  |  7.9 KB  |  303 lines
  1. \ This program is Copyright (C) 1987 by Thomas Almy.  All rights reserved.
  2.  
  3. \ This is an example program showing the operation of the multitasker.
  4. \ It solves the Tower of Hanoi Puzzle using multiple tasks rather than
  5. \ recursion or iteration!
  6.  
  7. \ The following options are appropriate on the ForthCMP command line:
  8. \  1 CONSTANT EGA        43 line EGA display
  9. \  I80186            80186 or later processor type
  10. \  1 CONSTANT VID-DELAY        IBM CGA (flicker problem)
  11.  
  12. 200 SEPSSEG
  13. 10000 100 MSDOSEXE
  14. NOMAP
  15.  
  16. INCLUDE MULTI    \ Universal screen driver
  17. \ INCLUDE MULTID \ IBM COMPATIBLE ( direct to display ) screen driver
  18. DECIMAL
  19.  
  20. FIND FOREGROUND #IF DROP #ELSE
  21. 1 0 IN/OUT
  22. : FOREGROUND DROP ( If not already defined, make into a noop ) ;
  23. #THEN
  24. FIND BACKGROUND #IF DROP #ELSE
  25. 1 0 IN/OUT
  26. : BACKGROUND DROP ( If not already defined, make into a noop ) ;
  27. #THEN
  28.  
  29. FIND l/s #IF DROP #ELSE 25 CONSTANT l/s #THEN    \ lines per screen
  30.  
  31. l/s 25 > CONSTANT BIGSCREEN? \ pack it in??
  32.  
  33. 1 1 IN/OUT
  34.  
  35. : 2** ( N -- 2**N )
  36.     1 SWAP 0 ?DO 2* LOOP ;
  37.  
  38. \ Offsets into HANOI messages
  39. ( offset zero is reserved for message pointer )
  40. 2 CONSTANT >INDX    \ Index into solution
  41. 4 CONSTANT >RING    \ ring number
  42. 6 CONSTANT >FROM    \ source ring
  43. 8 CONSTANT >TO        \ destination ring
  44. 10 CONSTANT >USE    \ temp ring
  45.  
  46. VARIABLE DCOUNT        \ extra taskswaps
  47.  
  48. 1 0 IN/OUT
  49. : SCRPOSITION ( index -- )
  50. \ put cursor to appropriate index position 
  51. BIGSCREEN? #IF
  52. \ there are 42 windows going down the screen and 13 windows across
  53.     0 l/s 1- UM/MOD 6 * SWAP GOTOXY ; ( position cursor )
  54. #ELSE
  55. \ there are 24 windows going down the screen, and seven windows across
  56.       0 l/s 1- UM/MOD 10 * SWAP GOTOXY ; ( position cursor )
  57. #THEN
  58.  
  59. VARIABLE DCOUNTER
  60.  
  61. 0 0 IN/OUT
  62. : MESSAGE-PRINT ( a task )
  63.     7 BACKGROUND
  64.     BEGIN
  65.     GET-MESSAGE >R        \ get message and save it
  66.     R@ >INDX @L SCRPOSITION    \ position cursor
  67.     R@ >RING @L 
  68.     DUP CASE 7 OF 15 ENDOF 8 OF 13 ENDOF 9 OF 12 ENDOF
  69.         DUP ENDCASE FOREGROUND
  70. BIGSCREEN? #IF
  71.     ASCII 0 + EMIT ASCII # EMIT
  72. #ELSE
  73.     ASCII # EMIT ASCII 0 + EMIT
  74.     SPACE
  75. #THEN
  76.     R@ >FROM @L EMIT
  77. BIGSCREEN? #IF
  78.     ASCII > EMIT
  79. #ELSE
  80.     ." ->"
  81. #THEN
  82.     R@ >TO @L EMIT
  83.     R> FREE            \ done with message
  84.     DCOUNT @ ?DUP IF \ wait a while??
  85.         DCOUNTER @ 1+ 7 AND DCOUNTER ! \ "randomize" the wait
  86.         DCOUNTER @ 8 + 12 */ 1+ WAIT 
  87.     THEN 
  88.     AGAIN 
  89.     ;
  90.  
  91.  
  92. \ Allocate 12 tasks to run the above word
  93.  
  94. ' MESSAGE-PRINT TASK  PRNT1
  95. ' MESSAGE-PRINT TASK  PRNT2
  96. ' MESSAGE-PRINT TASK  PRNT3
  97. ' MESSAGE-PRINT TASK  PRNT4
  98. ' MESSAGE-PRINT TASK  PRNT5
  99. ' MESSAGE-PRINT TASK  PRNT6
  100. ' MESSAGE-PRINT TASK  PRNT7
  101. ' MESSAGE-PRINT TASK  PRNT8
  102. ' MESSAGE-PRINT TASK  PRNT9
  103. ' MESSAGE-PRINT TASK  PRNT10
  104. ' MESSAGE-PRINT TASK  PRNT11
  105. ' MESSAGE-PRINT TASK  PRNT12
  106.  
  107.  
  108. TABLE DSPTBL-P PRNT1 , PRNT2 , PRNT3 , PRNT4 , PRNT5 , PRNT6 , PRNT7 , PRNT8 ,
  109.                PRNT9 , PRNT10 , PRNT11 , PRNT12 ,
  110. VARIABLE PINDEX        \ current index into dispatch table
  111.  
  112. VARIABLE PCOUNT        \ number of printer tasks to actually use
  113.  
  114. 0 1 IN/OUT
  115. : NEXT-PRINTER-TASK    ( -- task )
  116. \ gets address of the next printer task.
  117. \ What we are trying to do is have all eight tasks printing at once!
  118. \ This makes for one impressive display!
  119.     PINDEX @ DUP 1+ PCOUNT @ UMOD PINDEX ! \ count modulo PCOUNT
  120.     DSPTBL-P ;
  121.  
  122.  
  123. : MAKE-MESSAGE    ( index ring# from to using -- newMessage )
  124.     2 GET DUP >R  \ make a new message, 16 bytes long
  125.        >USE !L    \ store into all the fields
  126.     R@ >TO !L
  127.     R@ >FROM !L
  128.     R@ >RING !L
  129.     R@ >INDX !L
  130.     R> \ return message segment
  131.     ;
  132.  
  133.  
  134. 0 1 IN/OUT NEED NEXT-HANOI-TASK
  135.  
  136. 1 0 IN/OUT
  137. : SEND-MESSAGES ( ourMessage -- )
  138.     DUP >R         \ stash message on stack
  139.             \ calculate first message send
  140.        >INDX @L R@ >RING @L 1- 2** 2/ -  \ new index
  141.     R@ >RING @L 1-    \ new ring number
  142.     R@ >FROM @L     \ new from
  143.     R@ >USE  @L    \ new to
  144.     R@ >TO     @L    \ new use
  145.     MAKE-MESSAGE    \ create new message from this
  146.     NEXT-HANOI-TASK SEND-MESSAGE
  147.             \ calculate second message send
  148.     R@ >INDX @L R@ >RING @L 1- 2** 2/ +    \ new index
  149.     R@ >RING @L 1-    \ new ring number
  150.     R@ >USE  @L     \ new from
  151.     R@ >TO   @L     \ new to
  152.     R> >FROM @L     \ new use
  153.     MAKE-MESSAGE
  154.     NEXT-HANOI-TASK SEND-MESSAGE
  155.     ;
  156.  
  157. 0 0 IN/OUT
  158. : HANOI-TASK ( a task )
  159.     BEGIN
  160.         GET-MESSAGE         \ get next execution message
  161.     DUP >RING @L  1 > IF    \ high ring, send message to move lower rings
  162.         DUP SEND-MESSAGES THEN
  163.     NEXT-PRINTER-TASK SEND-MESSAGE    \ send our message on to printer task
  164.     AGAIN
  165.     ;
  166.  
  167. \ Allocate 6 tasks to run the above word
  168.  
  169. ' HANOI-TASK TASK HAN1
  170. ' HANOI-TASK TASK HAN2
  171. ' HANOI-TASK TASK HAN3
  172. ' HANOI-TASK TASK HAN4
  173. ' HANOI-TASK TASK HAN5
  174. ' HANOI-TASK TASK HAN6
  175.  
  176. TABLE DSPTBL-H  HAN1 , HAN2 , HAN3 , HAN4 , HAN5 , HAN6 ,
  177.  
  178. VARIABLE HINDEX        \ current index into dispatch table
  179.  
  180. VARIABLE HCOUNT        \ number of hanoi tasks to actually use
  181.  
  182.  
  183. 0 1 IN/OUT
  184. : NEXT-HANOI-TASK    ( -- task )
  185. \ gets address of the next HANOI task.
  186.     HINDEX @ DUP 1+ HCOUNT @ UMOD HINDEX ! \ count modulo HCOUNT
  187.     DSPTBL-H ;
  188.  
  189.  
  190. 0 1 IN/OUT 
  191. : WAITING-TASKS ( -- N )
  192.     0 MAIN-TASK
  193.     BEGIN
  194.         DUP WAITING? IF SWAP 1+ SWAP THEN
  195.     DUP 2+ CS: @ + 4 + \ addr of next task
  196.     DUP MAIN-TASK = UNTIL
  197.     DROP
  198. ;
  199.  
  200.  
  201. 1 1 IN/OUT
  202. : SETUP ( #rings -- message )
  203.     DUP 1- 2** 1- SWAP    \ got index and ring number
  204.     ASCII A            \ ring names
  205.     ASCII B
  206.     ASCII C
  207.     MAKE-MESSAGE ;
  208.  
  209.  
  210. 0 0 IN/OUT
  211. : RUN-DOWN \ execute until only main and TASKCOUNT are active
  212.     ACTIVE-TASKS 2 = IF EXIT THEN    \ nothing to wait for
  213.     0 l/s 1- GOTOXY 70 SPACES
  214.     0 l/s 1- GOTOXY ." waiting..." 
  215.     0
  216.     BEGIN  
  217.     ACTIVE-TASKS 2 > WHILE
  218.     1+ DUP 10 l/s 1- GOTOXY 6 U.R 
  219.     REPEAT
  220.     DROP
  221.     ;
  222.  
  223.  
  224. : GET-COMMAND  ( -- hcount pcount dcount ringcount  OR 0 )
  225. BIGSCREEN? #IF
  226.     0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 9, default-QUIT):"
  227. #ELSE
  228.     0 l/s 1- GOTOXY ." NUMBER OF RINGS ( maximum is 7, default-QUIT):"
  229. #THEN
  230.     #IN 
  231.     DUP 0= IF 7 EMIT EXIT THEN
  232. BIGSCREEN? #IF
  233.     1 MAX 9 MIN 
  234. #ELSE
  235.     1 MAX 7 MIN 
  236. #THEN
  237.     >R
  238.     0 l/s 1- GOTOXY 65 SPACES
  239.     0 l/s 1- GOTOXY ." NUMBER OF HANOI TASKS (1-6, default 6):"
  240.     #IN DUP 0= IF DROP 6 THEN 1 MAX 6 MIN 
  241.     0 l/s 1- GOTOXY 65 SPACES
  242.     0 l/s 1- GOTOXY ." NUMBER OF PRINTER TASKS (1-12, default 12):"
  243.     #IN DUP 0= IF DROP 12 THEN 1 MAX 12 MIN 
  244.     0 l/s 1- GOTOXY 65 SPACES
  245.     0 l/s 1- GOTOXY ." PRINTER TASK AVERAGE 18ms WAITS (max 50, default 0):"
  246.     #IN  50 MIN 0 MAX
  247.     R>
  248.     ;
  249.     
  250. VARIABLE MAXTASKS
  251. 0 0 IN/OUT
  252. : TASK-COUNTER ( a task )
  253.     1 BACKGROUND 
  254.     BEGIN
  255.         65 l/s 1- GOTOXY 
  256.     11 FOREGROUND WAITING-TASKS 7 .R
  257.     12 FOREGROUND ACTIVE-TASKS  DUP 3 .R 
  258.     10 FOREGROUND MAXTASKS @ MAX DUP MAXTASKS !  3 .R
  259.     5 WAIT ( about .1 sec updates )
  260.     AGAIN
  261.     ;
  262.  
  263. ' TASK-COUNTER TASK TASKCOUNT
  264.  
  265.  
  266. : MAIN
  267.     INIT-TASKS
  268.     7 BACKGROUND
  269.     14 FOREGROUND
  270.     CLS
  271.     ." MULTITASKING TOWER OF HANOI" CR
  272.     ." Copyright (C) 1987 by Thomas Almy.  All rights reserved." CR
  273.     ." This unmodified program may be distributed freely." CR
  274.     ." This program demonstrates the multitasking feature of ForthCMP," CR
  275.     ." the Forth language compiler" CR CR
  276.     ." The main task asks questions at the bottom of the display." CR
  277.     ." The tower puzzle is solved via message passing among a selectable number" CR
  278.     ." of tasks.  The printing of the moves is done be a selectable number of tasks." CR
  279.     ." The printer tasks can also have a variable amount of delay after each move." CR
  280.     ." The lower left corner of the display contains status information produced by" CR
  281.     ." a separate task 10 times per second.  The three numbers are:" CR
  282.     8 SPACES ." tasks waiting for timer" CR
  283.     8 SPACES ." tasks that are running" CR
  284.     8 SPACES ." total tasks used in last iteration" CR CR
  285.     ." Hitting Ctrl-Break will cause the program to abort and task status to be" CR
  286.     ." displayed."
  287.     TASKCOUNT WAKE
  288.     BEGIN
  289.     GET-COMMAND
  290.     RUN-DOWN
  291.     ?DUP WHILE
  292.         MAXTASKS OFF
  293.     CLS 
  294.     >R DCOUNT ! PCOUNT ! HCOUNT ! 
  295.     R> SETUP NEXT-HANOI-TASK SEND-MESSAGE
  296.     REPEAT
  297.     BYE
  298.     ;
  299.  
  300. INCLUDE FARMEM2
  301. INCLUDE FORTHLIB
  302. END
  303.