UNIT CC232;
INTERFACE
procedure restoreport(var comb);
function portinit(var comb; var com:integer; var baud:longint):integer;
function naf (var comb,n,a,f:integer; var data:longint; var xq:integer):integer;
IMPLEMENTATION
USES dos,crt;
TYPE
 clock_t=longint;
CONST
 DR=$F8;
 IE=$F9;
 II=$FA;
 LC=$FB;
 MC=$FC;
 LS=$FD;
 MS=$FE;

 COM1=$300;
 COM2=$200;

 LAST=$80;
 NEXT=$40;
 FIRST=$C0;

 OVERRUN=1;
 PARITY=2 ;
 FRAME=3  ;
 TIMEOUT=4;
 PRTCL=5  ;
VAR
 old_ie, old_ii, old_lc, old_mc, old_ls, old_ms, old_dl, old_dh:byte;

{------------------------------------------------------------------------}
function clock:longint;
begin
  clock=MEML[$0000:046C];
end;

function outrs(var comb:integer; var data:byte):integer;
var t0:longint;
begin
t0:=clock;
while( (port[comb+LS] and $20)=0 ) do
                if( (clock-t0) > 2 ) then begin
                                            outrs:=TIMEOUT;
                                            exit;
                                          end;
portw[comb+DR]:=data;
outrs:=0;
end;
{------------------------------------------------------------------------}
function inrs(var comb:integer; var data:byte ):integer;
var ic:integer;
    t0:longint;
begin
repeat
t0:=clock;
ic:=port[comb+LS];
while ( (ic and 1) = 0 ) do
           begin
           ic:=port[comb+LS];
           if( (clock-t0) > 2 ) then begin
                                       inrs:=TIMEOUT;
                                       exit;
                                     end;
           end;
data:=port[comb+DR];

if (ic and 2)<>0 then begin inrs:=OVERRUN; exit; end;
if (ic and 4)<>0 then begin inrs:=PARITY; exit; end;
if (ic and 8)<>0 then begin inrs:=FRAME; exit; end;
until  (data<>$40);
inrs:=0;
end;

{------------------------------------------------------------------------}
function naf (var comb,n,a,f:integer; var data:longint; var xq:integer):integer;
 var
   ic:integer;
   dd:byte;
begin
dd:=port[comb+MS];
dd:=port[comb+DR];
dd:=port[comb+LS];
ic:=outrs(comb,(n and $3F) OR FIRST);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=outrs(comb,a and $3F);
if (ic<>0) then begin naf:=ic; exit; end;

if( (f>=16) AND (f<24) ) then
      begin
         ic:=outrs(comb,f AND $3F);
         if (ic<>0) then begin naf:=ic; exit; end;
         ic:=outrs(comb,data AND $3F);
         if (ic<>0) then begin naf:=ic; exit; end;
         ic:=outrs(comb,(data SHR 6) AND $3F);
         if (ic<>0) then begin naf:=ic; exit; end;
         ic:=outrs(comb,(data SHR 12) AND $3F);
         if (ic<>0) then begin naf:=ic; exit; end;
         dd:=(data SHR 18) AND $3F{l};   {******************}
         ic:=outrs(comb,dd OR LAST);
         if (ic<>0) then begin naf:=ic; exit; end;
      end
      else begin
              ic:=outrs(comb,(f AND $3F) OR LAST);
              if (ic<>0) then begin naf:=ic; exit; end;
           end;


xq:=0;
ic:=inrs(comb,dd);
if (ic<>0) then begin naf:=ic; exit; end;
xq:=dd;
if ((xq AND LAST)=LAST) then begin naf:=0; exit; end;
ic:=outrs(comb,NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(comb,dd);
if (ic<>0) then begin naf:=ic; exit; end;

data:=dd AND $3F;
if ((dd AND LAST)=LAST) then begin naf:=0; exit; end;
ic:=outrs(comb,NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(comb,dd);
if (ic<>0) then begin naf:=ic; exit; end;
data:=data OR ((dd AND $3F) SHL 6);
if ((dd AND LAST)=LAST) then begin naf:=0; exit; end;
ic:=outrs(comb,NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(comb,dd);
if (ic<>0) then begin naf:=ic; exit; end;
data:=data OR ((dd AND $3F) SHL 12);
if ((dd AND LAST)=LAST) then begin naf:=0; exit; end;
ic:=outrs(comb,NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(comb,dd);
if (ic<>0) then begin naf:=ic; exit; end;
data:=data OR ((dd AND $3F) SHL 18);
if ((dd AND LAST)<>LAST) then begin naf:=PRTCL; exit; end;
naf:=0;
end;

{------------------------------------------------------------------------}
function portinit(var comb; var com:integer; var baud:longint):integer;
 VAR xq:integer;
     ic:integer;
     data:longint;
begin
if (com=2) then comb:=COM2
           else comb:=COM1;

old_ie:=port[comb+IE];
old_ii:=port[comb+II];
old_lc:=port[comb+LC];
old_mc:=port[comb+MC];
old_ls:=port[comb+LS];
old_ms:=port[comb+MS];
portw[comb+LC]:=$80;
old_dl:=port[comb+DR];
old_dh:=port[comb+IE];
portw[comb+DR]:=(trunc(115200/baud) AND $FF);
portw[comb+IE]:=((trunc(115200/baud) SHR 8) AND $FF);
portw[comb+LC]:=$1F;
portw[comb+IE]:=0;
portw[comb+MC]:=$B;
data:=0;
ic:=naf(0,0,16,data,xq);

portinit:=0;
end;
{------------------------------------------------------------------------}

procedure restoreport(var comb);
begin
portw[comb+LC]:=$80;
portw[comb+DR]:=old_dl;
portw[comb+IE]:=old_dh;
portw[comb+LC]:=old_lc;
portw[comb+IE]:=old_ie;
portw[comb+II]:=old_ii;
portw[comb+MC]:=old_mc;
portw[comb+LS]:=old_ls;
portw[comb+MS]:=old_ms;
end;
{---------------------------------------------------------------------}