%begin                                   {Input P-Code Pascal from tape. ADC}
   %const %integer max = 2*13 
   %const %integer %array blocks(1:max) =
      -(1<<16+351),     (1<<16+6),
      -(20<<16+3840),   (3<<16+6),
      -(78<<16+3840),   (1<<16+486),
       (1<<16+6),      -(62<<16+3840),
       (1<<16+3794),    (1<<16+6),
      -(74<<16+3840),   (1<<16+2121),
       (1<<16+6),      -(1<<16+351),
       (1<<16+6),      -(20<<16+3840),
       (3<<16+6),      -(78<<16+3840),
       (1<<16+486),     (1<<16+6),
      -(62<<16+3840),   (1<<16+3794),
       (1<<16+6),      -(74<<16+3840),
       (1<<16+2121),    (1<<16+6)

   %external %routine %spec Claim Tape
   %external %routine %spec Release tape
   %external %routine %spec Read tape(%integer Buffer address, size)
   %external %routine %spec Writetape(%integer Buffer address, size)
   %external %integerfnspec Tape error   {Set after any tape operation}
   %external %routine %spec Rewind tape %alias "REWIND"
   %integer  %array B(1:1000)                {Tape buffer}
   %integer  File no, j, k, C, This
   %integer  Buffer, N blocks, Block size

   Buffer = Addr(B(1))
   %cycle
      Claim tape
      %exit %if Tape error = 0
      Print string("*Tape force released - retrying")
      Newline
      Release tape
   %repeat
   Rewind Tape

   File no = -1
   %for j = 1, 1, max %cycle
      This = blocks(j)

      %if this < 0 %start                {First block of a new file}
         This = -This                    {For unpacking}
         Select output(1);  Close output {Close previous file}
         File no = File no + 1
         Select output(0)
         Print string("File.");  write(File no, 0);  newline
         Open output(1, "File.".To string(File no+'0'))
      %finish

      N blocks   = This>>16              {Unpack code for this group of
      Block size = This&x'FFFF'          {blocks.
      Select output(0)
      Spaces(3)
      Write(N blocks, 0);  Print string(" block")
      Print symbol('s') %if N blocks # 1
      Write(Block size, 1);Print string(" bytes")
      Newline
      Select output(1)

      %for k = 1, 1, N blocks %cycle
         Read tape(Buffer, Block size)
         %continue %if Block size = 6    {Ignore labels}
         %if Tape error # 0 %start
            Select output(0)
            Print string("*Tape error ")
            Write(Tape error, 0)
            Newline
            Select output(1)
         %else
            %for C = Buffer, 1, Buffer + Block size - 1 %cycle
               Print symbol(Byte integer(C))
            %repeat
         %finish
      %repeat

   %repeat

   Select output(1)
   Close output                          {Close last file}
   Select output(0)
   Rewind tape;  Release tape
   Print string("*Input complete")
   Newline

%end %of %program