home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1986 / 03 / berglst1.mar next >
Text File  |  1986-03-31  |  3KB  |  136 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.