home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / visionix / vmultiu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-12-28  |  16.4 KB  |  760 lines
  1. {
  2.  ════════════════════════════════════════════════════════════════════════════
  3.  
  4.  Visionix Process/Procedure/Thread "Multitasking" Unit (VMULTI)
  5.    Version 0.6
  6.  Copyright 1991,92,93 Visionix
  7.  ALL RIGHTS RESERVED
  8.  
  9.  
  10.  ────────────────────────────────────────────────────────────────────────────
  11.  
  12.  Revision history in reverse chronological order:
  13.  
  14.  Initials  Date      Comment
  15.  ────────  ────────  ────────────────────────────────────────────────────────
  16.  
  17.  lpg       03/16/93  Added Source Documentation
  18.  
  19.  mep       02/11/93  Cleaned up code for beta release
  20.  
  21.  jrt       02/08/93  Sync with beta 0.12 release
  22.  
  23.  jrt       12/07/92  Sync with beta 0.11 release
  24.  
  25.  jrt       11/21/92  Sync with beta 0.08
  26.  
  27.  jrt       09/01/92  First logged revision.
  28.  
  29.  ════════════════════════════════════════════════════════════════════════════
  30. }
  31.  
  32. (*-
  33.  
  34. [TEXT]
  35.  
  36. <Overview>
  37.  
  38. VMultiu implements a simple, procedure based, non-preemptive multitasking
  39. facility.
  40.  
  41. THIS UNIT IS INCOMPLETE!
  42.  
  43. In the next release, it will also implement a cross-platform
  44. multi-thread facility, and the ability to work with DesqView, OS/2
  45. and Windows to evenly distribute time slices.
  46.  
  47. <Interface>
  48. -*)
  49.  
  50. Unit VMultiu;
  51.  
  52. Interface
  53.  
  54. Uses
  55.  
  56.   VTypesu,
  57.   DOS;
  58.  
  59. {────────────────────────────────────────────────────────────────────────────}
  60.  
  61. Const
  62.  
  63.   VMS_New       = 1;
  64.   VMS_Do        = 2;
  65.   VMS_Dispose   = 3;
  66.  
  67. Type
  68.  
  69.   TMultiProc = Procedure( Status : BYTE; IData : Pointer );
  70.  
  71.   PMultiProcList = ^TMultiProcList;
  72.  
  73.   TMultiProcList = Record
  74.  
  75.     Proc     : TMultiProc; { pointer to procedure                 }
  76.     Interval : LONGINT;    { interval between required processing }
  77.     SPL      : BYTE;       { service processing level:            }
  78.                            {   7=highest priority, 0 = lowest     }
  79.     Name     : ST80;       { process name                         }
  80.     ID       : Pointer;    { process Instance Data                }
  81.     LastCall : LONGINT;    { last call time                       }
  82.     InProc   : BOOLEAN;    { already in procedure?                }
  83.  
  84.     Next     : PMultiProcList;
  85.  
  86.   END;
  87.  
  88.   TMachine = Record
  89.  
  90.     MultiProcListHead : PMultiProcList;
  91.     MultiProcListCurr : PMultiProcList;
  92.     MultiProcListTail : PMultiProcList;
  93.  
  94.   END;
  95.  
  96. {────────────────────────────────────────────────────────────────────────────}
  97.  
  98. Procedure VMultiProcNew(          Prc            : TMultiProc;
  99.                                   Interval       : LONGINT;
  100.                                   SPL            : BYTE;
  101.                                   Name           : TProcName;
  102.                                   ID             : POINTER;
  103.                               Var Error          : WORD           );
  104.  
  105. Procedure VMultiProcDispose(      Name           : TProcName      );
  106.  
  107. Procedure VMultiProcSetSPL(       Name           : TProcName      );
  108.  
  109. Procedure VMultiThreadNew(        Prc            : Pointer;
  110.                                   CallInterval   : LONGINT;
  111.                                   StayInterval   : LONGINT;
  112.                                   SPL            : BYTE;
  113.                                   Name           : TProcName;
  114.                                   StackSize      : WORD;
  115.                                   StackPtr       : Pointer        );
  116.  
  117. Procedure VMultiThreadDispose(    Name           : TProcName      );
  118.  
  119. Procedure VMultiThreadSetSPL(     Name           : TProcName      );
  120.  
  121. Procedure VMultiDo(               SPL            : BYTE           );
  122.  
  123. Procedure VMultiSleep(            Duration       : WORD           );
  124.  
  125. Procedure VMultiCriticalBEGIN;
  126.  
  127. Procedure VMultiCriticalEND;
  128.  
  129. Procedure VMultiSetDVSPL(         SPL            : BYTE           );
  130.  
  131. Procedure VMultiSetWinSPL(        SPL            : BYTE           );
  132.  
  133. {────────────────────────────────────────────────────────────────────────────}
  134.  
  135. Implementation
  136.  
  137. Var
  138.  
  139.   M        : TMachine;
  140.  
  141. {────────────────────────────────────────────────────────────────────────────}
  142.  
  143. Function GetLongintTime                                        : Longint;
  144.  
  145. Var
  146.  
  147.  H,M,S,S100 : WORD;
  148.  
  149. BEGIN
  150.  
  151.   GetTime( H,M,S,S100 );
  152.  
  153.   GetLongintTime := ( Longint( H ) * 60 * 60 * 100 ) +
  154.                     ( Longint( M ) * 60 * 100      ) +
  155.                     ( Longint( S ) * 100           ) + S100;
  156.  
  157. END;  { GetLongintTime }
  158.  
  159. {────────────────────────────────────────────────────────────────────────────}
  160.  
  161. (*-
  162.  
  163. [FUNCTION]
  164.  
  165. Procedure VMultiProcNew(          Prc            : TMultiProc;
  166.                                   Interval       : LONGINT;
  167.                                   SPL            : BYTE;
  168.                                   Name           : TProcName;
  169.                               Var Error          : WORD      );
  170.  
  171. [PARAMETERS]
  172.  
  173. Prc         Pointer to Called Procedure
  174. Interval    Time between updates in MilliSeconds
  175. SPL         Service Processing Level  (7=Highest,0=Lowest)
  176. Name        Name of Process Action
  177. Handle      VAR Returned Multi-tasking Process ID Number
  178. Error       VAR Returned Error Code (0=Success)
  179.  
  180. [RETURNS]
  181.  
  182. Function : None
  183. (VAR     : [Handle] Multi-tasking Process ID Number)
  184. (VAR     : [Error] Error Code)
  185.  
  186. [DESCRIPTION]
  187.  
  188. This procedure adds a new "multi-proc" to an internally stored list
  189. of "multi-procedures".  Multi procedures are procedures that can be
  190. called non-premptively when other functions, procedures, units, etc
  191. call the VMultiDO function.
  192.  
  193.  Prc                 Pointer to Multi-Procedure.
  194.  
  195.  Interval            Minimum wait between calls, in 100ths of a
  196.                      second.
  197.  
  198.  SPL                 System Priority Level.  How "important"
  199.                      it is that this multi-proc gets called.
  200.                      0 is most important, 10 is least.
  201.  
  202.  Name                Name of the procedure.
  203.  
  204. After the new multi-proc has been added to the list, the multi-proc
  205. will get called when other functions and routines call the VMultiDo
  206. function.  VMultiDo will check to see if it has been longer than
  207. "interval" 100ths of a second since the multi proc has been called,
  208. and if that time has elapsed, it will call the procedure.  This creates
  209. a simple mechanism to have procedures called in a non-premptive manner.
  210. All VisionTools libraries make calls to VMultiDo in the appropriate
  211. places (IE: when waiting for a key, when doing long operationg, etc.)
  212.  
  213.   TMultiProc = Procedure( Status : BYTE; IData : Pointer );
  214.  
  215.  
  216. When VMulti calls the new multi procedure, it will pass it one of
  217. three values in the Status byte:
  218.  
  219.   VMS_New       = 1;      { tells the multiproc this is the first call }
  220.   VMS_Do        = 2;      { tells the multiproc it is a normal call    }
  221.   VMS_Dispose   = 3;      { tells the multiproc this is the last call  }
  222.  
  223.  
  224.  
  225.  
  226.  
  227. [SEE-ALSO]
  228.  
  229. [EXAMPLE]
  230.  
  231. -*)
  232.  
  233. Procedure VMultiProcNew(          Prc            : TMultiProc;
  234.                                   Interval       : LONGINT;
  235.                                   SPL            : BYTE;
  236.                                   Name           : TProcName;
  237.                                   ID             : POINTER;
  238.                               Var Error          : WORD      );
  239.  
  240. Var
  241.  
  242.   MPN : PMultiProcList;
  243.  
  244. BEGIN
  245.  
  246.   With M Do
  247.   BEGIN
  248.  
  249.     New( MPN );
  250.  
  251.     If MultiProcListHead = NIL Then
  252.     BEGIN
  253.  
  254.       MultiProcListHead := MPN;
  255.       MultiProcListCurr := MPN;
  256.       MultiProcListTail := MPN;
  257.  
  258.     END;  { If MultiProcListHead }
  259.  
  260.     MPN^.Proc           := Prc;
  261.     MPN^.Interval       := Interval;
  262.     MPN^.SPL            := SPL;
  263.     MPN^.Name           := Name;
  264.     MPN^.InProc         := FALSE;
  265.     MPN^.LastCall       := 0;
  266.     MPN^.ID             := ID;
  267.     MPN^.Next           := MultiProcListHead;
  268.  
  269.     MultiProcListTail^.Next := MPN;
  270.  
  271.     MultiProcListTail := MPN;
  272.  
  273.     {--------------------}
  274.     { Call the procedure }
  275.     {--------------------}
  276.  
  277.     MPN^.Proc( VMS_New, MPN^.ID );
  278.  
  279.   END;  { With M }
  280.  
  281. END;  { VMultiProcNew }
  282.  
  283. {────────────────────────────────────────────────────────────────────────────}
  284.  
  285. (*-
  286.  
  287. [FUNCTION]
  288.  
  289. Procedure VMultiProcDispose(      Name           : TProcName    );
  290.  
  291. [PARAMETERS]
  292.  
  293. Name        Name of Process to Remove from List
  294.  
  295. [RETURNS]
  296.  
  297. (None)
  298.  
  299. [DESCRIPTION]
  300.  
  301. Removes processes from the Multi-Tasking Processing list.
  302. Disposes of a previously allocated multi-proc.
  303.  
  304.  Name                Name of the procedure to dispose of.
  305.  
  306. [SEE-ALSO]
  307.  
  308. [EXAMPLE]
  309.  
  310. -*)
  311.  
  312. Procedure VMultiProcDispose(      Name           : TProcName    );
  313.  
  314. BEGIN
  315.  
  316. END;  { VMultiProcDispose }
  317.  
  318. {────────────────────────────────────────────────────────────────────────────}
  319.  
  320. (*-
  321.  
  322. [FUNCTION]
  323.  
  324. Procedure VMultiProcSetSPL(       Name           : TProcName    );
  325.  
  326. [PARAMETERS]
  327.  
  328. Name        Name of Process to set the SPL Level on
  329.  
  330. [RETURNS]
  331.  
  332. (None)
  333.  
  334. [DESCRIPTION]
  335.  
  336. [SEE-ALSO]
  337.  
  338. [EXAMPLE]
  339.  
  340. -*)
  341.  
  342. Procedure VMultiProcSetSPL(       Name           : TProcName    );
  343.  
  344. BEGIN
  345.  
  346. END;  { VMultiProcSetSPL }
  347.  
  348. {────────────────────────────────────────────────────────────────────────────}
  349.  
  350. (*-
  351.  
  352. [FUNCTION]
  353.  
  354. Procedure VMultiThreadNew(        Prc            : Pointer;
  355.                                   CallInterval   : LONGINT;
  356.                                   StayInterval   : LONGINT;
  357.                                   SPL            : BYTE;
  358.                                   Name           : TProcName;
  359.                                   StackSize      : WORD;
  360.                                   StackPtr       : Pointer      );
  361.  
  362. [PARAMETERS]
  363.  
  364. Prc          Pointer to New Thread Procedure
  365. CallInterval Time Between updates in Milliseconds
  366. StayInterval Amount of Processing Time to Spend at this Thread
  367. SPL          Service Processing Level (7=Highest,0=Lowest)
  368. Name         Name of Thread Processing Action
  369. StackSize    Amount of Stack to Allocate to this Thread
  370. StackPtr     Pointer to Allocated Stack
  371.  
  372. [RETURNS]
  373.  
  374. (None)
  375.  
  376. [DESCRIPTION]
  377.  
  378. [SEE-ALSO]
  379.  
  380. [EXAMPLE]
  381.  
  382. -*)
  383.  
  384. Procedure VMultiThreadNew(        Prc            : Pointer;
  385.                                   CallInterval   : LONGINT;
  386.                                   StayInterval   : LONGINT;
  387.                                   SPL            : BYTE;
  388.                                   Name           : TProcName;
  389.                                   StackSize      : WORD;
  390.                                   StackPtr       : Pointer      );
  391.  
  392. BEGIN
  393.  
  394. END;  { VMultiThreadNew }
  395.  
  396. {────────────────────────────────────────────────────────────────────────────}
  397.  
  398. (*-
  399.  
  400. [FUNCTION]
  401.  
  402. Procedure VMultiThreadDispose(    Name           : TProcName    );
  403.  
  404. [PARAMETERS]
  405.  
  406. Name        Name of Thread Procedure to Dispose of
  407.  
  408. [RETURNS]
  409.  
  410. (None)
  411.  
  412. [DESCRIPTION]
  413.  
  414. [SEE-ALSO]
  415.  
  416. [EXAMPLE]
  417.  
  418. -*)
  419.  
  420. Procedure VMultiThreadDispose(    Name           : TProcName    );
  421.  
  422. BEGIN
  423.  
  424. END; { VMultiThreadDispose }
  425.  
  426. {────────────────────────────────────────────────────────────────────────────}
  427.  
  428. (*-
  429.  
  430. [FUNCTION]
  431.  
  432. Procedure VMultiThreadSetSPL(     Name           : TProcName    );
  433.  
  434. [PARAMETERS]
  435.  
  436. Name        Name of Thread Process to Set the SPL Level on
  437.  
  438. [RETURNS]
  439.  
  440. (None)
  441.  
  442. [DESCRIPTION]
  443.  
  444. [SEE-ALSO]
  445.  
  446. [EXAMPLE]
  447.  
  448. -*)
  449.  
  450. Procedure VMultiThreadSetSPL(     Name           : TProcName    );
  451.  
  452. BEGIN
  453.  
  454. END;  { VMultiThreadSetSPL }
  455.  
  456. {────────────────────────────────────────────────────────────────────────────}
  457.  
  458. (*-
  459.  
  460. [FUNCTION]
  461.  
  462. Procedure VMultiDo(               SPL            : BYTE         );
  463.  
  464. [PARAMETERS]
  465.  
  466. SPL         Service Processing Level (7=Highest,0=Lowest)
  467.  
  468. [RETURNS]
  469.  
  470. (None)
  471.  
  472. [DESCRIPTION]
  473.  
  474. This is the key function called to update all multitasking functions
  475. that are equal to or greater than the submitted processing level.
  476. Allows multi-procs of a priority <= SPL to run.
  477.  
  478. Calling this function with an SPL of Zero (0) allows ALL Processes
  479. to be executed.  This is considered the Standard action.
  480.  
  481. [SEE-ALSO]
  482.  
  483. [EXAMPLE]
  484.  
  485. -*)
  486.  
  487. Procedure VMultiDo(               SPL            : BYTE         );
  488.  
  489. Var
  490.  
  491.   MPN            : PMultiProcList;
  492.   TimeNow        : LONGINT;
  493.   DidOne         : BOOLEAN;
  494.  
  495. BEGIN
  496.  
  497.   MPN := M.MultiProcListCurr;
  498.  
  499.   If MPN <> NIL Then
  500.   BEGIN
  501.  
  502.     TimeNow := GetLongintTime;
  503.  
  504.     DidOne  := FALSE;
  505.  
  506.     REPEAT
  507.  
  508.       If ( Not MPN^.InProc                         ) And
  509.          ( MPN^.SPL >= SPL                         ) And
  510.          ( TimeNow - MPN^.LastCall > MPN^.Interval ) Then
  511.       BEGIN
  512.  
  513.         MPN^.InProc := TRUE;
  514.         MPN^.Proc( VMS_Do, MPN^.ID );
  515.         MPN^.InProc := FALSE;
  516.         MPN^.LastCall := TimeNow;
  517.         DidOne := TRUE;
  518.  
  519.       END; { If NOT MPN^InProc }
  520.  
  521.       MPN := MPN^.Next;
  522.  
  523.     UNTIL (DidOne) or ( MPN = M.MultiProcListCurr );
  524.  
  525.     M.MultiProcListCurr := M.MultiProcListCurr^.Next;
  526.  
  527.   END;  { If MPN }
  528.  
  529. END;  { VMultiDo }
  530.  
  531. {────────────────────────────────────────────────────────────────────────────}
  532.  
  533. (*-
  534.  
  535. [FUNCTION]
  536.  
  537. Procedure VMultiSleep(            Duration       : WORD         );
  538.  
  539. [PARAMETERS]
  540.  
  541. Duration    Amount of Time to Sleep (in Milliseconds)
  542.  
  543. [RETURNS]
  544.  
  545. (None)
  546.  
  547. [DESCRIPTION]
  548.  
  549. Functional equivalent of TP Delay, however this one allows for all MT
  550. actions to continue during the pause.
  551.  
  552. Sleeps for "duration" milliseconds, allowing multi-procs to run.
  553.  
  554. [SEE-ALSO]
  555.  
  556. [EXAMPLE]
  557.  
  558. -*)
  559.  
  560. Procedure VMultiSleep(            Duration       : WORD         );
  561.  
  562. Var
  563.  
  564.    TheTime     : LONGINT;
  565.    StartTime   : LONGINT;
  566.  
  567. BEGIN
  568.  
  569.   StartTime := GetLongintTime;
  570.  
  571.   Repeat
  572.  
  573.     VMultiDo( 0 );
  574.  
  575.     TheTime := GetLongintTime;
  576.  
  577.   Until TheTime > StartTime + Duration;
  578.  
  579. END;  { VMultiSleep }
  580.  
  581. {────────────────────────────────────────────────────────────────────────────}
  582.  
  583. (*-
  584.  
  585. [FUNCTION]
  586.  
  587. Procedure VMultiCriticalBEGIN;
  588.  
  589. [PARAMETERS]
  590.  
  591. (None)
  592.  
  593. [RETURNS]
  594.  
  595. (None)
  596.  
  597. [DESCRIPTION]
  598.  
  599. Begin a critical section.  No multi-procs will run, interrupts will
  600. be disabled, windows ENTER CRITICAL SECTION will be will be called.
  601.  
  602. [SEE-ALSO]
  603.  
  604. [EXAMPLE]
  605.  
  606. -*)
  607.  
  608. Procedure VMultiCriticalBEGIN;
  609.  
  610. BEGIN
  611.  
  612. END;  { VMultiCriticalBEGIN }
  613.  
  614. {────────────────────────────────────────────────────────────────────────────}
  615.  
  616. (*-
  617.  
  618. [FUNCTION]
  619.  
  620. Procedure VMultiCriticalEND;
  621.  
  622. [PARAMETERS]
  623.  
  624. (None)
  625.  
  626. [RETURNS]
  627.  
  628. (None)
  629.  
  630. [DESCRIPTION]
  631.  
  632. Ends a critical section.  Multi-proc can run, interrupts will be
  633. enabled, windows EXIT CRITICAL SECTION will be called.
  634.  
  635. [SEE-ALSO]
  636.  
  637. [EXAMPLE]
  638.  
  639. -*)
  640.  
  641. Procedure VMultiCriticalEND;
  642.  
  643. BEGIN
  644.  
  645. END;  { VMultiCriticalEND }
  646.  
  647. {────────────────────────────────────────────────────────────────────────────}
  648.  
  649. (*-
  650.  
  651. [FUNCTION]
  652.  
  653. Procedure VMultiSetDVSPL(         SPL            : BYTE         );
  654.  
  655. [PARAMETERS]
  656.  
  657. SPL         Service Processing Level (7=Highest,0=Lowest)
  658.  
  659. [RETURNS]
  660.  
  661. (None)
  662.  
  663. [DESCRIPTION]
  664.  
  665. Sets the System Priority Level for DesqView task switching.
  666. When VMultiDo is called with a priority >= this SPL,
  667. DesqView will be informed that another DV task should run.
  668.  
  669. [SEE-ALSO]
  670.  
  671. [EXAMPLE]
  672.  
  673. -*)
  674.  
  675. Procedure VMultiSetDVSPL(         SPL            : BYTE         );
  676.  
  677. BEGIN
  678.  
  679. END;  { VMultiSetDVSPL }
  680.  
  681. {────────────────────────────────────────────────────────────────────────────}
  682.  
  683. (*-
  684.  
  685. [FUNCTION]
  686.  
  687. Procedure VMultiSetWinSPL(        SPL            : BYTE         );
  688.  
  689. [PARAMETERS]
  690.  
  691. SPL         Service Processing Level (7=Highest,0=Lowest)
  692.  
  693. [RETURNS]
  694.  
  695. (None)
  696.  
  697. [DESCRIPTION]
  698.  
  699. Sets the System Priority Level for Windows task switching.
  700. When VMultiDo is called with a priority >= this SPL,
  701. windows will be informed that another windows task should run.
  702.  
  703. [SEE-ALSO]
  704.  
  705. [EXAMPLE]
  706.  
  707. -*)
  708.  
  709. Procedure VMultiSetWinSPL(        SPL            : BYTE         );
  710.  
  711. BEGIN
  712.  
  713. END;  { VMultiSetWinSPL }
  714.  
  715. {────────────────────────────────────────────────────────────────────────────}
  716.  
  717. (*-
  718.  
  719. [FUNCTION]
  720.  
  721. Procedure VMultiSetOS2SPL(        SPL            : BYTE         );
  722.  
  723. [PARAMETERS]
  724.  
  725. SPL         Service Processing Level (7=Highest,0=Lowest)
  726.  
  727. [RETURNS]
  728.  
  729. (None)
  730.  
  731. [DESCRIPTION]
  732.  
  733. Sets the System Priority Level for OS/2 task switching.
  734. When VMultiDo is called with a priority >= this SPL,
  735. Os/2 will be informed that another task should run.
  736.  
  737. [SEE-ALSO]
  738.  
  739. [EXAMPLE]
  740.  
  741. -*)
  742.  
  743. Procedure VMultiSetOS2SPL(        SPL            : BYTE         );
  744.  
  745. BEGIN
  746.  
  747. END;  { VMultiSetOS2SPL }
  748.  
  749. {────────────────────────────────────────────────────────────────────────────}
  750. {────────────────────────────────────────────────────────────────────────────}
  751. {────────────────────────────────────────────────────────────────────────────}
  752.  
  753. BEGIN
  754.  
  755.   M.MultiProcListHead := NIL;
  756.   M.MultiProcListTail := NIL;
  757.   M.MultiProcListCurr := NIL;
  758.  
  759. END.
  760.