unit ucamac;
interface
{camac make standard camac transfert see caution in subroutine description
 use online (or testonline ) before first transaction
 to be sure that the crate is online}
{Produit Nicolas 19.11.86}
{La Marra Daniel 28.11.91 modified for PC AT-386
                          because the 'portw' instruction are not same!}
{Produit Nicolas 95 corrected inhibit treatment}

uses crt;

PROCEDURE testonline;
{display a message until crate power ok and online switch of controller in
 online position}
procedure camac(n,a,f:integer;var data:word);
{dont test validity of f and a and n}
{dont wait for done but that is always ok in that sort of single word transfer}
PROCEDURE camac2(n,a,f:INTEGER;VAR data:longint);
{300 microsec}
{dont test validity of f and a and n}
{dont wait for done but that is always ok in that sort of single word transfer}
procedure block_camac(n,a,f:integer;rep:word;var data);
{do rep time the same camac command put io in data
data must be array rep of word}
procedure block_8_camac(n,a,f:integer;rep:word;var data);
{same then before but only 8 bit read and data must be
array rep of byte}
FUNCTION qcamac:BOOLEAN;
{return q response of last transfert}
FUNCTION xcamac:BOOLEAN;
{return x response of last transfert}
FUNCTION lam:BOOLEAN;
{return or of all lam in crate}
FUNCTION online:BOOLEAN;
{return online and power on status}
FUNCTION inhibit:BOOLEAN;
{return inhibit status}
PROCEDURE setinhibit;
{next camac cycles will have inhibit bit set}
PROCEDURE clearinhibit;
{next camac cycles wont have inhibit bit}
PROCEDURE zcamac;
{perform a z cycle}
PROCEDURE ccamac;
{perform a c cycle}
FUNCTION  rlam:longint;
{give out lam pattern}
FUNCTION  lamonstation(n:integer):BOOLEAN;
{test if station n assert lam}

implementation
var inh:boolean;
CONST datalow=$390;   {possibilities $380 $390}
      datamiddle=datalow+1;
      datahigh=datalow+2;
      lccommand=datalow+3;
      uccommand=datalow+4;
      ccontrolstatus=datalow+5;
      lamlow=datalow+6;
      lammiddle=datalow+7;
      lamhigh=datalow+8;

FUNCTION donecamac:BOOLEAN;
{return done bit = not busy}
BEGIN
 donecamac:=(port[ccontrolstatus] AND $80)<>0;
END;

FUNCTION qcamac:BOOLEAN;
BEGIN
 qcamac:=(port[ccontrolstatus] AND $40)=0;
END;

FUNCTION xcamac:BOOLEAN;
BEGIN
 xcamac:=(port[ccontrolstatus] AND $20)=0;
END;

FUNCTION lam:BOOLEAN;
BEGIN
 lam:=(port[ccontrolstatus] AND $10)<>0;
END;

FUNCTION online:BOOLEAN;
var bla:word;
BEGIN
 bla:=port[ccontrolstatus];
 online:=(bla<>255) and ((bla AND 1)<>0);
END;

FUNCTION inhibit:BOOLEAN;
BEGIN
 inh:=(port[ccontrolstatus] AND 2)<>0;
 inhibit:=inh;
END;

PROCEDURE setinhibit;
{set inhibit}
BEGIN
 inh:=true;
END;

PROCEDURE clearinhibit;
BEGIN
 inh:=false;
END;

PROCEDURE zcamac;
BEGIN
 port[ccontrolstatus]:=8;
END;

PROCEDURE ccamac;
BEGIN
 port[ccontrolstatus]:=4;
END;

function rlam:longint;
var lam:longint;
BEGIN
 lam:=port[lamhigh];
 lam:=(lam shl 8) + port[lammiddle];
 lam:=(lam shl 8) + port[lamlow];
 rlam:=lam;
END;

FUNCTION lamonstation(n:integer):BOOLEAN;
var pattern,lam:longint;
{this clumsy code with local variable because bug in turbo pascal
 donwsize longint to integer before and if not explicit}
    ok:boolean;
BEGIN
  pattern:=n-1;
  pattern:=1 shl pattern;
  lam:=rlam;
  ok:=(lam AND pattern)<>0;
  lamonstation:=ok;
END;

PROCEDURE testonline;
BEGIN
 WHILE NOT online DO BEGIN
  WRITELN('PLEASE SWITCH CAMAC CRATE ON AND CAMAC CONTROLER ONLINE');
  DELAY(1000);
  if keypressed then halt;
 END;
END;

PROCEDURE camac2(n,a,f:INTEGER;VAR data:longint);
VAR
    naf:INTEGER;
   readf,writef:BOOLEAN;
BEGIN
 readf:=f<8;
 writef:=(f>15) AND (f<24);
 IF writef THEN BEGIN
  port[datalow]:=LO(data);
  port[datamiddle]:=HI(data);
  port[datahigh]:=data shr 16;
 END;
 {fabriquer naf et le mettre dans ax}
 naf:=n SHL 4;
 naf:=((naf OR a) SHL 5) OR f;
 port[lccommand]:=lo(naf);
 port[uccommand]:=hi(naf);
 {preserve inhibit according to internal variable
  testing inhibit will be better but prohibitive intime}
 if (inh) then
  port[ccontrolstatus]:=3
 else
  port[ccontrolstatus]:=1;
 IF readf THEN BEGIN
 data:=port[datahigh];
 data:=(data shl 8) + port [datamiddle];
 data:=(data shl 8) + port [datalow];
 END;
{IF NOT XCAMAC THEN WRITELN('CAMAC ERROR WITH N,A,F,D ',N:4,A:4,F:4,DATA:4);}
END;



PROCEDURE camac(n,a,f:INTEGER;VAR data:word);

{190 microsec}
{CAUTION :: dont test validity of f and a and n}
{dont wait for done but that is always ok in that sort of single word transfer}

VAR
    naf:INTEGER;
   readf,writef:BOOLEAN;
BEGIN
 readf:=f<8;
 writef:=(f>15) AND (f<24);
 IF writef THEN BEGIN
  port[datalow]:=LO(data);
  port[datamiddle]:=HI(data);
 END;
 {fabriquer naf et le mettre dans ax}
 naf:=n SHL 4;
 naf:=((naf OR a) SHL 5) OR f;
 port[lccommand]:=lo(naf);
 port[uccommand]:=hi(naf);
 {preserve inhibit according to internal variable
  testing inhibit will be better but prohibitive in time}
 if (inh) then
  port[ccontrolstatus]:=3
 else
  port[ccontrolstatus]:=1;
 IF readf THEN BEGIN
  data:=port [datamiddle];
  data:=(data shl 8) + port [datalow];
 END;
 {IF NOT XCAMAC THEN WRITELN('CAMAC ERROR WITH N,A,F,D ',N:4,A:4,F:4,DATA:4);}
END;

procedure block_camac(n,a,f:integer;rep:word;var data);
VAR
   naf,i:INTEGER;
   readf,writef:BOOLEAN;
   x:word;
   in_out:array[1..65535 div 2]of word absolute data;
BEGIN
 readf:=f<8;
 writef:=(f>15) AND (f<24);
 naf:=n SHL 4;
 naf:=((naf OR a) SHL 5) OR f;
 port[lccommand]:=lo(naf);
 port[uccommand]:=hi(naf);
 if (inh) then
  x:=3
 else
  x:=1;
 IF writef THEN BEGIN
  for i:=1 to rep do begin
   port[datalow]:=LO(in_out[i]);
   port[datamiddle]:=HI(in_out[i]);
   port[ccontrolstatus]:=x;
  end;
 END;
 IF readf THEN BEGIN
  for i:=1 to rep do begin
   port[ccontrolstatus]:=x;
   in_out[i]:=(port[datamiddle] shl 8) or port[datalow];
  end;
 END;
 if (not writef) and (not readf) then begin
  for i:=1 to rep do begin
   port[ccontrolstatus]:=x;
  end;
 end;
END;

procedure block_8_camac(n,a,f:integer;rep:word;var data);
VAR
   naf,i:INTEGER;
   readf,writef:BOOLEAN;
   x:word;
   in_out:array[1..65535]of byte absolute data;
BEGIN
 readf:=f<8;
 writef:=(f>15) AND (f<24);
 naf:=n SHL 4;
 naf:=((naf OR a) SHL 5) OR f;
 port[lccommand]:=lo(naf);
 port[uccommand]:=hi(naf);
 if (inh) then
  x:=3
 else
  x:=1;
 IF writef THEN BEGIN
  for i:=1 to rep do begin
   port[datalow]:=in_out[i];
   port[ccontrolstatus]:=x;
  end;
 END;
 IF readf THEN BEGIN
  for i:=1 to rep do begin
   port[ccontrolstatus]:=x;
   in_out[i]:=port[datalow];
  end;
 END;
 if (not writef) and (not readf) then begin
  for i:=1 to rep do begin
   port[ccontrolstatus]:=x;
  end;
 end;
end;



begin
 inh:=false;
end.