{ Пакет для работы с контроллером КАМАК CC232
  Брязгин А.А. 93-42                        }
UNIT CC232;
INTERFACE
procedure restoreport;
function portinit(com:integer; baud:longint):integer;
function naf (n,a,f:integer; var data:longint; var xq:integer):integer;
procedure nafw2(n,a,f:integer;d:word);
procedure nafr2(n,a,f:integer;var d:word);
procedure naf0(n,a,f:integer);
procedure readqx(var qn,xn:byte);
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;

  comb: integer;
  x,q:byte;

{------------------------------------------------------------------------}
function clock:clock_t;
var H,M,S,S100:word;
    hi,mi,si,si100:longint;
begin
  gettime(h,m,s,s100);
  si100:=s100;
  si:=s*100;
  mi:=m*6000;
  hi:=ord(h);
  hi:=hi*360000;
  clock:=si100+si+mi+hi;
end;

function outrs(data:byte):integer;
var t0:clock_t;
begin
t0:=clock;
while( (port[comb+LS] and $20)=0 ) do
        	if( (clock-t0) > 40 ) then begin
                                            outrs:=TIMEOUT;
                                            exit;
                                          end;
portw[comb+DR]:=data;
outrs:=0;
end;
{------------------------------------------------------------------------}
function inrs(var data:byte):integer;
var ic:integer;
    t0:clock_t;
begin
repeat
t0:=clock;
ic:=port[comb+LS];
while ( (ic and 1) = 0 ) do
           begin
           ic:=port[comb+LS];
	   if( (clock-t0) > 40 ) 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 inrs(var data:byte):integer;
var ic:integer;
    t0:clock_t;
begin
t0:=clock;
ic:=port[comb+LS];
while ( (ic and 1) = 0 ) do
           begin
           ic:=port[comb+LS];
	   if( (clock-t0) > 40 ) 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;
inrs:=0;
end;  *)
{------------------------------------------------------------------------}
function naf (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((n and $3F) OR FIRST);
if (ic<>0) then begin naf:=ic; exit; end;
{sound(1000);
delay(200);
nosound;}

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

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


xq:=0;
ic:=inrs(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(NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(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(NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(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(NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(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(NEXT);
if (ic<>0) then begin naf:=ic; exit; end;

ic:=inrs(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(com:integer; 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;
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;
{---------------------------------------------------------------------}
 procedure nafw2(n,a,f:integer;d:word);
var data:longint;
    error,xq,i:integer;
begin
  data:=d and $FFFF;
  i:=0;
  error:=3;
 { repeat}
           error:=naf(n,a,f,data,xq);
          { i:=i+1;
  until (i=20) and (error=0);}
  x:=xq and 1;
  q:=(xq and 2) shr 1;
end;
{-------------------------------------------------------------------}
procedure nafr2(n,a,f:integer;var d:word);
var data:longint;
    error,xq,i:integer;
begin
  i:=0;
  error:=3;
{  repeat}
           error:=naf(n,a,f,data,xq);
          { i:=i+1;
  until (i=20) and (error=0);}
  d:=data;
  x:=xq and 1;
  q:=(xq and 2) shr 1;
end;
{---------------------------------------------------------------------}
procedure naf0(n,a,f:integer);
var data:longint;
    error,xq,i:integer;
begin
  i:=0;
  error:=3;
{  repeat }
           error:=naf(n,a,f,data,xq);
          { i:=i+1;
  until (i=20) and (error=0);}
  x:=xq and 1;
  q:=(xq and 2) shr 1;
end;
{----------------------------------------------------------------------}
procedure readqx(var qn,xn:byte);
begin
  xn:=x;
  qn:=q;
end;
begin
end.