PROGRAM uudecode_vms (INPUT,OUTPUT,INFILE,OUTFILE);

{       Original source pilfered from the MS-DOS turbo version on SIMTEL20 }
{       Converted from Turbo to Vax-Pascal by Erik Olson, Harvey Mudd College }
{       (EOLSON@HMCVAX.BITNET) (eolson@muddcs.UUCP) 10/86 }
{       Corrected small bug for End of file -  10/15/86 eol}
{       6-Aug-90  Bruce R. Mitchell  WNIMHACK%WSU.DECNET@MSUS1.BITNET      }
{                 Major rewrite of GetNextHunk to make it work under VMS   }
{                 Added (subsequently commented out) debugging print stmts }
{                 Added variable length output records within Pack_128     }

        CONST offset = 32;

        TYPE string80 = varying[80] of char;
             pack_128 = packed array[1..128] of char;

        VAR infile: text;
            ORecByteCount: Integer;
            outfile: file of pack_128;
            lineNum: integer;
            line: string80;
            outidx : integer;
            outbuf : pack_128;









        PROCEDURE Writebin(ch : char);

        BEGIN
          IF outidx = ORecByteCount THEN
          BEGIN
            WRITE(outfile,outbuf);
            Outidx := 1;
          END
          ELSE outidx := outidx + 1;
        Outbuf[outidx] := ch;
        END;









  procedure Abort(message: string80);

    begin {abort}
      writeln;
      if lineNum > 0 then write('Line ', lineNum, ': ');
      writeln(message);
    end; {Abort}










        PROCEDURE NextLine(VAR S: String80);

        BEGIN
          LineNum := SUCC(LineNum);
          IF linenum MOD 50 = 0 THEN WRITELN('Line ', LineNum);
          READLN(Infile, S);
          { WRITELN(Linenum, ' <', S, '>'); }
        END;









        Procedure Init;

    procedure GetInFile;

      VAR infilename: string80;

      begin {GetInFile}
        write('_File: ');
        readln(infilename);
        open(infile,infilename,history := old);
        reset(infile);
        writeln ('Decoding '+infilename)
      end; {GetInFile}

    procedure GetOutFile;

      var header, mode, outfilename: string80;
          ch: char;

      procedure ParseHeader;

        VAR index: integer;

        Procedure NextWord(var word:string80; var index: integer);

          begin {nextword}
            word := '';
            while header[index] = ' ' do
              begin
                index := succ(index);
                if index > length(header) then abort ('Incomplete header')
              end;
            while header[index] <> ' ' do
              begin
                word := word+header[index];
                index := succ(index)
              end
          end; {NextWord}

        begin {ParseHeader}
          header := header+' ';
          index := 7;
          NextWord(mode, index);
          NextWord(outfilename, index)
        end; {ParseHeader}

      begin {GetOutFile}
        if eof(infile) then abort('Nothing to decode.');
        NextLine (header);
        while not ((substr(header,1,6) = 'begin ') or eof(infile)) do
          NextLine(header);
        writeln;
        if eof(infile) then abort('Nothing to decode.');
        ParseHeader;
        open(outfile, outfilename,history := new);
        writeln ('Destination is ', outfilename);
        rewrite (outfile);
      end; {GetOutFile}

        BEGIN {init}
          lineNum := 0;
          GetInFile;
          GetOutFile;
          ORecByteCount := 0;
          WHILE ((ORecByteCount < 1) OR (ORecByteCount > 128)) DO
          BEGIN
            WRITE('_Bytes per output record (usually 128) [1.-128.] : ');
            READLN(ORecByteCount);
          END;
        END; { init}

  Function CheckLine: boolean;

    begin {CheckLine}
      if line = '' then abort ('Blank line in file');
      CheckLine := not (line[1] in [' ', '`'])
    end; {CheckLine}


  procedure DecodeLine;

    VAR lineIndex, byteNum, count, i: integer;
        chars: array [0..3] of integer;
        hunk: array [0..2] of  integer;
        Loser: Char;

    function nextch: char;

      begin {nextch}
        lineIndex := succ(lineIndex);
        if lineIndex > length(line) then abort('Line too short.');
        if not (line[lineindex] in [' '..'`'])
          then abort('Illegal character in line.');
        if line[lineindex] = '`' then nextch := ' '
                                  else nextch := line[lineIndex];
        { Writeln ('Nextch is <', line[lineindex], '>'); }
      end; {nextch}

        PROCEDURE GetNextHunk;

{       This procedure converts 4 printable ASCII characters in the input }
{       stream into 3 bytes [0.:255.]                                     }

        VAR i: integer;

        BEGIN {GetNextHunk}
{         Get next 4 characters, convert them to [0:(255.-OFFSET)], and store }
          FOR i := 0 TO 3 DO chars[i] := ORD(nextch) - offset;
{         Calculate each byte from the input characters }
{         NOTE WELL:  We are trying to generate BYTES here.  That means 8 BITS!}
{                     All the output hunks must be made modulo 256 to prevent  }
{                     overflow of the 8-bit output space!                      }
          hunk[0] := ((chars[0] * 4) + (chars[1] DIV 16)) MOD 256;
          hunk[1] := ((chars[1] * 16) + (chars[2] DIV 4)) MOD 256;
          hunk[2] := ((chars[2] * 64) + chars[3]) MOD 256;
          { WRITELN ('Bytes 0, 1, 2 are ', hunk[0], hunk[1], hunk[2]); }
          ByteNum := 0
        END; {GetNextHunk}

        BEGIN {DecodeLine}
          lineIndex := 0;
          byteNum := 3;
          Count := Ord(Nextch) - Offset;
          { WRITELN ('Decoding ', Count, ' bytes to output'); }
          FOR i := 1 TO count DO
          BEGIN
            IF byteNum = 3 THEN GetNextHunk;
            Writebin (CHR(hunk[byteNum]));
            ByteNum := SUCC(byteNum);
          END;
        END; {DecodeLine}

  procedure terminate;

    var trailer: string80;

    begin {terminate}
      if eof(infile) then abort ('Abnormal end.');
      NextLine (trailer);
      if length (trailer) < 3 then abort ('Abnormal end.');
      if substr (trailer, 1, 3) <> 'end' then abort ('Abnormal end.');
    write(outfile,outbuf);
      close (infile);
      close (outfile)
    end;

  begin {uudecode}
    init;
    NextLine(line);
    while CheckLine do
      begin
        DecodeLine;
        NextLine(line)
      end;
    terminate
  end.