$COPYRIGHT 'COPYRIGHT (C) 1982 BY HEWLETT-PACKARD COMPANY'$
$SYSPROG ON$
$PARTIAL_EVAL ON$
$STACKCHECK ON$
$RANGE OFF$
$DEBUG ON$
$OVFLCHECK OFF$
(************************************************************************)
(*                                                                      *)
(*      not released    VERSION         2.0                             *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      IOLIB           extensions                                      *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      library      -  IOLIB                                           *)
(*      name         -  EXTLIB                                          *)
(*      module(s)    -  serial_5                                        *)
(*                                                                      *)
(*      date         -  July 22 , 1982                                  *)
(*      update       -  July 30 , 1982                                  *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

(************************************************************************)
(*                                                                      *)
(*                                                                      *)
(*      GENERAL EXTENSIONS                                              *)
(*                                                                      *)
(*                                                                      *)
(************************************************************************)

PROGRAM serial_5_init;


MODULE serial_5 ;     

        { date    07/26/82
          update  07/30/82
          
          purpose This module contains the LEVEL 5 HPIB GROUP procedures.   
        }


IMPORT  iodeclarations , iocomasm , general_0  ;  

EXPORT 
  
  TYPE  serial_user_proc = PROCEDURE ( parameter : INTEGER );
  
  TYPE  serial_isr_block = RECORD
                           state : PACKED ARRAY[0..7] OF BOOLEAN;
                           mask  : INTEGER;
                           procs : ARRAY[0..7] OF serial_user_proc;
                           parms : ARRAY[0..7] OF INTEGER;
                         END;
  
  VAR   serial_isr_table : ARRAY[iominisc..iomaxisc] OF ^serial_isr_block;
  
  PROCEDURE on_data    ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_data   ( isc       : type_isc );
  
  PROCEDURE on_prompt  ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_prompt ( isc       : type_isc );
  
  PROCEDURE on_fp_error( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_fp_error(isc       : type_isc );
  
  PROCEDURE on_modem   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_modem  ( isc       : type_isc );
  
  PROCEDURE on_no_activity
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_no_activity
                       ( isc       : type_isc );
  
  PROCEDURE on_lost_carrier
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_lost_carrier
                       ( isc       : type_isc );
  
  PROCEDURE on_eol     ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_eol    ( isc       : type_isc );
  
  PROCEDURE on_break   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_break  ( isc       : type_isc );
  
  
IMPLEMENT
  
  CONST data_cond         = 0;     data_mask  =   1;    { data ready   }
        prmpt_cond        = 1;     prmpt_mask =   2;    { prompt       }
        fperr_cond        = 2;     fperr_mask =   4;    { frame/parity }
        mdmch_cond        = 3;     mdmch_mask =   8;    { modem change }
        noact_cond        = 4;     noact_mask =  16;    { no activity  }
        lstcr_cond        = 5;     lstcr_mask =  32;    { lost carrier }
        eol_cond          = 6;     eol_mask   =  64;    { end of line  }
        break_cond        = 7;     break_mask = 128;    { break        }
        
  TYPE coerce = RECORD CASE BOOLEAN OF 
                  TRUE:  ( int : INTEGER );
                  FALSE: ( ptr : ANYPTR )
                END;
  
  PROCEDURE serial_enable      
                       ( isc       : type_isc ;
                         newmask   : INTEGER );
  VAR x : INTEGER;
  BEGIN
    {  There are two interrupt mask areas - the general card interrupt mask
       and the ON INTR interrupt facility within the card's interrupts.  The 
       iocontrol register 13 is the ON INTR mask.  The drv_misc[3] AND 
       iocontrol register 121 is the general card interrupt mask. }
       
    WITH isc_table[ isc ].io_tmp_ptr^ DO BEGIN
      iocontrol ( isc , 13+256 , newmask );             { set ON INTR mask }
      x := ORD( drv_misc[3] );                          { get usr0mask     }
      IF newmask = 0 THEN x := BINAND(x,BINCMP(8))
                     ELSE x := BINIOR(x,8);             
      drv_misc[3] := CHR(x);                            { set/clr bit 3 in } 
                                                        {   usr0mask       }
      iocontrol ( isc , 121+256 , x );                  { set/clr bit 3 in }
                                                        {   ctl reg 121    }
    END; { of WITH DO BEGIN }
  END; { of serial_enable }
  
  
  PROCEDURE serial_isr_allocate
                       ( isc       : type_isc );
  VAR counter : INTEGER;
  BEGIN
    NEW(serial_isr_table[isc] );
    WITH serial_isr_table[isc]^ DO BEGIN
      FOR counter:=data_cond TO break_cond DO state[counter] := FALSE;
      mask := 0;      
    END; { of WITH DO BEGIN }
  END; { of serial_isr_allocate }
  
  PROCEDURE serial_isr_proc
                       ( temp      : ANYPTR  );
  VAR counter : INTEGER;
      happened: BOOLEAN;
      isc     : INTEGER;
      local   : coerce ;
      reason  : INTEGER;
  BEGIN
    local.ptr := temp;                  { coerce to get sc }
    isc       := local.int;
    
    reason := iostatus ( isc , 4 );
    
    { prevent serial_isr_proc in user_isr in temps - to save user doing it }
    serial_enable( isc , 0 );
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.dummy_sl := NIL;
      user_isr.dummy_pr := NIL;
    END; { of WITH isc_table DO BEGIN }
      
    WITH serial_isr_table[isc]^ DO BEGIN
      FOR counter := data_cond TO break_cond DO 
        IF state[ counter ] 
          THEN BEGIN
            happened := bit_set( reason , counter );
            IF happened THEN CALL( procs[counter] , parms[counter] );
          END; { of FOR DO IF bit_set THEN }
      
    { set up serial_isr_proc in user_isr in temps }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.real_proc := serial_isr_proc;
    END; { of WITH DO BEGIN }
    
    { re - enable interrupts }
    serial_enable( isc , mask );
  
  END; { of WITH BEGIN }
END; { of serial_isr_proc }
  
  PROCEDURE serial_isr_setup
                       ( isc       : type_isc ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER ;
                         which__cond: INTEGER );
  VAR local : coerce;
  BEGIN
    IF ( isc_table[isc].card_id <> hp98628_async ) AND
       ( isc_table[isc].card_id <> hp_datacomm )
      THEN io_escape(ioe_misc,isc);
    IF serial_isr_table[isc] = NIL THEN serial_isr_allocate(isc);
    WITH serial_isr_table[isc]^ DO BEGIN
      { set up procedures & parameters in allocated isr proc block }
      procs[which__cond] := your_proc;
      parms[which__cond] := your_parm;
    
      { set up state _condition and interrupt mask }
      CASE which__cond OF
        data_cond:   mask:=BINIOR(mask,data_mask  );
        prmpt_cond:  mask:=BINIOR(mask,prmpt_mask );
        fperr_cond:  mask:=BINIOR(mask,fperr_mask );
        mdmch_cond:  mask:=BINIOR(mask,mdmch_mask );
        noact_cond:  mask:=BINIOR(mask,noact_mask );
        lstcr_cond:  mask:=BINIOR(mask,lstcr_mask );
        eol_cond:    mask:=BINIOR(mask,eol_mask   );
        break_cond:  mask:=BINIOR(mask,break_mask );
      END; { of CASE }
      state[which__cond] := TRUE;
      
      { set up serial_isr_proc in user_isr in temps }
      WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.real_proc := serial_isr_proc;
        local.int          := isc;              { type coerce }
        user_parm          := local.ptr;        { type coerce }
      END; { of WITH DO BEGIN }
      
      { enable card }
      serial_enable( isc , mask );
    END; { of WITH DO BEGIN }
  END; { of serial_isr_setup }
  
  PROCEDURE serial_isr_kill
                       ( isc       : type_isc ;
                         which__cond: INTEGER );
  BEGIN
    IF serial_isr_table[isc] <> NIL THEN 
    WITH serial_isr_table[isc]^ DO BEGIN
    
      { clear state condition and interrupt mask }
      CASE which__cond OF
        data_cond:   mask:=BINAND(mask,BINCMP(data_mask  ));
        prmpt_cond:  mask:=BINAND(mask,BINCMP(prmpt_mask ));
        fperr_cond:  mask:=BINAND(mask,BINCMP(fperr_mask ));
        mdmch_cond:  mask:=BINAND(mask,BINCMP(mdmch_mask ));
        noact_cond:  mask:=BINAND(mask,BINCMP(noact_mask ));
        lstcr_cond:  mask:=BINAND(mask,BINCMP(lstcr_mask ));
        eol_cond:    mask:=BINAND(mask,BINCMP(eol_mask   ));
        break_cond:  mask:=BINAND(mask,BINCMP(break_mask ));
      END; { of CASE }
      state[which__cond] := FALSE;
      
      { if necessary clear serial_isr_proc in user_isr in temps }
      IF mask=0 THEN WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.dummy_sl := NIL;
        user_isr.dummy_pr := NIL;
        user_parm         := NIL;
      END; { of WITH isc_table DO BEGIN }
      
      { disable or enable card as specified by the _mask  }
      serial_enable( isc , mask );
    END; { of WITH DO BEGIN }
  END; { of serial_isr_kill }
  
  
  PROCEDURE on_data    ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,data_cond );
  END;
  PROCEDURE off_data   ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,data_cond );
  END;
  
  PROCEDURE on_prompt  ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,prmpt_cond );
  END;
  PROCEDURE off_prompt ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,prmpt_cond );
  END;
  
  PROCEDURE on_fp_error( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,fperr_cond );
  END;
  PROCEDURE off_fp_error(isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,fperr_cond );
  END;
  
  PROCEDURE on_modem   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,mdmch_cond );
  END;
  PROCEDURE off_modem  ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,mdmch_cond );
  END;
  
  PROCEDURE on_no_activity
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,noact_cond );
  END;
  PROCEDURE off_no_activity
                       ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,noact_cond );
  END;
  
  PROCEDURE on_lost_carrier
                       ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,lstcr_cond );
  END;
  PROCEDURE off_lost_carrier
                       ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,lstcr_cond );
  END;
  
  PROCEDURE on_eol     ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,eol_cond );
  END;
  PROCEDURE off_eol    ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,eol_cond );
  END;
  
  PROCEDURE on_break   ( isc       : type_isc  ;
                         your_proc : serial_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    serial_isr_setup(isc,your_proc,your_parm,break_cond );
  END;
  PROCEDURE off_break  ( isc       : type_isc );
  BEGIN
    serial_isr_kill(isc,break_cond );
  END;
        
END; { of serial_5 }


IMPORT iodeclarations , serial_5;
VAR counter : INTEGER;
BEGIN
  FOR counter := iominisc TO iomaxisc DO 
    serial_isr_table[counter] := NIL;
END.    { of serial_5_init  }  

