DataMuseum.dk

top - metrics - download

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

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

TextFile

mode list.yes
readtape=algol survey.yes
begin
  integer             i, j, shares, segm, blocks, res, hwds;
  integer array       ia (1:20);
  integer       field mode, file, block, int;
  integer array field name;

  procedure bl (z, s, b);
  zone          z       ;
  integer          s, b ;
  begin
    integer file, block, i;
    integer array ia (1:20);
    
    if s extract 1 = 1 then stderror (z, s, b);

    if b = 0 then
    begin
      getzone6 (z, ia);
      getshare (z, ia, ia (17));
      if ia (4) shift (-12) extract 1 <> 0 then
      begin
        getposition (z, file, block);
        system (14, i, ia);

        write (out, "nl", 1, <:*** b = 0 !!! file = :>, 
        file, <:, block = :>, block,
        "nl", 1, "sp", 13, <:answ.file = :>, ia (4),
         <: , answ.block = :>, ia (5));
       
      end;
    end;
  end procedure bl;
  

  mode  :=  2;
  name  :=  2;
  file  := 14;
  block := 16;

  int   := 2;

  read (in, shares, segm, blocks);
  write    (out, "nl", 1,
   "nl", 1, <:shares = :>, shares,
   "sp", 4, <:segm   = :>, segm  ,
   "sp", 4, <:blocks = :>, blocks);
  stopzone (out, false);

  begin
    zone array z (2, buflengthio (2, shares, segm * 512), shares, bl);

    open (z (1), 0, <:t:>, 0);
    close (z (1), true);
    res := monitor (42, z (1), i, ia);
    if res <> 0 then
      system (9, res, <:<10>lookup t:>);
 
<*  write (out, << ddd>,
    "nl", 1, <:t     = :>, ia.mode shift (-12) extract 11, ia.mode extract 12,
    ia.name, ia.file, ia.block);
*>
    open (z (1), ia.mode, ia.name, 2);
    open (z (2), 0      , <:0pi:>, 0);
 
    setposition (z (1), ia.file, ia.block);
 
    check (z (1));

    openinout   (z, 1);
    expellinout (z, 2);

    for i := 1 step 1 until blocks do
    begin
      hwds := 
      inoutrec (z, 0);
      inoutrec (z, hwds);
      if hwds  > 2 then
      begin
        if hwds <> segm * 512 then
          write (out, "nl", 1, <:bloklængdefejl : block no : :>, i,
          <: , block field : :>, z (1).int, <: , bloklængde : :>, hwds);

        if i <> z (1).int then
          write (out, "nl", 1, <:bloknummerfejl : block no : :>, i,
          <: , block field : :>, z (1).int);

        if i mod 10 = 0 then
        begin
          stopzone (z (1), false);
          getposition (z (1), file, block);
          if i <> block then
            write (out, "nl", 1, <:bloknummerfejl : block no : :>, i,
            <: , block count : :>, block);

          i := i + shares - 1;

          closeinout (z);
          setposition (z (1), file, i + shares - 1);
          check (z (1));
          getposition (z (1), file, i);
          openinout (z, 1);
          expellinout (z, 2);
        end;

      end else
      begin
        write (out, "nl", 1, <:tape mark , block no : :>, i);
        i := blocks;
      end;
    end;
    
    closeinout (z);
    close (z (1), true);
    close (z (2), true);
  end;
end;
▶EOF◀