home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / MULTASK.PQS / MULTASK.PAS
Pascal/Delphi Source File  |  2000-06-30  |  9KB  |  360 lines
  1. {task #1: keyboard  -> serial out
  2.  task #2: serial in ->  video out
  3.       control-C will abort program}
  4. program main;
  5. const   TASKS=2;
  6.         STACKSIZE=70;
  7. {next 7 constants are needed for the Kaypro}
  8.         KDATA=5;
  9.         KSTAT=7;
  10.         BAUDP=0;
  11.         SDATA=4;
  12.         SSTAT=6;
  13.         RMASK=1;
  14.         TMASK=4;
  15.  
  16.         CC=3;
  17. type    stack = array[0..STACKSIZE] of integer;
  18.         tasknum = -1..TASKS;
  19. var     sp0,sp1,sp2: integer;{when zero, task not initialized}
  20.         oldn: tasknum;
  21.         nextn: tasknum;
  22. Procedure defer; forward;
  23. procedure exit;
  24.           begin
  25.           writeln('TASK #',oldn,' terminated.');
  26.           oldn:=-1;
  27.           defer;
  28.           end;
  29. function keyin:byte;
  30.          begin
  31.            repeat
  32.              defer;
  33.            until (RMASK = (RMASK and port[KSTAT]));
  34.            keyin:= port[KDATA];
  35.          end;
  36. procedure videout(b:byte);
  37.           begin
  38.           bdos(6,b);
  39.           end;
  40. function serin: byte;
  41.          begin
  42.          repeat
  43.            defer;
  44.          until (RMASK = (RMASK and port[SSTAT]));
  45.          serin:= port[SDATA];
  46.          end;
  47. procedure serout(b:byte);
  48.           begin
  49.           repeat
  50.             defer;
  51.           until (TMASK = (TMASK and port[SSTAT]));
  52.           port[SDATA]:=b;
  53.           end;
  54. .ne 10
  55. Procedure task1;
  56. var       mystack: stack;
  57.           key: byte;
  58.           begin
  59.           stackptr:=addr(mystack[STACKSIZE]);
  60.           repeat
  61.             key:=keyin;
  62.             if key=CC then exit
  63.             else serout(key);
  64.           until false;{forever}
  65.           exit;
  66.           end;
  67. Procedure task2;
  68. var       mystack: stack;
  69.           begin
  70.           stackptr:=addr(mystack[STACKSIZE]);
  71.           repeat
  72.             videout(serin);
  73.           until false{forever};
  74.           exit;
  75.           end;
  76. procedure initall;
  77. var       i: integer;
  78.           Begin
  79.           sp1:=0;
  80.           sp2:=0;
  81.           oldn:=0;
  82.           {initialize Kaypro's SIO}
  83.           port[BAUDP]:=14;{9600 Baud}
  84.           port[SSTAT]:=24;
  85.           port[SSTAT]:=4;
  86.           port[SSTAT]:=68;
  87.           port[SSTAT]:=1;
  88.           port[SSTAT]:=0;
  89.           port[SSTAT]:=3;
  90.           port[SSTAT]:=193;
  91.           port[SSTAT]:=5;
  92.           port[SSTAT]:=234;
  93.           end;
  94. Procedure schedule;
  95.           begin
  96.           if oldn=TASKS then nextn:=1
  97.           else nextn:=oldn+1;
  98.           end;
  99. .bp
  100. procedure defer;
  101. var sp: integer;
  102.         begin
  103.         case oldn of
  104.            0: sp0:=stackptr;
  105.            1: sp1:=stackptr;
  106.            2: sp2:=stackptr;
  107.            end{case};
  108.         schedule;
  109.         oldn:=nextn;
  110.         case nextn of
  111.         0: sp:=sp0;
  112.         1: sp:=sp1;
  113.         2: sp:=sp2;
  114.         end{case};
  115.         if sp<>0 {initialized}
  116.         then begin
  117.           stackptr:=sp;
  118.              end
  119.         else {not initialized}
  120.              begin
  121.              writeln('Starting task #',nextn);
  122.              case nextn of
  123.              1: task1;
  124.              2: task2;
  125.              end{case};
  126.              end;
  127.      end{defer};
  128. begin{main}
  129. initall;
  130. writeln('Multitasking version of simple terminal program');
  131. writeln('Control-C will terminate it');
  132. writeln;
  133. defer;
  134. writeln('Main: done');
  135. end.
  136.  
  137.  
  138. {task #1: keyboard -> fifo1
  139.  task #2: fifo1    -> filter -> fifo2
  140.  task #3: fifo2    -> slow display    }
  141. program main;
  142. const   TASKS=3;
  143.         STACKSIZE=20;
  144.         NFIFOS=2;{#1 is for input and #2 for output}
  145.         PRATE=300;{SLOWs the display function}
  146. {the following three constants are for the Kaypro Computer}
  147.         KDATA=5; KSTAT=7; RMASK=1;
  148.         CR=13;
  149.         LF=10;
  150.         CC=3;
  151.         BS=8;
  152.         RUB=127;
  153.         SPACE=32;
  154.         CQ=17;{XON}
  155.         CS=19;{XOFF}
  156. type    stack = array[0..STACKSIZE] of integer;
  157.         fifo = record
  158.                buf: array[0..255] of byte;
  159.                inptr: byte;
  160.                outptr: byte;
  161.                flow: boolean;{for flow control}
  162.                end;
  163.         fifon = 1..NFIFOS;
  164.         tasknum = -1.. TASKS;
  165. var     sp0,sp1,sp2,sp3: integer;{when zero, task not initialized}
  166.         oldn: tasknum;
  167.         nextn: tasknum;
  168.         fifos: array[1..NFIFOS] of fifo;
  169. Procedure defer; forward;
  170. function occupancy(p: fifon):byte;
  171.          begin with fifos[p] do
  172.          occupancy:= inptr-outptr;
  173.          end;
  174. function vacancy(p: fifon): byte;
  175.          begin with fifos[p] do
  176.          vacancy:=outptr-inptr-1;
  177.          end;
  178. function dequeue1: byte;
  179.          begin with fifos[1] do
  180.          begin
  181.          while (occupancy(1)=0) or not flow
  182.                do defer;
  183.          dequeue1:= buf[outptr];
  184.          outptr:=outptr+1;
  185.          end;
  186.          end;
  187. function dequeue2: byte;
  188.          begin with fifos[2] do
  189.          begin
  190.          while (occupancy(2)=0) or not flow
  191.                do defer;
  192.          dequeue2:= buf[outptr];
  193.          outptr:=outptr+1;
  194.          end;
  195.          end;
  196. procedure exit;
  197.           begin
  198.           writeln('JOB #',oldn,' terminated.');
  199.           oldn:=-1;
  200.           defer;
  201.           end;
  202. procedure enqueue1(b:byte);
  203.           begin with fifos[1] do
  204.           begin
  205.           buf[inptr]:=b;
  206.           while vacancy(1)=0 do
  207.              defer;{hang while full}
  208.           inptr:=inptr+1;
  209.           end;
  210.           end;
  211. procedure enqueue2(b:byte);
  212.           begin with fifos[2] do
  213.           begin
  214.           buf[inptr]:=b;
  215.           while vacancy(2)=0 do
  216.              defer;{hang while full}
  217.           inptr:=inptr+1;
  218.           end;
  219.           end;
  220. function keyin:byte;
  221.          begin
  222.            repeat until (RMASK = (RMASK and port[KSTAT]));
  223.            keyin:= port[KDATA];
  224.          end;
  225. procedure vout(b:byte);
  226.           begin
  227.           bdos(6,b);
  228.           end;
  229. Procedure print;{task#3}
  230. var       mystack: stack;
  231.           i: integer;
  232.           begin
  233.           stackptr:=addr(mystack[STACKSIZE]);
  234.           i:=0;
  235.           {initialize fifo#2}
  236.           with fifos[2] do
  237.                begin
  238.                outptr:=0;
  239.                inptr:=0;
  240.                flow:=true;
  241.                end;
  242.           repeat
  243.             i:=i+1;
  244.             if i=PRATE then
  245.                begin
  246.                i:=0;
  247.                vout(dequeue2);
  248.                end
  249.             else
  250.                defer;
  251.           until false;{forever}
  252.           exit;
  253.           end;
  254. Procedure keyboard;{task #1}
  255. var       mystack: stack;
  256.           cb: byte;
  257.           begin
  258.           stackptr:=addr(mystack[STACKSIZE]);
  259.           {initialize fifo #1}
  260.           with fifos[1] do
  261.                begin
  262.                inptr:=0;
  263.                outptr:=0;
  264.                flow:=true;
  265.                end;
  266.           repeat
  267.             if (1 = (1 and port[KSTAT]))
  268.             then
  269.               begin
  270.               cb:= port[KDATA];
  271.               enqueue1(cb);
  272.               end
  273.             else defer;
  274.           until false{forever};
  275.           exit;
  276.           end;
  277. Procedure filter;{task #2}
  278. var       mystack: stack;
  279.           b: byte;
  280.           begin
  281.           stackptr:=addr(mystack[STACKSIZE]);
  282.           repeat
  283.             b:=dequeue1;
  284.             case b of
  285.             CR: begin
  286.                 enqueue2(CR);
  287.                 enqueue2(LF);
  288.                 end;
  289.             LF: {ignore};
  290.             CC: exit;
  291.             BS,RUB:
  292.                begin
  293.                enqueue2(BS);
  294.                enqueue2(SPACE);
  295.                enqueue2(BS);
  296.                end;
  297.             CQ: fifos[2].flow:=true;
  298.             CS: fifos[2].flow:=false;
  299.             else enqueue2(b);
  300.             end{case};
  301.           until false;{forever!}
  302.           exit;
  303.           end;
  304. procedure initall;
  305. var       i: integer;
  306.           Begin
  307.           sp1:=0;
  308.           sp2:=0;
  309.           sp3:=0;
  310.           oldn:=0;
  311.           end;
  312. Procedure schedule;
  313.           begin
  314.           if oldn=TASKS then nextn:=1
  315.           else nextn:=oldn+1;
  316.           end;
  317. procedure defer;
  318. var sp: integer;
  319.           begin
  320.            case oldn of
  321.            0: sp0:=stackptr;
  322.            1: sp1:=stackptr;
  323.            2: sp2:=stackptr;
  324.            3: sp3:=stackptr;
  325.            end{case};
  326.         schedule;
  327.         oldn:=nextn;
  328.         case nextn of
  329.         0: sp:=sp0;
  330.         1: sp:=sp1;
  331.         2: sp:=sp2;
  332.         3: sp:=sp3;
  333.         end{case};
  334.         if sp<>0 {initialized}
  335.         then begin
  336.           stackptr:=sp;
  337.              end
  338.         else {not initialized}
  339.              begin
  340.              case nextn of
  341.              1: keyboard;
  342.              2: filter;
  343.              3: print;
  344.              end{case};
  345.              end;
  346.      end{defer};
  347. begin{main}
  348. initall;
  349. writeln('<Demonstration of multitasking with queues (FIFOs)>');
  350. writeln;
  351. writeln('Control-S stops output (you can still type ahead!)');
  352. writeln('Control-Q restarts output (you can see what you have typed ahead)');
  353. writeln('RUB or BACKSPACE will "undo" on screen the last letter');
  354. writeln('Control-C terminates this program');
  355. writeln;
  356. defer;
  357. writeln('main: done');
  358. end.
  359.  
  360.