head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.25.53;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.04.37;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.45.27;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.23.14;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.26.45;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.27.50;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.11.50;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.11.26;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.26.14;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.10.31;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.16.37;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.10.59.17;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.46.28;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.54.17;  author jwh;  state Exp;
branches ;
next     44.2;

44.2
date     90.04.09.19.37.12;  author dew;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.11.26;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.03.18;  author jwh;  state Exp;
branches ;
next     42.2;

42.2
date     90.02.20.17.30.56;  author dew;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.48.05;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.30.14;  author jwh;  state Exp;
branches ;
next     40.5;

40.5
date     89.12.18.15.01.24;  author dew;  state Exp;
branches ;
next     40.4;

40.4
date     89.12.18.14.55.00;  author dew;  state Exp;
branches ;
next     40.3;

40.3
date     89.12.15.14.13.56;  author dew;  state Exp;
branches ;
next     40.2;

40.2
date     89.12.14.15.55.24;  author dew;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.52.15;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.36.26;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.28.32;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.40.56;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.19.16;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.34.11;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.09.13;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.41.17;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.49.49;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.10.59;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.47.55;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.32.51;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.10.59.49;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.34.40;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.14.26;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.30.57;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.09.51.39;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.29.15;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.15.58;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.13.58.06;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.11.10;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.26.46;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.26.24;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.37.21;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.15.49.21;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.24.28;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.29.46;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.34.36;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.25.21;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.09.51.49;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.00.40;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.42.25;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.58.28;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.48.27;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.00.43;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.49.39;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.49.25;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.59.27;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.46.38;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.15.14.13;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@					      (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$MODCAL ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$DEBUG OFF$
$OVFLCHECK OFF$
$PAGE$
(************************************************************************)
(*                                                                      *)
(*           RELEASED        VERSION         3.1                        *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           IOLIB                                           *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  IOLIB                                           *)
(*      module(s)    -  general_1                                       *)
(*                   -  hpib_1                                          *)
(*                   -  general_2                                       *)
(*                   -  general_3                                       *)
(*                   -  general_4                                       *)
(*                   -  hpib_0                                          *)
(*                   -  hpib_2                                          *)
(*                   -  hpib_3                                          *)
(*                   -  serial_0                                        *)
(*                   -  serial_3                                        *)
(*                                                                      *)
(*      author       -  Tim Mikkelsen                                   *)
(*      phone        -  303-226-3800   ext. 2910                        *)
(*                                                                      *)
(*      date         -  June  1 , 1981                                  *)
(*      update       -  June  4,  1984                                  *)
(*      release      -  Jul  12,  1985                                  *)
(*                                                                      *)
(*      source       -  IOLIB:IOLIB.TEXT                                *)
(*      object       -  IOLIB:IOLIB.CODE                                *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      This is the source code for an external procedures library      *)
(*      to be used for general purpose interfacing on the HP 9826.      *)
(*                                                                      *)
(*      The library consists of 3 primary sets of modules -             *)
(*                                                                      *)
(*              1.      KERNEL modules                                  *)
(*              2.      driver modules                                  *)
(*              3.      IOLIB  modules                                  *)
(*                                                                      *)
(*      The KERNEL modules consist of the following modules -           *)
(*                                                                      *)
(*              1.      iodeclarations  ( contains static r/w space )   *)
(*              2.      iocomasm                                        *)
(*              3.      general_0       ( initialization & low level    *)
(*                                        routines like ioread/iowrite) *)
(*      The KERNEL modules also have an executable program segement     *)
(*      that gets executed at the time it is loaded.  This program      *)
(*      initializes the static read/write memory.  This program also    *)
(*      allocates the temporary storage for any card that exists -      *)
(*      independent of whether there is or is not a driver for it.      *)
(*                                                                      *)
(*      The driver modules consist of the actual assembly or PASCAL     *)
(*      routines that deal with a specific interface card.  There is    *)
(*      also an executable program segment for each driver module.      *)
(*      This program searches the select code table in the static r/w   *)
(*      initialized by the KERNEL general_0 module for all select codes *)
(*      that have the right interface card ( HPIB drivers will search   *)
(*      for the 98624 interface ).  This program will then set up the   *)
(*      driver tables to point to the correct drivers.                  *)
(*                                                                      *)
(*      The rest of the IOLIB modules are high-level modules that are   *)
(*      used by an end user in his/her application program.             *)
(*                                                                      *)
(*      The KERNEL and some set of driver modules will exist in the     *)
(*      SYSTEM.INITLIB file as object code ( not EXPORT text ).  The    *)
(*      export text will reside on the SYSTEM.LIBRARY file.  The rest   *)
(*      of the library will reside on the SYSTEM.LIBRARY.               *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      BUG FIX HISTORY         - after release                         *)
(*                                                                      *)
(*                                                                      *)
(*      BUG #   BY  / ON        LOCATION        DESCRIPTION             *)
(*      -----   -----------     --------------  ----------------------  *)
(*                                                                      *)
(*      1250    T Mikkelsen     HPIB_3          request service allows  *)
(*              01/08/1982      request_service active ctl to request   *)
(*                                              service.                *)
(*                                                                      *)
(*      1251    T Mikkelsen     HPIB_2          local(7) with sc 7 as   *)
(*              01/08/1982      local           sys ctl / not act ctl   *)
(*              01/26/1982                      gives error.            *)
(*                                                                      *)
(*      1252    T Mikkelsen     HPIB_2          remote(7) with sc 7 as  *)
(*              01/08/1982      remote          act ctl / not sys ctl   *)
(*                                              doesn't give error.     *)
(*                                                                      *)
(*      1258    T Mikkelsen     HPIB_2          pass control sends the  *)
(*              01/08/1982      pass_control    wrong sequence to pass  *)
(*                                              control to itself.      *)
(*                                                                      *)
(*      1269    T Mikkelsen     SERIAL_3        bad check for a 98626   *)
(*              01/08/1982      set_stop_bits   card.                   *)
(*                                                                      *)
(*      1270    T Mikkelsen     SERIAL_3        make procedures for     *)
(*              01/08/1982      set_baud_rate   data comm consistent    *)
(*                              set_stop_bits   for buffered control.   *)
(*                              set_parity                              *)
(*                              set_char_length                         *)
(*                                                                      *)
(*      1281    T Mikkelsen     GENERAL_3       Wrong message for error *)
(*              01/08/1982      ioerror_message ioe_not_dvc.            *)
(*                                                                      *)
(*      0082    T Mikkelsen     GENERAL_3       Addition of a link for  *)
(*              07/23/1982      ioerror_message the error messages.     *)
(*                                              See also IODECLARATIONS.*)
(*                                                                      *)
(*      0083    T Mikkelsen     GENERAL_4       Addition of buffer_busy *)
(*              07/23/1982      buffer_busy     and isc_busy routines.  *)
(*                              isc_busy                                *)
(*                                                                      *)
(*      0355    T Mikkelsen     SERIAL_3        Set parity of one and   *)
(*              08/20/1982      set_parity      zero parity is backwards*)
(*                                              for the 98628 card.     *)
(*                                                                      *)
(*      0359    T Mikkelsen     SERIAL_3        Changes for addition    *)
(*              08/26/1982      set_parity      of 98626 drivers.       *)
(*                              set_char_length                         *)
(*                              set_stop_bits                           *)
(*                                                                      *)
(*      0364    T Mikkelsen     GENERAL_3       Addition of SRM driver  *)
(*              08/23/1982      ioerror_message error codes.  See also  *)
(*                                              IODECLARATIONS.         *)
(*                                                                      *)
(*       557    T Mikkelsen     GENERAL_3       Mistyped. ( typo )      *)
(*              10/01/1982      set_parity                              *)
(*                                                                      *)
(*      jsjs    T Mikkelsen     HPIB_2          BUG FIX error in Local  *)
(*              03/09/1983      local           procedure for isc param *)
(*                                              and not sys controller. *)
(*                                                                      *)
(*      tttt    J Schmidt       HPIB_1          Use timer on CPU board  *)
(*              08/03/1983                      if available for timeout*)
(*                                              checking                *)
(*                                                                      *)
(*              J Schmidt       serial modules  add code for 98644      *)
(*              5/15/84                                                 *)
(*              6/4/84                                                  *)
(*                                                                      *)
(*              D Willis        PARALLEL_3      Added for centronics    *)
(*              12/89                           support.                *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      REFERENCES :                                                    *)
(*                                                                      *)
(*                                                                      *)
(*      1.  9826 I/O Designers Guide            ( Loyd Nelson )         *)
(*                                                                      *)
(*      2.  68000 Manual                        ( Motorola )            *)
(*                                                                      *)
(*      3.  Pascal alpha site ERS               ( Roger Ison )          *)
(*                                                                      *)
(*      4.  Pascal I/O Library ERS              ( Tim Mikkelsen )       *)
(*                                                                      *)
(*      5.  9826 HPL EIO & IOD listings         ( Bob Hallissy )        *)
(*                                                                      *)
(*      6.  9826 HPL Misc. I/O Doc.             ( Bob Hallissy )        *)
(*                                                                      *)
(*      7.  9826 card documentation             ( Mfg. Specs. )         *)
(*                                                                      *)
(*      8.  Pascal I/O Library IRS              ( Tim Mikkelsen )       *)
(*                                                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL GROUP                                                   *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)



MODULE general_1 ;

	{ by      Tim Mikkelsen
	  date    07/15/81
	  update  11/20/81

	  purpose This module contains the LEVEL 1 GENERAL GROUP procedures.
	}


{local search{{
$SEARCH 'KERNEL.CODE', 'COMASM'$
{system search{}
$SEARCH 'IOLIB:KERNEL.CODE', 'IOLIB:COMASM'$
{}
IMPORT   iodeclarations  ;

EXPORT

  PROCEDURE ioinitialize;
  PROCEDURE iouninitialize;
  PROCEDURE ioreset     ( select_code : type_isc);
  PROCEDURE readchar    ( select_code : type_isc ;
			  VAR value   : CHAR );
  PROCEDURE writechar   ( select_code : type_isc ;
			  value       : CHAR );
  PROCEDURE readword    ( select_code : type_isc ;
			  VAR num     : INTEGER);
  PROCEDURE writeword   ( select_code : type_isc ;
			  value       : INTEGER);
  PROCEDURE set_timeout ( select_code : type_isc ;
			  time        : REAL );


IMPLEMENT

  IMPORT   general_0;



  PROCEDURE ioinitialize;
  BEGIN

    io_system_reset;

  END; { of ioinitialize }



  PROCEDURE iouninitialize;
  BEGIN

    io_system_reset;

  END; { of iouninitialize }



  PROCEDURE ioreset     ( select_code : type_isc);
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_init,
	 io_tmp_ptr);
  END; { of ioreset }


  PROCEDURE readchar    ( select_code : type_isc ;
			  VAR value   : CHAR );
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_rdb,
	 io_tmp_ptr,
	 value);
  END; { of readchar }



  PROCEDURE writechar   ( select_code : type_isc ;
			  value       : CHAR );
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_wtb,
	 io_tmp_ptr,
	 value);
  END; { of writechar }



  PROCEDURE readword    ( select_code : type_isc ;
			  VAR num     : INTEGER);
  VAR my_num : io_word;
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_rdw,
	 io_tmp_ptr,
	 my_num);
    num:=my_num;
  END; { of readword }



  PROCEDURE writeword   ( select_code : type_isc ;
			  value       : INTEGER);
  VAR my_value : io_word;
  BEGIN
    my_value:=value;
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_wtw,
	 io_tmp_ptr,
	 my_value);
  END; { of writeword }



  PROCEDURE set_timeout ( select_code : type_isc ;
			  time        : REAL            { in seconds } );
  BEGIN
    IF time>8191                { 4 byte timeout  - 1 byte left for shifts }
      THEN BEGIN
	{ error }
	io_escape(ioe_bad_tmo,select_code);
      END; { of IF }
    IF (time>0) AND (time<0.001)
      THEN BEGIN
	{ error }
	io_escape(ioe_bad_tmo,select_code);
      END; { of IF }

    WITH isc_table[select_code] DO BEGIN

      { the table entry used by drivers is in milliseconds }
      user_time:=ROUND(time*1000);

      IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout := user_time;

    END; { of WITH DO BEGIN }

  END; { of set_timeout }


END;    { of general_1 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      HPIB GROUP LEVEL 1                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      This level is included in the                                   *)
(*      general group because HP-IB                                     *)
(*      addressing is necessary for                                     *)
(*      general puropose device speci-                                  *)
(*      fication.                                                       *)
(*                                                                      *)
(************************************************************************)



MODULE hpib_1 ;

	{ by      Tim Mikkelsen
	  date    07/16/81
	  update  08/03/83 by J Schmidt

	  purpose This module contains the LEVEL 1 HPIB GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT


  PROCEDURE send_command( select_code : type_isc ;
			  command     : CHAR );
  FUNCTION  my_address  ( select_code : type_isc)
			: type_hpib_addr ;
  FUNCTION  active_controller
			( select_code : type_isc)
			: BOOLEAN;
  FUNCTION  system_controller
			( select_code : type_isc)
			: BOOLEAN;
  FUNCTION  addr_to_talk( device      : type_device)
			: type_isc;
  FUNCTION  addr_to_listen
			( device      : type_device)
			: type_isc;
  FUNCTION  set_to_talk ( device      : type_device)
			: type_isc;
  FUNCTION  set_to_listen
			( device      : type_device)
			: type_isc;
  FUNCTION  end_set     ( select_code : type_isc )
			: BOOLEAN;


IMPLEMENT

  IMPORT  iocomasm ,
	  general_0 ;

  TYPE    timeoutrec = record                        { tttt JS 8/3/83 }
			  counter: integer;          { tttt JS 8/3/83 }
			  firsttime: boolean;        { tttt JS 8/3/83 }
		       end;                          { tttt JS 8/3/83 }


  FUNCTION timerexists: boolean;  external;         { tttt JS 8/3/83 }

  FUNCTION timed_out(var rec: timeoutrec): boolean; external; {tttt JS 8/3/83}

  PROCEDURE send_command( select_code : type_isc ;
			  command     : CHAR );
  BEGIN
    WITH isc_table[select_code] DO
      CALL ( io_drv_ptr^.iod_send,
	     io_tmp_ptr,
	     command);
  END; { of send_command }



  FUNCTION  my_address  ( select_code : type_isc)
	    : type_hpib_addr ;
  BEGIN
    IF isc_table[select_code].io_tmp_ptr <> NIL
      THEN BEGIN
	WITH isc_table[select_code].io_tmp_ptr^ DO
	  IF addressed <> -1
	    THEN BEGIN
	      my_address:=addressed;
	    END
	    ELSE BEGIN
	      { error }
	      io_escape(ioe_not_hpib,select_code);
	    END; { of IF addressed }
      END
      ELSE BEGIN
	{ error }
	io_escape(ioe_not_hpib,select_code);
      END; { of IF io_tmp_ptr }
  END; { of my_address }



  FUNCTION  active_controller
			( select_code : type_isc)
			: BOOLEAN;
  BEGIN
    IF isc_table[select_code].card_type=hpib_card
      THEN BEGIN
	active_controller:=bit_set(iostatus(select_code,3),6);
      END
      ELSE BEGIN
	active_controller := TRUE;
      END; { of IF }
  END; { of active_controller }



  FUNCTION  system_controller
			( select_code : type_isc)
			: BOOLEAN;
  BEGIN
    IF isc_table[select_code].card_type=hpib_card
      THEN BEGIN
	system_controller:=bit_set(iostatus(select_code,3),7);
      END
      ELSE BEGIN
	system_controller := TRUE;
      END; { of IF }
  END; { of system_controller }



  FUNCTION  end_set     ( select_code : type_isc )
			: BOOLEAN ;
  VAR mybool : BOOLEAN;
  BEGIN
    WITH isc_table[select_code] DO
      CALL ( io_drv_ptr^.iod_end,
	     io_tmp_ptr,
	     mybool);
    end_set := mybool;
  END; { of send_command }


  $PAGE$

  FUNCTION  addr_to_talk( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
      timer  : INTEGER;
      hpibrec: timeoutrec;                                    {tttt JS 8/3/83}

  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=device DIV 100;

	WITH isc_table[io_isc] DO BEGIN

	  IF io_tmp_ptr <> NIL
	    THEN BEGIN

	      { set up user timeout - in case system drivers changed it }
	      io_tmp_ptr^.timeout:=user_time;

	      IF io_tmp_ptr^.addressed <> -1
		THEN BEGIN
		  IF ( card_type <> hpib_card ) AND
		     ( device MOD 100 > 31 )
		    THEN io_escape(ioe_misc,io_isc);
		  send_command(io_isc,CHR(talk_constant+(device MOD 100)));
		  send_command(io_isc,'?');
		  send_command(io_isc,CHR(my_address(io_isc)+listen_constant));
		END
		ELSE BEGIN
		  { error }
		  io_escape(ioe_not_hpib,io_isc);
		END; { of IF }
	    END
	    ELSE BEGIN
	    END; { of IF }
	END; { of WITH DO BEGIN }
      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN
		  { if non controller wait until listener }
		  IF user_time = 0
		    THEN BEGIN
		      REPEAT
			{ wait forever }
		      UNTIL bit_set(iostatus(io_isc,6),10);
		    END
		    ELSE BEGIN
		      { wait for timeout value }
		      IF timerexists THEN BEGIN             {tttt JS 8/3/83}
			hpibrec.firsttime:=true;             {tttt JS 8/3/83}
			hpibrec.counter:=user_time;          {tttt JS 8/3/83}
			REPEAT                               {tttt JS 8/3/83}
			UNTIL timed_out(hpibrec) OR          {tttt JS 8/3/83}
			  bit_set(iostatus(io_isc,6),10);    {tttt JS 8/3/83}
		      END                                    {tttt JS 8/3/83}
		      ELSE BEGIN                             {tttt JS 8/3/83}
			timer:=user_time*3;
			REPEAT
			  timer:=timer-1;
			UNTIL ( timer = 0 ) OR
			      ( bit_set(iostatus(io_isc,6),10) ) ;
		      END;                                   {tttt JS 8/3/83}
		      IF NOT bit_set(iostatus(io_isc,6),10)
			THEN io_escape(ioe_timeout,io_isc);
		    END; { of IF user_time=0 }
		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    addr_to_talk:=io_isc; { return select code }

  END; { of addr_to_talk }

  $PAGE$

  FUNCTION  addr_to_listen
			( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
      timer  : INTEGER;
      hpibrec: timeoutrec;                                   {tttt JS 8/3/83}

  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=device DIV 100;

	WITH isc_table[io_isc] DO BEGIN

	  IF io_tmp_ptr <> NIL
	    THEN BEGIN

	      { set up user timeout - in case system drivers changed it }
	      io_tmp_ptr^.timeout:=user_time;

	      IF io_tmp_ptr^.addressed <> -1
		THEN BEGIN
		  IF ( card_type <> hpib_card ) AND
		     ( device MOD 100 > 31 )
		    THEN io_escape(ioe_misc,io_isc);
		  send_command(io_isc,CHR(my_address(io_isc)+talk_constant));
		  send_command(io_isc,'?');
		  send_command(io_isc,CHR(listen_constant+(device MOD 100)));
		END
		ELSE BEGIN
		  { error }
		  io_escape(ioe_not_hpib,io_isc);
		END; { of IF }
	    END
	    ELSE BEGIN
	    END; { of IF }
	END; { of WITH DO BEGIN }
      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN
		  { if non controller wait until talker }
		  IF user_time = 0
		    THEN BEGIN
		      REPEAT
			{ wait forever }
		      UNTIL bit_set(iostatus(io_isc,6),9);
		    END
		    ELSE BEGIN
		      { wait for timeout value }
		      IF timerexists THEN BEGIN             {tttt JS 8/3/83}
			hpibrec.firsttime:=true;             {tttt JS 8/3/83}
			hpibrec.counter:=user_time;          {tttt JS 8/3/83}
			REPEAT                               {tttt JS 8/3/83}
			UNTIL timed_out(hpibrec) OR          {tttt JS 8/3/83}
			  bit_set(iostatus(io_isc,6), 9);    {tttt JS 8/3/83}
		      END                                    {tttt JS 8/3/83}
		      ELSE BEGIN                             {tttt JS 8/3/83}
			timer:=user_time*3;
			REPEAT
			  timer:=timer-1;
			UNTIL ( timer = 0 ) OR
			      ( bit_set(iostatus(io_isc,6),9) ) ;
		      END;                                   {tttt JS 8/3/83}
		      IF NOT bit_set(iostatus(io_isc,6),9)
			THEN io_escape(ioe_timeout,io_isc);
		    END; { of IF user_time=0 }
		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    addr_to_listen:=io_isc;

  END; { of addr_to_listen }

  $PAGE$


  { set to talk exists because of HPIB_2/HPIB_3 -
    those routines are intended to be the controller
    ( active ) and should not wait for the card to be
    addressed as talker.  addr_to_talk is used by
    data transfer routines.  set_to_talk is used by
    bus control routines.                               }




  FUNCTION  set_to_talk ( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=addr_to_talk(device);
      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN

		  io_escape(ioe_not_act,io_isc);

		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    set_to_talk:=io_isc; { return select code }

  END; { of set_to_talk }

  $PAGE$


  { set to listen exists because of HPIB_2/HPIB_3 -
    those routines are intended to be the controller
    ( active ) and should not wait for the card to be
    addressed as listener.  addr_to_listen is used by
    data transfer routines.  set_to_listen is used by
    bus control routines.                               }





  FUNCTION  set_to_listen
			( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
      timer  : INTEGER;
  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=addr_to_listen(device);

      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN

		  io_escape(ioe_not_act,io_isc);

		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    set_to_listen:=io_isc;

  END; { of set_to_listen }



END;    { of hpib_1 }
$PAGE$
MODULE general_2 ;

	{ by      Tim Mikkelsen
	  date    07/15/81
	  update  11/30/81

	  purpose This module contains the LEVEL 2 GENERAL GROUP procedures.

	}

IMPORT    iodeclarations;

EXPORT

  PROCEDURE readnumber ( device : type_device ;
			 VAR num: REAL ) ;
  PROCEDURE writenumber( device : type_device ;
			 value  : REAL ) ;
  PROCEDURE readstring
		       ( device : type_device ;
			 VAR str: STRING ) ;
  PROCEDURE readstring_until
		       ( term   : CHAR ;
			 device : type_device ;
			 VAR str: STRING );
  PROCEDURE writestring( device : type_device ;
			 str    : io_STRING ) ;
  PROCEDURE readnumberln
		       ( device : type_device ;
			 VAR num: REAL );
  PROCEDURE writenumberln
		       ( device : type_device ;
			 value  : REAL );
  PROCEDURE writestringln
		       ( device : type_device ;
			 str    : io_STRING );
  PROCEDURE readuntil  ( term   : CHAR ;
			 device : type_device );
  PROCEDURE skipfor    ( count  : INTEGER ;
			 device : type_device );


IMPLEMENT
IMPORT    sysglobals,
	  hpib_1 ,
	  general_1 ;



  PROCEDURE readnumber ( device : type_device ;
			 VAR num: REAL ) ;
  VAR io_work_str : STRING[255];
      i           : INTEGER;
      p2          : INTEGER;
      io_isc      : type_isc;
      numbuilt    : BOOLEAN;

    FUNCTION  numeric ( character : CHAR) : BOOLEAN;
    BEGIN
      CASE character OF
	'0'..'9',
	'+','-','.',
	'E','e'    : numeric:=TRUE

	OTHERWISE    numeric:=FALSE
      END; { of CASE }
    END; { of numeric }
  BEGIN
    { use TRY RECOVER to build a number until I find one }

    io_isc:=addr_to_talk(device);

    numbuilt := FALSE;

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      REPEAT

	SETSTRLEN(io_work_str,255);
	i:=1;

	{ skip over non-numeric characters }
	REPEAT
	  CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]);
	  WHILE io_work_str[i]=' ' DO
	    CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]);
	UNTIL numeric(io_work_str[i]) ;

	{ read in numeric characters }
	REPEAT
	  i:=i+1;
	  CALL ( iod_rdb , io_tmp_ptr , io_work_str[i] );
	  WHILE io_work_str[i]=' ' DO
	    CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]);
	UNTIL ( (NOT ( numeric(io_work_str[i]))) OR (
	      ( i>=255) ) );


	SETSTRLEN(io_work_str,i);
	io_work_char:=io_work_str[i];

	TRY

	  STRREAD(io_work_str,1,p2,num);

	  numbuilt := TRUE;

	RECOVER BEGIN
	  IF ( ESCAPECODE=-10 )                  AND
	     (  ( IORESULT = ORD(IBADFORMAT) )  OR
		( IORESULT = ORD(ISTROVFL)   ) )
	    THEN BEGIN
	      { this is the strread errors - try again }
	    END
	    ELSE BEGIN
	      { this means something else happened }
	      ESCAPE(ESCAPECODE);
	    END; { of IF my error }
	END; { of RECOVER }

      UNTIL numbuilt;


    END; { of WITH DO BEGIN }

  END; { of readnumber  }



  PROCEDURE writenumber (device : type_device ;
			 value  : REAL );
  VAR i           : INTEGER;
      p2          : INTEGER;
      io_isc       : type_isc;
      io_work_str : STRING[255];
  BEGIN
    io_isc:=addr_to_listen(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      STRWRITE(io_work_str,1,p2,value);
      FOR i:=1 TO p2-1 DO
	CALL ( iod_wtb , io_tmp_ptr , io_work_str[i]);

    END; { of WITH DO }

  END; { of writenumber  }



  PROCEDURE readstring
		       ( device : type_device ;
			 VAR str: STRING ) ;
  VAR i         : INTEGER;
      io_isc    : type_isc;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      SETSTRLEN(str,STRMAX(str));         { so I can do assign to empty string }
      i:=0;
      REPEAT
	i:=i+1;
	CALL ( iod_rdb , io_tmp_ptr , str[i]);
      UNTIL ( (i>=STRMAX(str)         )    OR
	      ( str[i] = io_line_feed ) );
      IF str[i]=io_line_feed THEN i:=i-1;
      IF i<>0 THEN IF str[i]=io_carriage_rtn THEN i:=i-1;
      SETSTRLEN(str,i);

    END; { of WITH DO BEGIN }

  END; { of readstring }




  PROCEDURE readstring_until
		       ( term   : CHAR ;
			 device : type_device ;
			 VAR str: STRING );
  VAR i           : INTEGER;
      io_isc       : type_isc;
      io_work_char: CHAR;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      SETSTRLEN(str,STRMAX(str));
      i:=0;
      REPEAT
	i:=i+1;
	CALL ( iod_rdb , io_tmp_ptr , str[i]);
      UNTIL ( (i>=STRMAX(str) )     OR
	      ( str[i]=term ) );
      SETSTRLEN(str,i);

    END; { of WITH DO BEGIN }

  END; { of readstring_until }



  PROCEDURE writestring( device : type_device ;
			 str    : io_STRING ) ;
  VAR i     : INTEGER;
      io_isc: type_isc;
  BEGIN
    io_isc:=addr_to_listen(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      FOR i:=1 TO STRLEN(str) DO
	CALL ( iod_wtb , io_tmp_ptr , str[i]);

    END; { of WITH DO }

  END; { of writestring }



  PROCEDURE readnumberln
		       ( device : type_device ;
			 VAR num: REAL );
  VAR io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_talk(device);
    readnumber(io_isc,num);
    IF io_work_char <> io_line_feed THEN
       readuntil(io_line_feed,io_isc);
  END; { of readnumberln }



  PROCEDURE writenumberln
		       ( device : type_device ;
			 value  : REAL );
  VAR io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_listen(device);
    writenumber(io_isc,value);
    writechar(io_isc,io_carriage_rtn);
    writechar(io_isc,io_line_feed);
  END; { of writenumberln }



  PROCEDURE writestringln
		       ( device : type_device ;
			 str    : io_STRING );
  VAR io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_listen(device);
    writestring(io_isc,str);
    writechar(io_isc,io_carriage_rtn);
    writechar(io_isc,io_line_feed);
  END; { of writestringln }



  PROCEDURE readuntil  ( term   : CHAR ;
			 device : type_device );
  VAR io_work_char: CHAR;
      io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      REPEAT
	CALL ( iod_rdb , io_tmp_ptr , io_work_char);
      UNTIL ( io_work_char=term );

    END; { of WITH DO BEGIN }

  END; { of readuntil }



  PROCEDURE skipfor    ( count  : INTEGER ;
			 device : type_device );
  VAR i           : INTEGER;
      io_isc      : type_isc;
      io_work_char: CHAR;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      FOR i:=1 TO count DO
	CALL ( iod_rdb , io_tmp_ptr , io_work_char);

    END; { of WITH DO BEGIN }

  END; { of skipfor }



END;  { of general_2 }
$PAGE$
MODULE general_3 ;

	{ by      Tim Mikkelsen
	  date    11/27/81
	  update  07/23/82

	  purpose This module contains the LEVEL 3 GENERAL GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT

  FUNCTION  ioerror_message ( ioerror : INTEGER )  : io_STRING;

IMPLEMENT

  FUNCTION  ioerror_message ( ioerror : INTEGER ) : io_STRING;
  VAR my_msg : io_STRING;
  BEGIN
    my_msg:='zzzz' ;                                            { 0082 TM 7/23/82 }

    IF ( ioerror <= ioe_misc )     AND
       ( ioerror >= ioe_no_error )
      THEN BEGIN
	CASE ioerror OF

	  ioe_no_error    :  my_msg := 'no error ';
	  ioe_no_card     :  my_msg := 'no card at select code';
	  ioe_not_hpib    :  my_msg := 'interface should be hpib';
	  ioe_not_act     :  my_msg := 'not active controller';
	  ioe_not_dvc     :  my_msg := 'should be device not sc';    { BUG 1281 TM 1/8/82 }
	  ioe_no_space    :  my_msg := 'no space left in buffer';
	  ioe_no_data     :  my_msg := 'no data left in buffer';
	  ioe_bad_tfr     :  my_msg := 'improper transfer attempted';
	  ioe_isc_busy    :  my_msg := 'the select code is busy';
	  ioe_buf_busy    :  my_msg := 'the buffer is busy';
	  ioe_bad_cnt     :  my_msg := 'improper transfer count';
	  ioe_bad_tmo     :  my_msg := 'bad timeout value';
	  ioe_no_driver   :  my_msg := 'no driver for this card';
	  ioe_no_dma      :  my_msg := 'no dma';
	  ioe_no_word     :  my_msg := 'word operations not allowed';
	  ioe_not_talk    :  my_msg := 'not addressed as talker';
	  ioe_not_lstn    :  my_msg := 'not addressed as listener';
	  ioe_timeout     :  my_msg := 'a timeout has occurred';
	  ioe_not_sctl    :  my_msg := 'not system controller';
	  ioe_rds_wtc     :  my_msg := 'bad status or control';
	  ioe_bad_sct     :  my_msg := 'bad set/clear/test operation';
	  ioe_crd_dwn     :  my_msg := 'interface card is dead';
	  ioe_eod_seen    :  my_msg := 'end/eod has occured';
	  ioe_misc        :  my_msg := 'miscellaneous - value of param error';
	END; { of CASE }
      END; { of IF }

    IF ( ioerror >= ioe_dc_fail ) AND
       ( ioerror <= ioe_dc_rval )
      THEN BEGIN
	CASE ioerror OF

	  ioe_sr_toomany  :  my_msg :=                          { 0364 TM 87/23/82 }
			     'too many chars w/o terminator';   { 0364 TM 87/23/82 }
	  ioe_dc_fail     :  my_msg := 'dc interface failure';
	  ioe_dc_usart    :  my_msg := 'USART receive buffer overflow';
	  ioe_dc_ovfl     :  my_msg := 'receive buffer overflow';
	  ioe_dc_clk      :  my_msg := 'missing clock';
	  ioe_dc_cts      :  my_msg := 'CTS false too long';
	  ioe_dc_car      :  my_msg := 'lost carrier disconnect';
	  ioe_dc_act      :  my_msg := 'no activity disconnect';
	  ioe_dc_conn     :  my_msg := 'connection not established';
	  ioe_dc_conf     :  my_msg := 'bad data bits/parity combination';
	  ioe_dc_reg      :  my_msg := 'bad status /control register';
	  ioe_dc_rval     :  my_msg := 'control value out of range';
	END; { of CASE }
      END; { of IF }

    IF ioe_result = ioe_sr_fail                                 { 0364 TM 8/23/82 }
      THEN my_msg := 'data link failure';                       { 0364 TM 8/23/82 }

    IF my_msg = 'zzzz'     { we don't let sleeping msgs lie }   { 0082 TM 7/23/82 }
      THEN CALL(io_error_link , ioerror , my_msg  );            { 0082 TM 7/23/82 }

    ioerror_message := my_msg;

  END; { ioerror_message }

END;  { of general_3 }
$PAGE$
MODULE general_4 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  07/23/82

	  purpose This module contains the LEVEL 4 GENERAL GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT

  PROCEDURE abort_transfer
		       ( VAR b_info: buf_info_type );
  FUNCTION  transfer_setup
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 VAR t_cnt : INTEGER )
		       : type_isc ;
  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type;
			 x_count   : INTEGER ) ;
  PROCEDURE transfer_word
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type;
			 x_count   : INTEGER ) ;
  PROCEDURE transfer_until
		       ( term      : CHAR ;
			 device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;
  PROCEDURE transfer_end
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER );
  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
  FUNCTION  buffer_space(VAR b_info: buf_info_type)
		       : INTEGER;
  FUNCTION  buffer_data( VAR b_info: buf_info_type)
		       : INTEGER;
  PROCEDURE readbuffer ( VAR b_info: buf_info_type;
			 VAR value : CHAR);
  PROCEDURE writebuffer( VAR b_info: buf_info_type;
			 value     : CHAR);
  PROCEDURE readbuffer_string
		       ( VAR b_info: buf_info_type;
			 VAR str   : STRING;
			 str_count : INTEGER);
  PROCEDURE writebuffer_string
		       ( VAR b_info: buf_info_type;
			 str       : io_STRING);

  FUNCTION  buffer_busy( VAR b_info: buf_info_type )            { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }
  FUNCTION  isc_busy   ( isc       : type_isc )                 { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }

IMPLEMENT


  IMPORT  hpib_1 ;

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER ) ;
    PROCEDURE NEW $ALIAS 'ASM_NEWBYTES'$
		  (VAR p:ANYPTR;v:INTEGER);EXTERNAL;
  BEGIN
    WITH b_info DO
      BEGIN
	{ what about IOBUFFER to a already existant buffer ? }
	{ - the space will be thrown away. }

	NEW(buf_ptr,t_count);

	act_tfr   := no_tfr;
	active_isc:= no_isc;
	buf_size  := t_count;
	buf_empty := buf_ptr;
	buf_fill  := buf_ptr;

	drv_tmp_ptr       := NIL;
	eot_proc.dummy_sl := NIL;
	eot_proc.dummy_pr := NIL;
	eot_parm          := NIL;               {JPC  02/22/82}
	dma_priority      := FALSE ;
      END; { of WITH DO }
  END; { of iobuffer }



  FUNCTION  buffer_data(VAR b_info : buf_info_type )
		      : INTEGER;
  BEGIN
    WITH b_info
    DO BEGIN
      buffer_data:=INTEGER(buf_fill)-INTEGER(buf_empty);
    END; { of WITH DO }
  END; { of buffer_data }



  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
  BEGIN
    WITH b_info
    DO BEGIN
      IF active_isc = no_isc
	THEN BEGIN
	  buf_fill:=buf_ptr;
	  buf_empty:=buf_ptr;
	END
	ELSE BEGIN
	  { error }
	  io_escape(ioe_buf_busy,no_isc);
	END; { of IF }
    END; { of WITH DO }
  END; { of buffer_reset }



  FUNCTION  buffer_space(VAR b_info: buf_info_type)
		       : INTEGER;
  BEGIN
    WITH b_info
    DO BEGIN
      IF ( buffer_data(b_info)=0 ) AND
	 ( active_isc = no_isc )   THEN buffer_reset(b_info);
      buffer_space:=buf_size+INTEGER(buf_ptr)-INTEGER(buf_fill);
    END; { of WITH DO }
  END; { of buffer_space }



  PROCEDURE abort_transfer
		       ( VAR b_info: buf_info_type );
  BEGIN
    WITH b_info
    DO BEGIN

      IF active_isc <> no_isc
	THEN BEGIN

	  WITH isc_table[active_isc] DO
	  CALL ( io_drv_ptr^.iod_init ,
		 io_tmp_ptr );


	END; { of IF }

    END; { of WITH b_info DO }

  END; { of abort_transfer }




  FUNCTION  transfer_setup
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 VAR t_cnt : INTEGER )
		       : type_isc ;
  VAR io_isc : type_isc;
  BEGIN

    IF device>iomaxisc THEN io_isc := device DIV 100
		       ELSE io_isc := device;

    IF isc_table[io_isc].io_tmp_ptr = NIL
		       THEN io_escape(ioe_no_driver,io_isc);


    WITH b_info
    DO BEGIN

      { test for tfr count }
      IF t_cnt=0
	THEN BEGIN
	  { error }
	  io_escape(ioe_bad_cnt,no_isc);
	END;

      { test for another tfr on this buffer }
      IF active_isc <> no_isc
	THEN BEGIN
	  { error }
	  io_escape(ioe_buf_busy,no_isc);
	END
	ELSE BEGIN
	  IF buffer_data(b_info)=0 THEN buffer_reset(b_info);
	END; { of IF }


      { configure card based on direction and check for available space/data }
      IF t_dir= to_memory
	THEN BEGIN
	  IF isc_table[io_isc].io_tmp_ptr^.in_bufptr <> NIL
	    THEN BEGIN
	      { error }
	      io_escape(ioe_isc_busy,io_isc);
	    END; { of IF }
	  IF buffer_space(b_info)<t_cnt
	    THEN BEGIN
	      { error }
	      io_escape(ioe_no_space,io_isc);
	    END; { of IF }
	  io_isc:=addr_to_talk(device);
	  isc_table[io_isc].io_tmp_ptr^.in_bufptr :=  ADDR( b_info );
	END
	ELSE BEGIN
	  IF isc_table[io_isc].io_tmp_ptr^.out_bufptr <> NIL
	    THEN BEGIN
	      { error }
	      io_escape(ioe_isc_busy,io_isc);
	    END; { of IF }
	  IF buffer_data(b_info)<t_cnt
	    THEN BEGIN
	      { error }
	      io_escape(ioe_no_data,io_isc);
	    END; { of IF }
	  io_isc:=addr_to_listen(device);
	  isc_table[io_isc].io_tmp_ptr^.out_bufptr :=  ADDR( b_info );
	END; { of IF }

      drv_tmp_ptr:= isc_table[io_isc].io_tmp_ptr;
      act_tfr    := no_tfr;
      usr_tfr    := t_tfr;
      b_w_mode   := FALSE;                      { byte mode }
      end_mode   := FALSE;                      { no EOI }
      direction  := t_dir;
      term_char  := -1;                         { no termination character }
      term_count := t_cnt;

    END; { of WITH b_info DO }

    transfer_setup := io_isc;

  END; { of transfer_setup }



  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
  VAR io_isc     : type_isc;
      t_count   : INTEGER;
  BEGIN
    t_count:=x_count;
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    { transfer temporary was set up in transfer_setup }

    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer }




  PROCEDURE transfer_word
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
  VAR io_isc    : type_isc;
      t_count   : INTEGER;
  BEGIN
    t_count:=x_count;
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    { fix up transfer temporary }
    b_info.b_w_mode   := TRUE;                       { word mode }

    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer_word }




  PROCEDURE transfer_until
		       ( term      : CHAR ;
			 device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;
  VAR io_isc    : type_isc;
      t_count   : INTEGER;
  BEGIN
    t_count := buffer_space(b_info);
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    IF t_dir = from_memory
      THEN BEGIN
	{ error }
	io_escape(ioe_bad_tfr,io_isc);
      END;

    WITH b_info DO BEGIN

      { fix up transfer temporary }
      term_char  := ord(term);                  { termination character }

      { check for transfer type cases }
      IF t_tfr = serial_FASTEST  THEN usr_tfr := serial_FHS;
      IF t_tfr = overlap_FASTEST THEN usr_tfr := overlap_FHS;
      IF t_tfr = OVERLAP         THEN usr_tfr := overlap_INTR;
      IF ( t_tfr = serial_DMA  )  OR  ( t_tfr = overlap_DMA )
	THEN BEGIN
	  { error }
	  io_escape(ioe_bad_tfr,io_isc);
	END; { of IF }

    END; { of WITH b_info DO BEGIN }


    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer_until }



  PROCEDURE transfer_end(device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;
  VAR io_isc    : type_isc;
      t_count   : INTEGER;
  BEGIN
    IF t_dir=from_memory
      THEN BEGIN
	t_count := buffer_data(b_info);
      END
      ELSE BEGIN
	t_count := buffer_space(b_info);
      END; { of IF }
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    { fix up transfer temporary }
    b_info.end_mode   := TRUE;                       { EOI }

    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer_end }



  PROCEDURE readbuffer ( VAR b_info: buf_info_type;
			 VAR value : CHAR);
  VAR p : ^CHAR;
  BEGIN
    IF buffer_data(b_info)<1
      THEN BEGIN
	{ error }
	io_escape(ioe_no_data,no_isc);
      END
      ELSE BEGIN
	WITH b_info
	DO BEGIN
	  IF ( active_isc <> no_isc ) AND
	     ( direction = from_memory )
	    THEN BEGIN
	      { error }
	      io_escape( no_isc , ioe_buf_busy );
	    END; { of IF }
	  p:=ANYPTR(buf_empty);
	  value:=p^;
	  buf_empty:=ANYPTR(INTEGER(buf_empty)+1);
	END; { of WITH b_info DO }
      END; { of IF }
  END; { of readbuffer }



  PROCEDURE writebuffer( VAR b_info: buf_info_type;
			 value     : CHAR);
  VAR p : ^CHAR;
  BEGIN
    IF buffer_space(b_info)<1
      THEN BEGIN
	{ error }
	io_escape(ioe_no_space,no_isc);
      END
      ELSE BEGIN
	WITH b_info
	DO BEGIN
	  IF ( active_isc <> no_isc ) AND
	     ( direction = to_memory )
	    THEN BEGIN
	      { error }
	      io_escape( no_isc , ioe_buf_busy );
	    END; { of IF }
	  p:=buf_fill;
	  p^:=value;
	  buf_fill:=ANYPTR(INTEGER(buf_fill)+1);
	END; { of WITH b_info DO }
      END; { of IF }
  END; { of writebuffer }



  PROCEDURE readbuffer_string
		       ( VAR b_info: buf_info_type;
			 VAR str   : STRING;
			 str_count : INTEGER);
  VAR i         : INTEGER ;
  BEGIN
    IF STRMAX(str) < str_count
      THEN BEGIN
	{ error - string too small }
	io_escape(ioe_misc,no_isc);
      END;
    SETSTRLEN(str,str_count);           { so I can put chars into empty string }
    IF buffer_data(b_info)<str_count
      THEN BEGIN
	{ error - not enought data in buffer }
	io_escape(ioe_no_data,no_isc);
      END
      ELSE BEGIN
	FOR i:=1 TO str_count
	  DO BEGIN
	    readbuffer(b_info,str[i]);
	  END; { of FOR BEGIN }
	SETSTRLEN(str,str_count);
      END; { of IF }
  END; { of readbuffer_string }



  PROCEDURE writebuffer_string
		       ( VAR b_info: buf_info_type;
			 str       : io_STRING);
  VAR i         : INTEGER;
  BEGIN
    IF buffer_space(b_info)<STRLEN(str)
      THEN BEGIN
	{ error }
	io_escape(ioe_no_space,no_isc);
      END
      ELSE BEGIN
	FOR i:=1 TO STRLEN(str)
	  DO BEGIN
	    writebuffer(b_info,str[i]);
	  END; { of FOR BEGIN }
      END; { of IF }
  END; { of writebuffer_string }


  FUNCTION  buffer_busy( VAR b_info: buf_info_type )            { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }
  BEGIN                                                         { 0083 TM 7/23/82 }
    WITH b_info DO BEGIN                                        { 0083 TM 7/23/82 }
      IF active_isc <> no_isc THEN buffer_busy := TRUE          { 0083 TM 7/23/82 }
			      ELSE buffer_busy := FALSE;        { 0083 TM 7/23/82 }
    END; { of WITH DO BEGIN }                                   { 0083 TM 7/23/82 }
  END; { of buffer_busy }                                       { 0083 TM 7/23/82 }

  FUNCTION  isc_busy   ( isc       : type_isc )                 { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }
  BEGIN                                                         { 0083 TM 7/23/82 }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN                    { 0083 TM 7/23/82 }
      IF ( in_bufptr <> NIL ) OR                                { 0083 TM 7/23/82 }
	 ( out_bufptr <> NIL ) THEN isc_busy := TRUE            { 0083 TM 7/23/82 }
			       ELSE isc_busy := FALSE;          { 0083 TM 7/23/82 }
    END; { of WITH DO BEGIN }                                   { 0083 TM 7/23/82 }
  END; { of isc_busy }                                          { 0083 TM 7/23/82 }



END;    { of general_4 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      HPIB GROUP                                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)




MODULE hpib_0 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  09/17/81

	  purpose This module contains the LEVEL 0 HPIB GROUP procedures.

	}


IMPORT    iodeclarations ;


EXPORT


  PROCEDURE set_hpib    ( select_code : type_isc ;
			  line        : type_hpib_line);
  PROCEDURE clear_hpib  ( select_code : type_isc ;
			  line        : type_hpib_line);
  FUNCTION  hpib_line   ( select_code : type_isc ;
			  line        : type_hpib_line)
			: BOOLEAN;

IMPLEMENT




  PROCEDURE set_hpib    ( select_code : type_isc ;
			  line        : type_hpib_line);
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_set,
	 io_tmp_ptr,
	 ORD(line));
  END;



  PROCEDURE clear_hpib  ( select_code : type_isc ;
			  line        : type_hpib_line);
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_clr,
	 io_tmp_ptr,
	 ORD(line));
  END;



  FUNCTION  hpib_line   ( select_code : type_isc ;
			  line        : type_hpib_line)
			: BOOLEAN;
  VAR my_boolean : BOOLEAN;
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_test,
	 io_tmp_ptr,
	 ORD(line),
	 my_boolean);
    hpib_line:=my_boolean;
  END;



END;    { of hpib_0 }
$PAGE$
MODULE hpib_2 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  03/09/83

	  purpose This module contains the LEVEL
		  2 HPIB GROUP procedures.

	}


IMPORT  iodeclarations ;

EXPORT


  PROCEDURE abort_hpib
		    ( select_code : type_isc);
  PROCEDURE clear   ( device      : type_device);
  PROCEDURE listen  ( select_code : type_isc ;
		      address     : type_hpib_addr );
  PROCEDURE local   ( device      : type_device);
  PROCEDURE local_lockout
		    ( select_code : type_isc);
  PROCEDURE pass_control
		    ( device      : type_device);
  PROCEDURE ppoll_configure
		    ( device      : type_device;
		      mask        : INTEGER );
  PROCEDURE ppoll_unconfigure
		    ( device      : type_device);
  PROCEDURE remote  ( device      : type_device);
  PROCEDURE secondary
		    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  PROCEDURE talk    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  PROCEDURE trigger ( device      : type_device);
  PROCEDURE unlisten( select_code : type_isc );
  PROCEDURE untalk  ( select_code : type_isc );


IMPLEMENT

  IMPORT  hpib_0 ,
	  hpib_1 ;


  PROCEDURE abort_hpib
		    ( select_code : type_isc);
  BEGIN

    { what about active tfrs ? }

    IF system_controller(select_code)
      THEN BEGIN
	set_hpib(select_code,ifc_line);
	   set_hpib(select_code,ren_line);
	   clear_hpib(select_code,ifc_line);
	   clear_hpib(select_code,atn_line);            {  all done by ifc }
      END
    ELSE BEGIN
      IF active_controller(select_code)
	THEN BEGIN
	  send_command(select_code,
	       CHR(talk_constant+my_address(select_code)));
	  send_command(select_code,'?');
	  clear_hpib(select_code,atn_line);
	END
	ELSE BEGIN
	  { do nothing }
	END; { of IF }
    END; { of IF }
  END; { of abort_hpib }


  PROCEDURE clear   ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    io_isc:=set_to_listen(device);
    IF device>iomaxisc
      THEN BEGIN
	send_command(io_isc,sdc_message);
      END
      ELSE BEGIN
	send_command(io_isc,dcl_message);
      END; { of IF }
  END; { of clear }



  PROCEDURE listen  ( select_code : type_isc ;
		      address     : type_hpib_addr );
  BEGIN
    send_command(select_code,CHR(listen_constant+address));
  END; { of listen }



  PROCEDURE local   ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    IF device>iomaxisc
      THEN BEGIN
	io_isc:=set_to_listen(device);                  { BUG 1251  TM 1/8/82 }
	send_command(io_isc,gtl_message);
      END
      ELSE BEGIN
	io_isc := device;                               { BUG 1251  TM 1/8/82 }
	IF system_controller(io_isc)                    { BUG jsjs  TM 3/9/83 }
	  THEN BEGIN
	    { system controller - drop REN }            { BUG jsjs  TM 3/9/83 }
	    clear_hpib(io_isc,ren_line);
	    IF active_controller(io_isc)                { BUG 1251  TM 1/26/82 }
	      THEN clear_hpib(io_isc,atn_line);         { BUG 1251  TM 1/26/82 }
	  END                                           { BUG jsjs  TM 3/9/83 }
	  ELSE BEGIN                                    { BUG jsjs  TM 3/9/83 }
	    { not system controller - send GTL }        { BUG jsjs  TM 3/9/83 }
	    send_command(io_isc,gtl_message);           { BUG jsjs  TM 3/9/83 }
	  END; { of IF }                                { BUG jsjs  TM 3/9/83 }
      END; { of IF }
  END; { of local }




  PROCEDURE local_lockout
		    ( select_code : type_isc);
  BEGIN
    send_command(select_code,llo_message);
  END; { of local_lockout }



  PROCEDURE pass_control
		    ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    IF device>iomaxisc                                  { BUG 1258  TM 1/8/82 }
      THEN BEGIN                                        { BUG 1258  TM 1/8/82 }
	io_isc := device DIV 100;                       { BUG 1258  TM 1/8/82 }
	send_command(io_isc,unl_message);               { BUG 1258  TM 1/8/82 }
	send_command(io_isc,                            { BUG 1258  TM 1/8/82 }
		 chr((device MOD 100)+talk_constant));  { BUG 1258  TM 1/8/82 }
      END                                               { BUG 1258  TM 1/8/82 }
      ELSE BEGIN                                        { BUG 1258  TM 1/8/82 }
	io_isc := set_to_talk(device);                  { BUG 1258  TM 1/8/82 }
      END; { of IF device }                             { BUG 1258  TM 1/8/82 }
    send_command(io_isc,tct_message);
  END;



  PROCEDURE ppoll_configure
		    ( device      : type_device;
		      mask        : INTEGER );
  VAR io_isc     : type_isc;
  BEGIN
    io_isc:=set_to_listen(device);
    IF io_isc=device
      THEN BEGIN
	{ error }
	io_escape(ioe_not_dvc,io_isc);
      END
      ELSE BEGIN
	send_command(io_isc,ppc_message);
	send_command(io_isc,CHR(ord(ppe_message)+(mask MOD 16)));
      END; { of IF }
  END; { of ppoll_configure }



  PROCEDURE ppoll_unconfigure
		    ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    io_isc:=set_to_listen(device);
    IF device>iomaxisc
      THEN BEGIN
	send_command(io_isc,ppc_message);
	send_command(io_isc,ppd_message);
      END
      ELSE BEGIN
	send_command(io_isc,ppu_message);
      END; { of IF }
  END; { of ppoll_unconfigure }



  PROCEDURE remote  ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    IF device>iomaxisc
      THEN BEGIN
	io_isc:=device DIV 100;
	IF NOT system_controller(io_isc)                { BUG 1252  TM 1/8/82 }
	  THEN io_escape(ioe_not_sctl,io_isc);          { BUG 1252  TM 1/8/82 }
	set_hpib(io_isc,ren_line);
	io_isc:=set_to_listen(device);
      END
      ELSE BEGIN
	io_isc := device;                               { BUG 1252  TM 1/8/82 }
	IF NOT system_controller(io_isc)                { BUG 1252  TM 1/8/82 }
	  THEN io_escape(ioe_not_sctl,io_isc);          { BUG 1252  TM 1/8/82 }
	set_hpib(io_isc,ren_line);
      END; { of IF }
  END; { of remote }



  PROCEDURE secondary
		    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  BEGIN
    send_command(select_code,CHR(address+96));
  END; { of secondary }



  PROCEDURE talk    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  BEGIN
    send_command(select_code,CHR(address+talk_constant));
  END; { of talk }



  PROCEDURE trigger ( device      : type_device);
  BEGIN
    send_command(set_to_listen(device),get_message);
  END; { of trigger }


  PROCEDURE unlisten( select_code : type_isc );
  BEGIN
    send_command(select_code,unl_message);
  END; { of unlisten }


  PROCEDURE untalk  ( select_code : type_isc );
  BEGIN
    send_command(select_code,unt_message);
  END; { of untalk }




END;    { of hpib_2 }
$PAGE$
MODULE hpib_3 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  01/08/82

	  purpose This module contains the LEVEL
		  3 HPIB GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT


  FUNCTION  requested
		    ( select_code : type_isc )
		    : BOOLEAN ;
  FUNCTION  ppoll   ( select_code : type_isc )
		    : INTEGER ;
  FUNCTION  spoll   ( device      : type_device)
		    : INTEGER ;

  PROCEDURE request_service
		    ( select_code : type_isc ;
		      response    : INTEGER );
  FUNCTION  listener( select_code : type_isc )
		    : BOOLEAN;
  FUNCTION  talker  ( select_code : type_isc )
		    : BOOLEAN ;
  FUNCTION  remoted ( select_code : type_isc )
		    : BOOLEAN ;
  FUNCTION  locked_out
		    ( select_code : type_isc )
		    : BOOLEAN ;


IMPLEMENT


  IMPORT  iocomasm ,
	  general_0 ,
	  general_1 ,
	  hpib_0 ,
	  hpib_1 ;




  FUNCTION  requested
		    ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    IF active_controller(select_code)
      THEN BEGIN
	requested:=hpib_line(select_code,srq_line);
      END
      ELSE BEGIN
	{ error - not active controller when look at srq }
	io_escape(ioe_not_act,select_code);
      END; { of IF }
  END; { of requested }





  FUNCTION  ppoll   ( select_code : type_isc )
		    : INTEGER ;
  VAR my_byte : CHAR;
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_ppoll,
	 io_tmp_ptr,
	 my_byte);
    ppoll:=ORD(my_byte);
  END; { of ppoll }




  FUNCTION  spoll   ( device      : type_device)
		    : INTEGER ;
  VAR io_isc      : type_isc;
      io_work_char: CHAR;
  BEGIN
    io_isc:=set_to_talk(device);
    send_command(io_isc,spe_message);
    readchar(io_isc,io_work_char);
    send_command(io_isc,spd_message);
    send_command(io_isc,unt_message);
    spoll:=ord(io_work_char);
  END; { of spoll }










  PROCEDURE request_service
		    ( select_code : type_isc ;
		      response    : INTEGER );
  BEGIN
    IF isc_table[select_code].card_type=hpib_card
      THEN BEGIN
	IF NOT active_controller(select_code)           { BUG 1250  TM 1/8/82 }
	  THEN iocontrol(select_code,1,response)        { BUG 1250  TM 1/8/82 }
	  ELSE io_escape(ioe_misc,select_code);         { BUG 1250  TM 1/8/82 }
      END
      ELSE BEGIN
	{ error }
	io_escape(ioe_not_hpib,select_code);
      END; { of IF }
  END; { of request_service }




  FUNCTION  listener( select_code : type_isc )
		    : BOOLEAN;
  BEGIN
    listener:=bit_set(iostatus(select_code,6),10);
  END; { of listener }





  FUNCTION  talker  ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    talker:=bit_set(iostatus(select_code,6),9);
  END; { of talker }




  FUNCTION  remoted ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    remoted:=bit_set(iostatus(select_code,6),15);
  END; { of remoted }




  FUNCTION  locked_out
		    ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    locked_out:=bit_set(iostatus(select_code,6),14);
  END;




END;    { of hpib_3 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      SERIAL GROUP                                                    *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      The 98626 code in the serial_0 and serial_3 modules has NOT     *)
(*      been tested and is included in the hopes that it is correct     *)
(*      and that someone will do the 98626 card drivers sometime.       *)
(*                                                                      *)
(*      There is a good chance that the 98626 will require a re-        *)
(*      release of the IOLIB:IOLIB file ( serial modules only ).        *)
(*                                                                      *)
(************************************************************************)




MODULE serial_0 ;

	{ by      Tim Mikkelsen
	  date    07/22/81
	  update  11/06/81

	  purpose This module contains the LEVEL
		  0 SERIAL GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT




  PROCEDURE set_serial  ( select_code : type_isc ;
			  line        : type_serial_line);
  PROCEDURE clear_serial( select_code : type_isc ;
			  line        : type_serial_line);
  FUNCTION  serial_line ( select_code : type_isc ;
			  line        : type_serial_line)
			: BOOLEAN;


IMPLEMENT

  IMPORT  iocomasm ,
	  general_0 ;



  PROCEDURE set_serial  ( select_code : type_isc ;
			  line        : type_serial_line);
  VAR mybit  : INTEGER;
      dummy  : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);

      IF (isc_table[select_code].card_id = hp98628_async)
	THEN BEGIN
	  CASE line OF

	    rts_line:   mybit := 1;

	    dtr_line:   mybit := 2;

	    drs_line:   mybit := 4;

	    OTHERWISE io_escape(ioe_bad_sct,select_code);

	  END; { of CASE line }
	  dummy := iostatus(select_code,8);
	  dummy := binior(dummy,mybit);
	  iocontrol(select_code,8+256,dummy);

	END
	ELSE BEGIN

	  IF (card_id = hp98626) OR (card_id = hp98644)
	    THEN BEGIN
	      CASE line OF

		rts_line:   mybit := 2;

		dtr_line:   mybit := 1;

		drs_line:   mybit := 8;

		OTHERWISE io_escape(ioe_bad_sct,select_code);

	      END; { of CASE line }

	      dummy := iostatus(select_code,5);
	      dummy := binior(dummy,mybit);
	      iocontrol(select_code,5,dummy);

	    END
	    ELSE BEGIN
	      CALL ( io_drv_ptr^.iod_set ,
		     io_tmp_ptr ,
		     ORD(line) );
	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }

  END; { of set_serial }




  PROCEDURE clear_serial( select_code : type_isc ;
			  line        : type_serial_line);
  VAR mybit  : INTEGER;
      dummy  : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN
	  CASE line OF

	    rts_line:   mybit := 1;

	    dtr_line:   mybit := 2;

	    drs_line:   mybit := 4;

	    OTHERWISE io_escape(ioe_bad_sct,select_code);

	  END; { of CASE line }
	  dummy := iostatus(select_code,8);
	  dummy := binand(dummy,bincmp(mybit));
	  iocontrol(select_code,8+256,dummy);

	END
	ELSE BEGIN

	  IF (card_id = hp98626) or (card_id = hp98644)
	    THEN BEGIN
	      CASE line OF

		rts_line:   mybit := 2;

		dtr_line:   mybit := 1;

		drs_line:   mybit := 8;

		OTHERWISE io_escape(ioe_bad_sct,select_code);

	      END; { of CASE line }

	      dummy := iostatus(select_code,5);
	      dummy := binand(dummy,bincmp(mybit));
	      iocontrol(select_code,5,dummy);

	    END
	    ELSE BEGIN
	      CALL ( io_drv_ptr^.iod_clr ,
		     io_tmp_ptr ,
		     ORD(line) );
	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }
  END; { of clear_serial }





  FUNCTION  serial_line ( select_code : type_isc ;
			  line        : type_serial_line )
			: BOOLEAN ;
  VAR mybit  : INTEGER;
      dummy  : INTEGER;
      reg    : INTEGER;
      mybool : BOOLEAN;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN
	  CASE line OF

	    rts_line:   BEGIN
			  reg   := 8;
			  mybit := 0;
			END;

	    dtr_line:   BEGIN
			  reg   := 8;
			  mybit := 1;
			END;

	    drs_line:   BEGIN
			  reg   := 8;
			  mybit := 2;
			END;

	    dsr_line:   BEGIN
			  reg   := 7;
			  mybit := 0;
			END;

	    dcd_line:   BEGIN
			  reg   := 7;
			  mybit := 1;
			END;

	    cts_line:   BEGIN
			  reg   := 7;
			  mybit := 2;
			END;

	    ri_line:    BEGIN
			  reg   := 7;
			  mybit := 3;
			END;

	    OTHERWISE io_escape(ioe_bad_sct,select_code);

	  END; { of CASE line }
	  dummy := iostatus(select_code,reg);
	  mybool:= bit_set(dummy,mybit);

	END
	ELSE BEGIN

	  IF (card_id = hp98626) or (card_id = hp98644)
	    THEN BEGIN
	      CASE line OF

		rts_line:   BEGIN
			      reg   := 5;
			      mybit := 1;
			    END;

		dtr_line:   BEGIN
			      reg   := 5;
			      mybit := 0;
			    END;

		drs_line:   BEGIN
			      reg   := 5;
			      mybit := 3;
			    END;

		dsr_line:   BEGIN
			      reg   := 11;
			      mybit := 5;
			    END;

		dcd_line:   BEGIN
			      reg   := 11;
			      mybit := 7;
			    END;

		cts_line:   BEGIN
			      reg   := 11;
			      mybit := 4;
			    END;

		ri_line:    BEGIN
			      reg   := 11;
			      mybit := 6;
			    END;

		OTHERWISE io_escape(ioe_bad_sct,select_code);

	      END; { of CASE line }
	      dummy := iostatus(select_code,reg);
	      mybool:= bit_set(dummy,mybit);

	    END
	    ELSE BEGIN

	      CALL ( io_drv_ptr^.iod_test ,
		 io_tmp_ptr ,
		 ORD(line) ,
		 mybool );

	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }

    serial_line := mybool;

  END; { of serial_line }





END; { of serial_0 }
$PAGE$
MODULE serial_3 ;

	{ by      Tim Mikkelsen
	  date    07/22/81
	  update  10/01/82

	  purpose This module contains the LEVEL
		  3 SERIAL GROUP procedures.

	}

IMPORT    iodeclarations ;

EXPORT


  PROCEDURE set_baud_rate
		    ( select_code : type_isc ;
		      rate        : REAL );
  PROCEDURE set_stop_bits
		    ( select_code : type_isc ;
		      num_bits    : REAL );
  PROCEDURE set_char_length
		    ( select_code : type_isc ;
		      num_char_bit: INTEGER );
  PROCEDURE set_parity
		    ( select_code : type_isc ;
		      parity_mode : type_parity);
  PROCEDURE send_break
		    ( select_code : type_isc );

  PROCEDURE abort_serial
		    ( select_code : type_isc );


IMPLEMENT


  IMPORT  iocomasm ,
	  general_0  ;


  PROCEDURE set_baud_rate
		    ( select_code : type_isc ;
		      rate        : REAL );
  VAR dummy : INTEGER;
    FUNCTION calc_rate ( r : REAL ) : INTEGER;
    VAR myrate : INTEGER;
    BEGIN
      myrate := 0;
      IF r=50    THEN myrate := 1;
      IF r=75    THEN myrate := 2;
      IF r=110   THEN myrate := 3;
      IF r=134.5 THEN myrate := 4;
      IF r=150   THEN myrate := 5;
      IF r=200   THEN myrate := 6;
      IF r=300   THEN myrate := 7;
      IF r=600   THEN myrate := 8;
      IF r=1200  THEN myrate := 9;
      IF r=1800  THEN myrate :=10;
      IF r=2400  THEN myrate :=11;
      IF r=3600  THEN myrate :=12;
      IF r=4800  THEN myrate :=13;
      IF r=9600  THEN myrate :=14;
      IF r=19200 THEN myrate :=15;

      calc_rate := myrate;

    END; { of calc_rate }
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  dummy:=calc_rate(rate);
	  IF dummy = 0 THEN io_escape(ioe_misc,select_code);
	  iocontrol(select_code,20,dummy);              { BUG 1270  TM 1/8/82 }
	  iocontrol(select_code,21,dummy);              { BUG 1270  TM 1/8/82 }

	END
	ELSE BEGIN

	  IF (isc_table[select_code].card_id = hp98626) OR
	     (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN

	      dummy:=ROUND(rate);
	      IF dummy = 0 THEN io_escape(ioe_misc,select_code);
	      iocontrol(select_code,3,dummy);

	      { what about 134.5 ? }

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF 98626 }

	END; { of IF 98628_async }

    END; { of WITH isc_table BEGIN }
  END; { of set_baud_rate }





  PROCEDURE set_stop_bits
		    ( select_code : type_isc ;
		      num_bits    : REAL );
  VAR myval : INTEGER;
      dummy : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  IF num_bits = 1
	    THEN BEGIN
	      myval := 0;
	    END
	    ELSE BEGIN
	      IF num_bits = 1.5
		THEN BEGIN
		  myval := 1;
		END
		ELSE BEGIN
		  IF num_bits = 2
		    THEN BEGIN
		      myval :=2
		    END
		    ELSE BEGIN
		      io_escape(ioe_misc,select_code);
		    END; { of IF 2 }

		END;   { of IF 1.5 }

	    END;     { of IF 1 }

	  iocontrol(select_code,35,myval);              { BUG 1270  TM 1/8/82 }

	END
	ELSE BEGIN
	  IF (isc_table[select_code].card_id = hp98626)   { BUG 1269  TM 1/8/82 }
	    OR (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN
	      IF num_bits = 1
		THEN BEGIN
		  myval:=0;
		END
		ELSE BEGIN
		  IF num_bits = 1.5
		    THEN BEGIN
		      IF binand(iostatus(select_code,4),3)<>0
			THEN io_escape(ioe_misc,select_code);
		      myval:=1;
		    END
		    ELSE BEGIN
		      IF num_bits = 2
			THEN BEGIN
			  myval:=1;
			END
			ELSE BEGIN
			  io_escape(ioe_misc,select_code);
			END; { of IF 2 }

		    END;   { of IF 1.5 }

		END;     { of IF 1 }

	      dummy:=iostatus(select_code,4);
	      dummy:=binand(dummy,251)+myval*4;                 { 0359 TM 8/26/82 }
	      iocontrol(select_code,4,dummy);

	    END
	    ELSE BEGIN
	      io_escape(ioe_misc,select_code);
	    END; { of IF 98626 }

	END; { of IF 98628_async }

    END; { of WITH isc_table BEGIN }

  END; { set_stop_bits }




  PROCEDURE set_char_length
		    ( select_code : type_isc ;
		      num_char_bit: INTEGER );
  VAR myval : INTEGER;
      dummy : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      CASE num_char_bit OF

	5:    myval := 0;
	6:    myval := 1;
	7:    myval := 2;
	8:    myval := 3;

	OTHERWISE io_escape(ioe_misc,select_code);

      END; { of CASE }


      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  iocontrol(select_code,34,myval);

	END
	ELSE BEGIN

	  IF(isc_table[select_code].card_id = hp98626)
	    or (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN

	      dummy:=iostatus(select_code,4);
	      dummy:=binand(dummy,252)+myval;                   { 0359 TM 8/23/82 }
	      iocontrol(select_code,4,dummy);                   {  557 TM 10/1/82 }

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF 98626 }

	END; { of IF 98628_asnync }

    END; { of WITH isc_table BEGIN }
  END; { set_char_length }





  PROCEDURE set_parity
		    ( select_code : type_isc ;
		      parity_mode : type_parity);
  VAR myval : INTEGER;
      dummy : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  CASE parity_mode OF

	    no_parity:    myval := 0;
	    odd_parity:   myval := 1;
	    even_parity:  myval := 2;
	    zero_parity:  myval := 3;                           { 0355 TM 8/20/82 }
	    one_parity:   myval := 4;                           { 0355 TM 8/20/82 }

	    OTHERWISE io_escape(ioe_misc,select_code);

	  END; { of CASE }

	  iocontrol(select_code,36,myval);

	END
	ELSE BEGIN

	  IF (isc_table[select_code].card_id = hp98626)
	    or (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN

	      CASE parity_mode OF

		no_parity:    myval := 0;
		odd_parity:   myval := 1;
		even_parity:  myval := 3;
		one_parity:   myval := 5;
		zero_parity:  myval := 7;

		OTHERWISE io_escape(ioe_misc,select_code);

	      END; { of CASE }

	      dummy:=iostatus(select_code,4);
	      dummy:=binand(dummy,199)+myval*8;                 { 0359 TM 8/23/82 }
	      iocontrol(select_code,4,dummy);

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF 98626 }

	END; { of IF 98628_asnync }

    END; { of WITH isc_table BEGIN }
  END; { set_parity }




  PROCEDURE send_break
		    ( select_code : type_isc );
  BEGIN

    { what about active tfrs }

    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  iocontrol(select_code,6,1);

	END
	ELSE BEGIN
	  IF (card_id = hp98626) or (card_id = hp98644)
	    THEN BEGIN

	      iocontrol(select_code,1,1);

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }
  END; { of send_break }


  PROCEDURE abort_serial
		    ( select_code : type_isc );
  BEGIN

    { what about active tfrs }

    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  iocontrol(select_code,256+125,1);             { BUG xxxx TM 1/26/82 }

	END
	ELSE BEGIN
	  IF (card_id = hp98626) or (card_id = hp98644)  { BUG FIX 6/4/84 }
	    THEN BEGIN

	      iocontrol(select_code,0,1);

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }
  END; { of abort_serial }



END;    { of serial_3 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      PARALLEL GROUP                                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)


module parallel_3;

import iodeclarations;


export
{
  IOCONTROL and IOSTATUS register definitions.
}
{-----------------------------------------------------------------}
	{
	  level 0 registers.
	  Registers 0 - 9 are system defined registers.
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_CARD_ID       =  0;
	PLLEL_REG_RESET         =  0;
	PLLEL_REG_INTDMA_STATUS =  1;

const
	{ for use with PLLEL_REG_CARD_ID }
	PARALLEL_CARDID         =  6;

type
	{ for use with: PLLEL_REG_INTDMA_STATUS }
	intdma_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   ie:          boolean;
			   ir:          boolean;
			   intlvl:      0..3;
			   pad:         0..3;
			   de1:         boolean;
			   de0:         boolean);
		end;




{-----------------------------------------------------------------}
	{
	  level 10 registers.
	  Register 10 - 19 are for hardware status and control.
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_PERIPHERAL_STATUS     = 10;
	PLLEL_REG_COMM_STATUS           = 11;
	PLLEL_REG_HOST_LINE_CONTROL     = 12;
	PLLEL_REG_IO_CONTROL            = 13;
	PLLEL_REG_FIFO                  = 14;

type
	{ for use with: PLLEL_REG_PERIPHERAL_STATUS }
	peripheral_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('1F');
			   nerror_low:  boolean;
			   select_high: boolean;
			   perror_high: boolean);
		end;
const
	PLLEL_PERIPHERAL_ONLINE         = HEX('02');

type
	{ for use with: PLLEL_REG_COMM_STATUS }
	comm_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..7;
			   fifofull:    boolean;
			   fifoempty:   boolean;
			   nstrobe_low: boolean; {true = asserted low}
			   busy_high:   boolean;
			   nack_low:    boolean);
		end;


type
	{ for use with: PLLEL_REG_HOST_LINE_CONTROL }
	host_line_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('1F');
			   ninit_low:   boolean;
			   nselectin_low:boolean;
			   wr_nrd_high: boolean);
		end;


type
	{ for use with: PLLEL_REG_IO_CONTROL }
	io_control_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('3F');
			   modify_io:   boolean;
			   input_high:  boolean);
		end;




{-----------------------------------------------------------------}
	{
	  level 20 registers.
	  Register 20 - 29 are for driver status and control.
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_PERIPHERAL_TYPE       = 20;
	PLLEL_REG_TYPE_RESET            = 21;
	PLLEL_REG_PERIPHERAL_RESET      = 22;
	PLLEL_REG_INTERRUPT_STATE       = 23;
	PLLEL_REG_DRIVER_OPTIONS        = 24;
	PLLEL_REG_OPTIONS_RESET         = 25;
	PLLEL_REG_DRIVER_STATE          = 26;

const
	{ for use with: PLLEL_REG_PERIPHERAL_TYPE
			PLLEL_REG_TYPE_RESET }
	NOT_PRESENT             =  0;
	OUTPUT_ONLY             =  1;
	HP_BIDIRECTIONAL        =  2;
	USER_SPEC_NO_DEVICE     =  10;
	USER_SPEC_OUTPUT_ONLY   =  11;
	USER_SPEC_HP_BIDIRECTIONAL =  12;

	OUTPUT_SET              = [OUTPUT_ONLY,
				   HP_BIDIRECTIONAL,
				   USER_SPEC_OUTPUT_ONLY,
				   USER_SPEC_HP_BIDIRECTIONAL];
	INPUT_SET               = [HP_BIDIRECTIONAL,
				   USER_SPEC_HP_BIDIRECTIONAL];
	USER_SET                = [NOT_PRESENT,
				   USER_SPEC_NO_DEVICE,
				   USER_SPEC_OUTPUT_ONLY,
				   USER_SPEC_HP_BIDIRECTIONAL];




type
	{ for use with PLLEL_REG_INTERRUPT_STATE }
	driver_int_state_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   fifo_full:   boolean;
			   fifo_empty:  boolean;
			   pad:         boolean;
			   busy_low:    boolean;
			   nack_low_trans:boolean;
			   nerror_trans:boolean;
			   select_trans:boolean;
			   pe_trans:    boolean);
		end;


type
	{ for use with: PLLEL_REG_DRIVER_OPTIONS
			PLLEL_REG_OPTIONS_RESET }
	driver_options_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('f');
			   ignore_pe:   boolean;
			   write_verify:boolean;
			   wr_nrd_low:  boolean;
			   use_nack:    boolean);
		end;


type
	{ for use with PLLEL_REG_DRIVER_STATE }
	driver_state_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   disabled:    boolean;
			   error:       boolean;
			   write:       boolean;
			   read:        boolean;
			   pad:         0..7;
			   active_xfer: boolean);
		end;

const
	DISABLED_BY_USER        =  hex('80');
	INACTIVE_ERROR          =  hex('40');
	INACTIVE_WRITE          =  hex('20');
	ACTIVE_WRITE            =  hex('21');
	INACTIVE_READ           =  hex('10');
	ACTIVE_READ             =  hex('11');


{-----------------------------------------------------------------}
	{
	  level 30 registers.
	  Registers 30 - 39 are for User ISR status and control
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_HOOK_STATUS           = 30;
	PLLEL_REG_HOOK_CLEAR            = 30;
	PLLEL_REG_USER_ISR_ENABLE       = 31;
	PLLEL_REG_USER_ISR_STATUS       = 32;

const
	{ for use with PLLEL_REG_HOOK_STATUS }
	USER_ISR_HOOK_INACTIVE  =  0;
	USER_ISR_HOOK_ACTIVE    =  1;


type
	{ for use with: PLLEL_REG_USER_ISR_ENABLE
			PLLEL_REG_USER_ISR_STATUS }
	user_isr_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   fifo_full:   boolean;
			   fifo_empty:  boolean;
			   xfer_extend: boolean;
			   busy_low:    boolean;
			   nack_low_trans:boolean;
			   nerror_trans:boolean;
			   select_trans:boolean;
			   pe_trans:    boolean);
		end;


{-----------------------------------------------------------------}
	{
	  All together now.
	}
{-----------------------------------------------------------------}
type
	p3regs_type = packed record case integer of
		1:(w:                   io_word);
		2:(bh:                  io_byte;
		   bl:                  io_byte);
		3:(intdma_status:       intdma_status_type);
		4:(peripheral_status:   peripheral_status_type);
		5:(comm_status:         comm_status_type);
		6:(host_line:           host_line_type);
		7:(io_control:          io_control_type);
		8:(driver_int_state:    driver_int_state_type);
		9:(driver_options:      driver_options_type);
		10:(driver_state:       driver_state_type);
		11:(user_isr_status:    user_isr_status_type);
		end;


{-----------------------------------------------------------------}
	{
	  HP Parallel interface support routines.
	}
{-----------------------------------------------------------------}
type
	PARALLEL_USER_ISR_TYPE = PROCEDURE(SC:TYPE_ISC);

	PROCEDURE SET_USER_ISR(SC:TYPE_ISC;
				  P:PARALLEL_USER_ISR_TYPE);
	PROCEDURE CLEAR_USER_ISR(SC:TYPE_ISC);
	FUNCTION NACK_SET(SC:TYPE_ISC):BOOLEAN;

implement

procedure sc_check(sc:type_isc);
begin
	with isc_table[sc] do
		if (card_ptr = NIL) or
		   (card_type <> pllel_card) then
			io_escape(ioe_no_card, sc);
end;

procedure set_user_isr(sc:type_isc; p:parallel_user_isr_type);
type
	pxlate_type = record
			case integer of
				1:(pproc:parallel_user_isr_type);
				2:(ioproc:io_proc);
		end;

var
	pxlate:pxlate_type;
begin
	sc_check(sc);
	pxlate.pproc := p;
	with isc_table[sc] do
	begin
		io_tmp_ptr^.user_isr.real_proc := pxlate.ioproc;
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_USER_ISR_ENABLE, 0);
	end;
end;


procedure clear_user_isr(sc:type_isc);
begin
	sc_check(sc);
	with isc_table[sc] do
	begin
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_HOOK_CLEAR, 0);
	end;
end;


function nack_set(sc:type_isc):boolean;
var
	b:boolean;
begin
	sc_check(sc);
	b := false;
	with isc_table[sc] do
		call(io_drv_ptr^.iod_end, io_tmp_ptr, b);
	nack_set := b;
end;

end.  {of PARALLEL_3}
@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 3236
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 3236
					      (*

 (c) Copyright Hewlett-Packard Company, 1985.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$MODCAL ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$DEBUG OFF$
$OVFLCHECK OFF$
$PAGE$
(************************************************************************)
(*                                                                      *)
(*           RELEASED        VERSION         3.1                        *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           IOLIB                                           *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  IOLIB                                           *)
(*      module(s)    -  general_1                                       *)
(*                   -  hpib_1                                          *)
(*                   -  general_2                                       *)
(*                   -  general_3                                       *)
(*                   -  general_4                                       *)
(*                   -  hpib_0                                          *)
(*                   -  hpib_2                                          *)
(*                   -  hpib_3                                          *)
(*                   -  serial_0                                        *)
(*                   -  serial_3                                        *)
(*                                                                      *)
(*      author       -  Tim Mikkelsen                                   *)
(*      phone        -  303-226-3800   ext. 2910                        *)
(*                                                                      *)
(*      date         -  June  1 , 1981                                  *)
(*      update       -  June  4,  1984                                  *)
(*      release      -  Jul  12,  1985                                  *)
(*                                                                      *)
(*      source       -  IOLIB:IOLIB.TEXT                                *)
(*      object       -  IOLIB:IOLIB.CODE                                *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      This is the source code for an external procedures library      *)
(*      to be used for general purpose interfacing on the HP 9826.      *)
(*                                                                      *)
(*      The library consists of 3 primary sets of modules -             *)
(*                                                                      *)
(*              1.      KERNEL modules                                  *)
(*              2.      driver modules                                  *)
(*              3.      IOLIB  modules                                  *)
(*                                                                      *)
(*      The KERNEL modules consist of the following modules -           *)
(*                                                                      *)
(*              1.      iodeclarations  ( contains static r/w space )   *)
(*              2.      iocomasm                                        *)
(*              3.      general_0       ( initialization & low level    *)
(*                                        routines like ioread/iowrite) *)
(*      The KERNEL modules also have an executable program segement     *)
(*      that gets executed at the time it is loaded.  This program      *)
(*      initializes the static read/write memory.  This program also    *)
(*      allocates the temporary storage for any card that exists -      *)
(*      independent of whether there is or is not a driver for it.      *)
(*                                                                      *)
(*      The driver modules consist of the actual assembly or PASCAL     *)
(*      routines that deal with a specific interface card.  There is    *)
(*      also an executable program segment for each driver module.      *)
(*      This program searches the select code table in the static r/w   *)
(*      initialized by the KERNEL general_0 module for all select codes *)
(*      that have the right interface card ( HPIB drivers will search   *)
(*      for the 98624 interface ).  This program will then set up the   *)
(*      driver tables to point to the correct drivers.                  *)
(*                                                                      *)
(*      The rest of the IOLIB modules are high-level modules that are   *)
(*      used by an end user in his/her application program.             *)
(*                                                                      *)
(*      The KERNEL and some set of driver modules will exist in the     *)
(*      SYSTEM.INITLIB file as object code ( not EXPORT text ).  The    *)
(*      export text will reside on the SYSTEM.LIBRARY file.  The rest   *)
(*      of the library will reside on the SYSTEM.LIBRARY.               *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      BUG FIX HISTORY         - after release                         *)
(*                                                                      *)
(*                                                                      *)
(*      BUG #   BY  / ON        LOCATION        DESCRIPTION             *)
(*      -----   -----------     --------------  ----------------------  *)
(*                                                                      *)
(*      1250    T Mikkelsen     HPIB_3          request service allows  *)
(*              01/08/1982      request_service active ctl to request   *)
(*                                              service.                *)
(*                                                                      *)
(*      1251    T Mikkelsen     HPIB_2          local(7) with sc 7 as   *)
(*              01/08/1982      local           sys ctl / not act ctl   *)
(*              01/26/1982                      gives error.            *)
(*                                                                      *)
(*      1252    T Mikkelsen     HPIB_2          remote(7) with sc 7 as  *)
(*              01/08/1982      remote          act ctl / not sys ctl   *)
(*                                              doesn't give error.     *)
(*                                                                      *)
(*      1258    T Mikkelsen     HPIB_2          pass control sends the  *)
(*              01/08/1982      pass_control    wrong sequence to pass  *)
(*                                              control to itself.      *)
(*                                                                      *)
(*      1269    T Mikkelsen     SERIAL_3        bad check for a 98626   *)
(*              01/08/1982      set_stop_bits   card.                   *)
(*                                                                      *)
(*      1270    T Mikkelsen     SERIAL_3        make procedures for     *)
(*              01/08/1982      set_baud_rate   data comm consistent    *)
(*                              set_stop_bits   for buffered control.   *)
(*                              set_parity                              *)
(*                              set_char_length                         *)
(*                                                                      *)
(*      1281    T Mikkelsen     GENERAL_3       Wrong message for error *)
(*              01/08/1982      ioerror_message ioe_not_dvc.            *)
(*                                                                      *)
(*      0082    T Mikkelsen     GENERAL_3       Addition of a link for  *)
(*              07/23/1982      ioerror_message the error messages.     *)
(*                                              See also IODECLARATIONS.*)
(*                                                                      *)
(*      0083    T Mikkelsen     GENERAL_4       Addition of buffer_busy *)
(*              07/23/1982      buffer_busy     and isc_busy routines.  *)
(*                              isc_busy                                *)
(*                                                                      *)
(*      0355    T Mikkelsen     SERIAL_3        Set parity of one and   *)
(*              08/20/1982      set_parity      zero parity is backwards*)
(*                                              for the 98628 card.     *)
(*                                                                      *)
(*      0359    T Mikkelsen     SERIAL_3        Changes for addition    *)
(*              08/26/1982      set_parity      of 98626 drivers.       *)
(*                              set_char_length                         *)
(*                              set_stop_bits                           *)
(*                                                                      *)
(*      0364    T Mikkelsen     GENERAL_3       Addition of SRM driver  *)
(*              08/23/1982      ioerror_message error codes.  See also  *)
(*                                              IODECLARATIONS.         *)
(*                                                                      *)
(*       557    T Mikkelsen     GENERAL_3       Mistyped. ( typo )      *)
(*              10/01/1982      set_parity                              *)
(*                                                                      *)
(*      jsjs    T Mikkelsen     HPIB_2          BUG FIX error in Local  *)
(*              03/09/1983      local           procedure for isc param *)
(*                                              and not sys controller. *)
(*                                                                      *)
(*      tttt    J Schmidt       HPIB_1          Use timer on CPU board  *)
(*              08/03/1983                      if available for timeout*)
(*                                              checking                *)
(*                                                                      *)
(*              J Schmidt       serial modules  add code for 98644      *)
(*              5/15/84                                                 *)
(*              6/4/84                                                  *)
(*                                                                      *)
(*              D Willis        PARALLEL_3      Added for centronics    *)
(*              12/89                           support.                *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      REFERENCES :                                                    *)
(*                                                                      *)
(*                                                                      *)
(*      1.  9826 I/O Designers Guide            ( Loyd Nelson )         *)
(*                                                                      *)
(*      2.  68000 Manual                        ( Motorola )            *)
(*                                                                      *)
(*      3.  Pascal alpha site ERS               ( Roger Ison )          *)
(*                                                                      *)
(*      4.  Pascal I/O Library ERS              ( Tim Mikkelsen )       *)
(*                                                                      *)
(*      5.  9826 HPL EIO & IOD listings         ( Bob Hallissy )        *)
(*                                                                      *)
(*      6.  9826 HPL Misc. I/O Doc.             ( Bob Hallissy )        *)
(*                                                                      *)
(*      7.  9826 card documentation             ( Mfg. Specs. )         *)
(*                                                                      *)
(*      8.  Pascal I/O Library IRS              ( Tim Mikkelsen )       *)
(*                                                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL GROUP                                                   *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)



MODULE general_1 ;

	{ by      Tim Mikkelsen
	  date    07/15/81
	  update  11/20/81

	  purpose This module contains the LEVEL 1 GENERAL GROUP procedures.
	}


{local search{{
$SEARCH 'KERNEL.CODE', 'COMASM'$
{system search{}
$SEARCH 'IOLIB:KERNEL.CODE', 'IOLIB:COMASM'$
{}
IMPORT   iodeclarations  ;

EXPORT

  PROCEDURE ioinitialize;
  PROCEDURE iouninitialize;
  PROCEDURE ioreset     ( select_code : type_isc);
  PROCEDURE readchar    ( select_code : type_isc ;
			  VAR value   : CHAR );
  PROCEDURE writechar   ( select_code : type_isc ;
			  value       : CHAR );
  PROCEDURE readword    ( select_code : type_isc ;
			  VAR num     : INTEGER);
  PROCEDURE writeword   ( select_code : type_isc ;
			  value       : INTEGER);
  PROCEDURE set_timeout ( select_code : type_isc ;
			  time        : REAL );


IMPLEMENT

  IMPORT   general_0;



  PROCEDURE ioinitialize;
  BEGIN

    io_system_reset;

  END; { of ioinitialize }



  PROCEDURE iouninitialize;
  BEGIN

    io_system_reset;

  END; { of iouninitialize }



  PROCEDURE ioreset     ( select_code : type_isc);
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_init,
	 io_tmp_ptr);
  END; { of ioreset }


  PROCEDURE readchar    ( select_code : type_isc ;
			  VAR value   : CHAR );
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_rdb,
	 io_tmp_ptr,
	 value);
  END; { of readchar }



  PROCEDURE writechar   ( select_code : type_isc ;
			  value       : CHAR );
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_wtb,
	 io_tmp_ptr,
	 value);
  END; { of writechar }



  PROCEDURE readword    ( select_code : type_isc ;
			  VAR num     : INTEGER);
  VAR my_num : io_word;
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_rdw,
	 io_tmp_ptr,
	 my_num);
    num:=my_num;
  END; { of readword }



  PROCEDURE writeword   ( select_code : type_isc ;
			  value       : INTEGER);
  VAR my_value : io_word;
  BEGIN
    my_value:=value;
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_wtw,
	 io_tmp_ptr,
	 my_value);
  END; { of writeword }



  PROCEDURE set_timeout ( select_code : type_isc ;
			  time        : REAL            { in seconds } );
  BEGIN
    IF time>8191                { 4 byte timeout  - 1 byte left for shifts }
      THEN BEGIN
	{ error }
	io_escape(ioe_bad_tmo,select_code);
      END; { of IF }
    IF (time>0) AND (time<0.001)
      THEN BEGIN
	{ error }
	io_escape(ioe_bad_tmo,select_code);
      END; { of IF }

    WITH isc_table[select_code] DO BEGIN

      { the table entry used by drivers is in milliseconds }
      user_time:=ROUND(time*1000);

      IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout := user_time;

    END; { of WITH DO BEGIN }

  END; { of set_timeout }


END;    { of general_1 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      HPIB GROUP LEVEL 1                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      This level is included in the                                   *)
(*      general group because HP-IB                                     *)
(*      addressing is necessary for                                     *)
(*      general puropose device speci-                                  *)
(*      fication.                                                       *)
(*                                                                      *)
(************************************************************************)



MODULE hpib_1 ;

	{ by      Tim Mikkelsen
	  date    07/16/81
	  update  08/03/83 by J Schmidt

	  purpose This module contains the LEVEL 1 HPIB GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT


  PROCEDURE send_command( select_code : type_isc ;
			  command     : CHAR );
  FUNCTION  my_address  ( select_code : type_isc)
			: type_hpib_addr ;
  FUNCTION  active_controller
			( select_code : type_isc)
			: BOOLEAN;
  FUNCTION  system_controller
			( select_code : type_isc)
			: BOOLEAN;
  FUNCTION  addr_to_talk( device      : type_device)
			: type_isc;
  FUNCTION  addr_to_listen
			( device      : type_device)
			: type_isc;
  FUNCTION  set_to_talk ( device      : type_device)
			: type_isc;
  FUNCTION  set_to_listen
			( device      : type_device)
			: type_isc;
  FUNCTION  end_set     ( select_code : type_isc )
			: BOOLEAN;


IMPLEMENT

  IMPORT  iocomasm ,
	  general_0 ;

  TYPE    timeoutrec = record                        { tttt JS 8/3/83 }
			  counter: integer;          { tttt JS 8/3/83 }
			  firsttime: boolean;        { tttt JS 8/3/83 }
		       end;                          { tttt JS 8/3/83 }


  FUNCTION timerexists: boolean;  external;         { tttt JS 8/3/83 }

  FUNCTION timed_out(var rec: timeoutrec): boolean; external; {tttt JS 8/3/83}

  PROCEDURE send_command( select_code : type_isc ;
			  command     : CHAR );
  BEGIN
    WITH isc_table[select_code] DO
      CALL ( io_drv_ptr^.iod_send,
	     io_tmp_ptr,
	     command);
  END; { of send_command }



  FUNCTION  my_address  ( select_code : type_isc)
	    : type_hpib_addr ;
  BEGIN
    IF isc_table[select_code].io_tmp_ptr <> NIL
      THEN BEGIN
	WITH isc_table[select_code].io_tmp_ptr^ DO
	  IF addressed <> -1
	    THEN BEGIN
	      my_address:=addressed;
	    END
	    ELSE BEGIN
	      { error }
	      io_escape(ioe_not_hpib,select_code);
	    END; { of IF addressed }
      END
      ELSE BEGIN
	{ error }
	io_escape(ioe_not_hpib,select_code);
      END; { of IF io_tmp_ptr }
  END; { of my_address }



  FUNCTION  active_controller
			( select_code : type_isc)
			: BOOLEAN;
  BEGIN
    IF isc_table[select_code].card_type=hpib_card
      THEN BEGIN
	active_controller:=bit_set(iostatus(select_code,3),6);
      END
      ELSE BEGIN
	active_controller := TRUE;
      END; { of IF }
  END; { of active_controller }



  FUNCTION  system_controller
			( select_code : type_isc)
			: BOOLEAN;
  BEGIN
    IF isc_table[select_code].card_type=hpib_card
      THEN BEGIN
	system_controller:=bit_set(iostatus(select_code,3),7);
      END
      ELSE BEGIN
	system_controller := TRUE;
      END; { of IF }
  END; { of system_controller }



  FUNCTION  end_set     ( select_code : type_isc )
			: BOOLEAN ;
  VAR mybool : BOOLEAN;
  BEGIN
    WITH isc_table[select_code] DO
      CALL ( io_drv_ptr^.iod_end,
	     io_tmp_ptr,
	     mybool);
    end_set := mybool;
  END; { of send_command }


  $PAGE$

  FUNCTION  addr_to_talk( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
      timer  : INTEGER;
      hpibrec: timeoutrec;                                    {tttt JS 8/3/83}

  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=device DIV 100;

	WITH isc_table[io_isc] DO BEGIN

	  IF io_tmp_ptr <> NIL
	    THEN BEGIN

	      { set up user timeout - in case system drivers changed it }
	      io_tmp_ptr^.timeout:=user_time;

	      IF io_tmp_ptr^.addressed <> -1
		THEN BEGIN
		  IF ( card_type <> hpib_card ) AND
		     ( device MOD 100 > 31 )
		    THEN io_escape(ioe_misc,io_isc);
		  send_command(io_isc,CHR(talk_constant+(device MOD 100)));
		  send_command(io_isc,'?');
		  send_command(io_isc,CHR(my_address(io_isc)+listen_constant));
		END
		ELSE BEGIN
		  { error }
		  io_escape(ioe_not_hpib,io_isc);
		END; { of IF }
	    END
	    ELSE BEGIN
	    END; { of IF }
	END; { of WITH DO BEGIN }
      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN
		  { if non controller wait until listener }
		  IF user_time = 0
		    THEN BEGIN
		      REPEAT
			{ wait forever }
		      UNTIL bit_set(iostatus(io_isc,6),10);
		    END
		    ELSE BEGIN
		      { wait for timeout value }
		      IF timerexists THEN BEGIN             {tttt JS 8/3/83}
			hpibrec.firsttime:=true;             {tttt JS 8/3/83}
			hpibrec.counter:=user_time;          {tttt JS 8/3/83}
			REPEAT                               {tttt JS 8/3/83}
			UNTIL timed_out(hpibrec) OR          {tttt JS 8/3/83}
			  bit_set(iostatus(io_isc,6),10);    {tttt JS 8/3/83}
		      END                                    {tttt JS 8/3/83}
		      ELSE BEGIN                             {tttt JS 8/3/83}
			timer:=user_time*3;
			REPEAT
			  timer:=timer-1;
			UNTIL ( timer = 0 ) OR
			      ( bit_set(iostatus(io_isc,6),10) ) ;
		      END;                                   {tttt JS 8/3/83}
		      IF NOT bit_set(iostatus(io_isc,6),10)
			THEN io_escape(ioe_timeout,io_isc);
		    END; { of IF user_time=0 }
		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    addr_to_talk:=io_isc; { return select code }

  END; { of addr_to_talk }

  $PAGE$

  FUNCTION  addr_to_listen
			( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
      timer  : INTEGER;
      hpibrec: timeoutrec;                                   {tttt JS 8/3/83}

  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=device DIV 100;

	WITH isc_table[io_isc] DO BEGIN

	  IF io_tmp_ptr <> NIL
	    THEN BEGIN

	      { set up user timeout - in case system drivers changed it }
	      io_tmp_ptr^.timeout:=user_time;

	      IF io_tmp_ptr^.addressed <> -1
		THEN BEGIN
		  IF ( card_type <> hpib_card ) AND
		     ( device MOD 100 > 31 )
		    THEN io_escape(ioe_misc,io_isc);
		  send_command(io_isc,CHR(my_address(io_isc)+talk_constant));
		  send_command(io_isc,'?');
		  send_command(io_isc,CHR(listen_constant+(device MOD 100)));
		END
		ELSE BEGIN
		  { error }
		  io_escape(ioe_not_hpib,io_isc);
		END; { of IF }
	    END
	    ELSE BEGIN
	    END; { of IF }
	END; { of WITH DO BEGIN }
      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN
		  { if non controller wait until talker }
		  IF user_time = 0
		    THEN BEGIN
		      REPEAT
			{ wait forever }
		      UNTIL bit_set(iostatus(io_isc,6),9);
		    END
		    ELSE BEGIN
		      { wait for timeout value }
		      IF timerexists THEN BEGIN             {tttt JS 8/3/83}
			hpibrec.firsttime:=true;             {tttt JS 8/3/83}
			hpibrec.counter:=user_time;          {tttt JS 8/3/83}
			REPEAT                               {tttt JS 8/3/83}
			UNTIL timed_out(hpibrec) OR          {tttt JS 8/3/83}
			  bit_set(iostatus(io_isc,6), 9);    {tttt JS 8/3/83}
		      END                                    {tttt JS 8/3/83}
		      ELSE BEGIN                             {tttt JS 8/3/83}
			timer:=user_time*3;
			REPEAT
			  timer:=timer-1;
			UNTIL ( timer = 0 ) OR
			      ( bit_set(iostatus(io_isc,6),9) ) ;
		      END;                                   {tttt JS 8/3/83}
		      IF NOT bit_set(iostatus(io_isc,6),9)
			THEN io_escape(ioe_timeout,io_isc);
		    END; { of IF user_time=0 }
		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    addr_to_listen:=io_isc;

  END; { of addr_to_listen }

  $PAGE$


  { set to talk exists because of HPIB_2/HPIB_3 -
    those routines are intended to be the controller
    ( active ) and should not wait for the card to be
    addressed as talker.  addr_to_talk is used by
    data transfer routines.  set_to_talk is used by
    bus control routines.                               }




  FUNCTION  set_to_talk ( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=addr_to_talk(device);
      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN

		  io_escape(ioe_not_act,io_isc);

		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    set_to_talk:=io_isc; { return select code }

  END; { of set_to_talk }

  $PAGE$


  { set to listen exists because of HPIB_2/HPIB_3 -
    those routines are intended to be the controller
    ( active ) and should not wait for the card to be
    addressed as listener.  addr_to_listen is used by
    data transfer routines.  set_to_listen is used by
    bus control routines.                               }





  FUNCTION  set_to_listen
			( device      : type_device)
			: type_isc;
  VAR io_isc : type_isc;
      timer  : INTEGER;
  BEGIN

    IF device>iomaxisc
      THEN BEGIN
	io_isc:=addr_to_listen(device);

      END
      ELSE BEGIN
	io_isc:=device;

	WITH isc_table[io_isc] DO BEGIN

	  { set up user timeout - in case system drivers changed it }
	  IF io_tmp_ptr <> NIL THEN io_tmp_ptr^.timeout:=user_time;

	  IF card_type=hpib_card THEN
	    BEGIN
	      IF NOT active_controller(io_isc)
		THEN BEGIN

		  io_escape(ioe_not_act,io_isc);

		END; { of IF }
	    END; { of IF card_type = hpib_card }
	END; { of WITH DO BEGIN }
      END; { of IF }

    set_to_listen:=io_isc;

  END; { of set_to_listen }



END;    { of hpib_1 }
$PAGE$
MODULE general_2 ;

	{ by      Tim Mikkelsen
	  date    07/15/81
	  update  11/30/81

	  purpose This module contains the LEVEL 2 GENERAL GROUP procedures.

	}

IMPORT    iodeclarations;

EXPORT

  PROCEDURE readnumber ( device : type_device ;
			 VAR num: REAL ) ;
  PROCEDURE writenumber( device : type_device ;
			 value  : REAL ) ;
  PROCEDURE readstring
		       ( device : type_device ;
			 VAR str: STRING ) ;
  PROCEDURE readstring_until
		       ( term   : CHAR ;
			 device : type_device ;
			 VAR str: STRING );
  PROCEDURE writestring( device : type_device ;
			 str    : io_STRING ) ;
  PROCEDURE readnumberln
		       ( device : type_device ;
			 VAR num: REAL );
  PROCEDURE writenumberln
		       ( device : type_device ;
			 value  : REAL );
  PROCEDURE writestringln
		       ( device : type_device ;
			 str    : io_STRING );
  PROCEDURE readuntil  ( term   : CHAR ;
			 device : type_device );
  PROCEDURE skipfor    ( count  : INTEGER ;
			 device : type_device );


IMPLEMENT
IMPORT    sysglobals,
	  hpib_1 ,
	  general_1 ;



  PROCEDURE readnumber ( device : type_device ;
			 VAR num: REAL ) ;
  VAR io_work_str : STRING[255];
      i           : INTEGER;
      p2          : INTEGER;
      io_isc      : type_isc;
      numbuilt    : BOOLEAN;

    FUNCTION  numeric ( character : CHAR) : BOOLEAN;
    BEGIN
      CASE character OF
	'0'..'9',
	'+','-','.',
	'E','e'    : numeric:=TRUE

	OTHERWISE    numeric:=FALSE
      END; { of CASE }
    END; { of numeric }
  BEGIN
    { use TRY RECOVER to build a number until I find one }

    io_isc:=addr_to_talk(device);

    numbuilt := FALSE;

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      REPEAT

	SETSTRLEN(io_work_str,255);
	i:=1;

	{ skip over non-numeric characters }
	REPEAT
	  CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]);
	  WHILE io_work_str[i]=' ' DO
	    CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]);
	UNTIL numeric(io_work_str[i]) ;

	{ read in numeric characters }
	REPEAT
	  i:=i+1;
	  CALL ( iod_rdb , io_tmp_ptr , io_work_str[i] );
	  WHILE io_work_str[i]=' ' DO
	    CALL ( iod_rdb , io_tmp_ptr , io_work_str[i]);
	UNTIL ( (NOT ( numeric(io_work_str[i]))) OR (
	      ( i>=255) ) );


	SETSTRLEN(io_work_str,i);
	io_work_char:=io_work_str[i];

	TRY

	  STRREAD(io_work_str,1,p2,num);

	  numbuilt := TRUE;

	RECOVER BEGIN
	  IF ( ESCAPECODE=-10 )                  AND
	     (  ( IORESULT = ORD(IBADFORMAT) )  OR
		( IORESULT = ORD(ISTROVFL)   ) )
	    THEN BEGIN
	      { this is the strread errors - try again }
	    END
	    ELSE BEGIN
	      { this means something else happened }
	      ESCAPE(ESCAPECODE);
	    END; { of IF my error }
	END; { of RECOVER }

      UNTIL numbuilt;


    END; { of WITH DO BEGIN }

  END; { of readnumber  }



  PROCEDURE writenumber (device : type_device ;
			 value  : REAL );
  VAR i           : INTEGER;
      p2          : INTEGER;
      io_isc       : type_isc;
      io_work_str : STRING[255];
  BEGIN
    io_isc:=addr_to_listen(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      STRWRITE(io_work_str,1,p2,value);
      FOR i:=1 TO p2-1 DO
	CALL ( iod_wtb , io_tmp_ptr , io_work_str[i]);

    END; { of WITH DO }

  END; { of writenumber  }



  PROCEDURE readstring
		       ( device : type_device ;
			 VAR str: STRING ) ;
  VAR i         : INTEGER;
      io_isc    : type_isc;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      SETSTRLEN(str,STRMAX(str));         { so I can do assign to empty string }
      i:=0;
      REPEAT
	i:=i+1;
	CALL ( iod_rdb , io_tmp_ptr , str[i]);
      UNTIL ( (i>=STRMAX(str)         )    OR
	      ( str[i] = io_line_feed ) );
      IF str[i]=io_line_feed THEN i:=i-1;
      IF i<>0 THEN IF str[i]=io_carriage_rtn THEN i:=i-1;
      SETSTRLEN(str,i);

    END; { of WITH DO BEGIN }

  END; { of readstring }




  PROCEDURE readstring_until
		       ( term   : CHAR ;
			 device : type_device ;
			 VAR str: STRING );
  VAR i           : INTEGER;
      io_isc       : type_isc;
      io_work_char: CHAR;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      SETSTRLEN(str,STRMAX(str));
      i:=0;
      REPEAT
	i:=i+1;
	CALL ( iod_rdb , io_tmp_ptr , str[i]);
      UNTIL ( (i>=STRMAX(str) )     OR
	      ( str[i]=term ) );
      SETSTRLEN(str,i);

    END; { of WITH DO BEGIN }

  END; { of readstring_until }



  PROCEDURE writestring( device : type_device ;
			 str    : io_STRING ) ;
  VAR i     : INTEGER;
      io_isc: type_isc;
  BEGIN
    io_isc:=addr_to_listen(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      FOR i:=1 TO STRLEN(str) DO
	CALL ( iod_wtb , io_tmp_ptr , str[i]);

    END; { of WITH DO }

  END; { of writestring }



  PROCEDURE readnumberln
		       ( device : type_device ;
			 VAR num: REAL );
  VAR io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_talk(device);
    readnumber(io_isc,num);
    IF io_work_char <> io_line_feed THEN
       readuntil(io_line_feed,io_isc);
  END; { of readnumberln }



  PROCEDURE writenumberln
		       ( device : type_device ;
			 value  : REAL );
  VAR io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_listen(device);
    writenumber(io_isc,value);
    writechar(io_isc,io_carriage_rtn);
    writechar(io_isc,io_line_feed);
  END; { of writenumberln }



  PROCEDURE writestringln
		       ( device : type_device ;
			 str    : io_STRING );
  VAR io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_listen(device);
    writestring(io_isc,str);
    writechar(io_isc,io_carriage_rtn);
    writechar(io_isc,io_line_feed);
  END; { of writestringln }



  PROCEDURE readuntil  ( term   : CHAR ;
			 device : type_device );
  VAR io_work_char: CHAR;
      io_isc       : type_isc;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      REPEAT
	CALL ( iod_rdb , io_tmp_ptr , io_work_char);
      UNTIL ( io_work_char=term );

    END; { of WITH DO BEGIN }

  END; { of readuntil }



  PROCEDURE skipfor    ( count  : INTEGER ;
			 device : type_device );
  VAR i           : INTEGER;
      io_isc      : type_isc;
      io_work_char: CHAR;
  BEGIN
    io_isc:=addr_to_talk(device);

    WITH isc_table[io_isc].io_drv_ptr^ ,
	 isc_table[io_isc]            DO BEGIN

      FOR i:=1 TO count DO
	CALL ( iod_rdb , io_tmp_ptr , io_work_char);

    END; { of WITH DO BEGIN }

  END; { of skipfor }



END;  { of general_2 }
$PAGE$
MODULE general_3 ;

	{ by      Tim Mikkelsen
	  date    11/27/81
	  update  07/23/82

	  purpose This module contains the LEVEL 3 GENERAL GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT

  FUNCTION  ioerror_message ( ioerror : INTEGER )  : io_STRING;

IMPLEMENT

  FUNCTION  ioerror_message ( ioerror : INTEGER ) : io_STRING;
  VAR my_msg : io_STRING;
  BEGIN
    my_msg:='zzzz' ;                                            { 0082 TM 7/23/82 }

    IF ( ioerror <= ioe_misc )     AND
       ( ioerror >= ioe_no_error )
      THEN BEGIN
	CASE ioerror OF

	  ioe_no_error    :  my_msg := 'no error ';
	  ioe_no_card     :  my_msg := 'no card at select code';
	  ioe_not_hpib    :  my_msg := 'interface should be hpib';
	  ioe_not_act     :  my_msg := 'not active controller';
	  ioe_not_dvc     :  my_msg := 'should be device not sc';    { BUG 1281 TM 1/8/82 }
	  ioe_no_space    :  my_msg := 'no space left in buffer';
	  ioe_no_data     :  my_msg := 'no data left in buffer';
	  ioe_bad_tfr     :  my_msg := 'improper transfer attempted';
	  ioe_isc_busy    :  my_msg := 'the select code is busy';
	  ioe_buf_busy    :  my_msg := 'the buffer is busy';
	  ioe_bad_cnt     :  my_msg := 'improper transfer count';
	  ioe_bad_tmo     :  my_msg := 'bad timeout value';
	  ioe_no_driver   :  my_msg := 'no driver for this card';
	  ioe_no_dma      :  my_msg := 'no dma';
	  ioe_no_word     :  my_msg := 'word operations not allowed';
	  ioe_not_talk    :  my_msg := 'not addressed as talker';
	  ioe_not_lstn    :  my_msg := 'not addressed as listener';
	  ioe_timeout     :  my_msg := 'a timeout has occurred';
	  ioe_not_sctl    :  my_msg := 'not system controller';
	  ioe_rds_wtc     :  my_msg := 'bad status or control';
	  ioe_bad_sct     :  my_msg := 'bad set/clear/test operation';
	  ioe_crd_dwn     :  my_msg := 'interface card is dead';
	  ioe_eod_seen    :  my_msg := 'end/eod has occured';
	  ioe_misc        :  my_msg := 'miscellaneous - value of param error';
	END; { of CASE }
      END; { of IF }

    IF ( ioerror >= ioe_dc_fail ) AND
       ( ioerror <= ioe_dc_rval )
      THEN BEGIN
	CASE ioerror OF

	  ioe_sr_toomany  :  my_msg :=                          { 0364 TM 87/23/82 }
			     'too many chars w/o terminator';   { 0364 TM 87/23/82 }
	  ioe_dc_fail     :  my_msg := 'dc interface failure';
	  ioe_dc_usart    :  my_msg := 'USART receive buffer overflow';
	  ioe_dc_ovfl     :  my_msg := 'receive buffer overflow';
	  ioe_dc_clk      :  my_msg := 'missing clock';
	  ioe_dc_cts      :  my_msg := 'CTS false too long';
	  ioe_dc_car      :  my_msg := 'lost carrier disconnect';
	  ioe_dc_act      :  my_msg := 'no activity disconnect';
	  ioe_dc_conn     :  my_msg := 'connection not established';
	  ioe_dc_conf     :  my_msg := 'bad data bits/parity combination';
	  ioe_dc_reg      :  my_msg := 'bad status /control register';
	  ioe_dc_rval     :  my_msg := 'control value out of range';
	END; { of CASE }
      END; { of IF }

    IF ioe_result = ioe_sr_fail                                 { 0364 TM 8/23/82 }
      THEN my_msg := 'data link failure';                       { 0364 TM 8/23/82 }

    IF my_msg = 'zzzz'     { we don't let sleeping msgs lie }   { 0082 TM 7/23/82 }
      THEN CALL(io_error_link , ioerror , my_msg  );            { 0082 TM 7/23/82 }

    ioerror_message := my_msg;

  END; { ioerror_message }

END;  { of general_3 }
$PAGE$
MODULE general_4 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  07/23/82

	  purpose This module contains the LEVEL 4 GENERAL GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT

  PROCEDURE abort_transfer
		       ( VAR b_info: buf_info_type );
  FUNCTION  transfer_setup
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 VAR t_cnt : INTEGER )
		       : type_isc ;
  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type;
			 x_count   : INTEGER ) ;
  PROCEDURE transfer_word
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type;
			 x_count   : INTEGER ) ;
  PROCEDURE transfer_until
		       ( term      : CHAR ;
			 device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;
  PROCEDURE transfer_end
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER );
  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
  FUNCTION  buffer_space(VAR b_info: buf_info_type)
		       : INTEGER;
  FUNCTION  buffer_data( VAR b_info: buf_info_type)
		       : INTEGER;
  PROCEDURE readbuffer ( VAR b_info: buf_info_type;
			 VAR value : CHAR);
  PROCEDURE writebuffer( VAR b_info: buf_info_type;
			 value     : CHAR);
  PROCEDURE readbuffer_string
		       ( VAR b_info: buf_info_type;
			 VAR str   : STRING;
			 str_count : INTEGER);
  PROCEDURE writebuffer_string
		       ( VAR b_info: buf_info_type;
			 str       : io_STRING);

  FUNCTION  buffer_busy( VAR b_info: buf_info_type )            { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }
  FUNCTION  isc_busy   ( isc       : type_isc )                 { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }

IMPLEMENT


  IMPORT  hpib_1 ;

  PROCEDURE iobuffer   ( VAR b_info: buf_info_type ;
			 t_count   : INTEGER ) ;
    PROCEDURE NEW $ALIAS 'ASM_NEWBYTES'$
		  (VAR p:ANYPTR;v:INTEGER);EXTERNAL;
  BEGIN
    WITH b_info DO
      BEGIN
	{ what about IOBUFFER to a already existant buffer ? }
	{ - the space will be thrown away. }

	NEW(buf_ptr,t_count);

	act_tfr   := no_tfr;
	active_isc:= no_isc;
	buf_size  := t_count;
	buf_empty := buf_ptr;
	buf_fill  := buf_ptr;

	drv_tmp_ptr       := NIL;
	eot_proc.dummy_sl := NIL;
	eot_proc.dummy_pr := NIL;
	eot_parm          := NIL;               {JPC  02/22/82}
	dma_priority      := FALSE ;
      END; { of WITH DO }
  END; { of iobuffer }



  FUNCTION  buffer_data(VAR b_info : buf_info_type )
		      : INTEGER;
  BEGIN
    WITH b_info
    DO BEGIN
      buffer_data:=INTEGER(buf_fill)-INTEGER(buf_empty);
    END; { of WITH DO }
  END; { of buffer_data }



  PROCEDURE buffer_reset(VAR b_info: buf_info_type ) ;
  BEGIN
    WITH b_info
    DO BEGIN
      IF active_isc = no_isc
	THEN BEGIN
	  buf_fill:=buf_ptr;
	  buf_empty:=buf_ptr;
	END
	ELSE BEGIN
	  { error }
	  io_escape(ioe_buf_busy,no_isc);
	END; { of IF }
    END; { of WITH DO }
  END; { of buffer_reset }



  FUNCTION  buffer_space(VAR b_info: buf_info_type)
		       : INTEGER;
  BEGIN
    WITH b_info
    DO BEGIN
      IF ( buffer_data(b_info)=0 ) AND
	 ( active_isc = no_isc )   THEN buffer_reset(b_info);
      buffer_space:=buf_size+INTEGER(buf_ptr)-INTEGER(buf_fill);
    END; { of WITH DO }
  END; { of buffer_space }



  PROCEDURE abort_transfer
		       ( VAR b_info: buf_info_type );
  BEGIN
    WITH b_info
    DO BEGIN

      IF active_isc <> no_isc
	THEN BEGIN

	  WITH isc_table[active_isc] DO
	  CALL ( io_drv_ptr^.iod_init ,
		 io_tmp_ptr );


	END; { of IF }

    END; { of WITH b_info DO }

  END; { of abort_transfer }




  FUNCTION  transfer_setup
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 VAR t_cnt : INTEGER )
		       : type_isc ;
  VAR io_isc : type_isc;
  BEGIN

    IF device>iomaxisc THEN io_isc := device DIV 100
		       ELSE io_isc := device;

    IF isc_table[io_isc].io_tmp_ptr = NIL
		       THEN io_escape(ioe_no_driver,io_isc);


    WITH b_info
    DO BEGIN

      { test for tfr count }
      IF t_cnt=0
	THEN BEGIN
	  { error }
	  io_escape(ioe_bad_cnt,no_isc);
	END;

      { test for another tfr on this buffer }
      IF active_isc <> no_isc
	THEN BEGIN
	  { error }
	  io_escape(ioe_buf_busy,no_isc);
	END
	ELSE BEGIN
	  IF buffer_data(b_info)=0 THEN buffer_reset(b_info);
	END; { of IF }


      { configure card based on direction and check for available space/data }
      IF t_dir= to_memory
	THEN BEGIN
	  IF isc_table[io_isc].io_tmp_ptr^.in_bufptr <> NIL
	    THEN BEGIN
	      { error }
	      io_escape(ioe_isc_busy,io_isc);
	    END; { of IF }
	  IF buffer_space(b_info)<t_cnt
	    THEN BEGIN
	      { error }
	      io_escape(ioe_no_space,io_isc);
	    END; { of IF }
	  io_isc:=addr_to_talk(device);
	  isc_table[io_isc].io_tmp_ptr^.in_bufptr :=  ADDR( b_info );
	END
	ELSE BEGIN
	  IF isc_table[io_isc].io_tmp_ptr^.out_bufptr <> NIL
	    THEN BEGIN
	      { error }
	      io_escape(ioe_isc_busy,io_isc);
	    END; { of IF }
	  IF buffer_data(b_info)<t_cnt
	    THEN BEGIN
	      { error }
	      io_escape(ioe_no_data,io_isc);
	    END; { of IF }
	  io_isc:=addr_to_listen(device);
	  isc_table[io_isc].io_tmp_ptr^.out_bufptr :=  ADDR( b_info );
	END; { of IF }

      drv_tmp_ptr:= isc_table[io_isc].io_tmp_ptr;
      act_tfr    := no_tfr;
      usr_tfr    := t_tfr;
      b_w_mode   := FALSE;                      { byte mode }
      end_mode   := FALSE;                      { no EOI }
      direction  := t_dir;
      term_char  := -1;                         { no termination character }
      term_count := t_cnt;

    END; { of WITH b_info DO }

    transfer_setup := io_isc;

  END; { of transfer_setup }



  PROCEDURE transfer   ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
  VAR io_isc     : type_isc;
      t_count   : INTEGER;
  BEGIN
    t_count:=x_count;
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    { transfer temporary was set up in transfer_setup }

    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer }




  PROCEDURE transfer_word
		       ( device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr ;
			 VAR b_info: buf_info_type ;
			 x_count   : INTEGER ) ;
  VAR io_isc    : type_isc;
      t_count   : INTEGER;
  BEGIN
    t_count:=x_count;
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    { fix up transfer temporary }
    b_info.b_w_mode   := TRUE;                       { word mode }

    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer_word }




  PROCEDURE transfer_until
		       ( term      : CHAR ;
			 device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;
  VAR io_isc    : type_isc;
      t_count   : INTEGER;
  BEGIN
    t_count := buffer_space(b_info);
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    IF t_dir = from_memory
      THEN BEGIN
	{ error }
	io_escape(ioe_bad_tfr,io_isc);
      END;

    WITH b_info DO BEGIN

      { fix up transfer temporary }
      term_char  := ord(term);                  { termination character }

      { check for transfer type cases }
      IF t_tfr = serial_FASTEST  THEN usr_tfr := serial_FHS;
      IF t_tfr = overlap_FASTEST THEN usr_tfr := overlap_FHS;
      IF t_tfr = OVERLAP         THEN usr_tfr := overlap_INTR;
      IF ( t_tfr = serial_DMA  )  OR  ( t_tfr = overlap_DMA )
	THEN BEGIN
	  { error }
	  io_escape(ioe_bad_tfr,io_isc);
	END; { of IF }

    END; { of WITH b_info DO BEGIN }


    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer_until }



  PROCEDURE transfer_end(device    : type_device;
			 t_tfr     : user_tfr_type;
			 t_dir     : dir_of_tfr;
			 VAR b_info: buf_info_type ) ;
  VAR io_isc    : type_isc;
      t_count   : INTEGER;
  BEGIN
    IF t_dir=from_memory
      THEN BEGIN
	t_count := buffer_data(b_info);
      END
      ELSE BEGIN
	t_count := buffer_space(b_info);
      END; { of IF }
    io_isc:=transfer_setup(device,t_tfr,t_dir,b_info,t_count);

    { fix up transfer temporary }
    b_info.end_mode   := TRUE;                       { EOI }

    WITH isc_table[io_isc]
    DO CALL ( io_drv_ptr^.iod_tfr ,
	      isc_table[io_isc].io_tmp_ptr,
	      ADDR(b_info) );

  END; { of transfer_end }



  PROCEDURE readbuffer ( VAR b_info: buf_info_type;
			 VAR value : CHAR);
  VAR p : ^CHAR;
  BEGIN
    IF buffer_data(b_info)<1
      THEN BEGIN
	{ error }
	io_escape(ioe_no_data,no_isc);
      END
      ELSE BEGIN
	WITH b_info
	DO BEGIN
	  IF ( active_isc <> no_isc ) AND
	     ( direction = from_memory )
	    THEN BEGIN
	      { error }
	      io_escape( no_isc , ioe_buf_busy );
	    END; { of IF }
	  p:=ANYPTR(buf_empty);
	  value:=p^;
	  buf_empty:=ANYPTR(INTEGER(buf_empty)+1);
	END; { of WITH b_info DO }
      END; { of IF }
  END; { of readbuffer }



  PROCEDURE writebuffer( VAR b_info: buf_info_type;
			 value     : CHAR);
  VAR p : ^CHAR;
  BEGIN
    IF buffer_space(b_info)<1
      THEN BEGIN
	{ error }
	io_escape(ioe_no_space,no_isc);
      END
      ELSE BEGIN
	WITH b_info
	DO BEGIN
	  IF ( active_isc <> no_isc ) AND
	     ( direction = to_memory )
	    THEN BEGIN
	      { error }
	      io_escape( no_isc , ioe_buf_busy );
	    END; { of IF }
	  p:=buf_fill;
	  p^:=value;
	  buf_fill:=ANYPTR(INTEGER(buf_fill)+1);
	END; { of WITH b_info DO }
      END; { of IF }
  END; { of writebuffer }



  PROCEDURE readbuffer_string
		       ( VAR b_info: buf_info_type;
			 VAR str   : STRING;
			 str_count : INTEGER);
  VAR i         : INTEGER ;
  BEGIN
    IF STRMAX(str) < str_count
      THEN BEGIN
	{ error - string too small }
	io_escape(ioe_misc,no_isc);
      END;
    SETSTRLEN(str,str_count);           { so I can put chars into empty string }
    IF buffer_data(b_info)<str_count
      THEN BEGIN
	{ error - not enought data in buffer }
	io_escape(ioe_no_data,no_isc);
      END
      ELSE BEGIN
	FOR i:=1 TO str_count
	  DO BEGIN
	    readbuffer(b_info,str[i]);
	  END; { of FOR BEGIN }
	SETSTRLEN(str,str_count);
      END; { of IF }
  END; { of readbuffer_string }



  PROCEDURE writebuffer_string
		       ( VAR b_info: buf_info_type;
			 str       : io_STRING);
  VAR i         : INTEGER;
  BEGIN
    IF buffer_space(b_info)<STRLEN(str)
      THEN BEGIN
	{ error }
	io_escape(ioe_no_space,no_isc);
      END
      ELSE BEGIN
	FOR i:=1 TO STRLEN(str)
	  DO BEGIN
	    writebuffer(b_info,str[i]);
	  END; { of FOR BEGIN }
      END; { of IF }
  END; { of writebuffer_string }


  FUNCTION  buffer_busy( VAR b_info: buf_info_type )            { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }
  BEGIN                                                         { 0083 TM 7/23/82 }
    WITH b_info DO BEGIN                                        { 0083 TM 7/23/82 }
      IF active_isc <> no_isc THEN buffer_busy := TRUE          { 0083 TM 7/23/82 }
			      ELSE buffer_busy := FALSE;        { 0083 TM 7/23/82 }
    END; { of WITH DO BEGIN }                                   { 0083 TM 7/23/82 }
  END; { of buffer_busy }                                       { 0083 TM 7/23/82 }

  FUNCTION  isc_busy   ( isc       : type_isc )                 { 0083 TM 7/23/82 }
		       : BOOLEAN;                               { 0083 TM 7/23/82 }
  BEGIN                                                         { 0083 TM 7/23/82 }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN                    { 0083 TM 7/23/82 }
      IF ( in_bufptr <> NIL ) OR                                { 0083 TM 7/23/82 }
	 ( out_bufptr <> NIL ) THEN isc_busy := TRUE            { 0083 TM 7/23/82 }
			       ELSE isc_busy := FALSE;          { 0083 TM 7/23/82 }
    END; { of WITH DO BEGIN }                                   { 0083 TM 7/23/82 }
  END; { of isc_busy }                                          { 0083 TM 7/23/82 }



END;    { of general_4 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      HPIB GROUP                                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)




MODULE hpib_0 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  09/17/81

	  purpose This module contains the LEVEL 0 HPIB GROUP procedures.

	}


IMPORT    iodeclarations ;


EXPORT


  PROCEDURE set_hpib    ( select_code : type_isc ;
			  line        : type_hpib_line);
  PROCEDURE clear_hpib  ( select_code : type_isc ;
			  line        : type_hpib_line);
  FUNCTION  hpib_line   ( select_code : type_isc ;
			  line        : type_hpib_line)
			: BOOLEAN;

IMPLEMENT




  PROCEDURE set_hpib    ( select_code : type_isc ;
			  line        : type_hpib_line);
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_set,
	 io_tmp_ptr,
	 ORD(line));
  END;



  PROCEDURE clear_hpib  ( select_code : type_isc ;
			  line        : type_hpib_line);
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_clr,
	 io_tmp_ptr,
	 ORD(line));
  END;



  FUNCTION  hpib_line   ( select_code : type_isc ;
			  line        : type_hpib_line)
			: BOOLEAN;
  VAR my_boolean : BOOLEAN;
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_test,
	 io_tmp_ptr,
	 ORD(line),
	 my_boolean);
    hpib_line:=my_boolean;
  END;



END;    { of hpib_0 }
$PAGE$
MODULE hpib_2 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  03/09/83

	  purpose This module contains the LEVEL
		  2 HPIB GROUP procedures.

	}


IMPORT  iodeclarations ;

EXPORT


  PROCEDURE abort_hpib
		    ( select_code : type_isc);
  PROCEDURE clear   ( device      : type_device);
  PROCEDURE listen  ( select_code : type_isc ;
		      address     : type_hpib_addr );
  PROCEDURE local   ( device      : type_device);
  PROCEDURE local_lockout
		    ( select_code : type_isc);
  PROCEDURE pass_control
		    ( device      : type_device);
  PROCEDURE ppoll_configure
		    ( device      : type_device;
		      mask        : INTEGER );
  PROCEDURE ppoll_unconfigure
		    ( device      : type_device);
  PROCEDURE remote  ( device      : type_device);
  PROCEDURE secondary
		    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  PROCEDURE talk    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  PROCEDURE trigger ( device      : type_device);
  PROCEDURE unlisten( select_code : type_isc );
  PROCEDURE untalk  ( select_code : type_isc );


IMPLEMENT

  IMPORT  hpib_0 ,
	  hpib_1 ;


  PROCEDURE abort_hpib
		    ( select_code : type_isc);
  BEGIN

    { what about active tfrs ? }

    IF system_controller(select_code)
      THEN BEGIN
	set_hpib(select_code,ifc_line);
	   set_hpib(select_code,ren_line);
	   clear_hpib(select_code,ifc_line);
	   clear_hpib(select_code,atn_line);            {  all done by ifc }
      END
    ELSE BEGIN
      IF active_controller(select_code)
	THEN BEGIN
	  send_command(select_code,
	       CHR(talk_constant+my_address(select_code)));
	  send_command(select_code,'?');
	  clear_hpib(select_code,atn_line);
	END
	ELSE BEGIN
	  { do nothing }
	END; { of IF }
    END; { of IF }
  END; { of abort_hpib }


  PROCEDURE clear   ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    io_isc:=set_to_listen(device);
    IF device>iomaxisc
      THEN BEGIN
	send_command(io_isc,sdc_message);
      END
      ELSE BEGIN
	send_command(io_isc,dcl_message);
      END; { of IF }
  END; { of clear }



  PROCEDURE listen  ( select_code : type_isc ;
		      address     : type_hpib_addr );
  BEGIN
    send_command(select_code,CHR(listen_constant+address));
  END; { of listen }



  PROCEDURE local   ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    IF device>iomaxisc
      THEN BEGIN
	io_isc:=set_to_listen(device);                  { BUG 1251  TM 1/8/82 }
	send_command(io_isc,gtl_message);
      END
      ELSE BEGIN
	io_isc := device;                               { BUG 1251  TM 1/8/82 }
	IF system_controller(io_isc)                    { BUG jsjs  TM 3/9/83 }
	  THEN BEGIN
	    { system controller - drop REN }            { BUG jsjs  TM 3/9/83 }
	    clear_hpib(io_isc,ren_line);
	    IF active_controller(io_isc)                { BUG 1251  TM 1/26/82 }
	      THEN clear_hpib(io_isc,atn_line);         { BUG 1251  TM 1/26/82 }
	  END                                           { BUG jsjs  TM 3/9/83 }
	  ELSE BEGIN                                    { BUG jsjs  TM 3/9/83 }
	    { not system controller - send GTL }        { BUG jsjs  TM 3/9/83 }
	    send_command(io_isc,gtl_message);           { BUG jsjs  TM 3/9/83 }
	  END; { of IF }                                { BUG jsjs  TM 3/9/83 }
      END; { of IF }
  END; { of local }




  PROCEDURE local_lockout
		    ( select_code : type_isc);
  BEGIN
    send_command(select_code,llo_message);
  END; { of local_lockout }



  PROCEDURE pass_control
		    ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    IF device>iomaxisc                                  { BUG 1258  TM 1/8/82 }
      THEN BEGIN                                        { BUG 1258  TM 1/8/82 }
	io_isc := device DIV 100;                       { BUG 1258  TM 1/8/82 }
	send_command(io_isc,unl_message);               { BUG 1258  TM 1/8/82 }
	send_command(io_isc,                            { BUG 1258  TM 1/8/82 }
		 chr((device MOD 100)+talk_constant));  { BUG 1258  TM 1/8/82 }
      END                                               { BUG 1258  TM 1/8/82 }
      ELSE BEGIN                                        { BUG 1258  TM 1/8/82 }
	io_isc := set_to_talk(device);                  { BUG 1258  TM 1/8/82 }
      END; { of IF device }                             { BUG 1258  TM 1/8/82 }
    send_command(io_isc,tct_message);
  END;



  PROCEDURE ppoll_configure
		    ( device      : type_device;
		      mask        : INTEGER );
  VAR io_isc     : type_isc;
  BEGIN
    io_isc:=set_to_listen(device);
    IF io_isc=device
      THEN BEGIN
	{ error }
	io_escape(ioe_not_dvc,io_isc);
      END
      ELSE BEGIN
	send_command(io_isc,ppc_message);
	send_command(io_isc,CHR(ord(ppe_message)+(mask MOD 16)));
      END; { of IF }
  END; { of ppoll_configure }



  PROCEDURE ppoll_unconfigure
		    ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    io_isc:=set_to_listen(device);
    IF device>iomaxisc
      THEN BEGIN
	send_command(io_isc,ppc_message);
	send_command(io_isc,ppd_message);
      END
      ELSE BEGIN
	send_command(io_isc,ppu_message);
      END; { of IF }
  END; { of ppoll_unconfigure }



  PROCEDURE remote  ( device      : type_device);
  VAR io_isc     : type_isc;
  BEGIN
    IF device>iomaxisc
      THEN BEGIN
	io_isc:=device DIV 100;
	IF NOT system_controller(io_isc)                { BUG 1252  TM 1/8/82 }
	  THEN io_escape(ioe_not_sctl,io_isc);          { BUG 1252  TM 1/8/82 }
	set_hpib(io_isc,ren_line);
	io_isc:=set_to_listen(device);
      END
      ELSE BEGIN
	io_isc := device;                               { BUG 1252  TM 1/8/82 }
	IF NOT system_controller(io_isc)                { BUG 1252  TM 1/8/82 }
	  THEN io_escape(ioe_not_sctl,io_isc);          { BUG 1252  TM 1/8/82 }
	set_hpib(io_isc,ren_line);
      END; { of IF }
  END; { of remote }



  PROCEDURE secondary
		    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  BEGIN
    send_command(select_code,CHR(address+96));
  END; { of secondary }



  PROCEDURE talk    ( select_code : type_isc ;
		      address     : type_hpib_addr );
  BEGIN
    send_command(select_code,CHR(address+talk_constant));
  END; { of talk }



  PROCEDURE trigger ( device      : type_device);
  BEGIN
    send_command(set_to_listen(device),get_message);
  END; { of trigger }


  PROCEDURE unlisten( select_code : type_isc );
  BEGIN
    send_command(select_code,unl_message);
  END; { of unlisten }


  PROCEDURE untalk  ( select_code : type_isc );
  BEGIN
    send_command(select_code,unt_message);
  END; { of untalk }




END;    { of hpib_2 }
$PAGE$
MODULE hpib_3 ;

	{ by      Tim Mikkelsen
	  date    07/17/81
	  update  01/08/82

	  purpose This module contains the LEVEL
		  3 HPIB GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT


  FUNCTION  requested
		    ( select_code : type_isc )
		    : BOOLEAN ;
  FUNCTION  ppoll   ( select_code : type_isc )
		    : INTEGER ;
  FUNCTION  spoll   ( device      : type_device)
		    : INTEGER ;

  PROCEDURE request_service
		    ( select_code : type_isc ;
		      response    : INTEGER );
  FUNCTION  listener( select_code : type_isc )
		    : BOOLEAN;
  FUNCTION  talker  ( select_code : type_isc )
		    : BOOLEAN ;
  FUNCTION  remoted ( select_code : type_isc )
		    : BOOLEAN ;
  FUNCTION  locked_out
		    ( select_code : type_isc )
		    : BOOLEAN ;


IMPLEMENT


  IMPORT  iocomasm ,
	  general_0 ,
	  general_1 ,
	  hpib_0 ,
	  hpib_1 ;




  FUNCTION  requested
		    ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    IF active_controller(select_code)
      THEN BEGIN
	requested:=hpib_line(select_code,srq_line);
      END
      ELSE BEGIN
	{ error - not active controller when look at srq }
	io_escape(ioe_not_act,select_code);
      END; { of IF }
  END; { of requested }





  FUNCTION  ppoll   ( select_code : type_isc )
		    : INTEGER ;
  VAR my_byte : CHAR;
  BEGIN
    WITH isc_table[select_code] DO
    CALL(io_drv_ptr^.iod_ppoll,
	 io_tmp_ptr,
	 my_byte);
    ppoll:=ORD(my_byte);
  END; { of ppoll }




  FUNCTION  spoll   ( device      : type_device)
		    : INTEGER ;
  VAR io_isc      : type_isc;
      io_work_char: CHAR;
  BEGIN
    io_isc:=set_to_talk(device);
    send_command(io_isc,spe_message);
    readchar(io_isc,io_work_char);
    send_command(io_isc,spd_message);
    send_command(io_isc,unt_message);
    spoll:=ord(io_work_char);
  END; { of spoll }










  PROCEDURE request_service
		    ( select_code : type_isc ;
		      response    : INTEGER );
  BEGIN
    IF isc_table[select_code].card_type=hpib_card
      THEN BEGIN
	IF NOT active_controller(select_code)           { BUG 1250  TM 1/8/82 }
	  THEN iocontrol(select_code,1,response)        { BUG 1250  TM 1/8/82 }
	  ELSE io_escape(ioe_misc,select_code);         { BUG 1250  TM 1/8/82 }
      END
      ELSE BEGIN
	{ error }
	io_escape(ioe_not_hpib,select_code);
      END; { of IF }
  END; { of request_service }




  FUNCTION  listener( select_code : type_isc )
		    : BOOLEAN;
  BEGIN
    listener:=bit_set(iostatus(select_code,6),10);
  END; { of listener }





  FUNCTION  talker  ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    talker:=bit_set(iostatus(select_code,6),9);
  END; { of talker }




  FUNCTION  remoted ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    remoted:=bit_set(iostatus(select_code,6),15);
  END; { of remoted }




  FUNCTION  locked_out
		    ( select_code : type_isc )
		    : BOOLEAN ;
  BEGIN
    locked_out:=bit_set(iostatus(select_code,6),14);
  END;




END;    { of hpib_3 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      SERIAL GROUP                                                    *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      The 98626 code in the serial_0 and serial_3 modules has NOT     *)
(*      been tested and is included in the hopes that it is correct     *)
(*      and that someone will do the 98626 card drivers sometime.       *)
(*                                                                      *)
(*      There is a good chance that the 98626 will require a re-        *)
(*      release of the IOLIB:IOLIB file ( serial modules only ).        *)
(*                                                                      *)
(************************************************************************)




MODULE serial_0 ;

	{ by      Tim Mikkelsen
	  date    07/22/81
	  update  11/06/81

	  purpose This module contains the LEVEL
		  0 SERIAL GROUP procedures.

	}


IMPORT    iodeclarations ;

EXPORT




  PROCEDURE set_serial  ( select_code : type_isc ;
			  line        : type_serial_line);
  PROCEDURE clear_serial( select_code : type_isc ;
			  line        : type_serial_line);
  FUNCTION  serial_line ( select_code : type_isc ;
			  line        : type_serial_line)
			: BOOLEAN;


IMPLEMENT

  IMPORT  iocomasm ,
	  general_0 ;



  PROCEDURE set_serial  ( select_code : type_isc ;
			  line        : type_serial_line);
  VAR mybit  : INTEGER;
      dummy  : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);

      IF (isc_table[select_code].card_id = hp98628_async)
	THEN BEGIN
	  CASE line OF

	    rts_line:   mybit := 1;

	    dtr_line:   mybit := 2;

	    drs_line:   mybit := 4;

	    OTHERWISE io_escape(ioe_bad_sct,select_code);

	  END; { of CASE line }
	  dummy := iostatus(select_code,8);
	  dummy := binior(dummy,mybit);
	  iocontrol(select_code,8+256,dummy);

	END
	ELSE BEGIN

	  IF (card_id = hp98626) OR (card_id = hp98644)
	    THEN BEGIN
	      CASE line OF

		rts_line:   mybit := 2;

		dtr_line:   mybit := 1;

		drs_line:   mybit := 8;

		OTHERWISE io_escape(ioe_bad_sct,select_code);

	      END; { of CASE line }

	      dummy := iostatus(select_code,5);
	      dummy := binior(dummy,mybit);
	      iocontrol(select_code,5,dummy);

	    END
	    ELSE BEGIN
	      CALL ( io_drv_ptr^.iod_set ,
		     io_tmp_ptr ,
		     ORD(line) );
	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }

  END; { of set_serial }




  PROCEDURE clear_serial( select_code : type_isc ;
			  line        : type_serial_line);
  VAR mybit  : INTEGER;
      dummy  : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN
	  CASE line OF

	    rts_line:   mybit := 1;

	    dtr_line:   mybit := 2;

	    drs_line:   mybit := 4;

	    OTHERWISE io_escape(ioe_bad_sct,select_code);

	  END; { of CASE line }
	  dummy := iostatus(select_code,8);
	  dummy := binand(dummy,bincmp(mybit));
	  iocontrol(select_code,8+256,dummy);

	END
	ELSE BEGIN

	  IF (card_id = hp98626) or (card_id = hp98644)
	    THEN BEGIN
	      CASE line OF

		rts_line:   mybit := 2;

		dtr_line:   mybit := 1;

		drs_line:   mybit := 8;

		OTHERWISE io_escape(ioe_bad_sct,select_code);

	      END; { of CASE line }

	      dummy := iostatus(select_code,5);
	      dummy := binand(dummy,bincmp(mybit));
	      iocontrol(select_code,5,dummy);

	    END
	    ELSE BEGIN
	      CALL ( io_drv_ptr^.iod_clr ,
		     io_tmp_ptr ,
		     ORD(line) );
	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }
  END; { of clear_serial }





  FUNCTION  serial_line ( select_code : type_isc ;
			  line        : type_serial_line )
			: BOOLEAN ;
  VAR mybit  : INTEGER;
      dummy  : INTEGER;
      reg    : INTEGER;
      mybool : BOOLEAN;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_bad_sct,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN
	  CASE line OF

	    rts_line:   BEGIN
			  reg   := 8;
			  mybit := 0;
			END;

	    dtr_line:   BEGIN
			  reg   := 8;
			  mybit := 1;
			END;

	    drs_line:   BEGIN
			  reg   := 8;
			  mybit := 2;
			END;

	    dsr_line:   BEGIN
			  reg   := 7;
			  mybit := 0;
			END;

	    dcd_line:   BEGIN
			  reg   := 7;
			  mybit := 1;
			END;

	    cts_line:   BEGIN
			  reg   := 7;
			  mybit := 2;
			END;

	    ri_line:    BEGIN
			  reg   := 7;
			  mybit := 3;
			END;

	    OTHERWISE io_escape(ioe_bad_sct,select_code);

	  END; { of CASE line }
	  dummy := iostatus(select_code,reg);
	  mybool:= bit_set(dummy,mybit);

	END
	ELSE BEGIN

	  IF (card_id = hp98626) or (card_id = hp98644)
	    THEN BEGIN
	      CASE line OF

		rts_line:   BEGIN
			      reg   := 5;
			      mybit := 1;
			    END;

		dtr_line:   BEGIN
			      reg   := 5;
			      mybit := 0;
			    END;

		drs_line:   BEGIN
			      reg   := 5;
			      mybit := 3;
			    END;

		dsr_line:   BEGIN
			      reg   := 11;
			      mybit := 5;
			    END;

		dcd_line:   BEGIN
			      reg   := 11;
			      mybit := 7;
			    END;

		cts_line:   BEGIN
			      reg   := 11;
			      mybit := 4;
			    END;

		ri_line:    BEGIN
			      reg   := 11;
			      mybit := 6;
			    END;

		OTHERWISE io_escape(ioe_bad_sct,select_code);

	      END; { of CASE line }
	      dummy := iostatus(select_code,reg);
	      mybool:= bit_set(dummy,mybit);

	    END
	    ELSE BEGIN

	      CALL ( io_drv_ptr^.iod_test ,
		 io_tmp_ptr ,
		 ORD(line) ,
		 mybool );

	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }

    serial_line := mybool;

  END; { of serial_line }





END; { of serial_0 }
$PAGE$
MODULE serial_3 ;

	{ by      Tim Mikkelsen
	  date    07/22/81
	  update  10/01/82

	  purpose This module contains the LEVEL
		  3 SERIAL GROUP procedures.

	}

IMPORT    iodeclarations ;

EXPORT


  PROCEDURE set_baud_rate
		    ( select_code : type_isc ;
		      rate        : REAL );
  PROCEDURE set_stop_bits
		    ( select_code : type_isc ;
		      num_bits    : REAL );
  PROCEDURE set_char_length
		    ( select_code : type_isc ;
		      num_char_bit: INTEGER );
  PROCEDURE set_parity
		    ( select_code : type_isc ;
		      parity_mode : type_parity);
  PROCEDURE send_break
		    ( select_code : type_isc );

  PROCEDURE abort_serial
		    ( select_code : type_isc );


IMPLEMENT


  IMPORT  iocomasm ,
	  general_0  ;


  PROCEDURE set_baud_rate
		    ( select_code : type_isc ;
		      rate        : REAL );
  VAR dummy : INTEGER;
    FUNCTION calc_rate ( r : REAL ) : INTEGER;
    VAR myrate : INTEGER;
    BEGIN
      myrate := 0;
      IF r=50    THEN myrate := 1;
      IF r=75    THEN myrate := 2;
      IF r=110   THEN myrate := 3;
      IF r=134.5 THEN myrate := 4;
      IF r=150   THEN myrate := 5;
      IF r=200   THEN myrate := 6;
      IF r=300   THEN myrate := 7;
      IF r=600   THEN myrate := 8;
      IF r=1200  THEN myrate := 9;
      IF r=1800  THEN myrate :=10;
      IF r=2400  THEN myrate :=11;
      IF r=3600  THEN myrate :=12;
      IF r=4800  THEN myrate :=13;
      IF r=9600  THEN myrate :=14;
      IF r=19200 THEN myrate :=15;

      calc_rate := myrate;

    END; { of calc_rate }
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  dummy:=calc_rate(rate);
	  IF dummy = 0 THEN io_escape(ioe_misc,select_code);
	  iocontrol(select_code,20,dummy);              { BUG 1270  TM 1/8/82 }
	  iocontrol(select_code,21,dummy);              { BUG 1270  TM 1/8/82 }

	END
	ELSE BEGIN

	  IF (isc_table[select_code].card_id = hp98626) OR
	     (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN

	      dummy:=ROUND(rate);
	      IF dummy = 0 THEN io_escape(ioe_misc,select_code);
	      iocontrol(select_code,3,dummy);

	      { what about 134.5 ? }

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF 98626 }

	END; { of IF 98628_async }

    END; { of WITH isc_table BEGIN }
  END; { of set_baud_rate }





  PROCEDURE set_stop_bits
		    ( select_code : type_isc ;
		      num_bits    : REAL );
  VAR myval : INTEGER;
      dummy : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  IF num_bits = 1
	    THEN BEGIN
	      myval := 0;
	    END
	    ELSE BEGIN
	      IF num_bits = 1.5
		THEN BEGIN
		  myval := 1;
		END
		ELSE BEGIN
		  IF num_bits = 2
		    THEN BEGIN
		      myval :=2
		    END
		    ELSE BEGIN
		      io_escape(ioe_misc,select_code);
		    END; { of IF 2 }

		END;   { of IF 1.5 }

	    END;     { of IF 1 }

	  iocontrol(select_code,35,myval);              { BUG 1270  TM 1/8/82 }

	END
	ELSE BEGIN
	  IF (isc_table[select_code].card_id = hp98626)   { BUG 1269  TM 1/8/82 }
	    OR (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN
	      IF num_bits = 1
		THEN BEGIN
		  myval:=0;
		END
		ELSE BEGIN
		  IF num_bits = 1.5
		    THEN BEGIN
		      IF binand(iostatus(select_code,4),3)<>0
			THEN io_escape(ioe_misc,select_code);
		      myval:=1;
		    END
		    ELSE BEGIN
		      IF num_bits = 2
			THEN BEGIN
			  myval:=1;
			END
			ELSE BEGIN
			  io_escape(ioe_misc,select_code);
			END; { of IF 2 }

		    END;   { of IF 1.5 }

		END;     { of IF 1 }

	      dummy:=iostatus(select_code,4);
	      dummy:=binand(dummy,251)+myval*4;                 { 0359 TM 8/26/82 }
	      iocontrol(select_code,4,dummy);

	    END
	    ELSE BEGIN
	      io_escape(ioe_misc,select_code);
	    END; { of IF 98626 }

	END; { of IF 98628_async }

    END; { of WITH isc_table BEGIN }

  END; { set_stop_bits }




  PROCEDURE set_char_length
		    ( select_code : type_isc ;
		      num_char_bit: INTEGER );
  VAR myval : INTEGER;
      dummy : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      CASE num_char_bit OF

	5:    myval := 0;
	6:    myval := 1;
	7:    myval := 2;
	8:    myval := 3;

	OTHERWISE io_escape(ioe_misc,select_code);

      END; { of CASE }


      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  iocontrol(select_code,34,myval);

	END
	ELSE BEGIN

	  IF(isc_table[select_code].card_id = hp98626)
	    or (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN

	      dummy:=iostatus(select_code,4);
	      dummy:=binand(dummy,252)+myval;                   { 0359 TM 8/23/82 }
	      iocontrol(select_code,4,dummy);                   {  557 TM 10/1/82 }

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF 98626 }

	END; { of IF 98628_asnync }

    END; { of WITH isc_table BEGIN }
  END; { set_char_length }





  PROCEDURE set_parity
		    ( select_code : type_isc ;
		      parity_mode : type_parity);
  VAR myval : INTEGER;
      dummy : INTEGER;
  BEGIN
    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  CASE parity_mode OF

	    no_parity:    myval := 0;
	    odd_parity:   myval := 1;
	    even_parity:  myval := 2;
	    zero_parity:  myval := 3;                           { 0355 TM 8/20/82 }
	    one_parity:   myval := 4;                           { 0355 TM 8/20/82 }

	    OTHERWISE io_escape(ioe_misc,select_code);

	  END; { of CASE }

	  iocontrol(select_code,36,myval);

	END
	ELSE BEGIN

	  IF (isc_table[select_code].card_id = hp98626)
	    or (isc_table[select_code].card_id = hp98644)
	    THEN BEGIN

	      CASE parity_mode OF

		no_parity:    myval := 0;
		odd_parity:   myval := 1;
		even_parity:  myval := 3;
		one_parity:   myval := 5;
		zero_parity:  myval := 7;

		OTHERWISE io_escape(ioe_misc,select_code);

	      END; { of CASE }

	      dummy:=iostatus(select_code,4);
	      dummy:=binand(dummy,199)+myval*8;                 { 0359 TM 8/23/82 }
	      iocontrol(select_code,4,dummy);

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF 98626 }

	END; { of IF 98628_asnync }

    END; { of WITH isc_table BEGIN }
  END; { set_parity }




  PROCEDURE send_break
		    ( select_code : type_isc );
  BEGIN

    { what about active tfrs }

    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  iocontrol(select_code,6,1);

	END
	ELSE BEGIN
	  IF (card_id = hp98626) or (card_id = hp98644)
	    THEN BEGIN

	      iocontrol(select_code,1,1);

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }
  END; { of send_break }


  PROCEDURE abort_serial
		    ( select_code : type_isc );
  BEGIN

    { what about active tfrs }

    WITH isc_table[select_code] DO BEGIN

      IF card_type <> serial_card THEN io_escape(ioe_misc,select_code);

      IF isc_table[select_code].card_id = hp98628_async
	THEN BEGIN

	  iocontrol(select_code,256+125,1);             { BUG xxxx TM 1/26/82 }

	END
	ELSE BEGIN
	  IF (card_id = hp98626) or (card_id = hp98644)  { BUG FIX 6/4/84 }
	    THEN BEGIN

	      iocontrol(select_code,0,1);

	    END
	    ELSE BEGIN

	      io_escape(ioe_misc,select_code);

	    END; { of IF }

	END; { of IF }

    END; { of WITH isc_table BEGIN }
  END; { of abort_serial }



END;    { of serial_3 }
$PAGE$
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      PARALLEL GROUP                                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)


module parallel_3;

import iodeclarations;


export
{
  IOCONTROL and IOSTATUS register definitions.
}
{-----------------------------------------------------------------}
	{
	  level 0 registers.
	  Registers 0 - 9 are system defined registers.
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_CARD_ID       =  0;
	PLLEL_REG_RESET         =  0;
	PLLEL_REG_INTDMA_STATUS =  1;

const
	{ for use with PLLEL_REG_CARD_ID }
	PARALLEL_CARDID         =  6;

type
	{ for use with: PLLEL_REG_INTDMA_STATUS }
	intdma_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   ie:          boolean;
			   ir:          boolean;
			   intlvl:      0..3;
			   pad:         0..3;
			   de1:         boolean;
			   de0:         boolean);
		end;




{-----------------------------------------------------------------}
	{
	  level 10 registers.
	  Register 10 - 19 are for hardware status and control.
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_PERIPHERAL_STATUS     = 10;
	PLLEL_REG_COMM_STATUS           = 11;
	PLLEL_REG_HOST_LINE_CONTROL     = 12;
	PLLEL_REG_IO_CONTROL            = 13;
	PLLEL_REG_FIFO                  = 14;

type
	{ for use with: PLLEL_REG_PERIPHERAL_STATUS }
	peripheral_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('1F');
			   nerror_low:  boolean;
			   select_high: boolean;
			   perror_high: boolean);
		end;
const
	PLLEL_PERIPHERAL_ONLINE         = HEX('02');

type
	{ for use with: PLLEL_REG_COMM_STATUS }
	comm_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..7;
			   fifofull:    boolean;
			   fifoempty:   boolean;
			   nstrobe_low: boolean; {true = asserted low}
			   busy_high:   boolean;
			   nack_low:    boolean);
		end;


type
	{ for use with: PLLEL_REG_HOST_LINE_CONTROL }
	host_line_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('1F');
			   ninit_low:   boolean;
			   nselectin_low:boolean;
			   wr_nrd_high: boolean);
		end;


type
	{ for use with: PLLEL_REG_IO_CONTROL }
	io_control_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('3F');
			   modify_io:   boolean;
			   input_high:  boolean);
		end;




{-----------------------------------------------------------------}
	{
	  level 20 registers.
	  Register 20 - 29 are for driver status and control.
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_PERIPHERAL_TYPE       = 20;
	PLLEL_REG_TYPE_RESET            = 21;
	PLLEL_REG_PERIPHERAL_RESET      = 22;
	PLLEL_REG_INTERRUPT_STATE       = 23;
	PLLEL_REG_DRIVER_OPTIONS        = 24;
	PLLEL_REG_OPTIONS_RESET         = 25;
	PLLEL_REG_DRIVER_STATE          = 26;

const
	{ for use with: PLLEL_REG_PERIPHERAL_TYPE
			PLLEL_REG_TYPE_RESET }
	NOT_PRESENT             =  0;
	OUTPUT_ONLY             =  1;
	HP_BIDIRECTIONAL        =  2;
	USER_SPEC_NO_DEVICE     =  10;
	USER_SPEC_OUTPUT_ONLY   =  11;
	USER_SPEC_HP_BIDIRECTIONAL =  12;

	OUTPUT_SET              = [OUTPUT_ONLY,
				   HP_BIDIRECTIONAL,
				   USER_SPEC_OUTPUT_ONLY,
				   USER_SPEC_HP_BIDIRECTIONAL];
	INPUT_SET               = [HP_BIDIRECTIONAL,
				   USER_SPEC_HP_BIDIRECTIONAL];
	USER_SET                = [NOT_PRESENT,
				   USER_SPEC_NO_DEVICE,
				   USER_SPEC_OUTPUT_ONLY,
				   USER_SPEC_HP_BIDIRECTIONAL];




type
	{ for use with PLLEL_REG_INTERRUPT_STATE }
	driver_int_state_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   fifo_full:   boolean;
			   fifo_empty:  boolean;
			   pad:         boolean;
			   busy_low:    boolean;
			   nack_low_trans:boolean;
			   nerror_trans:boolean;
			   select_trans:boolean;
			   pe_trans:    boolean);
		end;


type
	{ for use with: PLLEL_REG_DRIVER_OPTIONS
			PLLEL_REG_OPTIONS_RESET }
	driver_options_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   pad:         0..hex('f');
			   ignore_pe:   boolean;
			   write_verify:boolean;
			   wr_nrd_low:  boolean;
			   use_nack:    boolean);
		end;


type
	{ for use with PLLEL_REG_DRIVER_STATE }
	driver_state_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   disabled:    boolean;
			   error:       boolean;
			   write:       boolean;
			   read:        boolean;
			   pad:         0..7;
			   active_xfer: boolean);
		end;

const
	DISABLED_BY_USER        =  hex('80');
	INACTIVE_ERROR          =  hex('40');
	INACTIVE_WRITE          =  hex('20');
	ACTIVE_WRITE            =  hex('21');
	INACTIVE_READ           =  hex('10');
	ACTIVE_READ             =  hex('11');


{-----------------------------------------------------------------}
	{
	  level 30 registers.
	  Registers 30 - 39 are for User ISR status and control
	}
{-----------------------------------------------------------------}
const
	PLLEL_REG_HOOK_STATUS           = 30;
	PLLEL_REG_HOOK_CLEAR            = 30;
	PLLEL_REG_USER_ISR_ENABLE       = 31;
	PLLEL_REG_USER_ISR_STATUS       = 32;

const
	{ for use with PLLEL_REG_HOOK_STATUS }
	USER_ISR_HOOK_INACTIVE  =  0;
	USER_ISR_HOOK_ACTIVE    =  1;


type
	{ for use with: PLLEL_REG_USER_ISR_ENABLE
			PLLEL_REG_USER_ISR_STATUS }
	user_isr_status_type = packed record
		case integer of
			0:(w:           io_word);
			1:(bh:          io_byte;
			   bl:          io_byte);
			2:(b:           io_byte; {upper byte unused}
			   fifo_full:   boolean;
			   fifo_empty:  boolean;
			   xfer_extend: boolean;
			   busy_low:    boolean;
			   nack_low_trans:boolean;
			   nerror_trans:boolean;
			   select_trans:boolean;
			   pe_trans:    boolean);
		end;


{-----------------------------------------------------------------}
	{
	  All together now.
	}
{-----------------------------------------------------------------}
type
	p3regs_type = packed record case integer of
		1:(w:                   io_word);
		2:(bh:                  io_byte;
		   bl:                  io_byte);
		3:(intdma_status:       intdma_status_type);
		4:(peripheral_status:   peripheral_status_type);
		5:(comm_status:         comm_status_type);
		6:(host_line:           host_line_type);
		7:(io_control:          io_control_type);
		8:(driver_int_state:    driver_int_state_type);
		9:(driver_options:      driver_options_type);
		10:(driver_state:       driver_state_type);
		11:(user_isr_status:    user_isr_status_type);
		end;


{-----------------------------------------------------------------}
	{
	  HP Parallel interface support routines.
	}
{-----------------------------------------------------------------}
type
	PARALLEL_USER_ISR_TYPE = PROCEDURE(SC:TYPE_ISC);

	PROCEDURE SET_USER_ISR(SC:TYPE_ISC;
				  P:PARALLEL_USER_ISR_TYPE);
	PROCEDURE CLEAR_USER_ISR(SC:TYPE_ISC);
	FUNCTION NACK_SET(SC:TYPE_ISC):BOOLEAN;

implement

procedure sc_check(sc:type_isc);
begin
	with isc_table[sc] do
		if (card_ptr = NIL) or
		   (card_type <> pllel_card) then
			io_escape(ioe_no_card, sc);
end;

procedure set_user_isr(sc:type_isc; p:parallel_user_isr_type);
type
	pxlate_type = record
			case integer of
				1:(pproc:parallel_user_isr_type);
				2:(ioproc:io_proc);
		end;

var
	pxlate:pxlate_type;
begin
	sc_check(sc);
	pxlate.pproc := p;
	with isc_table[sc] do
	begin
		io_tmp_ptr^.user_isr.real_proc := pxlate.ioproc;
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_USER_ISR_ENABLE, 0);
	end;
end;


procedure clear_user_isr(sc:type_isc);
begin
	sc_check(sc);
	with isc_table[sc] do
	begin
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_HOOK_CLEAR, 0);
	end;
end;


function nack_set(sc:type_isc):boolean;
var
	b:boolean;
begin
	sc_check(sc);
	b := false;
	with isc_table[sc] do
		call(io_drv_ptr^.iod_end, io_tmp_ptr, b);
	nack_set := b;
end;

end.  {of PARALLEL_3}
@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.2
log
@Correct documentation and code inconsistency with
PLLEL_REG_CARDID -> PLLEL_REG_CARD_ID
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@d2907 1
a2907 1
	PLLEL_REG_CARDID        =  0;
@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.2
log
@Added a peripheral online constant, mainly for user convienence.
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@d2960 2
@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.5
log
@Updated for new search conventions.
@
text
@@


40.4
log
@Updated to reflect new search convention.
@
text
@d237 1
a237 1
{system serach{{
@


40.3
log
@1) updated search method so this file could be used for driver testing.

2) updated PARALLEL_3 to reflect nomenclature change from program isr to the
more appropriate user isr terminology.
@
text
@d235 1
a235 1
{{
d237 1
a237 1
{}
@


40.2
log
@Added the PARALLEL_3 module, which provides application programmer's
with a clean interface to the HP Parallel driver.
@
text
@d235 6
a240 2
IMPORT  $SEARCH 'IOLIB:KERNEL.CODE', 'IOLIB:COMASM'$
	  iodeclarations  ;
d3112 1
a3112 1
	  Registers 30 - 39 are for program ISR status and control
d3118 2
a3119 2
	PLLEL_REG_PROG_ISR_ENABLE       = 31;
	PLLEL_REG_PROG_ISR_STATUS       = 32;
d3123 2
a3124 2
	PROG_ISR_HOOK_INACTIVE  =  0;
	PROG_ISR_HOOK_ACTIVE    =  1;
d3128 3
a3130 3
	{ for use with: PLLEL_REG_PROG_ISR_ENABLE
			PLLEL_REG_PROG_ISR_STATUS }
	prog_isr_status_type = packed record
d3165 1
a3165 1
		11:(prog_isr_status:    prog_isr_status_type);
d3175 1
a3175 1
	PARALLEL_PROG_ISR_TYPE = PROCEDURE(SC:TYPE_ISC);
d3177 3
a3179 3
	PROCEDURE SET_PROGRAM_ISR(SC:TYPE_ISC;
				  P:PARALLEL_PROG_ISR_TYPE);
	PROCEDURE CLEAR_PROGRAM_ISR(SC:TYPE_ISC);
d3192 1
a3192 1
procedure set_program_isr(sc:type_isc; p:parallel_prog_isr_type);
d3196 1
a3196 1
				1:(pproc:parallel_prog_isr_type);
d3208 1
a3208 1
		call(io_drv_ptr^.iod_wtc, io_tmp_ptr, PLLEL_REG_PROG_ISR_ENABLE, 0);
d3213 1
a3213 1
procedure clear_program_isr(sc:type_isc);
@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d182 5
d2876 9
a2884 1
END.    { of serial_3 }
d2886 345
@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
