home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1988 / 02 / lindley / lindley.ls1 next >
Text File  |  1979-12-31  |  13KB  |  487 lines
  1.  
  2.  
  3.  
  4.  
  5. {$K-}             {Compiler switch - never change}
  6.  
  7. {************************************************}
  8. {***                                          ***}
  9. {***                Turbo Pascal              ***}
  10. {***            Multitasking Kernel           ***}
  11. {***                 written by               ***}
  12. {***              Craig A. Lindley            ***}
  13. {***                                          ***}
  14. {***    Ver: 2.0     Last update: 08/15/87    ***}
  15. {***                                          ***}
  16. {************************************************}
  17.  
  18. CONST
  19.  
  20.    task_stack_size  = 1000; {stack size for each}
  21.                            {task}
  22.    turbodseg: integer = 0; {storage for turbos}
  23.                            {data segment value}
  24.  
  25.  
  26. TYPE
  27.  
  28. {possible states for a task}
  29.    task_state = (ready,waiting,running);
  30.  
  31. {808X register set}
  32.    register_type = RECORD
  33.    CASE integer OF
  34.       1: (ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
  35.       2: (al,ah,bl,bh,cl,ch,dl,dh         :byte);
  36.    END;
  37.  
  38.  
  39. {Task control block (tcb) structure}
  40.  
  41.  tcbptr = ^ tcb;       {ptr to tcb}
  42.  
  43.  tcb = RECORD
  44.     link:  tcbptr;     {link to next tcb in dseg}
  45.     bptr:  integer;    {base ptr offset in sseg}
  46.     state: task_state; {ready, waiting, running}
  47.     id:    byte;       {task number}
  48.  END;
  49.  
  50.  waitptr = ^tcbptr;    {ptr to ptr to tcb}
  51.                        {used for passing parms}
  52.                        {to wait}
  53.  
  54.  semaphore = RECORD    {Semaphore data type}
  55.     count:  integer;   {number of times signaled}
  56.     signal: tcbptr;    {pointer to waiting task}
  57.                        {if there is one}
  58.  END;
  59.  
  60.  
  61. {******** Begin Multitasking Variables *********}
  62.  
  63. VAR
  64.  
  65.    cp,                  {current task pointer}
  66.    new_tcb_ptr,         {ptr to new tcb in dseg}
  67.    temp_ptr:   tcbptr;
  68.  
  69.    waitfor:    waitptr; {address of item to}
  70.                         {wait on}
  71.    stk,bp:     integer; {variables for setting}
  72.                         {808X sp and bp}
  73.    frame_ptr:  integer; {stack frame pointer}
  74.    next_id:    integer; {next task id number}
  75.    i:          integer;
  76.    child_process: boolean; {fork successful flag}
  77.  
  78.  
  79. {******** Begin Multitasking Procedures ********}
  80.  
  81.  
  82. PROCEDURE Fork;        {fork off a new task}
  83.  
  84. {This procedure manipulates Turbo Pascal's stack}
  85. {frame as required to fool it into operating in}
  86. {a new task's environment.}
  87.  
  88. BEGIN
  89.  
  90.    child_process:=false;   {indicate the parent}
  91.                            {process until proven}
  92.                            {otherwise}
  93.    {check if enough stack space for a new task}
  94.  
  95.    IF abs(frame_ptr - task_stack_size) > 0 THEN
  96.    BEGIN                   {if enough}
  97.       INLINE($89/$26/stk); {get 808X Sp to}
  98.                            {calculate Bp pointer}
  99.       cp^.bptr:=stk+2;     {save Bp ptr in this}
  100.                            {frame}
  101.       new(new_tcb_ptr);    {allociate new tcb}
  102.  
  103.       {link new tcb into scheduler loop}
  104.       {make its state running and give it an id}
  105.  
  106.       new_tcb_ptr^.link:=cp^.link;
  107.       cp^.link:=new_tcb_ptr;
  108.       new_tcb_ptr^.state:=running;
  109.       next_id:=next_id+1;
  110.       new_tcb_ptr^.id:=next_id;
  111.  
  112.       cp^.state:=ready;    {old frame is ready}
  113.  
  114.       {copy old stack to new stack frame}
  115.       FOR i:=0 TO 5 DO
  116.          mem[sseg:frame_ptr-6+i]:=mem[sseg:stk+i];
  117.  
  118.       {make Bp storage in stack frame point at}
  119.       {this frame}
  120.  
  121.       memw[sseg:frame_ptr-4]:=frame_ptr;
  122.       bp:=frame_ptr-4;     {calculate Bp pointer}
  123.  
  124.       INLINE($8B/$2E/bp);  {set 808X Bp reg to}
  125.                            {this new value}
  126.  
  127.      {reserve stack frame space}
  128.      frame_ptr:=frame_ptr-task_stack_size;
  129.      cp:=new_tcb_ptr;      {cp points at new task}
  130.      child_process:=true;  {indicate child process}
  131.    END;
  132.  
  133. END;
  134.  
  135.  
  136. (*
  137. PROCEDURE Yield;
  138.  
  139. {This procedure cause the executing task to}
  140. {relinquish control of the CPU to the next ready}
  141. {task.}
  142.  
  143. BEGIN
  144.  
  145.    child_process:=false;   {reset variable}
  146.    IF cp^.link <> cp THEN  {must have more than}
  147.                            {one task forked to be}
  148.                            {able to yield}
  149.    BEGIN
  150.       INLINE($89/$26/stk); {get 808X sp}
  151.       cp^.bptr:=stk+2;     {save Bp ptr in}
  152.                            {current task frame}
  153.       cp^.state:=ready;    {yielded task ready}
  154.       temp_ptr:=cp;
  155.  
  156.       {look for next ready task in scheduler loop}
  157.       {there must be at least one or else}
  158.  
  159.       WHILE (temp_ptr^.link^.state <> ready) DO
  160.          temp_ptr:=temp_ptr^.link;
  161.  
  162.       cp:=temp_ptr^.link;  {cp points at new task}
  163.       cp^.state:=running;  {indicate running}
  164.       bp:=cp^.bptr;        {get the bp of task}
  165.  
  166.      INLINE($8B/$2E/bp);   {restore it to 808X bp}
  167.    END
  168.    ELSE
  169.    BEGIN
  170.       writeln('Cannot yield only single task running');
  171.       halt;
  172.    END;
  173.  
  174. END;
  175. *)
  176.  
  177. PROCEDURE Yield;
  178.  
  179. {This version in assembly language for}
  180. {speed. See version above for comments.}
  181.  
  182. BEGIN
  183.  
  184.    IF cp^.link <> cp THEN  {must have more than}
  185.                            {one task forked to be}
  186.                            {able to yield}
  187.    BEGIN
  188.       INLINE($C6/$06/child_process/$00/
  189.                               {child_process is false}
  190.              $C4/$3E/cp/      {les di,[cp]}
  191.              $89/$E0/         {mov ax,sp}
  192.              $05/$02/$00/     {add ax,2}
  193.              $26/             {es:}
  194.              $89/$45/$04/     {mov [di+4],ax}
  195.              $26/             {es:}
  196.              $C6/$45/$06/$00/ {mov byte ptr [di+6],0}
  197.              $89/$FB/         {L1: mov bx,di}
  198.              $26/             {es:}
  199.              $C4/$1F/         {les bx,[bx]}
  200.              $26/             {es:}
  201.              $80/$7F/$06/$00/ {cmp byte ptr [bx+6],0}
  202.              $74/$04/         {je L2}
  203.              $89/$DF/         {mov di,bx}
  204.              $EB/$F0/         {jmp L1}
  205.              $89/$1E/cp/      {L2: mov [cp],bx}
  206.              $8C/$06/cp+2/    {    mov [cp+2],es}
  207.              $26/             {es:}
  208.              $C6/$47/$06/$02/ {mov byte ptr [bx+6],2}
  209.              $26/             {es:}
  210.              $8B/$6F/$04);    {mov bp,[bx+4]}
  211.    END
  212.    ELSE
  213.    BEGIN
  214.       writeln('Cannot yield only single task running');
  215.       halt;
  216.    END;
  217.  
  218. END;
  219.  
  220. (*
  221. PROCEDURE Wait;  {put current task in wait mode}
  222.                  {until a send makes it ready}
  223.  
  224. {Due to constraints of this kernel, parameters}
  225. {cannot be passed directly to the wait procedure.}
  226. {To overcome this limitation, a global variable}
  227. {called waitfor is used. The address of the}
  228. {tcbptr on which to wait should be stored in}
  229. {waitfor. See the fifo routines for an example of}
  230. {the proper usage of Wait.}
  231.  
  232. BEGIN
  233.  
  234.    child_process:=false;   {reset variable}
  235.    IF cp^.link <> cp THEN  {must have more than}
  236.                            {one task forked to be}
  237.                            {able to wait}
  238.    BEGIN
  239.       waitfor^ := cp;      {waitfor points at the}
  240.                            {current task}
  241.  
  242.       INLINE($89/$26/stk); {get 808X sp}
  243.       cp^.bptr:=stk+2;     {save it in current}
  244.                            {task frame}
  245.       cp^.state:=waiting;  {task now waiting}
  246.       temp_ptr:=cp;
  247.  
  248.       {look for next ready task in scheduler loop}
  249.       {there must be at least one or else}
  250.  
  251.       WHILE (temp_ptr^.link^.state <> ready) DO
  252.          temp_ptr:=temp_ptr^.link;
  253.  
  254.       cp:=temp_ptr^.link;  {cp points at new task}
  255.       cp^.state:=running;  {indicate running}
  256.       bp:=cp^.bptr;        {get bp for this task}
  257.       INLINE($8B/$2E/bp);  {restore it to 808X bp}
  258.    END
  259.    ELSE
  260.    BEGIN
  261.       writeln('Cannot wait only single task running');
  262.       halt;
  263.    END;
  264.  
  265. END;
  266. *)
  267.  
  268. PROCEDURE Wait;  {put current task in wait mode}
  269.                  {until a send makes it ready}
  270.  
  271. BEGIN
  272.  
  273.    IF cp^.link <> cp THEN  {must have more than}
  274.                            {one task forked to be}
  275.                            {able to wait}
  276.    BEGIN
  277.       waitfor^ := cp;      {waitfor points at the}
  278.                            {current task}
  279.       INLINE($C6/$06/child_process/$00/
  280.                               {child_process is false}
  281.              $C4/$3E/cp/      {les di,[cp]}
  282.              $89/$E0/         {mov ax,sp}
  283.              $05/$02/$00/     {add ax,2}
  284.              $26/             {es:}
  285.              $89/$45/$04/     {mov [di+4],ax}
  286.              $26/             {es:}
  287.              $C6/$45/$06/$01/ {mov byte ptr [di+6],1}
  288.              $89/$FB/         {L1: mov bx,di}
  289.              $26/             {es:}
  290.              $C4/$1F/         {les bx,[bx]}
  291.              $26/             {es:}
  292.              $80/$7F/$06/$00/ {cmp byte ptr [bx+6],0}
  293.              $74/$04/         {je L2}
  294.              $89/$DF/         {mov di,bx}
  295.              $EB/$F0/         {jmp L1}
  296.              $89/$1E/cp/      {L2: mov [cp],bx}
  297.              $8C/$06/cp+2/    {    mov [cp+2],es}
  298.              $26/             {es:}
  299.              $C6/$47/$06/$02/ {mov byte ptr [bx+6],2}
  300.              $26/             {es:}
  301.              $8B/$6F/$04);    {mov bp,[bx+4]}
  302.  
  303.    END
  304.    ELSE
  305.    BEGIN
  306.       writeln('Cannot wait only single task running');
  307.       halt;
  308.    END;
  309.  
  310. END;
  311.  
  312.  
  313. PROCEDURE Send(VAR s:tcbptr);
  314.  
  315. {Make the specified task ready for next scheduler}
  316. {go around}
  317.  
  318. BEGIN
  319.  
  320.    s^.state:=ready;    {task state is ready}
  321.    s:=NIL;             {clear pointer}
  322.  
  323. END;
  324.  
  325.  
  326.  
  327. PROCEDURE Pause(t:integer);
  328.  
  329. {Pause the execution of a task for t 1/4 sec}
  330. {intervals. Note even t results in more}
  331. {accurate timmings.}
  332.  
  333.  FUNCTION tic_count : integer;
  334.  
  335.  {Get the current tic count from the Bios}
  336.  
  337.  VAR
  338.  
  339.     regs: register_type;
  340.  
  341.  BEGIN
  342.  
  343.     regs.ax:=0;         {request clock tic read}
  344.     intr($1A,regs);
  345.     tic_count:=regs.dx; {LSB of count in dx}
  346.  
  347.  END;
  348.  
  349.  
  350. VAR
  351.  
  352.    tics,i: integer;
  353.  
  354. BEGIN
  355.  
  356.    tics:=0;             {initial tic count to 0}
  357.    IF t > 0 THEN        {if a legal tic count}
  358.    BEGIN
  359.       FOR i:=1 TO t DO  {250 msec = 4.55 tics}
  360.          IF odd(i) THEN {use this algorithm for}
  361.                         {approximation}
  362.             tics:=tics+4 {250 msec = 4.5 tics}
  363.          ELSE
  364.             tics:=tics+5;
  365.       {add tics to current tic_count to get}
  366.       tics:=tics+tic_count;    {target time}
  367.  
  368.       REPEAT
  369.          yield;    {return when tic count is}
  370.                    {reached or exceeded}
  371.       UNTIL tics <= tic_count;
  372.    END
  373.    ELSE
  374.       writeln('Bad tic count specified');
  375.  
  376. END;
  377.  
  378.  
  379. PROCEDURE Init_Kernel;
  380.  
  381. {This procedure initializes the multitasking}
  382. {for use. It sets up the TCB for task 0 and}
  383. {indicates that it is running.}
  384.  
  385. BEGIN
  386.  
  387.    turbodseg:=dseg;     {save turbo data segment}
  388.    frame_ptr:= $FFFE;   {initial stack location}
  389.    next_id:=0;          {first task id}
  390.    new(new_tcb_ptr);    {get new tcb in dseg}
  391.    cp:=new_tcb_ptr;     {cp points at tcb}
  392.    cp^.link:=cp;        {points at itself}
  393.    cp^.state:=running;  {in running state}
  394.    cp^.id:=next_id;     {id = 0}
  395.  
  396.    {now allociate 1st frame for task 0}
  397.    frame_ptr:=frame_ptr-task_stack_size;
  398.  
  399. END;
  400.  
  401.  
  402.  
  403. {********* Begin Semaphore Procedures **********}
  404.  
  405. PROCEDURE Initialize_semaphore(VAR s:semaphore);
  406.  
  407. {Initialize a semaphore data structure}
  408.  
  409. BEGIN
  410.  
  411.    s.count := 0;       {indicate resource is}
  412.                        {available}
  413.    s.signal:=NIL;      {and that there are no}
  414.                        {waiters}
  415.  
  416. END;
  417.  
  418.  
  419.  
  420. PROCEDURE Alloc(VAR s:semaphore);
  421.  
  422. {This procedure allociates exclusive use of a}
  423. {resource to the task that executes it. This}
  424. {claim is maintained even though the task}
  425. {gives up control of the CPU via a yield etc.}
  426.  
  427. BEGIN
  428.  
  429.    WHILE s.count <> 0 DO  {wait for semaphore}
  430.                           {controlled resource}
  431.                           {to become available}
  432.    BEGIN
  433.       waitfor := addr (s.signal);
  434.       wait;
  435.    END;                   {then}
  436.    s.count:=1;            {claim it}
  437.  
  438. END;
  439.  
  440.  
  441. PROCEDURE Dealloc(VAR s:semaphore);
  442.  
  443. {This procedure deallociates a resource.}
  444. {Note this routine yields so the deallociated}
  445. {resource has a chance of being used}
  446. {immediately}
  447.  
  448. BEGIN
  449.  
  450.    s.count:=0;     {remove claim on resource}
  451.    send(s.signal); {and awaken the waiting task}
  452.    yield;          {give other tasks a chance}
  453.  
  454. END;
  455.  
  456. {End of kernel procedures}
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  
  468.  
  469.  
  470.  
  471.  
  472.  
  473.  
  474.  
  475.  
  476.  
  477.  
  478.  
  479.  
  480.  
  481.  
  482.  
  483.  
  484.  
  485.                                        
  486.  
  487.