Esempio n. 1
0
void msg1Prtln( const char * text, int * status ) {
  int err;                /* return value from printf */
  size_t len = 0;         /* Length of input text */

  if (*status != SAI__OK) return;

  /* how many characters do we expect to deliver (including newline) */
  len = strlen( text ) + 1;

  /* Note that we must add the newline */
  err = printf( "%s\n", text );

  /* only call fflush if printf succeeded so as not to reset errno */
  if (err > 0) fflush(stdout);

  if (err < 0) {
    *status = MSG__OPTER;
    emsMark();
    emsSyser( "ERR", errno );
    emsRep( "MSG_PRINT_MESS",
	    "msg1Prtln: Error printing message to stdout: ^ERR", status );
    emsRlse();
  } else if ((size_t)err != len) {
    emsMark();
    *status = MSG__OPTER;
    emsSeti( "NEX", len );
    emsSeti( "NGOT", err );
    emsRep("MSG_PRINT_MESS",
	    "msg1Prtln: Error printing message to stdout. Printed ^NGOT"
	    " characters but expected to print ^NEX", status );
    emsRlse();
  }

}
Esempio n. 2
0
int datAnnul( HDSLoc **locator, int * status ) {
  /* Attempts to run even if status is bad */
  int lstat = SAI__OK;

  /* Sanity check argument */
  if (!locator) return *status;
  if (! *locator) return *status;

  /* Begin an entirely new error context as we need to run this
     regardless of external errors */
  lstat = *status;
  emsBegin( &lstat );
  emsMark();

  /* Free file resources */
  dat1Annul( *locator, &lstat );

  /* Free the memory associated with this locator */
  *locator = dat1FreeLoc( *locator, &lstat );

  /* End the error context and return the final status */
  emsRlse();
  emsEnd( &lstat );
  *status = lstat;

  return *status;
}
Esempio n. 3
0
void errClear( int * status ) {
  int level;      /* Error context level */
  int tstlev = 0; /* Test level variable */

  /*  Initialise the error context level. */
  emsLevel( &level );

  /*  Loop to return the Error Reporting System to the default context
   *  level. We assume we're there when emsRlse will go no lower. */
  while ( level != tstlev) {
    tstlev = level;
    emsRlse();
    emsLevel( &level );
  }

  /*  Check if there are any error messages pending output in the error
   *  table. */
  emsStat( status );
  if (*status != SAI__OK) {

    /*     There are error messages pending output, so call ERR_FLUSH to
     *     deliver them to the user. */
    errFlush( status );

    /*     Check the returned status for output errors: if they have
     *     occurred, annul the error table at the current (default) context. */
    if (*status != SAI__OK) emsAnnul( status );

  } else {

    /*     There are no pending error messages, so just reset the status to
     *     SAI__OK. (the if statement guarantees this but it was done this
     *     way in Fortran) */
    *status = SAI__OK;
  }
}
Esempio n. 4
0
IDL_VPTR hds2idl( int argc, IDL_VPTR argv[] ) {
/*
** Declare variables
*/
IDL_VPTR hds_name;       /* IDL_VPTR to name of the HDS object to be read */
IDL_VPTR var;            /* Variable pointer to IDL object */
IDL_VARIABLE temp;       /* Temporary storage for primitive scalar variable */
IDL_StructDefPtr sdef;   /* Structure definition of sub-structure */
IDL_STRING *objname;     /* Pointer to object name as IDL string */
HDSLoc *objloc = NULL;   /* Locator of file */

int status;             /* Starlink status */

char type[DAT__SZTYP+1];/* HDS type of component */
UCHAR idltype;          /* IDl type of component */
int ndims;              /* Number of dimensions of object */
int dims[DAT__MXDIM];   /* Dimensions of object HDS style */
IDL_LONG idldims[DAT__MXDIM];/* Dimensions of object IDL style */
int i;                  /* loop index */
int fstat;              /* Final status (before emsEload) */
int isstruct;           /* Whether object is structure */
void *tdata;            /* Pointer to data area of IDL variable or array */

char param[EMS__SZPAR+1]; /* Error message parameter name */
int parlen;             /* Length of error message parameter name */
char opstr[EMS__SZMSG+1]; /* Error message */
int oplen;              /* Length of error message */

IDL_LONG one[IDL_MAX_ARRAY_DIM]={1};

/* Start Error context */
   status = SAI__OK;
   emsMark();

/* Check that the correct number of arguments were passed in */
   if(argc != 1) {

   /* Print an error message and return */
      status = SAI__ERROR;
      emsRep( " ", "hds2idl: Incorrect number of arguments", &status );

   } else {
   /* Extract the arguments to comprehensible names */
      hds_name = argv[0];
      objname = &hds_name->value.str;

   /* Open the HDS object */
      getcomp( IDL_STRING_STR(objname), "READ", &objloc, &status );

   /* Check for structure or primitive */
      datStruc( objloc, &isstruct, &status );
      if (status == SAI__OK) {
         if ( isstruct ) {
         /* Create a structure */
            sdef = idlstructdef( objloc, &status );

         /* Create a temporary variable */
            if ( status == SAI__OK ) {
               (void *)IDL_MakeTempStruct( sdef, 1, one, &var, TRUE );
               idlstructfill( objloc, var->value.s, &status );
            }

         } else {
         /* Object is primitive */
            datType( objloc, type, &status );
            idltype = getidltype( type );
            datShape( objloc, DAT__MXDIM, dims, &ndims, &status );
            if ( status == SAI__OK ) {
               if (ndims) {
               /* Get dimensions IDL style */
                  for (i=0;i<ndims;i++) idldims[i] = (IDL_LONG)dims[i];
               /* Object is primitive array */
                  tdata = IDL_MakeTempArray( (int)idltype, ndims, idldims,
                    IDL_BARR_INI_ZERO , &var );

               } else {
               /* Object is primitive scalar */
                  var = &temp;
                  var->type = idltype;
                  var->flags = 0;
                  tdata = &var->value;
               }

               idlprimfill( objloc, var, tdata, &status );
            }

         }

      /* Annul the object (and close the file) */
         datAnnul( &objloc, &status );
      }
   }

   if ( status != SAI__OK ) {
   /*  Report any error messages             */
   /*  Adding Starlink-style !! and ! prefix */
      fstat = status;
      while ( status != SAI__OK ) {
         emsEload(
            param, &parlen, opstr, &oplen, &status );
         if ( status != SAI__OK )
            IDL_Message( IDL_M_NAMED_GENERIC, IDL_MSG_INFO, opstr );
      }

   /*  Set to return undefined variable */
      var = IDL_Gettmp();

   /*  and close error context */
      emsRlse();
   }

/*  That's it, return to the calling routine */
   return var;
}
Esempio n. 5
0
int
datErmsg(int  status, size_t *len, char *msg_str)
{

/* Local Variables:                                                         */
   const char *trans = NULL;         /* Pointer to translation text         */
   int lstat;                        /* Local status variable               */
   int emslen;                       /* Length from EMS                     */

/*.                                                                         */

/* Test for each DAT__ error code, obtaining a pointer to the textual       */
/* translation.                                                             */
   switch ( status )
   {
      default:
         trans = NULL;
         break;

      case SAI__OK:
         trans = "OK, no error (SAI__OK)";
         break;

      case DAT__LOCIN:
         trans = "Locator invalid (DAT__LOCIN)";
         break;

      case DAT__TYPIN:
         trans = "Type invalid (DAT__TYPIN)";
         break;

      case DAT__NAMIN:
         trans = "Name invalid (DAT__NAMIN)";
         break;

      case DAT__MODIN:
         trans = "Mode invalid (DAT__MODIN)";
         break;

      case DAT__DELIN:
         trans = "Deletion invalid (DAT__DELIN)";
         break;

      case DAT__DIMIN:
         trans = "Dimensions invalid (DAT__DIMIN)";
         break;

      case DAT__FILIN:
         trans = "File invalid (DAT__FILIN)";
         break;

      case DAT__OBJIN:
         trans = "Object invalid (DAT__OBJIN)";
         break;

      case DAT__GRPIN:
         trans = "Group invalid (DAT__GRPIN)";
         break;

      case DAT__SUBIN:
         trans = "Subscripts invalid (DAT__SUBIN)";
         break;

      case DAT__COMEX:
         trans = "Component already exists (DAT__COMEX)";
         break;

      case DAT__OBJNF:
         trans = "Object not found (DAT__OBJNF)";
         break;

      case DAT__TRUNC:
         trans = "Text truncated (DAT__TRUNC)";
         break;

      case DAT__ACCON:
         trans = "Access conflict (DAT__ACCON)";
         break;

      case DAT__CONER:
         trans = "Conversion error (DAT__CONER)";
         break;

      case DAT__UNSET:
         trans = "Primitive data undefined (DAT__UNSET)";
         break;

      case DAT__VERMM:
         trans = "Version mismatch (DAT__VERMM)";
         break;

      case DAT__PRMAP:
         trans = "Primitive data mapped (DAT__PRMAP)";
         break;

      case DAT__FILCK:
         trans = "File lock error (DAT__FILCK)";
         break;

      case DAT__FILNF:
         trans = "File not found (DAT__FILNF)";
         break;

      case DAT__FILPR:
         trans = "File protected (DAT__FILPR)";
         break;

      case DAT__INCHK:
         trans = "Integrity check (DAT__INCHK)";
         break;

      case DAT__FATAL:
         trans = "Fatal internal error (DAT__FATAL)";
         break;

      case DAT__ISMAP:
         trans = "Data currently mapped (DAT__ISMAP)";
         break;

      case DAT__BOUND:
         trans = "Outside bounds of object (DAT__BOUND)";
         break;

      case DAT__FILCL:
         trans = "File close error (DAT__FILCL)";
         break;

      case DAT__FILCR:
         trans = "File create error (DAT__FILCR)";
         break;

      case DAT__FILMP:
         trans = "File mapping error (DAT__FILMP)";
         break;

      case DAT__FILND:
         trans = "File not deleted (DAT__FILND)";
         break;

      case DAT__FILNX:
         trans = "File not extended (DAT__FILNX)";
         break;

      case DAT__FILRD:
         trans = "File read error (DAT__FILRD)";
         break;

      case DAT__FILWR:
         trans = "File write error (DAT__FILWR)";
         break;

      case DAT__NOMEM:
         trans = "Memory allocation error (DAT__NOMEM)";
         break;

      case DAT__WLDIN:
         trans = "Wild card search context invalid (DAT__WLDIN)";
         break;
   }

/* If translation text was found, then determine the number of significant  */
/* characters to be returned and copy them to the output string.            */
   if ( trans != NULL )
   {
      strcpy( msg_str, trans );
      *len = strlen( msg_str );
   }

/* If the error code is not a DAT__ error code, then use ems_ to translate  */
/* it as a system error code, and copy the resulting text to the output     */
/* string.                                                                  */
   else
   {
      lstat = SAI__OK;
      emsMark( );
      emsSyser( "MESSAGE", status );
      emsMload( " ", "^MESSAGE", msg_str, &emslen, &lstat );
      *len = emslen;
      emsRlse( );
   }

/* Exit the routine.                                                        */
   return SAI__OK;
}
Esempio n. 6
0
void datMsg( const char * token, const HDSLoc * loc ) {

  /*  Local Variables: */
  char buff[EMS__SZMSG+EMS__SZMSG+2];  /* Buffer for file+path */
  char file[EMS__SZMSG+1];             /* Container file name */
  char path[EMS__SZMSG+1];             /* Object path name */

  char *bra;   /* Position of '(' character */
  char *dot;   /* Position of '.' */
  size_t ncf;   /* Number of characters in filename */
  int nlev; /* Object level in HDS */
#if defined( vms )
  char *semi;  /* Position of ';' */
#endif
  char *start; /* Position to start in path name */
  int status = DAT__OK; /* local status variable */
  int odd;   /* Is the filename odd? */
  int ok;    /* No error occurred? */

  /*  Mark the error stack */
  emsMark();

  /*  Obtain the data object path and container file name. */
  hdsTrace( loc, &nlev, path, file, &status, sizeof(path), sizeof(file) );

  if ( status == DAT__OK ) {

    /*  If necessary, handle VAX/VMS file names.  Locate the semicolon which
     *  delimits the version number in the file name. */

#if defined( vms )

    semi = strchr( file, ';' );

    /*  If found, then select the file name prior to it by replacing
	it with a nul. */
    if (semi != NULL ) {
      *semi = '\0';
    }

#endif

    /* Find the filename length */
    ncf = strlen( file );

    /*  See if the file is "odd". Check to see if it has the default file
     *  extension of '.SDF' with at least one character preceding it. */

    odd = 1;
    if ( ncf >= 5 ) {
      if ( strcmp( &file[ncf-DAT__SZFLX], DAT__FLEXT ) == 0) {
	odd = 0;
      } else {
	odd = 1;
      }
    }

    /*  If the file name is not odd, then omit the file extension. */
    if (!odd) file[ncf-DAT__SZFLX] = '\0';

    /*  Enter the file name into the buffer, surrounding it in quotes if it
     *  is odd. */

    *buff = '\0';
    if (odd) strcat(buff, "\"" );
    strcat( buff, file );
    if (odd) strcat(buff, "\"" );

    /*  If the object is not a top-level object, then find the position of
     *  the first '.' in its pathname, which marks the start of the first
     *  component name. */

    if (nlev > 1 ) {

      dot = strchr( path, '.' );

      /*  If successful, see if the '.' is preceded by a '(' indicating that
       *  the top-level object is subscripted. Derive the starting position in
       *  the path name so that the subscript is used if present. */

      if (dot != NULL) {

	bra = strchr( path, '(' );
	if (bra != NULL && bra < dot) {
	  start = bra;
	} else {
	  start = dot;
	}

	/*  Add the required part of the path name to the buffer. */
	strcat( buff, start );

      }

    } else {
      /*  If the object is a top-level object, then see if it is subscripted.
       *  If so, then add the subscript to the buffer. */

      start = strchr( path, '(' );

      if ( start != NULL ) {
	strcat( buff, start );
      }

    }

  }

  /*  Note if any error has occurred. */
  ok = ( status == DAT__OK  ? 1 : 0 );

  /*  If an error occurred, then annul it. Release the error stack. */
  if ( status != DAT__OK ) emsAnnul( &status );
  emsRlse();

  /*  If no error occurred, then assign the resulting buffer contents to
   *  the message token. */
  if (ok) emsSetc( token, buff );

}
Esempio n. 7
0
void crehds( int argc, IDL_VPTR argv[] ) {
/*
** Declare variables
*/
char *hdsname;    /* The name of the HDS container file to create */
char *strucname;  /* The name of the top-level structure */
IDL_VPTR var;

int ndims;
hdsdim dims[DAT__MXDIM];

int status;        /* Starlink status */

HDSLoc* toploc = NULL;      /* Locator to top object */
int numtags;                /* Number of tags = 0 if not a structure */
char hdstype[DAT__SZTYP+1]; /* corresponding HDS type */
int fstat;                  /* Final status (before emsEload) */
char param[EMS__SZPAR+1];     /* Error message parameter name */
int parlen;                 /* Length of error message parameter name */
char opstr[EMS__SZMSG+1];     /* Error message */
int oplen;                  /* Length of error message */
char **taglist;             /* Pointer to taglist */
char *data;                 /* Pointer to data */
IDL_LONG nvals;             /* Number of values in var */
int elt_len;                /* Length of element of structure */
IDL_STRING *IDL_tags;
hdsdim IDL_ntags;

char defname[12]="IDL2HDS_OUT";

/* Start Error context */
   status = SAI__OK;
   emsMark();

/* Check that the correct number of arguments were passed in */
   if ( ( argc == 2 ) | (argc == 3 ) ) {
      var = argv[0];

      if ( argv[1]->flags & IDL_V_ARR ) {
         IDL_tags = (IDL_STRING *)argv[1]->value.arr->data;
         IDL_ntags = (hdsdim)argv[1]->value.arr->n_elts;
      } else {
         IDL_tags = &argv[1]->value.str;
         IDL_ntags = 1;
      }
      taglist = getstringarray( 1, &IDL_ntags, IDL_tags );

      if ( argc == 3 )
         hdsname = argv[2]->value.str.s;
      else
         hdsname = defname;
      strucname = hdsname;

      IDL_VarGetData( var, &nvals, &data, 0 );

      getobjectdetails( var, data, taglist,
         hdstype, &numtags, &ndims, dims, &elt_len, &status );
      hdsNew( hdsname, strucname, hdstype, ndims, dims, &toploc, &status );
      if ( numtags ) {
/* is a structure - invoke the structure handler */
         hdsstructwrite(
            toploc, data, taglist, numtags, ndims, dims, var, &status );
         retstringarray( taglist );
      } else {
         hdsprimwrite( toploc, hdstype, ndims, dims, data, &status );
      }

      datAnnul( &toploc, &status );

   } else {
      status = SAI__ERROR;
      emsRep( " ", "crehds: Incorrect number of arguments", &status );
   }

/*  Report any error messages */
/*  Adding Starlink-style !! and ! prefix */
   if ( status != SAI__OK ) {
      fstat = status;
      while ( status != SAI__OK ) {
         emsEload(
            param, &parlen, opstr, &oplen, &status );
         if ( status != SAI__OK )
            IDL_Message( IDL_M_NAMED_GENERIC, IDL_MSG_INFO, opstr );
      }
   }
   emsRlse();

/*  That's it, return to the calling routine */
   return;
}
Esempio n. 8
0
void errTune( const char * param, int value, int * status ) {

    const char * parnames[] = { "SZOUT", "STREAM", "REVEAL", NULL };
    const char * thispar = NULL;   /* Selected parameter */

    int i;
    int set;                 /* Value has been set */
    int istat = SAI__OK;     /* Internal status */
    int env = 0;             /* Are we using the environment? */
    int npars = 0;           /* Number of parameters to read */
    int useval = 0;          /* Tuning value to actually use */
    int envval;              /* Tuning value from environment */
    int fromenv = 0;         /* Value came from environment */
    int ltune;               /* Actual tuning value used */

    /* Check for 'ENVIRONMENT' */
    if  (strcasecmp( param, "ENVIRONMENT" ) == 0) {
        env = 1;
        /* work it out ourselves */
        npars = 0;
        while ( parnames[npars] ) {
            npars++;
        }
    } else {
        env = 0;
        npars = 1;
        thispar = param;
    }

    /* Now for each required parameter */
    i = 0;
    while ( istat == SAI__OK && i < npars) {

        /* Select next par name if we are in env mode */
        if (env) {
            thispar = parnames[i];
            set = 0;
        } else {
            set = 1;
        }
        i++;

        /*     See if the associated environment variable is set
         *     If so, override the given VALUE - make sure we do not
         *     clear tokens by starting a new context. */
        emsMark();
        fromenv = 0;
        envval = mers1Getenv( 0, thispar, &istat );
        emsRlse();

        if (envval == -1) {
            /* everything okay but no environment variable */
            useval = value;
        } else if (envval > 0 ) {
            set = 1;
            useval = envval;
            fromenv = 1;
        }

        if (istat == SAI__OK && set) {
            ltune = -1;

            /*        Check that the given parameter name is acceptable
             *        and handle it. */
            if (strcasecmp( "SZOUT", thispar) == 0) {
                if (useval == 0) {
                    ltune = ERR__SZMSG;
                } else if ( useval > 6 ) {
                    ltune = MIN( useval, ERR__SZMSG );
                } else {
                    istat = ERR__BTUNE;
                }
                if (ltune != -1) {
                    err1Ptwsz( ltune );
                }

            } else if (strcasecmp( "STREAM", thispar) == 0 ) {

                if (useval == 0) {
                    ltune = 0;
                } else if (useval == 1) {
                    ltune = 1;
                } else {
                    istat = ERR__BTUNE;
                }
                if (ltune != -1) err1Ptstm( ltune );

            } else if (strcasecmp( "REVEAL", thispar ) == 0 ) {

                if (useval == 0) {
                    ltune = 0;
                } else if (useval == 1) {
                    ltune = 1;
                } else {
                    istat = ERR__BTUNE;
                }
                if (ltune != -1) {
                    emsTune( "REVEAL", ltune, &istat );
                    err1Ptrvl( ltune );
                }

            } else {

                /*           The given tuning parameter was not in the available set.
                 *           Set status and report an error message.
                 *           We  mark and rlse to prevent possible token name clash */
                emsMark();
                istat = ERR__BDPAR;
                emsSetc( "PARAM", thispar );
                emsRep( "ERR_TUNE_PAR",
                        "errTune: Invalid tuning parameter: ^PARAM", &istat );
                emsRlse();
            }

            if (istat == ERR__BTUNE) {

                /*           The given tuning parameter value was invalid
                 *           Report an error message
                 *           We  mark and rlse to prevent posible token name clash */
                emsMark();
                emsSetc( "PARAM", thispar );
                emsSeti( "VALUE", useval );
                if (fromenv) {
                    emsSetc( "SOURCE", "from environment variable" );
                } else {
                    emsSetc( "SOURCE", " " );
                }
                emsRep( "ERR_TUNE_INV",
                        "errTune: ^PARAM invalid value ^VALUE ^SOURCE", &istat);
                emsRlse();
            }
        }
    }

    /*  Set return status */
    if (*status == SAI__OK) *status = istat;
}