Allow f77 apps to bypass internal HDS lock checks

This is because multi-threaded C apps that use F77 code (via a suitabel C
wrapper) serialise the execution of the F77 code using a mutex (usually
within the wrapper layer), and so HDS functions called within the F77
code (via a suitable wrapper) should not perform extra serialisation
checks.

The new datNolock function can be used to indicate that locking checks
should not be performed on a specified object.

Author: David Berry

Makefile.am

@@ -108,6 +108,7 @@ datValid.c \
 datVec.c \
 datLock.c \
 datLocked.c \
+datNolock.c \
 datUnlock.c \
 hdsCopy.c \
 hdsErase.c \

dat1.h

@@ -155,6 +155,8 @@ typedef struct Handle {
                                 for any known child objects */
    int nchild;              /* The length of the "children" array */
    char *name;              /* Name (cleaned) of the HDF object within its parent */
+   char docheck;            /* If non-zero, check any lock is appropriate
+                               before using the locator */
 } Handle;
 
 /* Private definition of the HDS locator struct */

dat1Handle.c

@@ -217,6 +217,7 @@ Handle *dat1Handle( const HDSLoc *parent_loc, const char *name, int rdonly,
          }
 
 /* Initialise the Handle to indicate it is currently unlocked. */
+         result->docheck = 1;
          result->nwrite_lock = 0;
          result->nread_lock = 0;
          result->read_lockers = NULL;
@@ -225,7 +226,7 @@ Handle *dat1Handle( const HDSLoc *parent_loc, const char *name, int rdonly,
 /* If a parent was supplied, see if the current thread has a read or
    write lock on the parent object. We give the same sort of lock to the
    new Handle below (ignoring the supplied value for "rdonly"). */
-         if( parent ) {
+         if( parent && parent->docheck ) {
             lock_status = dat1HandleLock( parent, 1, 0, 0, status );
             if( lock_status == 1 ) {
                rdonly = 0;

dat1ValidateLocator.c

@@ -113,7 +113,7 @@ int dat1ValidateLocator( const char *func, int checklock, const HDSLoc *loc,
 /* If required, check that the object is locked by the current thread for
    the appropriate type of access. Do not check any child objects as these
    will be checked if and when accessed. */
-   if( checklock && *status == SAI__OK ) {
+   if( checklock && loc->handle->docheck && *status == SAI__OK ) {
       lock_status = dat1HandleLock( loc->handle, 1, 0, 0, status );
 
 /* Calling function will not make any change to the object. In this case

datNolock.c

@@ -0,0 +1,107 @@
+/*
+*+
+*  Name:
+*     datNolock
+
+*  Purpose:
+*     Indicate that an object should be used without checking its lock.
+
+*  Language:
+*     Starlink ANSI C
+
+*  Type of Module:
+*     Library routine
+
+*  Invocation:
+*     datNolock( HDSLoc *locator, int *status );
+
+*  Arguments:
+*     locator = HDSLoc * (Given)
+*        Locator to the object that is to be modified.
+*     status = int* (Given and Returned)
+*        Pointer to global status.
+
+*  Description:
+*     By default, every HDS function will check that the supplied locator
+*     is locked for use by the current thread before using it, and issue
+*     an error report if it is not suitably locked. In some cases however,
+*     this check is not required and can cause problems. This function can
+*     be used to supres the check when required. It stores a flag with the
+*     given locator indicating that no such checks should be performed
+*     before using the locator.
+*
+*     For instance, objects created within Fortran code may require this
+*     flag to be set.
+
+*  Authors:
+*     DSB: David S Berry (DSB)
+*     {enter_new_authors_here}
+
+*  History:
+*     9-OCT-2017 (DSB):
+*        Initial version
+*     {enter_further_changes_here}
+
+*  Copyright:
+*     Copyright (C) 2017 East Asian Observatory.
+*     All Rights Reserved.
+
+*  Licence:
+*     Redistribution and use in source and binary forms, with or
+*     without modification, are permitted provided that the following
+*     conditions are met:
+*
+*     - Redistributions of source code must retain the above copyright
+*       notice, this list of conditions and the following disclaimer.
+*
+*     - Redistributions in binary form must reproduce the above
+*       copyright notice, this list of conditions and the following
+*       disclaimer in the documentation and/or other materials
+*       provided with the distribution.
+*
+*     - Neither the name of the {organization} nor the names of its
+*       contributors may be used to endorse or promote products
+*       derived from this software without specific prior written
+*       permission.
+*
+*     THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
+*     CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
+*     INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+*     MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+*     DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
+*     CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+*     SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+*     LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+*     USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+*     AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+*     LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
+*     IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
+*     THE POSSIBILITY OF SUCH DAMAGE.
+
+*  Bugs:
+*     {note_any_bugs_here}
+*-
+*/
+
+#include "sae_par.h"
+#include "dat1.h"
+#include "hds.h"
+
+int datNolock( HDSLoc *locator, int *status ) {
+
+/* Check inherited status. */
+   if (*status != SAI__OK) return *status;
+
+/* Validate input locator. */
+   dat1ValidateLocator( "datNolock", 0, locator, 0, status );
+
+/* Check we can de-reference "locator" safely. */
+   if( *status == SAI__OK ) {
+
+/* Set the flag. */
+      locator->handle->docheck = 0;
+   }
+
+   return *status;
+}
+

hds.h

@@ -960,6 +960,13 @@ datType(const HDSLoc *locator, char type_str[DAT__SZTYP + 1], int *status);
 int
 datUnlock( HDSLoc *locator, int recurs, int *status);
 
+/*=============================================================*/
+/* datNolock - Prevent lock checks being performed on an object. */
+/*=============================================================*/
+
+int
+datNolock( HDSLoc *locator, int *status);
+
 
 /*=========================*/
 /* datUnmap - Unmap object */

hds_v5.h

@@ -946,6 +946,13 @@ datThere_v5(const HDSLoc *locator, const char *name_c, hdsbool_t *there, int *st
 int
 datType_v5(const HDSLoc *locator, char type_str[DAT__SZTYP + 1], int *status);
 
+/*=============================================================*/
+/* datNolock - Prevent lock echks being performed on an object */
+/*=============================================================*/
+
+int
+datNolock_v5( HDSLoc *locator, int *status);
+
 /*=============================================================*/
 /* datUnlock - Unlock an object so another thread can lock it. */
 /*=============================================================*/

hds_v5_map.h

@@ -130,6 +130,7 @@
 #define datTemp datTemp_v5
 #define datThere datThere_v5
 #define datType datType_v5
+#define datNolock datNolock_v5
 #define datUnlock datUnlock_v5
 #define datUnmap datUnmap_v5
 #define datValid datValid_v5