$linenum 10001,sysprog$
$ucsd, modcal$
$lines 20000$
$sysprog$



module k196_con;


export
    FUNCTION K196_Error  : BOOLEAN;
    PROCEDURE trigger_K196;
    PROCEDURE Init_K196;
    PROCEDURE Set_k196_Res (res : integer);
    PROCEDURE Set_k196_Range (range : integer);
    PROCEDURE Set_k196_Mode (M,T : CHAR);
    PROCEDURE Set_k196_Filter(filter: integer);
    FUNCTION  Read_k196: REAL;       {  Reads Keithley 196 DVM  }
    PROCEDURE Reset_k196;


implement

import iodeclarations,general_0,general_2,
       general_1,sysdevs,hpib_1,hpib_2,hpib_3,hpib_0,
       newasm,sysglobals;

const
  k196Addr = 707;

var
  waitsecs,waitread,waitset  :integer;

PROCEDURE Wait(sec: REAL);    {wait for sec seconds}
var t:INTEGER;
begin
   t := sysclock;
   while t + sec*100 > sysclock do ;
end;

FUNCTION Ready  : BOOLEAN;
       {Performs a Serial Poll of the Keithley 196
        and waits until it gets a ready bit set.}
  var
    status: integer;
    done  : boolean;
  begin
    done:=false;
    repeat
      Status:= SPOLL (k196Addr);  {read serial pole byte}
      IF na_test (4,Status) THEN
        done:=true;
    until done;
    ready:=true;
  end; {ready}

FUNCTION Readingdone  : BOOLEAN;
       {Performs a Serial Poll of the Keithley 196
        and waits until it gets a reading done bit set.}
  var
    status,i : integer;
    done     : boolean;
  begin
    done:=false;
    i:=0;
    repeat
      Status:= SPOLL (k196Addr);  {read serial pole byte}
      IF na_test (3,Status) THEN
        done:=true;
    i:=i+1;
(*    if i >= 500 then
      begin
        writeln('Timeout Error in Keithley 196, Reading cycle not ending');
        done:=true;
      end;           *)
    until done;
    readingdone:=true;
  end; {readingdone}

FUNCTION K196_Error  : BOOLEAN;
{  Performs an error check of the Keithley 196.

   Returns : TRUE if error condition exists.
             FALSE otherwise
}
VAR ErrStr : STRING[255];
    status: integer;
BEGIN
   K196_Error := FALSE;
   Status:= SPOLL (k196Addr);
   IF na_test (5,Status) THEN
     begin
       K196_Error :=true;
       if ready then
         WRITESTRINGLN (K196Addr,'G1U1X');
       if ready then
       READSTRING (K196Addr, ErrStr);
       writeln('Error String= ',ErrStr);
       if ErrStr[1]='1' then writeln('Trigger Error');
       if ErrStr[12]='1' then writeln('Illegal Command Option');
       if ErrStr[13]='1' then writeln('Illegal Command');
       if ErrStr[11]='1' then writeln('No Remote');
     end;
 END; {K196_Error}


PROCEDURE TRIGGER_K196;   {triggers the Keithley 196 }
  begin
    if ready then
      WRITESTRINGLN (k196Addr, 'T5X'); {trigger Keithley 196}
  end; {trigger_k196}



PROCEDURE Init_K196;
    {Auto,Disable SRQ,Trigger on X,No prefix,4 1/2 digits,(Trigger)}
BEGIN
  if ready then
    WRITESTRINGLN (K196Addr, 'R0M0T5G1S1X');
  IF K196_Error THEN
    WRITELN ('Error occurred initializing Keithley 196');
END; {Init_K196}

PROCEDURE Set_k196_Res(res : integer);
  { Sets the resolution of the 196

    3 = 3 1/2 digits - S0
    4 = 4 1/2 digits - S1
    5 = 5 1/2 digits - S2
    6 = 6 1/2 digits - S3  }

  VAR 
    Cmd_Str : STRING[255];
    Length,j  : INTEGER;
  begin
       IF NOT (res IN [3..6]) THEN
          WRITELN ('ILLEGAL resolution for K196 :  ',res:0)
      ELSE
        BEGIN
          Cmd_Str := ' ';
          waitsecs:=0;
          case res of
            3: j:=0;
            4: j:=1;
            5: j:=2;
            6: 
               begin
                 j:=3;
                 waitsecs :=4; {with 6 1/2 digit resolution
                                 the 196 takes 3 secs. for 1 reading}
               end;
          end; {case}

          STRWRITE (Cmd_Str, 1, Length, 'S', j:1, 'X');
          if ready then
            WRITESTRINGLN (K196Addr, Cmd_Str);
          IF K196_Error THEN
            WRITELN ('Error occurred in Set_196_Res, with Cmd_Str=',Cmd_Str);
       END;
  end;

PROCEDURE Set_k196_Range (range : integer);

  {Sets the 196 range to  Auto if 0 or to the range selected by
   the integer 1 thru 7}

VAR Cmd_Str : STRING[255];
    Length : INTEGER;
begin
     IF NOT (range IN [0..7]) THEN
        WRITELN ('ILLEGAL range for K196 :  ',range:0)
     ELSE
      BEGIN
        Cmd_Str := ' ';
        STRWRITE (Cmd_Str, 1, Length, 'R', range:1, 'X');
        if ready then
          WRITESTRINGLN (K196Addr, Cmd_Str);
        wait(waitset);
        IF K196_Error THEN
          WRITELN ('Error occurred in Set_196_Range, with Cmd_Str=',Cmd_Str);
     END;
end;

PROCEDURE Set_k196_Mode (M,T : CHAR);

{  Determines the mode of operation of the
   Keithley 196 System DMM

   "M"
      'V'  ==>  Voltmeter
      'A'  ==>  Ammeter
      'R'  ==>  Ohmmeter

   "T"
      'A'  ==>  AC
      'D'  ==>  DC
      'B'  ==>  dB
}

VAR Cmd_Str : STRING[255];
    Length, j : INTEGER;

BEGIN
     M:=charupper(M);  { Change lower case letters to upper case }
     T:=charupper(T);
     IF NOT ((M IN ['V','A','R']) or
             (T IN ['A','D','B'])) THEN
        WRITELN ('ILLEGAL mode for K196 :  ',T,M)
     ELSE
      BEGIN
        waitread:=0;
        IF (M='V') and (T='D') then j:= 0 else
        IF (M='V') and (T='A') then 
           begin
             j:= 1;
             waitread:=1;
           end
          else
        IF (M='R')             then j:= 2 else
        IF (M='A') and (T='D') then j:= 3 else
        IF (M='A') and (T='A') then j:= 4 else
        IF (M='V') and (T='B') then j:= 5 else
        IF (M='A') and (T='B') then j:= 6;
        Cmd_Str := ' ';
        STRWRITE (Cmd_Str, 1, Length, 'F', j:1, 'X');
        if ready then
          WRITESTRINGLN (K196Addr, Cmd_Str);
        wait(waitset);
        IF K196_Error THEN
           WRITELN ('Error occurred in Set_k196_Mode, with Cmd_Str=',Cmd_Str);
      END;
END; {Set_k196_Mode}

Procedure Set_k196_filter(filter: integer);

    {Sets filter function to off if filter = 0
     Number of readings averaged if filter = 1-99}

VAR Cmd_Str : STRING[255];
    Length, status : INTEGER;
    Done  : boolean;

  begin
    IF NOT (filter IN [0..99]) then
      writeln('Illegal number of readings to be averaged in Set_k196_filter(1-99)')
    ELSE
      begin
        Cmd_Str := ' ';
        IF filter =0 then
          begin
            if ready then
              WRITESTRINGLN(k196Addr,'P0X');
          end
        ELSE
          begin
            IF (filter IN [1..9]) then
              STRWRITE (Cmd_Str, 1, Length, 'P',0:1, filter:1, 'X')
            ELSE IF (filter IN [10..99]) then
              STRWRITE (Cmd_Str, 1, Length, 'P', filter:2, 'X');
            if ready then
              WRITESTRINGLN (K196Addr, Cmd_Str);
          end;
        IF K196_Error THEN
        WRITELN ('Error occurred in Set_k196_Filter, with Cmd_Str=',Cmd_Str);

      end;
  end; {Set_k196_filter}

FUNCTION Read_k196: REAL;       {  Reads Keithley 196 DVM  }
VAR Answer : STRING[255];
    Length, status: INTEGER;
    Dummy : REAL;
    Done  : boolean;
BEGIN
  wait(waitread); {wait for meter to settle after input change}
  wait(waitsecs); {wait for meter to get data accurately with resolution}
  if ready then
    TRIGGER_K196;   {Start a new set of data reading}
  if readingdone then
  if ready then
  WRITESTRINGLN (K196Addr, 'G0X');   {send prefix back with data ,trigger}
  READSTRING (K196Addr, Answer);
  IF K196_Error THEN
    BEGIN
     WRITELN ('Error occurred in Read_k196');
     Read_k196 := 0;
    END
  ELSE  {no error}
    BEGIN
     STRREAD (Answer,5,Length,Dummy);
     Read_k196 := Dummy;   {Place to hold data}
     IF Answer[1]='O' THEN
        WRITELN ( '*** K196 OVERFLOW ***');
    END;

END;  {Read_k196}

PROCEDURE Reset_k196;      {put 196 into continous trigger and local mode}
VAR Cmd_Str : STRING[255];
    Length : INTEGER;
begin
   if ready then
     WRITESTRINGLN (K196Addr,'T4X');
   CLEAR (K196Addr);
   LOCAL (K196Addr);
   call(cleariohook);
end;

end.