DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »algmovetx   «

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

TextFile

mode list.yes
algmove=algol connect.no rts.algftnrts
begin
  zone    array z (2, 42 * 128, 2, stderror);
  integer       result, status, i, hwds, sumsegs, segments, size, outkind;
  integer array entry (1:10), zdescr (1:20), sdescr (1:12);
  long    array la (1:2);
  integer field kind, file, block;
  long    array field docname;

  procedure blpr (z, s, b);
  zone            z       ;
  integer            s, b ;
  begin 
    integer             i;
    long    array field name;
    integer array       zdescr (1:20), ia (1:10);

    name := 2;

    getzone6 (z, zdescr);

    write (out,
    "nl", 1, <:zone.name     : :>, zdescr.name,
    "nl", 1, <:status        : :>, s,
    "nl", 1, <:halfs xferred : :>, b);

    system (14, 0, ia);

    write (out,
    "nl", 1, <:answer : :>);

    for i := 1 step 1 until 8 do
      write (out, 
      "nl", 1, <:answer (:>, i, <:) : :>, ia (i));

    if s extract 1 = 1 then 
      stderror (z, s, b);

  end blpr;

  kind  := docname := 2;
  file  := 14;
  block := 16;

  if system (4, 0, la) <> 2 shift 12 + 10 then
     system (9, 0, <:<10>param:>);

  open  (z (1), 0, la, 0);
  close (z (1), true);

  if monitor (42, z (1), i, entry) <> 0 then
    system (9, 0, <:<10>unknown:>);

  outkind := size := entry.kind;

  if size < 0 then
    open (z (1), entry.kind extract 23, entry.docname, 0)
  else
    open (z (1), 4                    , la           , 0);

  if setposition (z (1), entry.file, entry.block) then
    stopzone (z (1), false);

  if system (4, 2, la) <  4 shift 12 + 10 then
     system (9, 2, <:<10>param:>);

  open  (z (2), 0, la, 0);
  close (z (2), true);

  if monitor (42, z (2), i, entry) <> 0 then
    system (9, 2, <:<10>unknown:>);

  size := entry.kind;

  if size < 0 then
    open (z (2), entry.kind extract 23, entry.docname, 0)
  else
    open (z (2), 4                    , la           , 0);

  if setposition (z (2), entry.file, entry.block) then
    stopzone (z (2), false);

  sumsegs := 0;

  for hwds := inrec6 (z (2), 0) while hwds > 2 do
  begin
    inrec_6 (z (2), hwds);
    outrec6 (z (1), hwds);
    tofrom  (z (1), z (2), hwds);

    segments := hwds shift (-9);
    sumsegs := sumsegs + segments;
  end;

  close (z (1), true);
  close (z (2), true);

  if outkind >= 0 then
  begin
    i := monitor   (42, z (1), 0, entry);
    if i <> 0 then
      system (9, i, <:<10>lookup:>);
    entry (1) := sumsegs;
    i:= monitor   (44, z (1), 0, entry);
    if i <> 0 then
      system (9, i, <:<10>change:>);
  end;

  write (out,
  "nl", 1, <:segments read : :>, sumsegs);
end;
▶EOF◀