module impiocp;

exports
imports stream from stream;
 procedure ioinit;
 procedure openin(s:integer;var filename:pathname);
 function instrm:integer;
 procedure closein(s:integer);
 procedure openout(s:integer;var filename:pathname);
 function outstrm:integer;
 procedure closeout(s:integer);
 function iocpp(ep,n,x:integer):integer;
 exception streamerror(s:integer);
 exception openerror(s:integer);
 exception closeerror(s:integer);
 exception eoferror(s:integer);
 exception iocperror(ep:integer);
private

const
 maxstreams=3;
type
 streamno=0..maxstreams;
 streamtable=array[streamno] of filetype;
 streamdeftab=array[streamno] of boolean;
var
 ins,outs:streamtable;
 insdef,outsdef:streamdeftab;
 curins,curouts:streamno;
 
procedure ioinit;
var
 i:streamno;
 console:pathname;
begin
  console:='console:';
  streamopen(ins[0],console,0,8,true,false);
  insdef[0]:=true;
  curins:=0;      {set current input to console}
  streamopen(outs[0],console,0,8,true,true);
  outsdef[0]:=true;
  curouts:=0;     {set current output to console}
  for i:=1 to maxstreams do
    begin insdef[i]:=false ; outsdef[i]:=false end;
end;

procedure openin(s:integer;var filename:pathname);
begin
  if (s<1) or (s>maxstreams) then raise streamerror(s);
  if insdef[s]=true then raise openerror(s);
  streamopen(ins[s],filename,0,8,false,false);  {not charfile, not openwrite}
  insdef[s]:=true;
end;

function instrm:integer;
begin
 instrm:=curins;
end;

procedure closein(s:integer);
begin
  if (s<1) or (s>maxstreams) then raise streamerror(s);
  if insdef[s]=false then raise openerror(s);
  streamclose(ins[s]);
  insdef[s]:=false;
  if s=curins then curins:=0;
end;

procedure openout(s:integer;var filename:pathname);
begin
  if (s<1) or (s>maxstreams) then raise streamerror(s);
  if outsdef[s]=true then raise openerror(s);
  streamopen(outs[s],filename,0,8,false,true);  {not charfile, openwrite}
  outsdef[s]:=true;
end;

function outstrm:integer;
begin
  outstrm:=curouts;
end;

procedure closeout(s:integer);
begin
  if (s<1) or (s>maxstreams) then raise streamerror(s);
  if outsdef[s]=false then raise openerror(s);
  streamclose(outs[s]);
  outsdef[s]:=false;
  if s=curins then curins:=0;
end;

function iocpp(ep,n,x:integer):integer;
type 
 str255=string[255];
 pstr=^str255;
const
 nul=0; nl=10;
var
 strp:pstr;
 i:integer;

procedure printsym(sym:integer);
begin
  with outs[curouts],flag do begin
    if sym=nl then begin
      if noisech<>nul then begin
        element.c:=chr(noisech);    {usually CR}
        putc(outs[curouts]);
      end;
      if eolch<>nul then begin
        element.c:=chr(eolch);    {usually LF}
        putc(outs[curouts]);
      end;
    end else begin
      element.c:=chr(sym);
      putc(outs[curouts]);
    end;
  end;
end;

begin
case ep of

1 {read symbol}, 2{next symbol}, 4{read ch}:
  begin
    with ins[curins],flag do begin
      if not charready then getc(ins[curins]);
      if feof then raise eoferror(curins);
      if ep=1 then charready:=false;  {leave charready true for next sym}
      i:=ord(element.c);
      if feoln then i:=nl;
    end;
    iocpp:=i;
  end;

3 {print symbol},5 {print ch}:
  begin
    printsym(n);
    iocpp:=0;
  end;

7 {print string},15 {clean print string}:
  begin
    strp:=makeptr(x,n,pstr);    {turn params into a string pointer}
    for i:=1 to length(strp^) do printsym(ord(strp^[i]));
    iocpp:=0;
    end;
        
8 {select input}:
  begin
    if (n<0) or (n>maxstreams) then raise streamerror(n);
    if insdef[n]=false then raise openerror(n);
    curins:=n;
    iocpp:=0;
  end;
  
9 {select output}:
  begin
    if (n<0) or (n>maxstreams) then raise streamerror(n);
    if outsdef[n]=false then raise openerror(n);
    curouts:=n;
    iocpp:=0;
  end;
  
17 {print symbol n times}:
  begin
    for i:=1 to shift(n,-8) do printsym(land(n,255));
    iocpp:=0;
  end;
  
otherwise:begin
    raise iocperror(ep);
  end;
end;
end.