DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »sevaxtx     «

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

TextFile

mode list.yes

movevax=algol connect.no list.yes survey.yes blocks.yes
begin
      procedure  blpr (z, s, b);
      zone             z;
      integer             s, b;
        if s extract 1 = 1 then
          stderror (z, s, b);

      integer       i, j, hwds, chars, pos, startpos, endpos, char, sepleng,
                    par, result;
      integer array zdout, zdin (1:20), tab (0:255), ia (1:10);
      long          noplchar, no_of_lines, no_of_chars;
      long    array param, inname, outname, docname (1:2), line (1:14);
      real          shcl;
      zone          inz (768, 1, blpr), outz (128, 1, stderror);

      trapmode := 1 shift 10;

      no_of_lines := no_of_chars := 0;

      par := 0;
      sepleng := system (4, par, outname);

      par := par + 1;
      sepleng := system (4, par, param);

      if sepleng <> 6 shift 12 + 10 then
      begin
        write (out, 
        "nl", 1, <:***:>, outname, <: no outfile param:>, "nl", 1);
        goto slut;
      end;
      
      par := par + 1;
      sepleng := system (4, par, inname);

      if sepleng <> 4 shift 12 + 10 then
      begin
        write (out,
        "nl", 1, <:***:>, param, <: no infile param:>, "nl", 1);
        goto slut;
      end;

      result  := 21 shift 1;

      fpproc (28, result, outz, outname);

      if result > 0 then
      begin
        write (out,
        "nl", 1, <:***:>, param, <: connect out error :>, case result of (
        <:no resources:>    , <:malfunction:>, <:not user/non-exist:>,
        <:convention error:>, <:not allowed:>, <:name format error:>    ),
        "nl", 1);
        goto slut;
      end;

      setblpr (outz, stderror);

      getzone6 (outz, zdout);
      zdout    (10) :=    0 ; <*give up mask*>
      setzone6 (outz, zdout);

      check (outz);

      fpproc (27, result, inz, inname);

      if result > 0 then
      begin
        write (out,
        "nl", 1, <:***:>, param, <: connect in  error :>, case result of (
        <:no resources:>    , <:malfunction:>, <:not user/non-exist:>,
        <:convention error:>, <:not allowed:>, <:name format error:>    ),
        "nl", 1);
        goto slut;
      end;

      setblpr (inz, blpr);

      getzone6 (inz, zdin);
      zdin (10) := 1 shift 7; <*give up mask*>
      zdin (14) := zdin (19); <*rec base := base buf area*>
      zdin (15) := zdin (19) + 4 * zdin (20); <*last half*>
      setzone6 (inz, zdin);

      check (inz);

      getzone6 (outz, zdout);
      getzone6 ( inz, zdin );

      for i := 1, 2 do
        docname (i) := extend zdout (2*i) shift 24 + zdout (2*i+1);

      open (outz, zdout (1), docname, 0);

      if zdout (1) extract 12 = 18 then
        setposition (outz, zdout (7), zdout (8));

       for i := 1, 2 do
        docname (i) := extend zdin (2*i) shift 24 + zdin (2*i+1);

      open (inz , zdin  (1), docname , 1 shift 7);

      if zdin (1) extract 12 = 18 then
        setposition (inz, zdin (7), zdin (8));

      for i := readchar (inz, char) while
               char <> 25 do
        outchar (outz, char);

      outchar (outz, 'em');

      getzone6 (outz, zdout);

      if zdout (1) extract 12 = 4 then
      begin <*area, cut down and set shortclock*>
        monitor (42) lookup entry :(outz, 0, ia);
        systime (7, 0, shcl);
        ia (6) :=      shcl ; <*shortclock*>
        ia (1) := zdout (9) ; <*segments  *>
        monitor (44) change entry :(outz, 0, ia);
      end <*area*>;

      close (outz, false );
      close (inz , false);
  slut:
end

end
▶EOF◀