Power-Programmierung/CD1.mdf/magazine/drdobbs/1986/03/berglst2.mar

Text File | 1986-03-31 | 6KB | 222 lines

{task #1: keyboard -> fifo1
 task #2: fifo1    -> filter -> fifo2
 task #3: fifo2    -> slow display    }
program main;
const   TASKS=3;
        STACKSIZE=20;
        NFIFOS=2;{#1 is for input and #2 for output}
        PRATE=300;{SLOWs the display function}
{the following three constants are for the Kaypro Computer}
        KDATA=5; KSTAT=7; RMASK=1;
        CR=13;
        LF=10;
        CC=3;
        BS=8;
        RUB=127;
        SPACE=32;
        CQ=17;{XON}
        CS=19;{XOFF}
type    stack = array[0..STACKSIZE] of integer;
        fifo = record
               buf: array[0..255] of byte;
               inptr: byte;
               outptr: byte;
               flow: boolean;{for flow control}
               end;
        fifon = 1..NFIFOS;
        tasknum = -1.. TASKS;
var     sp0,sp1,sp2,sp3: integer;{when zero, task not initialized}
        oldn: tasknum;
        nextn: tasknum;
        fifos: array[1..NFIFOS] of fifo;
Procedure defer; forward;
function occupancy(p: fifon):byte;
         begin with fifos[p] do
         occupancy:= inptr-outptr;
         end;
function vacancy(p: fifon): byte;
         begin with fifos[p] do
         vacancy:=outptr-inptr-1;
         end;
function dequeue1: byte;
         begin with fifos[1] do
         begin
         while (occupancy(1)=0) or not flow
               do defer;
         dequeue1:= buf[outptr];
         outptr:=outptr+1;
         end;
         end;
function dequeue2: byte;
         begin with fifos[2] do
         begin
         while (occupancy(2)=0) or not flow
               do defer;
         dequeue2:= buf[outptr];
         outptr:=outptr+1;
         end;
         end;
procedure exit;
          begin
          writeln('JOB #',oldn,' terminated.');
          oldn:=-1;
          defer;
          end;
procedure enqueue1(b:byte);
          begin with fifos[1] do
          begin
          buf[inptr]:=b;
          while vacancy(1)=0 do
             defer;{hang while full}
          inptr:=inptr+1;
          end;
          end;
procedure enqueue2(b:byte);
          begin with fifos[2] do
          begin
          buf[inptr]:=b;
          while vacancy(2)=0 do
             defer;{hang while full}
          inptr:=inptr+1;
          end;
          end;
function keyin:byte;
         begin
           repeat until (RMASK = (RMASK and port[KSTAT]));
           keyin:= port[KDATA];
         end;
procedure vout(b:byte);
          begin
          bdos(6,b);
          end;
Procedure print;{task#3}
var       mystack: stack;
          i: integer;
          begin
          stackptr:=addr(mystack[STACKSIZE]);
          i:=0;
          {initialize fifo#2}
          with fifos[2] do
               begin
               outptr:=0;
               inptr:=0;
               flow:=true;
               end;
          repeat
            i:=i+1;
            if i=PRATE then
               begin
               i:=0;
               vout(dequeue2);
               end
            else
               defer;
          until false;{forever}
          exit;
          end;
Procedure keyboard;{task #1}
var       mystack: stack;
          cb: byte;
          begin
          stackptr:=addr(mystack[STACKSIZE]);
          {initialize fifo #1}
          with fifos[1] do
               begin
               inptr:=0;
               outptr:=0;
               flow:=true;
               end;
          repeat
            if (1 = (1 and port[KSTAT]))
            then
              begin
              cb:= port[KDATA];
              enqueue1(cb);
              end
            else defer;
          until false{forever};
          exit;
          end;
Procedure filter;{task #2}
var       mystack: stack;
          b: byte;
          begin
          stackptr:=addr(mystack[STACKSIZE]);
          repeat
            b:=dequeue1;
            case b of
            CR: begin
                enqueue2(CR);
                enqueue2(LF);
                end;
            LF: {ignore};
            CC: exit;
            BS,RUB:
               begin
               enqueue2(BS);
               enqueue2(SPACE);
               enqueue2(BS);
               end;
            CQ: fifos[2].flow:=true;
            CS: fifos[2].flow:=false;
            else enqueue2(b);
            end{case};
          until false;{forever!}
          exit;
          end;
procedure initall;
var       i: integer;
          Begin
          sp1:=0;
          sp2:=0;
          sp3:=0;
          oldn:=0;
          end;
Procedure schedule;
          begin
          if oldn=TASKS then nextn:=1
          else nextn:=oldn+1;
          end;
procedure defer;
var sp: integer;
          begin
           case oldn of
           0: sp0:=stackptr;
           1: sp1:=stackptr;
           2: sp2:=stackptr;
           3: sp3:=stackptr;
           end{case};
        schedule;
        oldn:=nextn;
        case nextn of
        0: sp:=sp0;
        1: sp:=sp1;
        2: sp:=sp2;
        3: sp:=sp3;
        end{case};
        if sp<>0 {initialized}
        then begin
          stackptr:=sp;
             end
        else {not initialized}
             begin
             case nextn of
             1: keyboard;
             2: filter;
             3: print;
             end{case};
             end;
     end{defer};
begin{main}
initall;
writeln('<Demonstration of multitasking with queues (FIFOs)>');
writeln;
writeln('Control-S stops output (you can still type ahead!)');
writeln('Control-Q restarts output (you can see what you have typed ahead)');
writeln('RUB or BACKSPACE will "undo" on screen the last letter');
writeln('Control-C terminates this program');
writeln;
defer;
writeln('main: done');
end.