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

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

PROGRAM gpio_5_init(OUTPUT);


MODULE gpio_5 ;     

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


IMPORT  iodeclarations , iocomasm , general_0 ;

EXPORT 
  
  TYPE  gpio_user_proc = PROCEDURE ( parameter : INTEGER );
  
  TYPE  gpio_isr_block = RECORD
                           state : PACKED ARRAY[0..0] OF BOOLEAN;
                           mask  : INTEGER;
                           procs : ARRAY[0..0] OF gpio_user_proc;
                           parms : ARRAY[0..0] OF INTEGER;
                         END;
  
  VAR   gpio_isr_table : ARRAY[iominisc..iomaxisc] OF ^gpio_isr_block;
  
  PROCEDURE on_flag    ( isc       : type_isc  ;
                         your_proc : gpio_user_proc ;
                         your_parm : INTEGER );
  PROCEDURE off_flag   ( isc       : type_isc );
  
  
IMPLEMENT
  
  CONST flgcond        = 0;     flgmask = 128;
  
  TYPE coerce = RECORD CASE BOOLEAN OF
                  TRUE:  ( int : INTEGER );
                  FALSE: ( ptr : ANYPTR )
                END;
  
  PROCEDURE gpio_isr_allocate
                       ( isc       : type_isc );
  VAR counter : INTEGER;
  BEGIN
    NEW(gpio_isr_table[isc] );
    WITH gpio_isr_table[isc]^ DO BEGIN
      FOR counter:=flgcond TO flgcond DO state[counter] := FALSE;
      mask := 0;      
    END; { of WITH DO BEGIN }
  END; { of gpio_isr_allocate }
  
  PROCEDURE gpio_isr_proc
                       ( temp      : ANYPTR );
  VAR counter : INTEGER;
      happened: BOOLEAN;
      isc     : INTEGER;
      local   : coerce ;
  BEGIN
    local.ptr := temp;
    isc       := local.int;
    
    { prevent gpio_isr_proc in user_isr in temps }
    iocontrol( isc , 5 , 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 gpio_isr_table[isc]^ DO BEGIN
      FOR counter := flgcond TO flgcond DO 
        IF state[ counter ] 
          THEN BEGIN
            happened := FALSE;
            CASE counter OF
              flgcond: happened:=bit_set(ioread_byte(isc,0),0);
            END; { of CASE }
            IF happened THEN CALL( procs[counter] , parms[counter] );
          END; { of FOR DO IF bit_set THEN }
      
    { set up gpio_isr_proc in user_isr in temps }
    WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
      user_isr.real_proc := gpio_isr_proc;
    END; { of WITH DO BEGIN }
    
    { re - enable interrupts }
    iocontrol( isc , 5 , mask );
  
  END; { of WITH BEGIN }
END; { of gpio_isr_proc }
  
  PROCEDURE gpio_isr_setup
                       ( isc       : type_isc ;
                         your_proc : gpio_user_proc ;
                         your_parm : INTEGER ;
                         which_cond: INTEGER );
  VAR local : coerce ;
  BEGIN
    IF ( isc_table[isc].card_id <> hp98622 ) THEN io_escape(ioe_misc,isc);
    IF gpio_isr_table[isc] = NIL THEN gpio_isr_allocate(isc);
    WITH gpio_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
        flgcond:  mask:=BINIOR(mask,flgmask);
      END; { of CASE }
      state[which_cond] := TRUE;
      
      { set up gpio_isr_proc in user_isr in temps }
      WITH isc_table[isc].io_tmp_ptr^ DO BEGIN
        user_isr.real_proc := gpio_isr_proc;
        local.int          := isc;              { type coercion }
        user_parm          := local.ptr;        { type coercion }
      END; { of WITH DO BEGIN }
      
      { enable card }
      iocontrol( isc , 5 , mask );
    END; { of WITH DO BEGIN }
  END; { of gpio_isr_setup }
  
  PROCEDURE gpio_isr_kill
                       ( isc       : type_isc ;
                         which_cond: INTEGER );
  BEGIN
    IF gpio_isr_table[isc] <> NIL THEN 
    WITH gpio_isr_table[isc]^ DO BEGIN
    
      { clear state condition and interrupt mask }
      CASE which_cond OF
        flgcond:  mask:=BINAND(mask,BINCMP(flgmask));
      END; { of CASE }
      state[which_cond] := FALSE;
      
      { if necessary clear gpio_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  }
      iocontrol( isc , 5 , mask );
    END; { of WITH DO BEGIN }
  END; { of gpio_isr_kill }
  
  
  PROCEDURE on_flag    ( isc       : type_isc  ;
                         your_proc : gpio_user_proc ;
                         your_parm : INTEGER );
  BEGIN
    gpio_isr_setup(isc,your_proc,your_parm,flgcond );
  END;
  
  PROCEDURE off_flag   ( isc       : type_isc );
  BEGIN
    gpio_isr_kill(isc,flgcond );
  END;
  
END; { of gpio_5 }


IMPORT iodeclarations , gpio_5;
VAR counter : INTEGER;
BEGIN
  FOR counter := iominisc TO iomaxisc DO 
    gpio_isr_table[counter] := NIL;
END.    { of gpio_5_init  }  

