home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
drdobbs
/
1988
/
02
/
lindley
/
lindley.ls1
next >
Wrap
Text File
|
1979-12-31
|
13KB
|
487 lines
{$K-} {Compiler switch - never change}
{************************************************}
{*** ***}
{*** Turbo Pascal ***}
{*** Multitasking Kernel ***}
{*** written by ***}
{*** Craig A. Lindley ***}
{*** ***}
{*** Ver: 2.0 Last update: 08/15/87 ***}
{*** ***}
{************************************************}
CONST
task_stack_size = 1000; {stack size for each}
{task}
turbodseg: integer = 0; {storage for turbos}
{data segment value}
TYPE
{possible states for a task}
task_state = (ready,waiting,running);
{808X register set}
register_type = RECORD
CASE integer OF
1: (ax,bx,cx,dx,bp,si,di,ds,es,flags:integer);
2: (al,ah,bl,bh,cl,ch,dl,dh :byte);
END;
{Task control block (tcb) structure}
tcbptr = ^ tcb; {ptr to tcb}
tcb = RECORD
link: tcbptr; {link to next tcb in dseg}
bptr: integer; {base ptr offset in sseg}
state: task_state; {ready, waiting, running}
id: byte; {task number}
END;
waitptr = ^tcbptr; {ptr to ptr to tcb}
{used for passing parms}
{to wait}
semaphore = RECORD {Semaphore data type}
count: integer; {number of times signaled}
signal: tcbptr; {pointer to waiting task}
{if there is one}
END;
{******** Begin Multitasking Variables *********}
VAR
cp, {current task pointer}
new_tcb_ptr, {ptr to new tcb in dseg}
temp_ptr: tcbptr;
waitfor: waitptr; {address of item to}
{wait on}
stk,bp: integer; {variables for setting}
{808X sp and bp}
frame_ptr: integer; {stack frame pointer}
next_id: integer; {next task id number}
i: integer;
child_process: boolean; {fork successful flag}
{******** Begin Multitasking Procedures ********}
PROCEDURE Fork; {fork off a new task}
{This procedure manipulates Turbo Pascal's stack}
{frame as required to fool it into operating in}
{a new task's environment.}
BEGIN
child_process:=false; {indicate the parent}
{process until proven}
{otherwise}
{check if enough stack space for a new task}
IF abs(frame_ptr - task_stack_size) > 0 THEN
BEGIN {if enough}
INLINE($89/$26/stk); {get 808X Sp to}
{calculate Bp pointer}
cp^.bptr:=stk+2; {save Bp ptr in this}
{frame}
new(new_tcb_ptr); {allociate new tcb}
{link new tcb into scheduler loop}
{make its state running and give it an id}
new_tcb_ptr^.link:=cp^.link;
cp^.link:=new_tcb_ptr;
new_tcb_ptr^.state:=running;
next_id:=next_id+1;
new_tcb_ptr^.id:=next_id;
cp^.state:=ready; {old frame is ready}
{copy old stack to new stack frame}
FOR i:=0 TO 5 DO
mem[sseg:frame_ptr-6+i]:=mem[sseg:stk+i];
{make Bp storage in stack frame point at}
{this frame}
memw[sseg:frame_ptr-4]:=frame_ptr;
bp:=frame_ptr-4; {calculate Bp pointer}
INLINE($8B/$2E/bp); {set 808X Bp reg to}
{this new value}
{reserve stack frame space}
frame_ptr:=frame_ptr-task_stack_size;
cp:=new_tcb_ptr; {cp points at new task}
child_process:=true; {indicate child process}
END;
END;
(*
PROCEDURE Yield;
{This procedure cause the executing task to}
{relinquish control of the CPU to the next ready}
{task.}
BEGIN
child_process:=false; {reset variable}
IF cp^.link <> cp THEN {must have more than}
{one task forked to be}
{able to yield}
BEGIN
INLINE($89/$26/stk); {get 808X sp}
cp^.bptr:=stk+2; {save Bp ptr in}
{current task frame}
cp^.state:=ready; {yielded task ready}
temp_ptr:=cp;
{look for next ready task in scheduler loop}
{there must be at least one or else}
WHILE (temp_ptr^.link^.state <> ready) DO
temp_ptr:=temp_ptr^.link;
cp:=temp_ptr^.link; {cp points at new task}
cp^.state:=running; {indicate running}
bp:=cp^.bptr; {get the bp of task}
INLINE($8B/$2E/bp); {restore it to 808X bp}
END
ELSE
BEGIN
writeln('Cannot yield only single task running');
halt;
END;
END;
*)
PROCEDURE Yield;
{This version in assembly language for}
{speed. See version above for comments.}
BEGIN
IF cp^.link <> cp THEN {must have more than}
{one task forked to be}
{able to yield}
BEGIN
INLINE($C6/$06/child_process/$00/
{child_process is false}
$C4/$3E/cp/ {les di,[cp]}
$89/$E0/ {mov ax,sp}
$05/$02/$00/ {add ax,2}
$26/ {es:}
$89/$45/$04/ {mov [di+4],ax}
$26/ {es:}
$C6/$45/$06/$00/ {mov byte ptr [di+6],0}
$89/$FB/ {L1: mov bx,di}
$26/ {es:}
$C4/$1F/ {les bx,[bx]}
$26/ {es:}
$80/$7F/$06/$00/ {cmp byte ptr [bx+6],0}
$74/$04/ {je L2}
$89/$DF/ {mov di,bx}
$EB/$F0/ {jmp L1}
$89/$1E/cp/ {L2: mov [cp],bx}
$8C/$06/cp+2/ { mov [cp+2],es}
$26/ {es:}
$C6/$47/$06/$02/ {mov byte ptr [bx+6],2}
$26/ {es:}
$8B/$6F/$04); {mov bp,[bx+4]}
END
ELSE
BEGIN
writeln('Cannot yield only single task running');
halt;
END;
END;
(*
PROCEDURE Wait; {put current task in wait mode}
{until a send makes it ready}
{Due to constraints of this kernel, parameters}
{cannot be passed directly to the wait procedure.}
{To overcome this limitation, a global variable}
{called waitfor is used. The address of the}
{tcbptr on which to wait should be stored in}
{waitfor. See the fifo routines for an example of}
{the proper usage of Wait.}
BEGIN
child_process:=false; {reset variable}
IF cp^.link <> cp THEN {must have more than}
{one task forked to be}
{able to wait}
BEGIN
waitfor^ := cp; {waitfor points at the}
{current task}
INLINE($89/$26/stk); {get 808X sp}
cp^.bptr:=stk+2; {save it in current}
{task frame}
cp^.state:=waiting; {task now waiting}
temp_ptr:=cp;
{look for next ready task in scheduler loop}
{there must be at least one or else}
WHILE (temp_ptr^.link^.state <> ready) DO
temp_ptr:=temp_ptr^.link;
cp:=temp_ptr^.link; {cp points at new task}
cp^.state:=running; {indicate running}
bp:=cp^.bptr; {get bp for this task}
INLINE($8B/$2E/bp); {restore it to 808X bp}
END
ELSE
BEGIN
writeln('Cannot wait only single task running');
halt;
END;
END;
*)
PROCEDURE Wait; {put current task in wait mode}
{until a send makes it ready}
BEGIN
IF cp^.link <> cp THEN {must have more than}
{one task forked to be}
{able to wait}
BEGIN
waitfor^ := cp; {waitfor points at the}
{current task}
INLINE($C6/$06/child_process/$00/
{child_process is false}
$C4/$3E/cp/ {les di,[cp]}
$89/$E0/ {mov ax,sp}
$05/$02/$00/ {add ax,2}
$26/ {es:}
$89/$45/$04/ {mov [di+4],ax}
$26/ {es:}
$C6/$45/$06/$01/ {mov byte ptr [di+6],1}
$89/$FB/ {L1: mov bx,di}
$26/ {es:}
$C4/$1F/ {les bx,[bx]}
$26/ {es:}
$80/$7F/$06/$00/ {cmp byte ptr [bx+6],0}
$74/$04/ {je L2}
$89/$DF/ {mov di,bx}
$EB/$F0/ {jmp L1}
$89/$1E/cp/ {L2: mov [cp],bx}
$8C/$06/cp+2/ { mov [cp+2],es}
$26/ {es:}
$C6/$47/$06/$02/ {mov byte ptr [bx+6],2}
$26/ {es:}
$8B/$6F/$04); {mov bp,[bx+4]}
END
ELSE
BEGIN
writeln('Cannot wait only single task running');
halt;
END;
END;
PROCEDURE Send(VAR s:tcbptr);
{Make the specified task ready for next scheduler}
{go around}
BEGIN
s^.state:=ready; {task state is ready}
s:=NIL; {clear pointer}
END;
PROCEDURE Pause(t:integer);
{Pause the execution of a task for t 1/4 sec}
{intervals. Note even t results in more}
{accurate timmings.}
FUNCTION tic_count : integer;
{Get the current tic count from the Bios}
VAR
regs: register_type;
BEGIN
regs.ax:=0; {request clock tic read}
intr($1A,regs);
tic_count:=regs.dx; {LSB of count in dx}
END;
VAR
tics,i: integer;
BEGIN
tics:=0; {initial tic count to 0}
IF t > 0 THEN {if a legal tic count}
BEGIN
FOR i:=1 TO t DO {250 msec = 4.55 tics}
IF odd(i) THEN {use this algorithm for}
{approximation}
tics:=tics+4 {250 msec = 4.5 tics}
ELSE
tics:=tics+5;
{add tics to current tic_count to get}
tics:=tics+tic_count; {target time}
REPEAT
yield; {return when tic count is}
{reached or exceeded}
UNTIL tics <= tic_count;
END
ELSE
writeln('Bad tic count specified');
END;
PROCEDURE Init_Kernel;
{This procedure initializes the multitasking}
{for use. It sets up the TCB for task 0 and}
{indicates that it is running.}
BEGIN
turbodseg:=dseg; {save turbo data segment}
frame_ptr:= $FFFE; {initial stack location}
next_id:=0; {first task id}
new(new_tcb_ptr); {get new tcb in dseg}
cp:=new_tcb_ptr; {cp points at tcb}
cp^.link:=cp; {points at itself}
cp^.state:=running; {in running state}
cp^.id:=next_id; {id = 0}
{now allociate 1st frame for task 0}
frame_ptr:=frame_ptr-task_stack_size;
END;
{********* Begin Semaphore Procedures **********}
PROCEDURE Initialize_semaphore(VAR s:semaphore);
{Initialize a semaphore data structure}
BEGIN
s.count := 0; {indicate resource is}
{available}
s.signal:=NIL; {and that there are no}
{waiters}
END;
PROCEDURE Alloc(VAR s:semaphore);
{This procedure allociates exclusive use of a}
{resource to the task that executes it. This}
{claim is maintained even though the task}
{gives up control of the CPU via a yield etc.}
BEGIN
WHILE s.count <> 0 DO {wait for semaphore}
{controlled resource}
{to become available}
BEGIN
waitfor := addr (s.signal);
wait;
END; {then}
s.count:=1; {claim it}
END;
PROCEDURE Dealloc(VAR s:semaphore);
{This procedure deallociates a resource.}
{Note this routine yields so the deallociated}
{resource has a chance of being used}
{immediately}
BEGIN
s.count:=0; {remove claim on resource}
send(s.signal); {and awaken the waiting task}
yield; {give other tasks a chance}
END;
{End of kernel procedures}