home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D11 / CHESSDLL.ZIP / TASKMGR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  2.6 KB  |  128 lines
  1. unit TaskMgr;
  2.  
  3. {$G+,W-}
  4.  
  5. interface
  6.  
  7. type
  8.   TTaskInfo = record                 { Stores the state of the stack   }
  9.     SPtr, SSeg, Size: Word;
  10.   end;
  11.  
  12.   TSpawnProc = procedure;
  13.  
  14.  
  15. { for the Application task: }
  16. procedure AllocateTask(Size: Word);
  17. procedure DisposeTask;
  18. procedure Spawn( Proc: TSpawnProc );
  19.  
  20. { Task messaging }
  21. function Message(Msg: Word): Word;
  22.  
  23. implementation
  24.  
  25. {$IFDEF WINDOWS}
  26. uses GameRec, OMemory;
  27. {$ELSE}
  28. uses GameRec, Memory;
  29. {$ENDIF}
  30.  
  31. procedure AllocateTask(Size: Word);
  32. var
  33.   P : Pointer;
  34. begin
  35.   P := MemAllocSeg(Size);
  36.   if P = nil then Exit;
  37.   with CC do
  38.   begin
  39.     GameStack.SSeg := Seg(P^);
  40.     GameStack.Size := Size;
  41.     GameStack.SPtr := Size - 2;
  42.     AppStack.SSeg  := SSeg;
  43.   end;
  44. end;
  45.  
  46.  
  47. procedure DisposeTask;
  48. begin
  49.   with CC.GameStack do
  50.     if SSeg <> 0 then FreeMem(Ptr(SSeg, 0), Size);
  51.   FillChar(CC.GameStack, 0, SizeOf(CC.GameStack));
  52. end;
  53.  
  54.  { TerminateStack kills the game stack and RETurns to the ret addr }
  55.  { already on App stack, presumeably, the last caller of Resume.   }
  56.  { The Game stack only shares a common starting point with the App }
  57.  { stack - after that, it runs to completion without trying to     }
  58.  { splice its execution back into the App stack.                   }
  59.  
  60. procedure TerminateTask(Dummy: Word); far; assembler;
  61. asm
  62.         { Switch to the App's stack }
  63.     MOV    SS, CC.AppStack.SSeg
  64.     MOV    SP, CC.AppStack.SPtr
  65.         MOV    BP, SP
  66. end;
  67.  
  68. function Message(Msg: Word): Word; assembler;
  69. asm
  70.     MOV    AX, Msg
  71.     MOV    BX, SS
  72.     CMP    BX, CC.AppStack.SSeg
  73.     JNE    @@1
  74.  
  75.         { Switch to game stack }
  76.     MOV    CC.AppStack.SPtr, SP
  77.  
  78.     MOV    SS, CC.GameStack.SSeg   { Now on the new stack }
  79.     MOV    SP, CC.GameStack.SPtr
  80.     JMP    @@2
  81.  
  82.         { Back to the App stack }
  83. @@1:    MOV    CC.GameStack.SPtr, SP
  84.  
  85.     MOV    SS, CC.AppStack.SSeg     { Now on the new stack }
  86.     MOV    SP, CC.AppStack.SPtr
  87. @@2:
  88.     MOV    BP, SP
  89. end;
  90.  
  91.  
  92.  
  93. procedure Spawn( Proc: TSpawnProc); assembler;
  94. asm
  95.     MOV    AX, SS
  96.  
  97.     { only an App can Spawn a game }
  98.     CMP    AX, CC.AppStack.SSeg
  99.     JNE    @@1
  100.  
  101.         { Setup task stack }
  102.         LES    DI,DWORD PTR CC.GameStack.TTaskInfo.SPtr
  103.         STD
  104.  
  105.         {  Returning out will terminate task }
  106.         MOV    AX, SEG TerminateTask
  107.         STOSW
  108.         MOV    AX, OFFSET TerminateTask
  109.         STOSW
  110.  
  111.         { Setup ret to "call" proc }
  112.         MOV    AX, Proc.Word[2]
  113.         STOSW
  114.         MOV    AX, Proc.Word[0]
  115.         STOSW
  116.         MOV    AX, DI            { Fake BP }
  117.         STOSW
  118.         CLD
  119.         MOV    CC.GameStack.TTaskInfo.SPtr,AX
  120.  
  121.         PUSH    0
  122.         CALL    Message
  123. @@1:
  124. end;
  125.  
  126. end.
  127.  
  128.