{*-------------------------------------------*
 | Pasmat - All Direct I/O is in this Module |
 *-------------------------------------------*}
{$K0}  {$K7}  {$K12}  {$K14}  {$K15}
module pmfileio;
 {$L-}
 {$I PMDEFS.INC}
 {$L+}

  var
    finp: file of packed array [0..ibufsize] of char;
    fout: text;

  external procedure @hlt;
   {check file name for legality}
  external function cpmname(str: string): boolean;
   {pasmat entry points}
  external procedure flushsymbol;
  external procedure newline(indent: lineindex);

{$p----------------------------*
 | Terminate and Print Message |
 *-----------------------------*}


  procedure finaldata;

    var
      fstatus: integer;

    begin  {print summary data}
      if not silentmode then
	begin
	if (overflows > 0) or (comoverflows > 0) then
	  writeln;
	writeln(inputline - 1: 1, ' lines input, ', currentline: 1,
		' lines output');
	if overflows = 1 then
	  writeln('Token too wide for output at output line ',
		  firstoverflow: 1)
	else if overflows > 1 then
	  writeln('Token too wide for output in ', overflows: 1,
		  ' places, first at output line ', firstoverflow: 1);
	if comoverflows = 1 then
	  writeln('Comment too wide for output at output line ',
		  firstcomoverflow: 1)
	else if comoverflows > 1 then
	  writeln('Comment too wide for output in ', comoverflows: 1,
		  ' places, first at output line ', firstcomoverflow:
	   1);
	end;
      close(fout, fstatus);
      if fstatus = 255 then
	writeln('Unable to close output file');
    end;  {finaldata}
{$p-----------------*
 | Character output |
 *------------------*}


  procedure writea(ch: char);

    var
      i: lineindex;

    begin  {Write a character to the output buffer. If necessary (which
	    it always is after the buffer is filled), write the
	    previous contents of the buffer}
      charcount := charcount + 1;
      oldest := charcount mod bufsize;
      with unwritten[oldest] do
	begin
	if charcount > bufsize then
	  if actionis = graphic then
	    write(fout, character)
	  else if actionis = spaces then
	    begin
	    for i := 1 to spacing do
	      write(fout, ' ');
	    end
	  else  {actionis = beginline}
	    begin
	    if outputline > 1 then  {not initial begin}
	      begin
	      writeln(fout);
	      end;
	    outputline := outputline + 1;
	    for i := 1 to spacing div tabinterval do
	      write(fout, chr(tab));
	    for i := 1 to spacing mod tabinterval do
	      write(fout, ' ');
	    end;
	actionis := graphic;
	character := ch;
	writecol := writecol + 1;
	if ch = chr(tab) then
	  writecol := writecol + tabinterval - (writecol mod
		      tabinterval);
	end;  {with}
    end;  {writea}


  procedure flushbuffer;

    var
      i: 0..bufsize;

    begin  {flush any unwritten buffer}
      for i := 1 to bufsize do
	writea(' ');
      charcount := 0;
      writeln(fout);
    end;  {flushbuffer}

{$P----------------*
 | Character Input |
 *-----------------*}


  procedure getchar;

    begin  {read next character from input file}
      repeat
	if endfile then
	  ch := chr($1A)
	else
	  ch := gnb(finp);
	if (ch = chr($1A)) or (ch = chr($FF)) then
	  begin  {eof}
	  ch := ' ';
	  endfile := true;
	  exit
	  end;  {eof}
	ch := chr(ord(ch) & $7F);  {strip hi bit}
      until ch <> chr($0A);  {skip over line feeds}
      if ch = chr($0D) then
	begin  {eoln}
	if newinputline then
	  blankline := true
	else
	  newinputline := true;
	column := 0;
	inputline := inputline + 1;
	if not formatting then
	  newline(0);
	ch := ' ';
	end  {eoln}
      else
	begin  {normal}
	column := column + 1;
	if not formatting then
	  writea(ch);
	if ch = chr(tab) then
	  column := column + tabinterval - (column mod tabinterval);
	end  {normal}
    end  {getchar} ;

{$p---------------*
 | Error Handling |
 *----------------*}


  procedure lineoverflow;

    begin  {token too long for output line, note it}
      flushbuffer;
      overflows := overflows + 1;
      if overflows = 1 then
	firstoverflow := currentline - 1;
      if not silentmode then
	begin
	writeln(' ');  {put following message on separate line}
	writeln('Warning - token too wide for output: ', 'input line ',
		inputline: 1, ', output line ', currentline - 1: 1);
	end  {not silentmode} ;
    end;  {lineoverflow}


  procedure comentoverflow;

    begin  {block comment too long for output line, note it}
      comoverflows := comoverflows + 1;
      if comoverflows = 1 then
	firstcomoverflow := currentline;
      if not silentmode then
	begin
	writeln(' ');  {put following message on separate line}
	writeln('Warning - comment too wide for output: ',
		'input line ', inputline: 1, ', output line ',
		currentline: 1);
	end  {not silentmode} ;
    end;  {comentoverflow}


  procedure abort(line: integer;
		  kind: abortkind);

   {the argument 'line' is not used in CP/M version}

    begin  {abort formatting}
      flushsymbol;
      newformatting := false;
      formatting := false;
      if not silentmode then
	begin
	writeln(' ');
	if kind = syntax then
	  writeln('Syntax error: input line ', inputline: 1,
		  ', output line ', currentline - 2: 1)
	else if kind = nesting then
	  writeln('Too many levels: input line ', inputline: 1,
		  ', output line', currentline - 1: 1)
	else
	  writeln('Bad comment: input line ', inputline: 1,
		  ', output line ', currentline - 1: 1);
	end  {not silentmode} ;
      writea(ch);
      while not endfile do
	getchar;
      flushbuffer;
      finaldata;
      @hlt;
    end;  {abort}

{$p-----------------------*
 | Get input/output files |
 *------------------------*}


  procedure getfiles;

    var
      name: string;
      ch: char;


    procedure gname;

      var
	i: integer;

      begin  {gname}
	name := '';
	i := 1;
	while (i <= length(clinearg)) and (clinearg[i] = ' ') do
	  i := i + 1;  {skip leading blanks}
	while (i <= length(clinearg)) and (clinearg[i] <> ' ') do
	  begin  {copy up to next blank}
	  ch := clinearg[i];
	  i := i + 1;
	  if ch in ['a'..'z'] then
	    ch := chr(ord(ch) - $20);  {ensure upper case}
	  name := concat(name, ch);
	  end;
	if i > 1 then  {remove name}
	  delete(clinearg, 1, i - 1);
      end  {gname} ;


    procedure usage(str: string);

      begin  {print error message and abort}
	writeln(str);
	writeln('Usage:  pasmat infile outfile options');
	@hlt
      end  {usage} ;

    begin  {getfiles}
      gname;
      assign(finp, name);
      reset(finp);
      if ioresult = 255 then
	usage(concat('Unable to open ', name, ' for input'));
      gname;
      if not cpmname(name) then
	usage(concat('Illegal CP/M name: ', name));
      assign(fout, name);
      rewrite(fout);
      if ioresult = 255 then
	usage(concat('Unable to open ', name, ' for output'));
    end;  {getfiles}

modend .
