DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »sensedisctx «

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »sensedisctx « 

TextFile

mode list.yes
sensedisc=algol survey.yes
begin
  integer             sh;
  long    array       param, progname (1:2);

  sh := 5; <*default*>

  system (4, 0, progname);

  if system (4, 1, param) = 4 shift 12 + 4 then
    sh := param (1);

  begin
    zone                z (1, sh, stderror);
    integer             i, result;
    integer array       tail (1:10), shdescr (1:12), answer (1:8);

    for i := 1 step 1 until 10 do
      tail (i) := 0;

    tail (1) := tail (2) := 1;

    open  (z, 0, <::>, 0);
    
    result := monitor (40) create entry :(z, 1, tail);

    if result <> 0 then
    begin
      write (out,
      "nl", 1, <:***:>, progname, <: create entry, result = :>,
      case result of (
      <:...:>,
      <:catalog i/o error:>,
      <:name conflict:>,
      <:claims exceeded:>,
      <:bases:>,
      <:name format illegal:>,
      <:maincat not present:>));

      goto slut;
    end;

    result := monitor (52) create area process :(z, 1, tail);
    if result <> 0 then
    begin
      write (out,
      "nl", 1, <:***:>, progname, <: create area process, result = :>,
      case result of (
      <:area claims exceeded:>, 
      <:catalog i/o error:>,
      <:entry not found:>,
      <:entry not an area:>,
      <:name format illegal:>));

      goto remove;
    end;

    for i := 1 step 1 until sh do
    begin
      getshare6 (z, shdescr, i);
      shdescr   (4) := 0; <*sense*>
      setshare6 (z, shdescr, i);

      monitor (16, z, i, answer);
    end;

    i := 1;

    repeat
      i := increase (i);
      if i > sh then
        i := 1;

      monitor (18, z, i, answer);

      if answer (1) <> 0 then
        stderror (z, answer (2), answer (1));

      monitor (16, z, i, answer);
    until false;

remove:
    result := monitor (48, z, 1, tail);
    if result <> 0 then
      write (out,
      "nl", 1, <:***:>, progname, <:remove entry, result = :>,
      case result of (
      <:...:>,
      <:catalog i/o error:>,
      <:entry not found:>,
      <:entry protected:>,
      <:in use:>,
      <:name format illegal:>,
      <:maincat not psesent:>));

slut:
    close (z, true);
  end;
end;
▶EOF◀