{task #1: keyboard  -> serial out
task #2: serial in ->  video out
     control-C will abort program}
program main;
const   TASKS=2;
       STACKSIZE=70;
{next 7 constants are needed for the Kaypro}
       KDATA=5;
       KSTAT=7;
       BAUDP=0;
       SDATA=4;
       SSTAT=6;
       RMASK=1;
       TMASK=4;

       CC=3;
type    stack = array[0..STACKSIZE] of integer;
       tasknum = -1..TASKS;
var     sp0,sp1,sp2: integer;{when zero, task not initialized}
       oldn: tasknum;
       nextn: tasknum;
Procedure defer; forward;
procedure exit;
         begin
         writeln('TASK #',oldn,' terminated.');
         oldn:=-1;
         defer;
         end;
function keyin:byte;
        begin
          repeat
            defer;
          until (RMASK = (RMASK and port[KSTAT]));
          keyin:= port[KDATA];
        end;
procedure videout(b:byte);
         begin
         bdos(6,b);
         end;
function serin: byte;
        begin
        repeat
          defer;
        until (RMASK = (RMASK and port[SSTAT]));
        serin:= port[SDATA];
        end;
procedure serout(b:byte);
         begin
         repeat
           defer;
         until (TMASK = (TMASK and port[SSTAT]));
         port[SDATA]:=b;
         end;
ne 10
Procedure task1;
var       mystack: stack;
         key: byte;
         begin
         stackptr:=addr(mystack[STACKSIZE]);
         repeat
           key:=keyin;
           if key=CC then exit
           else serout(key);
         until false;{forever}
         exit;
         end;
Procedure task2;
var       mystack: stack;
         begin
         stackptr:=addr(mystack[STACKSIZE]);
         repeat
           videout(serin);
         until false{forever};
         exit;
         end;
procedure initall;
var       i: integer;
         Begin
         sp1:=0;
         sp2:=0;
         oldn:=0;
         {initialize Kaypro's SIO}
         port[BAUDP]:=14;{9600 Baud}
         port[SSTAT]:=24;
         port[SSTAT]:=4;
         port[SSTAT]:=68;
         port[SSTAT]:=1;
         port[SSTAT]:=0;
         port[SSTAT]:=3;
         port[SSTAT]:=193;
         port[SSTAT]:=5;
         port[SSTAT]:=234;
         end;
Procedure schedule;
         begin
         if oldn=TASKS then nextn:=1
         else nextn:=oldn+1;
         end;
bp
procedure defer;
var sp: integer;
       begin
       case oldn of
          0: sp0:=stackptr;
          1: sp1:=stackptr;
          2: sp2:=stackptr;
          end{case};
       schedule;
       oldn:=nextn;
       case nextn of
       0: sp:=sp0;
       1: sp:=sp1;
       2: sp:=sp2;
       end{case};
       if sp<>0 {initialized}
       then begin
         stackptr:=sp;
            end
       else {not initialized}
            begin
            writeln('Starting task #',nextn);
            case nextn of
            1: task1;
            2: task2;
            end{case};
            end;
    end{defer};
begin{main}
initall;
writeln('Multitasking version of simple terminal program');
writeln('Control-C will terminate it');
writeln;
defer;
writeln('Main: done');
end.


{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.



You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.