DataMuseum.dk

top - metrics - download

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

└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
    └─⟦6b41451d2⟧ 
        └─⟦this⟧ »tserver« 

TextFile

server=algol index.no ; server process
begin 
  integer factor, irrel, home, server;
  boolean test;
  algol copy.netparams;

  test  := parameter(<:test:>, 0) > 0;
  server:= parameter(<:serv:>, 1);
  factor:= parameter(<:factor:>, 10);

  begin
    zone zin (buf_size//4*4,4,recv_error),
         zout(buf_size//4*1,1,send_error);

    zone clock(1,1, stderror);
    integer n, c, counts, count; real r;

    procedure send_error(z, s, b);
    zone z; integer s, b;
    begin
      if false add (s shift(-21)) then
      begin
        zone zz(1,1,ignore);
        long array field name;
        integer array zd(1:20), sd(1:12);
        integer f;
        getzone6(z,zd); name:= 2;
        open(zz, 2 shift 12 + 0, zd.name, 0); init(zz, 5);
        getshare6(zz, sd, 1);
        sd(8):= 1234567; <* illegal char count *>
        setshare6(zz, sd, 1);
        for f:= 16, 18 do monitor(f, zz, 1, sd);
      end;
      system(10,0,<:can't send anything!:>);
      goto restart;
    end;

    procedure recv_error(z, s, b);
    zone z; integer s, b;
    begin
      system(10,0,<:can't get anything!:>);
      goto restart;
    end;

    integer i, size, chars, out_chars;
    integer array in_data, out_data(1:buf_chars);

    boolean array cap(1:max_serv,
                      0:max_dist);
    integer serv, dist;

    procedure send_cap(cap) to:(zout);
    boolean array cap; zone zout;
    begin
      integer array data(1:buf_chars);
      integer serv, dist, chars;

      fill(data) with:(0);
      data.routing_mode:= inform;
      data.cur         := 1;

      chars:= header_chars;
      for serv:= 1 step 1 until max_serv do
      for dist:= 0 step 1 until max_dist do
      begin chars:= chars + 1;
        data(chars):= if cap(serv, dist) then 1 else 0;
      end;
      deliver(zout, data, chars);
  
    end;

    procedure deliver(z, data, chars); value chars;
    zone z; integer array data; integer chars;
    begin
      integer size;
      get(z, irrel);
      size:= pack_chars(z, data, chars);
      send(z, size);
    end;

    open(zin,  0, <:main35002:>, 0); init(zin,  3);
    open(zout, 0, <:main35002:>, 0); init(zout, 5);

    begin <* start clock *>
      integer array sd(1:12);
      open(clock, 0, <:clock:>, 0);
      getshare6(clock, sd, 1); sd(5):= 10;
      setshare6(clock, sd, 1);
      send(clock, 0);
    end;

    c:= count:= 0;
    counts:= parameter(<:counts:>,1);

    for serv:= 1 step 1 until max_serv do
    for dist:= 0 step 1 until max_dist do
     cap(serv, dist):= false;
    timing(<:init:>); from;

    home:= 0;
    cap(serv_a, home):= true;

    restart:  send_cap(cap) to:(zout);
              out_chars:= header_chars;

              fill(in_data) with:(0);
              fill(out_data)with:(0);

    repeat
      repeat
        send(zin, buf_size);

        while wait(n, zin, clock) and n = 2 do
        begin <* timer interrupt *>
          get(clock, 0-0-0); send(clock, 0);
          c:= (c+1) mod counts;
          if c = 0 then
          begin
            to;
            write(out, << zd dd dd>, systime(4, time_now, r), r,
                       << dddd>, cpu_time * 1000 / (if count = 0 then 1 else count),
                       << ddddd>, 0, count, 0, 
                       <:  data chars=:>, out_chars - header_chars, nl,1);
            setposition(out, 0, 0);
            count:= 0;
            from;
          end;
        end;

        get(zin, size);
        if size = 0 then goto restart;
        crack(zin, in_data, size);  chars:= size//2*3;
        if in_data.routing_mode = inform then goto restart;
      until in_data.routing_mode = new_request
         or in_data.routing_mode = next_request;

      <* prepare delivery of reply *>
      tofrom(out_data, in_data, header_chars * 2);
      out_data.routing_mode:= reply;
      out_data.cur:= out_data.cur + 1;
      out_data.addr(out_data.cur):= server;

      <* perform service-action on in_data, and produce out_data *>
      out_chars:= header_chars;
      for i:= header_chars + 1 step 1 until chars do
      begin
        out_chars:= out_chars + 1;
        out_data(out_chars):= in_data(i);
      end;

      count:= count + 1;

      if test then
      begin
        write(out, <:servicing trans no.:>, in_data.addr(1));
        write(out, <:, with service = :>, false add (64 + in_data.service_kind),1);
        write(out, nl,1);
        setposition(out, 0, 0);
      end;

      deliver(zout, out_data, (outchars-header_chars)*factor+header_chars);

    until false;
  end;
end 
▶EOF◀