DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »tstopjob«

└─⟦a41ae585a⟧ Bits:30001842 SW-save af projekt 1000, Alarm-system
    └─⟦72244f0ef⟧ 
        └─⟦this⟧ »tstopjob« 

TextFile

job oer 4 200 time 11 0 size 100000 area 10
(
source = copy 25.1
tstoplst = set 1 disc1
tstoperr = set 1 disc1
tstoplst = indent source mark lc
listc=cross tstoplst
o tstoperr
message compile tstop
pascal80 codesize.1024 alarmenv source
mode list.no
o c
lookup pass6code
if ok.yes
(tstopbin=set 1 disc1
tstopbin=move pass6code
scope user tstopbin
)
tstoplst=copy listc tstoperr
scope user tstoplst
scope user tstoperr
finis output.no
)
process testoutput (insem, opsem: sempointer);

  (*The process spools output sent to >insem< and outputs it to >opsem<,
    presumable the operator, on request herefrom, i.e. answer to a read*)

const
version = "vers  1.02 /";
  var
    full      :  sempointer;
     full_sem : semaphore;
    inp, outp:   shadow;
z: zone;
k : integer;

\f


  process input (insem, full: sempointer);

    const
      n = 20 (*No of lines spooled*);
    type
      char4 = array (1..4) of char;
      shortline = record
        first, last, next: integer;
        userstuff:         array (6..35) of char;
        spooler_mark:      char4;
        newline:           char
        end;
    var
      p:            pool 2*n of shortline;
      free:         semaphore;
      refi, refo:   reference;
      j,k,
      curr_mark:    integer:=                0;


    function mark: char4;
      var
        i:   1..4;
        no:  integer;
      begin
      no:= curr_mark;
      for i:= 4 downto 1 do
        begin
        mark(i):= chr (no mod 10 + ord ('0'));
        no:= no div 10
        end;
      curr_mark:= succ (curr_mark) mod 10000
      end (*mark*);

\f


    begin
    while openpool (p) do
      begin
      alloc (refo, p, free);
      return (refo)
      end;

    repeat
      wait (refi, insem^);
      if open (free) then
        sensesem (refo, free)
      else
        wait (refo, full^);
      lock refi as i: shortline do
        lock refo as o: shortline do with o do
          begin
          o:= i;
          for j:= last to 35 do
            userstuff(j):= ' ';
          last:= 35+4+1;
          newline:= chr (10);
          spooler_mark:= mark
          end;
      return (refi);
      signal (refo, full^)
    until false
    end (*input*);
\f


  process output (outsem, full: sempointer);
    type
      shortline = record
                    first, last, next: integer;
                    info: array (6..35+4+1) of char
                    end;
      buffertype = record
        info:       shortline;
        filler:     array (35+4+1+1..97) of char
        end;

    var
      copy,
      ref:  reference;
out_sem,
      answer,
      att:  semaphore;
      buf:  pool 1+2 of buffertype;
      i:    integer := 10;

    begin
    alloc (ref, buf, att);

    ref^.u1:= 1 (*read*);

    lock ref as b: buffertype do with b, info do
      begin
      first:= 6+alfalength; last:= 97;
      info:= 't         '
      end;

    signal (ref, outsem^);

    while openpool (buf) do
      begin
      alloc (ref, buf, answer);
      ref^.u1:= 2 (*write*);
      return (ref)
      end;

while (i<>0) do
begin
wait( copy, full^);
wait(  ref, answer);
lock ref as r : buffertype do
lock copy as c : shortline do
r.info := c;
signal( ref, outsem^);
return( copy);
i:= pred(i);
end;

    repeat
i := 20;

      wait (ref, att);

      signal (ref, outsem^);

while open( full^) and (i<>0) do
begin
i:= pred(i);
wait( ref, full^);
signal( ref, out_sem);
end;

i := 20;

      while open (out_sem) and (i <> 0) do
        begin
        i:= pred (i);
        wait (copy, out_sem);
        wait (ref, answer);
        lock ref as r: buffertype do
          lock copy as c: shortline do
            r.info:= c;
        return (copy);
        signal (ref, outsem^)
        end
    until false
    end (*output*);
\f


  begin
testopen(z,own.incname,opsem);
testout(z,version,0);
full := ref( full_sem);
k:=
    create ('spooler inp',
            input (insem, full),
inp, 300);
if k<>0 then testout(z,"createerr in", k);
k:=
    create ('spooler outp',
            output (opsem, full),
outp, 300);
if k<>0 then testout(z,"createerr ou", k);

  start (inp, stdpriority);
  start (outp, stdpriority)
  end (*spooler*).
▶EOF◀