!File:	LABIOACQ.FOR
!	Version 'V04-000'
!
!****************************************************************************
!*									    *
!*  COPYRIGHT (c) 1978, 1980, 1982, 1984 BY				    *
!*  DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS.		    *
!*  ALL RIGHTS RESERVED.						    *
!* 									    *
!*  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED   *
!*  ONLY IN  ACCORDANCE WITH  THE  TERMS  OF  SUCH  LICENSE  AND WITH THE   *
!*  INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR  ANY  OTHER   *
!*  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY   *
!*  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE IS  HEREBY   *
!*  TRANSFERRED.							    *
!* 									    *
!*  THE INFORMATION IN THIS SOFTWARE IS  SUBJECT TO CHANGE WITHOUT NOTICE   *
!*  AND  SHOULD  NOT  BE  CONSTRUED AS  A COMMITMENT BY DIGITAL EQUIPMENT   *
!*  CORPORATION.							    *
!* 									    *
!*  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE  OR  RELIABILITY OF ITS   *
!*  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.		    *
!* 									    *
!*									    *
!****************************************************************************
!
	Program LABIO_DATA_ACQ

! This is the program that acquires data for the LABIO system
! It uses the connect-to-interrupt feature of VMS to acquire
! via a user written I/O routine. The actual I/O routine is
! written in MACRO. The main program monitors the event flags
! and enables and disables data acquisition for each channel.
! It also notifies users via event flags when a buffer is full.


! Define the LABIO data base

	Include	'LABCHNDEF.FOR'

! Local Variables
	Logical*4 SECTION_FLAGS, SECTION_PROT	

! System Services
	Logical*4 SYS$ASCEFC,SYS$MGBLSC,SYS$ASSIGN,SYS$QIO
	Logical*4 SYS$CLREF

! External constants
	External SEC$M_GBL,SEC$M_WRT,SS$_CREATED,SS$_WASSET
	External SET_EF_AST

! Misc.
	Logical*4 AD_CIN_UP,SUCCESS

!
! Create the Global Section for the data buffer
! This data buffer will be READ/WRITE for the owner, READ only  for the GROUP. 
!
! First see if the global section already exists, if it
! does just map to it. and set the restart flag.
!
! If not, Open the Data File. This can not be openned
! via FORTRAN since we need the VMS channel number.
!
!
	SECTION(1) = %Loc( LABIO_BUFFER_S)	!Start address of section
	SECTION(2) = %Loc( LABIO_BUFFER_E) - 1	!End address
! Page count for the section
	SECTION_SIZE = ( SECTION(2) - SECTION(1) )/512 + 1

! FLAGS for Section are GLOABAL,SHARED,NON_ZEROED,READ/WRITE,TEMP,GLOBAL
!
	  SECTION_FLAGS = %Loc( SEC$M_GBL ) + %Loc( SEC$M_WRT )

! Try just mapping to the global section
	SUCCESS = SYS$MGBLSC( SECTION,,,%Val(SECTION_FLAGS),'LABIOCOMMON',,)
	If( SUCCESS ) Then
	  RESTART = .TRUE.	!Succes, this is a restart
	Else
	  SUCCESS = GBL_SECTION_UFO( SECTION_SIZE, 'LABIO_SEC_FILE',
	1                          SECTION_CHANNEL )
	  If( .not. SUCCESS ) 
	1   Call FATAL_ERROR(SUCCESS,'Opening Global Section File')

! PROTECTION is OWNER = READ/WRITE, GROUP = READ, SYSTEM/WORLD = none
!
	  SECTION_PROT = 'F E 0 F'X !Protection for section

! Create and Map the Section
!
	  SUCCESS = SYS$CRMPSC( SECTION,,,%Val(SECTION_FLAGS),'LABIOCOMMON',
	1           ,,%Val(SECTION_CHANNEL),%Val(SECTION_SIZE),,
	1	    %Val(SECTION_PROT),%Val(SECTION_SIZE))
	  If( .not. SUCCESS )
	1 Call FATAL_ERROR(SUCCESS,'Creating Global Section')
	  RESTART = .FALSE.			!We are not restarting
	End If
!
! If this is not a restart, clear the data structures
!
	If( .not. RESTART ) Then
	 Do 32 I = 1, MAX_AD_CHANNEL		!Clear AD_BLOCK
	  Do 30 J = 1, 16
30	   AD_BLOCK(J,I) = 0
	  Do 31 K = 1, BUFFER_COUNT		!Clear Data buffers
	   Do 31 J = 1, MAX_BUF_SIZE
31	    DATA_BUFFER(J,K,I) = 0	
32	 Continue
	 Do 33 I = 1, MAX_PID
	  Do 33 J = 1,2
33	   CONNECT_BLOCK(I,J) = 0		!Clear Process connect block
	End IF
!
! Create event flag cluster EF_NOTIFY and associate with event flags 64-95
! These are used to notify the Data Acquisition process.

	SUCCESS = SYS$ASCEFC( %VAL(EF_NOTIFY_1),EF_NOTIFY_CLSTR,,)
	If ( .not. SUCCESS)
	1	Call FATAL_ERROR( SUCCESS, 'CREATING EVENT FLAG CLUSTER')
!
! Create event flag cluster EF_STATUS and associate with event flags 96-127
! These are used to notify and report the status of the user buffers
!
	SUCCESS = SYS$ASCEFC( %VAL(EF_STATUS_1),EF_STATUS_CLSTR,,)
	If ( .not. SUCCESS)
	1	Call FATAL_ERROR( SUCCESS, 'CREATING EVENT FLAG CLUSTER')

!
! Make sure that we can't be swapped
!
	Call SYS$SETSWM(%Val(1))

!
! Set-up the Connect-to-Interrupt
! First assign a VMS channel for the device
! Then call the connect-to-interrupt setup routine.
!
	SUCCESS = SYS$ASSIGN( 'LABIO_AD',CIN_CHANNEL,, )
	If ( .not. SUCCESS ) 
	1 Call FATAL_ERROR( SUCCESS, 'assigning A/D device' )

	SUCCESS = AD_CIN_SETUP( CIN_CHANNEL,SET_EF_AST )
	If( .not. SUCCESS ) 
	1 Call FATAL_ERROR( SUCCESS, 'connecting-to-interrupt')
!
! End Of Initialization, Notify other processes by setting EF_DATA_ACQ
!
	Call SYS$SETEF( %Val( EF_DATA_ACQ) )

!
! Wait for an event flag in the EF_NOTIFY cluster
! Then read the EF_NOTIFY CLUSTER and EF_STATUS_CLUSTER

10	Call SYS$WFLOR( %Val(EF_NOTIFY_1) , %Val('FFFF'X) )
!
! Look for the flag(s) set in EF_NOTIFY
! If the corresponding activity flag is set, activate the channel,
! otherwise deactivate it. Also check the buffer status flag, if clear
! clear the buffer index.
!
	Do 20 I = 1,16
	If( SYS$CLREF( %Val(EF_NOTIFY_OFF + I)) .eq. %Loc(SS$_WASSET)) Then
	  If( AD_BLOCK(1,I) .ne. 0 ) Then
	    If( SYS$READEF( %Val(EF_ACTIVITY_OFF + I),EF_STATE )
	1                        .eq. %Loc(SS$_WASSET ) ) Then
	        AD_BLOCK(1,I) = ACTIVE
	     Else
	        AD_BLOCK(1,I) = INACTIVE
	     End if
	    If( SYS$READEF( %Val(EF_STATUS_OFF + I),EF_STATE )
	1                        .eq. %Loc(SS$_WASCLR))  AD_BLOCK(7,I) = 0
	  End If
	End If
20	Continue
	Go To 10

	End

	Subroutine SET_EF_AST( EVENT_FLAGS )

! This is a AST routine which is invoked by the 
! Interrupt service routine. This routine sets
! the event flags indicated by the ISR.

	Include 'LABCHNDEF.FOR'
	Integer	EVENT_FLAGS

!
! The Event flags are set in cluster EF_STATUS_CLSTR
!

	Do 10 I = 1,16
	If( (EVENT_FLAGS .and. BIT(I)) .ne. 0 ) 
	1  Call SYS$SETEF( %Val(EF_STATUS_OFF + I) )
10	Continue
	Return

	End
![End of File]
