home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 8 / CDASC08.ISO / NEWS / 554 / JUIN / TSKSWTCH.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-07  |  2KB  |  65 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 331 of 374
  3. From : Sean Palmer                         1:104/123.0          25 May 93  00:00
  4. To   : All
  5. Subj : MultiTasking,Threads
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Lot of talk going on about multitasking lately.
  8.  
  9. Here's some source to do simple task switching:}
  10.  
  11. {create a new process thread}
  12. {needs the process's start address, a stack buffer, and the size of that
  13.  stack}
  14. {processes must be far procedures with no parameters}
  15.  
  16. function newProcess(process,stack:pointer;stackSize:word):pointer;begin
  17.  inc(word(stack),stackSize-12); {room for p1,p2,far return adr}
  18.  pointer(stack^):=process;   {fake far return adr}
  19.  dec(word(stack),2);
  20.  word(stack^):=word(stack);  {fake pushed bp}
  21.  newProcess:=stack;
  22.  end;
  23.  
  24. {transfer control from one process to another}
  25.  
  26. procedure transfer(var p1,p2:pointer);far;assembler;asm
  27.  mov ax,ds
  28.  lds si,p1       {store old process' stack}
  29.  mov [si],sp
  30.  mov [si+2],ss
  31.  lds si,p2       {get next process' stack}
  32.  mov ss,[si+2]
  33.  mov bp,[si]     {epilog will move this to sp}
  34.  mov ds,ax
  35.  end;
  36.  
  37. {test code}
  38.  
  39. var
  40.  p0,             {main program's saved stack pointer}
  41.  p1,p2:pointer;  {processes' saved stack pointers}
  42.  stack1,stack2:array[0..255]of byte; {processes' stacks}
  43.  
  44. procedure proc1;far;var i:integer;begin
  45.  for i:=0 to 7 do begin
  46.   writeln('First');
  47.   transfer(p1,p2);
  48.   end;
  49.  transfer(p1,p0);  {return}
  50.  end;
  51.  
  52. procedure proc2;far;label _LOOP;begin
  53. _LOOP:
  54.  writeln('Second');
  55.  transfer(p2,p1);
  56.  writeln('Third');
  57.  transfer(p2,p1);
  58.  goto _LOOP;
  59.  end;
  60.  
  61. begin
  62.  p1:=newProcess(@proc1,@stack1,256);
  63.  p2:=newProcess(@proc2,@stack2,256);
  64.  transfer(p0,p1);
  65.  end.