/*
 *--------------------------------------------------------------
 *
 * MarkToArea --
 *
 *      This procedure is called to determine whether an item
 *      lies entirely inside, entirely outside, or overlapping
 *      a given rectangular area.
 *
 * Results:
 *      -1 is returned if the item is entirely outside the area
 *      given by areaPtr, 0 if it overlaps, and 1 if it is entirely
 *      inside the given area.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * ScaleMark --
 *
 *      This procedure is invoked to rescale a marker. If fixscale
 *      is set then only the position is scaled. If minscale is set greater
 *      than zero then scaleX is limited to that value.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The item referred to by itemPtr is rescaled
 *      so that the following transformation is applied to all
 *      point coordinates:
 *              x' = originX + scaleX*(x-originX)
 *              y' = originY + scaleY*(y-originY)
 *
 *      The mark is also scaled to scaleX, if fixscale is set.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * TranslateMark --
 *
 *      This procedure is called to move marker by a given amount.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The position of the mark is offset by (xDelta, yDelta), and
 *      the bounding box is updated in the generic part of the item structure.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * MarkToPostscript --
 *
 *      This procedure is called to generate Postscript for
 *      the marker.
 *
 * Results:
 *      The return value is a standard Tcl result.  If an error
 *      occurs in generating Postscript then an error message is
 *      left in interp->result, replacing whatever used to be there.
 *      If no error occurs, then Postscript for the marker is
 *      appended to the result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * MarkCorrectAnchor--
 *
 *      This procedure is called to shift the "center" position
 *      of a marker to correct for any requested anchors. Note
 *      this doesn't correct for any scale factors.
 *
 *--------------------------------------------------------------
 */


/**
 * Register all the sla:: commands.
 */


// Return a clone of the pointer to the main AstFrameSet.


// Return a copy of the pointer to the main AstFrameSet.


/**
 *  Name:
 *     gaiaFreeNDF
 *
 *  Purpose:
 *     Free an NDF, by anulling its identifier and freeing any
 *     locally allocated resources.
 */


/**
 *   Name:
 *      gaiaMapComponent
 *
 *   Purpose:
 *      Map an NDF data component for the given access access, returning a
 *      pointer to the mapped memory. The memory must be unmapped either
 *      directly or by annuling the NDF identifier, before the program
 *      exits.
 *
 *   Note:
 *      If the data values require modification, then a copy should be
 *      made instead.
 */


/**
 *  Name:
 *     gaiaCreateNDF.
 *
 *  Purpose:
 *     Create a new simple NDF.
 *
 *  Description:
 *     Create a new NDF with the given type (HDS format) and bounds.
 *     Add the given WCS (NULL for none). The components can be accessed using
 *     gaiaMapComponent.
 */


/**
 *  Name:
 *     gaiaCopyNDF.
 *
 *  Purpose:
 *     Create a new NDF by selective copying of parts of an existing NDF.
 *
 *  Description:
 *     Create a new NDF and populate it with some of the content of an
 *     existing NDF using the ndfScopy() routine. The filename is for the new
 *     NDF. The dimensionality and data type of the array components can be
 *     set, and a new (matching) wcs established.
 *
 *     If an axis value is given (i.e. has positive value) then this
 *     forces the "axis" AXIS component to be copied to the first AXIS
 *     component, if an AXIS component is present (use when extracting a
 *     single axis and the AXIS component is still required, i.e. spectral
 *     extraction). In this case "AXIS" must be in the component list.
 */


/*
 *  Name:
 *     gaiaInitMNDF
 *
 *  Purpose:
 *     Initialise access to an NDF and/or any related NDFs. This
 *     routine should be called before any others in the multiple
 *     image NDFs per container file interface.
 *
 *  Description:
 *     Categorise and store displayable information for the given NDF and
 *     any related ones.
 *
 *     Displayables in this context are either array components of the
 *     given NDF, or the components of any other NDFs which are stored at
 *     the same "level" (i.e. HDS path) within a HDS container file.
 *     This can also be extended to include searching of the NDF extension
 *     for other "related" NDFs. These are also limited to being
 *     children of an extension (i.e. no recursive deep searches).
 *
 *     The return from this function is a pointer to an initialised
 *     information structure about the NDFs and displayables
 *     available. If this fails then zero is returned.
 *
 */


/*
 *  Name:
 *     traceMNDFExtensions
 *
 *  Purpose:
 *     Looks for NDFs that are children of the extensions of an NDF and
 *     add their displayables to a multiple NDF info struct list.
 *
 */


/*
 *  Name:
 *     traceMNDFs
 *
 *  Purpose:
 *     Given a locator to an NDF locate siblings and add to the multiple NDF
 *     structure given (this will be created if given NULL). Does work for
 *     gaiaInitMNDF. Exists so that we can recurse looking for NDFs in
 *     extensions. Returns the address of the last struct added, and (as the
 *     headptr value, the address of the first struct).
 *
 */


/*
 *  Name:
 *     gaiaCheckMNDF
 *
 *  Purpose:
 *     See if the given NDF (specified by its index) contains the
 *     required component. If not found then a 0 is returned.
 */


/*
 *  Name:
 *     gaiaGetIdMNDF
 *
 *  Purpose:
 *     Get NDF identifier for a particular NDF.
 */


/*
 *  Name:
 *     gaiaGetInfoMNDF
 *
 *  Purpose:
 *     Get information about a particular NDF.
 */


/*
 *  Name:
 *     gaiaGetMNDF
 *
 *  Purpose:
 *     Obtained a copy of an NDF data component.
 *
 *  Description:
 *     This routine obtains access to a named NDF data component and
 *     returns either a copy or a pointer to mapped memory depending
 *     the readonly state of the NDF.
 *
 *     If readonly is true then a mapped pointer is returned,
 *     otherwise a copy is made into some supplied memory (may want to
 *     offer malloc version?).
 */


/*
 *  Name:
 *     gaiaSetReadMNDF
 *
 *  Purpose:
 *     Set the access method for the NDF data components.
 *     The value is 1 for readonly and 0 for writable memory.
 *
 *  Notes:
 *     Existing memory is not affected by this call, you will need to
 *     recall gaiaFreeMNDF and gaiaGetMNDF make the change.
 */


/*
 *  Name:
 *     gaiaGetReadMNDF
 *
 *  Purpose:
 *     Get the access method for the NDF data components.
 *
 *  Notes:
 *     Existing memory is not affected by this call, you will need to
 *     recall gaiaFreeMNDF and gaiaGetMNDF make the change.
 */


/*
 *  Name:
 *     gaiaCountMNDFs
 *
 *  Purpose:
 *     Return the number of NDFs available.
 */


/*
 *  Name:
 *     gaiaReleaseMNDF
 *
 *  Purpose:
 *     Release all NDF resources associated with given handle.
 */


/*
 *  Name:
 *     gaiaFreeMNDF
 *
 *  Purpose:
 *     Release components accessed for an NDF.
 */


/*
 *  Name:
 *     gaiaCloneMNDF
 *
 *  Purpose:
 *     Create a copy of an NDFinfo handle structure with cloned NDF
 *     identifiers and header copy. Use this when independent access
 *     of the container file is required (i.e. when you need to map in
 *     more than one NDF in a single container file at a time).
 *
 *     Obviously you should avoid mixed mode access to this file
 *     otherwise treat it as independent (i.e. close it sometime).
 */


/**
 * Name:
 *    gaiaNDFOpen
 *
 * Purpose:
 *    Open an NDF and return the identifier.
 */


/**
 * Name:
 *    gaiaNDFClose
 *
 * Purpose:
 *    Close an NDF.
 */


/**
 * Name:
 *    gaiaNDFType
 *
 * Purpose:
 *    Query the data type of a component.
 */


/**
 * Name:
 *    gaiaNDFCGet
 *
 * Purpose:
 *    Query a character component (label, units, title).
 */


/**
 * Name:
 *    gaiaNDFCPut
 *
 * Purpose:
 *    Set the value of a character component (label, units, title).
 */


/**
 * Name:
 *    gaiaNDFMap
 *
 * Purpose:
 *    Map an NDF component with a given data type. Returns data and number of
 *    elements.
 */


/*
 * Name:
 *    gaiaNDFUnmap
 *
 * Purpose:
 *    Unmap the named NDF component.
 */


/**
 * Name:
 *    gaiaNDFGtWcs
 *
 * Purpose:
 *    Get the AST frameset that defines the NDF WCS. Returns the address of
 *    the frameset.
 *
 *    To match the behaviour in KAPPA (and the Fortran part of GAIA), if the
 *    WCS component isn't present we look for a FITS WCS and attempt to use
 *    that. If that fails a default NDF WCS is returned.
 */


/**
 * Name:
 *    gaiaNDFGtAxisWcs
 *
 * Purpose:
 *    Get an AST frameset that describes the coordinates of a given axis.
 *    Axes are in the AST sense, i.e. start at 1.
 */


/**
 * Name:
 *    gaiaNDFQueryDims
 *
 * Purpose:
 *    Query the dimensions of an NDF.
 */


/**
 * Name:
 *    gaiaNDFQueryBounds
 *
 * Purpose:
 *    Query the bounds of an NDF.
 */


/**
 * Name:
 *    gaiaNDFExists
 *
 * Purpose:
 *    Determine whether an NDF component exists.
 */


/**
 * Name:
 *    gaiaNDFWriteFitsChan
 *
 * Purpose:
 *    Write a new FITS extension to an NDF using the contents of a FITS
 *    channel.
 */


/**
 * Name:
 *    gaiaNDFCanWrite
 *
 * Purpose:
 *    Return whether an NDF has been opened with write access.
 */


/**
 * Name:
 *    gaiaNDFExtensionExists
 *
 * Purpose:
 *    Return whether an extension exists.
 */


/**
 * Name:
 *    gaiaNDFGetProperty
 *
 * Purpose:
 *     Get the value of a primitive stored in an extension.
 */


/**
 * Name:
 *    gaiaNDFGetDoubleProperty
 *
 * Purpose:
 *    Get the value of a double precision primitive stored in an extension.
 */


/**
 * Name:
 *    gaiaNDFGetPropertyDims
 *
 * Purpose:
 *    Get the dimensions of a component stored in an extension. The dimensions
 *    are returned in the dims array which should be at least NDF__MXDIM.
 */


/*
 * Name:
 *    gaiaNDFFindChild
 *
 * Purpose:
 *    Search an HDS path for any children that are NDFs and return an
 *    identifier to the first one. Usually name is the name of an HDS
 *    container file being presented for opening.
 */


/*
 * Name:
 *    gaiaNDFSiblingSearch
 *
 * Purpose:
 *    Search an HDS container file for sibling NDFs. Siblings are at the same
 *    HDS level as the given NDF and may include any NDFs stored in the NDF's
 *    extensions, if requested (deepsearch is true). The number of sibling
 *    located and a Tcl list of their basic properties is returned (HDS path
 *    and dimensionality followed by the first three dimensions).
 */


/*
 * Name:
 *    traceSiblingExtensions
 *
 * Purpose:
 *    Looks for NDFs that are children of the extensions of an NDF and
 *    add their displayables to the list of displayables.
 *
 */


/*
 *  Do the work for gaiaNDFSiblingSearch by tracing the properties of any
 *  siblings to the main NDF. Also searches for additional NDFs in the
 *  extensions (mainly exists so that this can be done recursively).
 */


/*
 *  Name:
 *     gaiaUtilsErrMessage
 *
 *  Purpose:
 *     Copy the current EMS error message into a dynamic string for returning.
 *     Make sure status is set before calling this and release the memory used
 *     for the string when complete. On return status is reset to SAI__OK and
 *     the error stack is empty.
 */


/**
 * Get an AST frameset that describes the coordinates of a given axis.
 * Axes are in the AST sense, i.e. start at 1. The offset value is a shift
 * that should be applied to the GRID coordinates (useful when an NDF data
 * component has been sectioned outside of the NDF library, this is the
 * origin).
 */


/**
 * Query the equivalent current coordinate of a base coordinate along the
 * given axis.
 *
 * Returns a coordinate value in *coord that may be formatted and "trailed" by
 * the axis units and label (this can be done two ways depending on whether
 * the result is for reading or parsing, for parsing the label and units
 * really trail as coord label (units), for reading they are mixed together as
 * label: coord units).  The position along the axis is identified using
 * ncoords pixel coordinates, where ncoords must match the dimensionality of
 * the FrameSet (at least up to ncoords axes, axes beyond that are handled as
 * dummies). The coordinate returned is matched to the requested axis by being
 * the coordinate with the largest change wrt to a single pixel step. We need
 * to use this logic as the relationship between the base frame axes and the
 * current frame ones may not be straight-forward. Note that the value
 * returned by the coord argument should be immediately copied.
 */


/**
 * Return a 2D WCS that describes the coordinates of an image plane extracted
 * from a cube or higher.
 *
 * The arguments are the WCS and the two axis that are to be retained. The
 * axes correspond to the base frame, not the current frame. The length values
 * should be the "size" of the axes (image width and height for instance), and
 * index a position along the axis to be dropped (usually corresponds to the
 * image plane index).
 */


/**
 * Wrapper for the ATL_PLROI function. Takes an AST Plot and returns a list of
 * Plots, one for each ROI found in the Plot.
 */


/**
 * Wrapper for the ATL_AXTRM function. Takes an AST FrameSet and returns
 * one with any ROI's identified and trims the current frame to the given
 * axes (if needed).
 */


/**
 * Read a set of FITS cards (80 character non-NULL terminated strings stored
 * at a single memory location) into an AST FITS channel, and return the
 * channel. The result is 1 if there were no errors. If an existing channel is
 * given it will be used rather than creating a new one (so make sure NULL is
 * passed as necessary).
 */


/**
 * Read a set of FITS cards (80 character non-NULL terminated strings stored
 * at a single memory location) and return a FrameSet if they contain a WCS
 * with the given encoding (NULL for the default). Returns an AST FrameSet if
 * successful and a result of 1.
 */


/**
 * Convert a 2D ARD description into a mask. The description should be in GRID
 * coordinates. The mask should be at least dims[0]*dims[1]. The area used in
 * the mask is returned in the lbnd and ubnd arrays, so they need to be of
 * size at least 2 (strictly the returned bounds are the ARD interior bounds).
 * When the mask is empty the bound shoulds all be set to 0.
 */


/*
 *  Return a NaN for use with float arrays.
 */


/*
 *  Return a NaN for use with double arrays.
 */


/*
 *--------------------------------------------------------------
 * Word_Init --
 *
 *   This procedure initialises the rtd_word canvas item.
 *
  *--------------------------------------------------------------
 *
 */


/*
 *--------------------------------------------------------------
 *
 * DeleteWord --
 *
 *      This procedure is called to clean up the data structure
 *      associated with a word.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      Resources associated with itemPtr are released.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * ComputeWordBbox --
 *
 *      This procedure is invoked to compute the bounding box of
 *      all the pixels that may be drawn as part of a word.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The fields x1, y1, x2, and y2 are updated in the header
 *      for itemPtr.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * DisplayWord --
 *
 *      This procedure is invoked to draw a word item in a given drawable.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      ItemPtr is drawn in drawable using the transformation
 *      information in canvas.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * WordToPoint --
 *
 *      Computes the distance from a given point to the word.
 *
 * Results:
 *      The return value is 0 if the point whose x and y coordinates
 *      are coordPtr[0] and coordPtr[1] is inside the word.  If the
 *      point isn't inside the word then the return value is the
 *      distance from the point to the item.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * WordToArea --
 *
 *      This procedure is called to determine whether an item
 *      lies entirely inside, entirely outside, or overlapping
 *      a given rectangular area.
 *
 * Results:
 *      -1 is returned if the item is entirely outside the area
 *      given by areaPtr, 0 if it overlaps, and 1 if it is entirely
 *      inside the given area.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * ScaleWord --
 *
 *      This procedure is invoked to rescale a word.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The item referred to by itemPtr is rescaled
 *      so that the following transformation is applied to all
 *      point coordinates:
 *              x' = originX + scaleX*(x-originX)
 *              y' = originY + scaleY*(y-originY)
 *
 *      The word is also scaled to scaleX if resize is true.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * TranslateWord --
 *
 *      This procedure is called to move a word by a given amount.
 *
 * Results:
 *      None.
 *
 * Side effects:
 *      The position of the word is offset by (xDelta, yDelta), and
 *      the bounding box is updated in the generic part of the item structure.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * WordToPostscript --
 *
 *      This procedure is called to generate Postscript for
 *      the word item.
 *
 * Results:
 *      The return value is a standard Tcl result.  If an error
 *      occurs in generating Postscript then an error message is
 *      left in interp->result, replacing whatever used to be there.
 *      If no error occurs, then Postscript for the word is
 *      appended to the result.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * LineToPostscript --
 *
 *      This procedure generates a parenthesized Postscript string
 *      describing one line of text from a text item.
 *
 * Results:
 *      None. The parenthesized string is appended to
 *      interp->result.  It generates proper backslash notation so
 *      that Postscript can interpret the string correctly.
 *
 * Side effects:
 *      None.
 *
 *--------------------------------------------------------------
 */


/*
 *--------------------------------------------------------------
 *
 * RtdWordLastBBox --
 *
 *    Returns the complete bounding box of the last text item whose
 *    canvas bounding box was requested.
 *
 *      - xb, X corners of the string bounding box
 *      - yb, Y corners of the string bounding box
 *
 *--------------------------------------------------------------
 */


/******************************************************************************
 *
 *	F U N C _ S U B S T R (void)
 *
 * The ICL function SUBSTR(S,n,m) returns the substring of S beginning at n
 * of length m.
 *
 * Note we adjust for the fact that the first character is in the 0th position.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S N A M E (void)
 *
 * SNAME (S,n,m) delivers the name derived by concatenating the string
 * S with integer n formatted into m characters including leading zeros
 * m is optional, if not present is taken to be the number required.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I N D E X (char *s1, char *pattern)
 *
 * INDEX(s1,s2) returns the position of the first occurence of pattern
 * s2 in string s1.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ E L E M E N T (void)
 *
 * ELEMENT(I,delim,s) returns the Ith element of a delimited string.
 *
 * So, if the string looks like ....(....(....(pppp( ....(....(..., then
 * element (3,"(",s) gives us pppp
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S Y S E R R (node *n)
 *
 * SYSERR <VALUE|IDENT|IDENTIFICATION|TEXT|FULL> <ERROR CODE>
 *
 * This function returns the translation of the facility (ADAM) error code
 * in the format requested.
 * If the 'error code' parameter is missing returns the translation of the last
 * global status value stored by ICL.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ R A (char *s)
 *
 * RA(s) returns the right ascension in radians from a string in hrs, mins
 * and seconds.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ R A 2 S (void)
 *
 * RA2S(r,ndp,sep) produces a string in HMS format.
 *
 * 'ra' is in radians, 'ndp' decimal places required on seconds. Character
 * 'sep' separates fields.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ D E C L (char *s)
 *
 * DECL(I,m,n) - calculates a delination in radians from a string in degrees,
 * minutes & seconds.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ D E C 2 S (void)
 *
 * DEC2S(r,ndp,sep) returns a string in DMS format.
 *
 * 'decl' is in radians, 'ndp' decimal places required in seconds,
 * character 'sep' separates fields
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I A N D (int left, int right)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I O R (int left, int right)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I E O R (int left, int right)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I N O T (int arg)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L G E (char *lf, char *rt)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L G T (char *lf, char *rt)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L L E (char *lf, char *rt)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L L T (char *lf, char *rt)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L E Q (char *lf, char *rt)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L N E (char *lf, char *rt)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L E N ( char *s)
 *
 * Evaluates LEN(s) - the length of the string s.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ K E Y V A L (char *s)
 *
 * KEYVAL(s) - value of the key with name 's'. Not yet implemented!
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I N K E Y (void)
 *
 * INKEY() - value of the last key pressed (only works in screen mode)
 * 	     (Not yet implemented)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I C H A R (char *s)
 *
 * ICHAR(s)  - ASCII value of first character of string.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ U P C A S E (char *s)
 *
 * UPCASE(s) string 's' is converted to upper case.
 * Uses uppercase() in utils.c
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L O G I C A L (void)
 *
 * LOGICAL(x) - the value of x converted to logical.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S T R I N G (void)
 *
 * STRING(x) - the value of x converted to a string.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ V E R S I O N (void)
 *
 * VERSION() - returns the current version of ICL as a string.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ O S (void)
 *
 * OS() - returns the host operating system name as a string.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ C H A R (void)
 *
 * CHAR(i) - returns the character whose ASCII value is i.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ T Y P E (void)
 *
 * TYPE(x) returns the type of x as one of "REAL", "INTEGER", "LOGICAL",
 *      "STRING" or "UNDEFINED".
 *
 * x is an identifer (should be a node of type name_interpret() with the
 * string_part() member equal to the identifer).  We find x in arglist[0] (set
 * up there by get_args() in interp.c).
 * We use lookup_variable_value() to get the variable's value if it exists
 * and use maptypetostring() to produce the type of the value as a string.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ U N D E F I N E D (void)
 *
 * UNDEFINED(x) -true if x is undefined.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ V A R I A B L E (void)
 *
 * VARIABLE(proc,x) a functions which returns the value of variable 'x' of
 * procedure 'proc' or, with only one parameter (VARIABLE(x)) returns the
 * variable value from the global symbol table.
 *
 * The parameters (accessed via arglist[]) are name_interpret() nodes whose
 * string_part() contain the relevant parameter.
 *
 * A procedure entry (in symtab world) has a value member that points to a
 * procedure_interpret() node whose type is TYPE_SYMBOL and whose
 * symbol_part() points to that procedure's symbol table.
 * The sub[0] member points to the formal parameter list, sub[1] to the
 * procedure body, etc. lookup_symbol() will return the procedure_interpret()
 * node if it can find the named procedure.
 * If the procedure has been executed the local variables and parameters
 * will be in the symbol_part() table. The routine
 * lookup_procvariable_value(procnode, varname) will look up the variable name
 * and return its corresponding value (including the case where the variable
 * is a parameter)
 * OR
 * return an exception if the variable is not defined, or is defined as a
 * parameter passed as a variable that is not defined.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ R A N D O M (void)
 *
 * RANDOM(I) - returns a random number between 0 and 1 from seed I.
 *
 * I must be a variable, ie a name_interpret() node with string_part()
 * set to the variables identity.
 * lookup_variable_value() will return the variables value or an exception if
 * not defined.
 * assign_helper(pointer to name_interpret node, value) (interp.c) will perform
 * the assignment of the random number.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	M I N _ M A X (int func)
 *
 * A general function returning either the minimun or maximum (func = FUNC_MIN
 * or FUNC_MAX) of a series of arguments.
 *
 * The arguments are in arglist[i], i = 0,1,2..., a count is in nargs (set up
 * by get_args()).  All arguments can be integer or real.
 *
 * The smart bit in this is the use of
 *   (func == FUNC_MAX) == (result of currentmin/max < next arg)
 *   If func is FUNC_MAX then currentmax is kept in val and
 *                            changes if max IS < next arg
 *   If func is FUNC_MIN then currentmin is kept in val and
 *                            changes if min ISNOT < next arg
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ M I N (void)
 *
 * MIN(x1,x2...) the minimum of at least two arguments.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ M A X (void)
 *
 * MAX(x1,x2...) the maximum of at least two arguments.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ B I N (void)
 *
 * BIN(I,n,m) converts the integer I into binary  with an 'n' char string
 * result with 'm' digits.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	H E X D E C O C T (int func)
 *
 * HEX/DEC/OCT(I,n,m) converts the integer I into hex, decimal or octal with
 * an 'n' char string result with 'm' significant digits.
 *
 * The func argument specifies which format (FUNC_HEX, FUNC_DEC, FUNC_OCT).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ H E X (void)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ D E C (void)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ O C T (void)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N I T _ F U N C T I O N S (void)
 *
 * Establish entries for all the ICL function routines in the symbol table.
 * Called from main() during ICL initialisation.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S E N D T O I O S U B S Y S T E M (int command, int info, char *mess)
 *
 * Sends an ICL command to the io-subsystem process using a pipe creatd when
 * the io process was fork()ed.
 *
 * 'command' is one of the IO_COMMAND_xxxxx actions.
 * 'info' is an integer value valid for that command.
 * 'mess" is a character string to be passed to the subsystem.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T A C K A N D S E T O U T P U T F P (value vfp)
 *
 * Used to save the current ICL output file descriptor and set it to 'vfp'
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	R E S T O R E O U T F P (void)
 *
 * Unstack file descriptor.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L O P E N A S O U T F P (char *whofor, char *filename)
 *
 * This routine opens a file (name 'filename') for output for ICL routine
 * 'whofor' (diagnostic).
 *
 * Method:
 * Saves the current contents of out_fp and sets it to the opened file
 * descriptor using stackandsetoutfp().
 *
 * Returns trueval if successfull,otherwise an exception
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L C L O S E A S O U T F P (char *whofor, char *filename)
 *
 * The system has been using the an output file via the descriptor out_fp.
 * This routine closes that file and restores out_fp to its previous value
 * using restoreoutfp().
 *
 * It is expected that the caller used iclopenasoutfp() to open the file and
 * so it is a system error if restoreoutfp() fails.
 *
 * Returns trueval or exception message if fclose() fails.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S Y S T E M F A I L (char *mess)
 *
 * Output a system failure message (just prior to an abnormal exit)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	O U T S T R I N G (char *mess)
 *
 * Output the string 'mess' to the terminal immediately using the ICL
 * iosubsystem (or to stderr if not in terminal_output mode)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	B U F S T R I N G  (char *mess)
 *
 * Appends the string 'mess' to the internal output buffer 'outbuffp'.
 * If the buffer overflows it is flushed to the terminal or to stderr if
 * we are not in terminal mode.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	B U F C H A R (char ch)
 *
 * Appends the character 'char' to the internal output buffer 'outbuffp'.
 * If the buffer overflows it is flushed to the terminal or to stderr if
 * we are not in terminal mode.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	B U F N E W L I N E (void)
 *
 * Appends a newline to the internal output buffer 'outbuffp'.
 * If the buffer overflows it is flushed to the terminal or to stderr if
 * we are not in terminal mode.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F L S H B U F (void)
 *
 * Flushes the internal output buffer 'outbuffp' to the terminal (or to stderr
 * if we are not in terminal mode)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	O U T F P I N T (int i)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	O U T F P R E A L (double d)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	O U T F P S T R I N G (char *mess)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	O U T F P C H A R (char ch)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	O U T F P F O R M A T S T R I N G (char *form, char *mess)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L E M S _ F L U S H ( int *status )
 *
 * Flush EMS error messages and reset status to SAI__OK
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N I T _ O U T P U T (void)
 *
 * Called from main() to initialise the output module
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T A C K _ T H I S _ I N P U T (void)
 *
 * Saves the current input context.
 *
 * Returns 1 if OK, 0 if stack full
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T A C K _ F I L E _ I N P U T (FILE *fp, char *name)
 *
 * Stack the current input stream and reset it to be a file pointed to
 * by the C filedescriptor 'fp' of name "name".
 *
 * Returns 1 if OK, zero if input stack full or malloc fails to allocate a
 * buffer
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T A C K _ S T R I N G _ I N P U T (char *s, int length)
 *
 * Stack the current input stream and set it to be input from the string s,
 * of length "length".
 *
 * Returns 1 of OK, zero if input stack overflow
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	U N S T A C K _ I N P U T (void)
 *
 * Return to earlier input source by popping input stack
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T A C K _ P R O M P T (char *newprompt)
 *
 * This pushes the current prompt onto the stack and sets the current prompt
 * to be 'newprompt'
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	U N S T A C K _ P R O M P T (void)
 *
 * Restore the top of prompt stack as the current prompt by popping 'prompts[]'
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	C L E A R _ P R O M P T S T A C K (void)
 *
 * Clear the current prompt stack.  This is used on completion of a call to
 * yyparse() to ensure that any incomplete parsing (due to a parse error
 * in, say, a loop) does not leave us in the wrong context.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N I T _ I N P U T (void)
 *
 * Initialise the input system.
 *
 * We assume input from an input stream named stdin (Unix standard) and by
 * using isatty(fileno(stdin)) we check whether stdin is attached to a
 * interactive device or has been re-routed to a file.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E R A C T I V E (void)
 *
 * By testing the INPUT_TTY bit in the current in_flags we discern if we are
 * interacting with a terminal.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	T E R M I N A L _ O U T P U T (void)
 *
 * By testing the INPUT_TTY bit in the base level in_flags we discern if we are
 * interacting with a terminal.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S E N S E _ V M S (FILE *fp)
 *
 * VMS variable length records consist of a two-byte length count with the
 * lower byte first (of course - this is VAX after all), followed by length
 * bytes of line. If the length is odd, it is padded to an even boundary.
 *
 * For most files, the second byte of the length count will be very small,
 * probably zero and very likely less than 8, which is the lowest ASCII value
 * you should expect to find in a text file. This means that we can recognise
 * VMS files when the first line is less than 4096 characters long.
 * This is probably reasonable.
 *
 * fseek(FILE *fp, 0,0) positions input at the first byte within a file
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L _ I N P U T (void)
 *
 * This is the get_next_input_character input routine for lex.
 *
 * 'in_length' contains a count of the number of characters available in the
 * input buffer.  If non-zero at this point then we can decrement this count
 * and return the next buffered character by using in_bufp which is maintained
 * to point to the next input character in the input_buffer
 * If the buffer is empty then
 *  (1) input was from a string (in_flags has INPUT_STRING bit set)
 *      in which case the string is exhausted and we return 0 (ie null)
 *  (2) input is from an interactive terminal (ie in_flags has INPUT_TTY
 *      bit set).
 *      In the understanding that the iosubsystem will handle interupts we use
 *	outstring() to issue the prompt "prompt" (a global variable maintained
 *      to be the relevant prompt).  We then continue at (4)
 *  (3) input is from a virginal file (ie we havent read from it yet)
 *      In this case we test if it is a VMS file using sense_vms()
 *      and if it is we set the INPUT_VMS bit in the current input stream flags.
 *  (4) We clear the INPUT_VIRGIN flags bit.
 *      We now read input.  If from a VMS file we use GET_VMS_LINE()
 *      otherwise we use icl_fgets().  If fgets() fails we set the input
 *      buffer empty.
 *  (5) We then check if the last character in the input was a ~ in which
 *	case we shorten the line to ignore it and its newline.  This will
 *	cause another line to be read by the parser that is newline terminated.
 *      Finally  if the input buffer is still empty we return zero (ie null)
 *	otherwise we reduce the length count and using in_bufp return the
 *	first character in the buffer.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L _ U N P U T (int c)
 *
 * Put a character back in the buffer.
 *
 * Lex is well-behaved about this except for EOF characters.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	C L E A R U P A F T E R I N P U T (char *whofor)
 *
 * This function clears up after INPUT commands
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L _ F G E T S ( filename, buffer, buffersize, iclvalue vfp )
 *
 * Reads a string from the file 'filename' whose internal icl value is vfp.
 * Reads at most 'buffersize' chars into 'buffer'
 *
 * Used to implement the READ command from proc_read() in fileio.c
 *
 * fgets(char *buf, int length, FILE *fp)
 *   reads at most one less than the "length" characters from the stream fp
 *   into the buffer buf.  No additional charcters are read after a newline
 *   character (retained) or after EOF.  The input is null terminated by
 *   fgets().  returns buf is successful, nil if EOF encountered immediately
 *   OR if an error occurs with the associated setting of fp's corresponding
 *   flags bits.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	C L E A R U P A F T E R R E A D (value file, char *whofor,
 *					 char *filename)
 *
 * Clear up after read operations.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I C L O P E N F I L E (char *whofor, char *filename, char *mode)
 *
 * This routine is called in all cases of opening a file for the user with
 * create, open and append.
 *
 * We have translated the command to an open mode in mode, "w" for create,
 * 'r" for open, "a" for append" and 'whofor' represents the command directly.
 *
 * FILE * fopen(char * filename, char * mode)
 *      opens the file filename with the mode "mode" and returns the
 *	filedescriptor if successful, nil otherwise.
 *      Relevant modes are:
 *      "r", open text file for reading
 *      "w" create text file for writing (or zero an existing file)
 *      "a" open or create text file for writing
 *
 * returns with an icl file 'value' or an exception if the open fails
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	D O _ L O A D (char *command_name, char *name)
 *
 * A helper function for the various commands which LOAD files.
 *
 * It opens the file "name" in read mode and then pushes the input source
 * stack with the resulting file pointer. It then uses yyparse() to process
 * the file line by line and if yyparse() delivers an executable entity
 * (todo is set) it interprets it It continues to do this until an exception
 * occurs (either in parsing or in interpreting) or the file exhuasts, when
 * it closes the file, pops the input stack and returns.
 *
 * Will return an exception if it fails.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	C O M P O S E _ S Y N T A X E R R (char *mess)
 *
 * This is mostly used by the parser to handle syntax errors.
 *
 * Given an error message in 'mess', the routine constructs the string
 *              SYNTAXERR  message\n
 *              ICL>Current contents of input line\n  ( from in_buffer)
 *
 * It then returns an exception whose message is is this string augmented with
 * an indication of the error position in the input line. This means that when
 * the exception is printed a ^ is printed near the location of the error.
 *
 * We assume the error is caused by the current token which is held in
 * yytext. We print the error position indicator by printing spaces up to the
 * point of the error and then print a ^. We do this using in_bufp (current
 * position in buffer), in_buffer ( start of current input buffer) and yytext
 * (current token from LEX).
 *
 * The number of spaces to be printed is
 *
 * strlen(prompt) + current position in buffer - start position in buffer -
 * length of current token (if any)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S Y S _ E X C E P T I O N (char *mess)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S Y S _ E X C E P T I O N 1 (char *format, char *arg1)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S Y S _ E X C E P T I O N 2 (char *format, char *arg1, char *arg2)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ C L E A R (node *n)
 *
 * Handles the ICL command "CLEAR Row Column"
 *
 * We first evaluate the Row and Column arguments using interpret_to_integer()
 * using the linearised argument list arglist[].
 *
 * These are then sent to the iosubsystem using sendtoiosubsystem()
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ L O C A T E (node *n)
 *
 * Handles the ICL command "LOCATE Row Column Message"
 *
 * We first evaluate the Row and Column arguments using interpret_to_integer()
 * using the linearised argument list arglist[].  We then use concat_args()
 * to loin together the remaining arguments into a single string 'message'
 * which is then sent to the iosubsystem using sendtoiosubsystem().
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ S E T (node *n)
 *
 * Implements the ICL "SET" command.
 *
 * Using the comms structure it searches for the relevant SET command
 * using arglist[] which by this time has been set to the list of arguments
 * given to the set command (see get_args() in interp.c()).
 *
 * If it finds the command it checks to see if the string member of the comms
 * structure is the address of numeric. If so then a numeric argument is
 * expected and the value member points to the integer to be set to the
 * argument value.
 *
 * If not numeric then, if a string argument is expected the string member is
 * non nil and points to the char * variable to be set.
 * If the string argument is nil then a flag is being set on/off and the value
 * member points to the integer to be set to 1 (on) or 0 (off).
 *
 * If the SET command is not found on a first pass but the argument begins
 * with "NO" then we search again for the string after the "NO".
 * If a match is now found then the relevant flag (pointed to by the value
 * member) is set off.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ L I S T (node *n)
 *
 * Implements the ICL "LIST procedure" command.
 *
 * This routine interprets the argument to the list command as a string and
 * then calls listaproc() (symtab.c) to perform the actual listing.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ V A R S (node *n)
 *
 * Implements the ICL "VARS [proc]" command.
 *
 * Lists the variables of procedure 'proc' with their current types and values
 * or with no argument lists the direct mode variables.
 *
 * The node argument 'n' argument points to the expression node of the
 * argument to VARS. If not nil, we call interpret() and then listprocsvars()
 * with the result as a string.
 *
 * If nil, we call listprocsvars(CHARNIL) to list the direct mode variables.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ P R O C S ( node *n)
 *
 * Implements the ICL "PROCS" command to list the names of all the current
 * procedures.
 *
 * Uses listallprocs() (symtab.c).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ L O A D (node *n)
 *
 * Implements the ICL command "LOAD file" which processes commands from the
 * file "file.ICL" rather than from the terminal. The SAVE command saves
 * procedures in filenames compatible with this command.
 *
 * This  function interprets the file argument as a string and then, if it does
 * not end with .icl, this string is appended.
 * do_load() (in input.c) is used to actually load and interpret the file.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ S A V E (node *n)
 *
 * Implements the ICL "SAVE proc" command.
 *
 * This saves the source of the ICL procedure 'proc' in the file proc.icl.
 *
 * If the parameter is the string ALL then we save all the currently known
 * procedures into a file SAVE.ICL (used automatically on ICL exit unless
 * NOSAVE is set).
 *
 * This routine interprets the single argument as a string and, if it is not
 * the string "all" calls fileaproc(proc,proc.icl) (symtab.c). Otherwise
 * fileaproc( CHARNIL,"save.icl") is called.
 *
 ******************************************************************************
 */


/* initialised in init_procs() */


/******************************************************************************
 *
 *	P R O C _ S I G N A L (node *n)
 *
 * Implements the ICL command "SIGNAL name [text]" to signal an ICL exception.
 *
 * 'Name' is the exception name and can be any valid ICL identifier.
 * 'text' is a message associated with the 'name'
 *
 * Following proc_signal() an ICL exception handler will be executed if one
 * exists for the exception, otherwise a message will be output, and a return
 * will be made to direct mode.
 *
 * The 'name' argument is interpreted as a string and exception() is called
 * to generate the exception. We use the string concatenate facilty of
 * interpreting abbut_interpret() nodes of the arguments to join the exception
 * name and its text qualifiers.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ D E L E T E (node *n)
 *
 * Implements the ICL command "DELETE proc".
 *
 * This removes the entry for the procedure "proc" from the symbol table.
 *
 * We interpret the proc parameter as a string and use delete_symbol()
 * (symtab.c) to remove it.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ D E F H E L p (node *n)
 *
 * Implements the ICL command "DEFHELP topic helpfile key1 key2...
 *
 * This associates a particular helpfile and item within it with the
 * specified topic.
 *
 * The topic and its target are interpreted before being stored.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ D E F S T R I N G (node *n)
 *
 * Implements the ICL command "DEFSTRING com(mand) equivalence string"
 *
 * This associates an equivalence string with a new ICL command 'command' -
 * the command to be defined.  The syntax com(mand) can be used and indicates
 * that com, comm, comma, comman and command are all acceptable abbreviations
 * for the command.
 *
 * Issuing the command is equivalent to having typed the equivalence string.
 * Any parameters given to 'command' are appended to the equivalence string.
 *
 * Both the command and the equivalence string are interpreted before storing.
 * The equivalence string will need to have arguments added when it is used,
 * and we will need to re-parse it then.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ D E F P R O C (Node *n)
 *
 * Implements the ICL command 'DEFPROC com(mand) file [procedure]'
 *
 * This defines a command which runs a procedure from a source file.
 *
 * command - the command to be defined. COM(MAND) specifies that COM is the
 *   minimum acceptable abbreviation
 * file - the source file containing the procedure
 * procedure - the procedure to be executed. If ommitted defaults to command.
 *
 * When command is issued, the file file.ICL is opened, loaded (if not already
 * loaded) and the procedure is called.  Any parameters with the issued
 * command are passed to the procedure.
 *
 * A series of entries in the global symbol table is established- one for
 * each possible abbreviation.  The val member contains the name of the file
 * as a string, and the value member points to a defproc_interpret() node
 * whose the sub[0] member points to the the procedure name and whose
 * sub[1] members points to the command name.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R O C _ H E L P (node *n)
 *
 * Implements the ICL command "HELP  [topic]".
 *
 * This the topic (if present) as a string to the help system.
 *
 * The help command may have several parameters.  The whole abbut_interpret()
 * node list formed by the parser for this sequence is pointed to by 'n' and
 * interpreting this causes the command string and all of its parameters to be
 * interpreted and the results of this to be seen as strings and concatenated
 * together.
 *
 * If no help topic command is given, then the help system is called with no
 * parameters.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N I T _ P R O C S (void)
 *
 * Install in the global symbol table all the implemented built_in commands.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	V A L U E _ S Y M B O L S (void)
 *
 * Deliver the current value of symbols as an ICL value.
 *
 * Used in defining a parameter_interpret() node in interp.c.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	R E S T O R E S Y M B O L T A B L E C O N T E X T (void)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	N E W _ S Y M T A B (char *name, int type, node *n)
 *
 * Create a new symbol table entry.
 *
 * This will also create a dummy symtab header if name = nil, type = 0 and
 * n = nil
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	V A L U E _ E M P T Y S Y M T A B (void)
 *
 * Construct an empty symbol table and return as an ICL value.
 *
 ******************************************************************************
 */


/*****************************************************************************
 *
 *	S Y M B O L _ T O T A L (symtab *sym, int type)
 *
 * Returns the total number of symbols of type 'type' in the given symbol
 * table 'sym'
 *
 *****************************************************************************
 */


/******************************************************************************
 *
 *	L O O K U P _ S Y M B O L (char *name, int type)
 *
 * Lookup a symbol of the given type in the active symbol table.
 *
 * If we are searching for variables or parameters then we search the
 * "symbols" symbol table (either a proc's symbol table if we are executing a
 * proc, or the same as world if not).  It we are searching for anything else
 * then we will only find it in the global "world" table.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L O O K F O R _ V A R I A B L E _ V A L U E (symtab *sym, char * name)
 *
 * This routine looks up a variable in a given symbol_table.
 *
 * If the variable is a parameter then, on calling the current procedure we
 * could have passed EITHER an expression, which is evaluated and the formal
 * node's value member points to that value (whose interpret member will not
 * be parameter_interpret())
 * OR
 * a variable.  In this case the value member points to a node whose type is
 * TYPE_SYMTAB, whose interpret member is parameter_interpret(), whose
 * symboltable_part() member points to the symbol table of the corresponding
 * actual variable and whose sub[0] member points to a node that is the
 * corresponding actual variable (ie a name_interpret() node whose value field
 * is an ICL string whose value is the identity of the passed variable).
 *
 * If a value cannot be found, a suitable exception is returned.
 *
 * RETURNS AN ACTUAL VALUE STRUCTURE - IE A COPY OF ONE IN A
 * SYMBOL TABLE
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L O O K U P _ V A R I A B L E _ V A L U E (char *name)
 *
 * Looks up a variable in the active symbol table using
 * lookfor_variable_value(symbols,..).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L O O K U P _ P R O C V A R I A B L E _ V A L U E
 *		(node * procnode, char *name)
 *
 * Looks up a variable in an ICL procedure symbol table or, if 'procnode'
 * is NULL in the world table.
 *
 * On entry 'procnode' is either NODENULL or  will point to
 * a procedure_interpret() node the symboltable_part() of which points to the
 * symbol table of that procedure.
 *
 * Uses lookfor_variable_value() to search this table for name.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L O O K U P _ P R O C (char *name)
 *
 * Looks up a command name in the global symbol table, searching in the
 * required order for procedures of different classes.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P U T _ S Y M B O L (value symbval, char *name, int type, node *n)
 *
 * Stores a node under a given name, with a supplied symbol type and with a
 * value (n) in a symbol table (all given). A symboltable ICL value is passed
 * and symboltable_part() is used to get the actual symbol table involved.
 *
 * If the symbol already exists, its node value is re-used (overwritten),
 * so that existing pointers to the symbol table entry will point to the
 * new value. I don't believe anything relies on this feature currently.
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T O R E _ S Y M B O L (char *name, int type, node *n)
 *
 * Stores a given node under the given name, with the given symbol type
 * in the active symbol table using put_symbol().
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N S T A L L _ A B B R E V S (char *name, node *n)
 *
 * Install a name as a hidden procedure with all the abbreviations implied by
 * specifications of the form: COM(MAND)
 *
 * With DEFPROC or DEFSTRING one can specify the new command or procedure
 * using COM(MAND) meaning that COM, COMM, COMMA, COMMAN and COMMAND are all
 * suitable forms of the command.  This routine generates all the
 * abbreviations and adds each as a HIDDEN_PROC to the global
 * symbol table with the value "n".
 *
 * WILL FAIL GIVEN COMM() ie empty optional part!!
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	PUT_VALUE (symtab *symb, char *name, int type, value val)
 *
 * Stores a given value under the given name, with the given symbol type in
 * the given symbol table.
 *
 * If the symbol already exists, the same node object is used,  so that
 * pointers to the symbol table entry will point at the new value. I don't
 * believe anything relies on this currently.
 * put_value() exists because it is common to change a value in a variable.
 * This avoids creating and freeing a node object on every assignment.
 * If a node value is changed, the interpreter function is changed so that,
 * if the node is interpreted, the correct thing happens.
 *
 * Returns the value assigned (or exception if failed to assign).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	A S S I G N _ H E L P E R (node *var, value val)
 *
 * Assign the value 'val' to the variable 'var'.
 * 'Var' is a name_interpret() node whose string_part member contains the
 * identity of the variable.
 *
 * If the variable is a parameter then, on calling the current procedure we
 * could have passed
 * EITHER
 * an expression, which is evaluated and the formal's value member points to
 * that value
 * OR
 * a variable.  In this latter  case the formal's node value will point to a
 * node whose type is TYPE_SYMTAB, whose interpret member is
 * parameter_interpret(), whose symboltable_part() member points to the symbol
 * table of the corresponding actual variable and whose sub[0] member points
 * to a node that is the corresponding actual variable (ie a name_interpret()
 * whose string_part() member points to the identifier).
 *
 * If the variable is not a parameter then we can use
 * put_value(activesymtab(SYM_VARIABLE), var's name, SYM_VARIABLE,val)....) to
 * achieve the storage otherwise we can use put_value(symboltable from formal
 * entry, actual parameter's name,SYM_VARIABLE,val).
 ******************************************************************************
 */


/*****************************************************************************
 * A S S I G N _ H E L P E R 1 ( node *var, value val )
 *
 * Similare to assign_helper but used by reload_vars_hds.
 * Therefore if the variable is a parameter given as a value, we assume it is
 * not required to be reset.
 ******************************************************************************
 */


/******************************************************************************
 *
 *	D E L E T E _ S Y M B O L (char *name, int type)
 *
 * Deletes a symbol from the active symbol table, freeing any associated
 * storage. It uses get_symbol to find the symbol if present already and then
 * relies on the fact that get_symbol will have moved it to the front of the
 * list.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *     D E L E T E _ S Y M _ P A R A M E T E R S (value symbval)
 *
 * This routine is called after a procedure has been executed to free all
 * storage used to hold procedure parameters (SYM_PARAMETER type variables).
 * Not that we have to be careful about passed-by-reference variables as, if
 * we free the associated memory, we will corrupt the variable in the calling
 * routine
 *
 * It uses get_symbol() to find the symbol if present already and then relies
 * on the fact that get_symbol will have moved it to the front of the list.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *     F O R A L L _ T Y P E D _ S Y M B O L S
 *		(int type, int (*fn)(char *name, node *valu, int type))
 *
 * This is an iterator. It scans the active symbol table for names of the
 * given type and applies the given function to their value nodes.
 *
 * The function has signature char* X node* -> int and expects a
 * typed_symbol's name and value node.
 * If the function returns zero, the scan is aborted.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R I N T _ T Y P E D (char *name, node *p, int sym_type)
 *
 * Print a symbol table entry in a form suitable for the VARS and PROCS
 * built-ins.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	P R I N T _ T Y P E D _ S Y M B O L S (int sym_type)
 *
 * A helper for the PROCS and VARS ICL command processing.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L I S T P R O C (char *name, node *val, int dummy)
 *
 * A routine to list a PROC's body on the terminal.
 *
 * The 'val' argument points to the procedure's body (extracted from the symtab
 * entry). As this routine also used to list all procs one by one it has a
 * dummy 'int' parameter so it can be used with forall_typed_symbols() in
 * symtab.c.
 *
 * print() (in interp.c) calls the interpret function of the node entry for
 * the procedure with the action OP_PRINT. This causes the procedure to list
 * itself.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L I S T A P R O C (char *name)
 *
 * Routine used by the ICL command "LIST" and lists the procedure with the
 * name "name".
 *
 * Uses lookup_symbol() to find the proc entry in the global symbol table and,
 * if found, use listproc() to list it
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L I S T A L L P R O C S (void)
 *
 * Lists the names of all the current procedures using
 * print_typed_symbols(SYM_PROC) (in symtab.c)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	L I S T P R O C S V A R S (char *name)
 *
 * Used in processing the ICL command "VARS".
 * Lists the variables of procedure name with their current types and values
 * OR, when name is CHARNIL, lists the direct mode variables
 *
 * A PROC entry is always found in the global world symbtab.
 * Its symboltable_part() member, if it has been executed at least once,
 * points to its local symbol table.
 *
 * Search the global symtab for a match (lookup_proc() using the string
 * argument name) and if we find it, we use the symboltable_part() entry
 * as the source of the variables.
 * If name is nil, we use the world symtab as the source.
 * We save the current active symbol table in symbols and restore
 * it once done and we use print_typed_symbols() to do the printing
 * (symtab.c).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F I L E A P R O C (char *procname,char *filename, char *comm)
 *
 * Saves the procedure 'procname' in the file 'filename' for the command 'comm'.
 *
 * If the procname parameter is CHARNIL then saves all the currently known
 * procedures into the file filename
 * OR
 * if procname is not CHARNIL the procedure is checked to exist (lookup_proc()).
 *
 * The file "filename" is opened for write using iclopenasoutfp()
 * If procname is CHARNIL then forall_typed_symbols() is called with
 * listproc() to print all the procs to the file otherwise listproc() is used
 * once to list the named proc to filename.
 * The file filename is then closed using iclcloseasoutfp().
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E G E R _ M U L T I P L Y (int a, int b)
 *
 * Integer Multiply of a and b;  Checks for overflow by checking that the
 * product divided by either a or b gives b or a respectively; By checking
 * for zeros divide explicitly this cannot overflow.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E G E R _ D I V I D E (int a, int b)
 *
 * Integer Divide of a by b ;  Checks for division by zero.
 *
 * The only other case of worry is when b is -1 and a is ICL_MIN_INT
 * (calculated in init_arith()) at initialisation time) which would give us
 * INT_MAXT+1 as a result.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E G E R _ A D D (int a, int b)
 *
 * Integer add of a and b.
 *
 * With add when the operands are of differing signs no overflow can occur.
 * With same signs
 *   +ve + +ve  Crucial case is 01111111111 + 0000000001 => 100000000000
 *              ie a change of sign occurs when it overflows
 *		Worst case is 01111111 + 011111111 => 111111110
 *              ie a change of sign occurs when it overflows
 *		Anything in between therefore changes sign.
 *   -ve + -ve  Crucial case is 100000000 + 11111111111 => 011111111111
 *              ie a change of sign occurs when it overflows
 *		Worst case is 100000 + 1000000 => 00000000
 *              ie a change of sign occurs on overflow
 *		Anything in between therefore changes sign.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E G E R _ S U B T R A C T (int a, int b)
 *
 * Integer subtract of b from a.
 *
 * With subtract when the operands are of the same sign no overflow can occur
 * as we will be in effect adding a positive to a negative (-ve - -ve)
 * or subtracting a positive from a positive (+ve - +ve)
 * With differing signs
 *   +ve - -ve  Crucial case is 0111111 - 1111111
 *			   is 0111111 + 000000000 + 1  (2's complement)
 *			   is 1000000
 *		Worst case is 011111 - 100000
 *                         is 011111 + 011111 + 1  (2's compliment)
 *                         is 111111
 *              ie a change of sign with first operand  occurs when it overflows
 *   -ve - +ve  Crucial case is 1000000 - 000000001
 *			   is 1000000 + 1111111110 +1  (2's complement)
 *			   is 0111111111
 *		Worst case is 100000 - 011111
 *                         is 100000 + 100000 + 1
 *                         is 000001
 *              ie a change of sign occurs with first operand on overflow
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E G E R _ N E G A T E (int a)
 *
 * When negating an integer the host can only overflow if we start with
 * ICL_MIN_INT as -(ICL_MIN_INT) = - ( - MAX_INT -1) = MAX_INT + 1.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	I N T E G E R _ P O W E R (int a, int b)
 *
 * Calculates a to the power b.
 *
 * Integer arithmetic has to be checked for overflow and so we use
 * integer_multiply() to multiply a by itself b times.
 *
 * Special Cases
 * ____________
 *
 * If b < 0 then we return zero (as x^-m = 1/x^m which is not an int ) unless
 * a is zero as well which is a singularity.
 * Otherwise if a is zero, then if b is zero we have a domain error and if
 * b is non zero we return zero.
 * Otherwise, anything else to power zero is one.
 *
 * Once all these special cases are dealt with we can use interger_multiply()
 * to deliver the result taking care of overflow.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	D O R E A L O P (int op, double l, double r)
 *
 * Perform a double precision binary operation 'op' on the ICL values l and r
 * (left operand and right operand).
 *
 * 'op' can be POWER (l**r), MULTIPLY (l*r), ADD(l+r), SUBTRACT (l-r)
 * or DIVIDE (l/r).  The function does not address overflow as this is
 * handled by its caller do_operator().  It returns the ICL value result or
 * an exception (0**0 or 0**(-n)) or l/0).
 * This function aborts ICL if op is not one of the expected values.
 *
 * pow(double x, double r) returns x**y.  pow(x,0.0) is 1 for all x. The
 * function handles exceptional arguments in the spirit of ANSI/IEEE Std
 * 754-1985.  In addition it may also set errno and call matherr().
 *
 * The SVID (System V Interface Definition) specifies that certain libm
 * functions call matherr() when Unix exceptions are detected.  Users may
 * define their own mechanisms for handling Unix exceptions, by including a
 * function named matherr() in their programs.  When an Unix exception occurs,
 * a pointer to the structure exception will be passed to the user supplied
 * matherr() function.  This structure, defined in math.h, is as follows:
 *
 *  struct exception {
 *                   int type; char *name; double arg1, arg2, retval;
 *                   }
 *
 * The element type is an integer describing the type of the exception and can
 * be DOMAIN, SING, OVERFLOW, UNDERFLOW.  The element name will point to a
 * string naming the function that incurred the error. The elements arg1 and
 * arg2 are the calling values of that function and retval is set to the
 * default value that will be returned by the function unless matherr() sets it
 * otherwise. If the user supplied matherr() returns non-zero, no Unix
 * exception messages will be printed and the global system owned variable
 * errno will not be set.  If no user supplied function is available the
 * system supplied function will be invoked which will:
 *
 * DOMAIN	NaN returned; errno set to EDOM and message printed on stderr.
 *		Pow(0.0,0.0) and atan(0.0,0.0) return default results but set
 *		errno and print the message.
 * SING		An IEEE infinity returned; errno set to EDOM and message
 *		printed on stderr.
 * OVERFLOW	In default rounding mode (As used in ICL), an IEEE infinity
 *		of appropriate sign is returned; errno set to ERANGE.
 * UNDERFLOW	An appropriately signed zero, subnormal number or smallest
*		normalised number is returned. errno is set to ERANGE.
 *
 * Specifically (entry is M: message printed, NaN: IEEE NaN result and
 *		invalid operation exception; INF : IEEE infinity result and
 *		division by zero exception; IEEE OVF : IEEE Overflow result
 *		and exception; IEEE UND : IEEE Underflow result and exception;
 *		PI : Closest machine representation to pi.
 *
 *		DOMAIN		SING		OVERFLOW	UNDERFLOW
 *
 * errno set to	EDOM		EDOM		ERANGE		ERANGE
 * Normal op	Invalid op	Div by zero	Overflow	Underflow
 * ACOS,ASIN	M,NaN
 * ATAN2(0,0)	M,+-0.0 or +-PI
 * COSH,SINH					IEEE OVF
 * EXP						IEEE OVF	IEEE UND
 * LOG, LOG10(x<0) M,NaN
 * LOG, LOG10(x=0)  		M,-INF
 * POW
 *   Usual Cases    				IEEE OVF	IEEE UND
 *   (x<0)**(y not int)
 *		M,NaN
 *   0**0	M,1.0
 *   0 ** (y < 0)		M,+-INF
 * SQRT(X<0)	M,NaN
 *
 * As we are calling pow() here and acos(), asin(), atan2() etc. elsewhere
 * we wish to avoid the M effect above (ie prevent the message being
 * printed).  Hence we should (but do not yet!) provide our own matherr()
 * function.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 * 	D O _ O P E R A T O R (left operand, operator code, right operand )
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	D O _ R E L O P E R A T O R (value val1, int op, value val2)
 *
 * Calculate expression R E L A T I O N A L expression.
 *
 * 'val1' and 'val2' contain the left and right operands respectively while 'op'
 * is the yacc operation code for the relational operation.
 *
 * Note that one or both of val1 and val2 may be of TYPE_STRING. If BOTH
 * are of type string then the ICL syntax defines that we do string comparison
 * but only for a limited number of valid relational operations.
 *
 * If either (or both) val1 or val2 are not of TYPE_STRING the other is
 * interpreted as using as_nonstring() and arithmetic relational operations
 * are used.
 *
 * Cannot cause overflow
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	C A L L _ U N A R Y _ I N T E G E R _ F U N C (value val, int (*fn)())
 *
 * Interpret a built-in function with one integer argument and an integer
 * result which cannot generate an exception.
 *
 * Prior to the call to this function interpret_to_integer() guarantees us an
 * integer value 'val'.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	C A L L _ B I N A R Y _ I N T E G E R _ F U N C (value val1,
 *					value val2, int (*fn)( int, int ))
 *
 *
 * Interpret a built-in function of two integer arguments and an integer result
 * which cannot generate an exception.
 *
 * Prior to the call to this function interpret_to_integer() guarantees us
 * integer values for 'val1' and 'val2'.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T R I N G T O I N T V A L U E (char *thestring)
 *
 * Given a string we wish to convert the string in decimal format into an
 * integer ICL value.
 *
 * Care must be taken to ensure that if there is an overflow in the evaluating
 * value that we return an exception
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	B A S E D S T R I N G T O I N T V A L U E (char *thestring)
 *
 * Given a string we wish to convert the string in based format into an
 * integer ICL value.
 *
 * The bases are indicated by a prefix on the string of digits
 *        %x or %X for hexadecimal
 *        %b or %B for binary
 *        %o or %O for octal
 *        NONE     for decimal
 *
 * Care must be taken to ensure that if there is an overflow in the evaluating
 * value that we return an exception
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A B S (value arg)
 *
 * Provide abs() but detecting overflow due to taking abs() of largest
 * negative integer value; The standard abs cannot overflow (fabs())
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ N I N T (value arg)
 *
 * Provide fortran type nint() detecting overflow due to taking nint() of
 * a real that is out-of-range for an integer.
 *
 * If given an integer numeric we return it.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I N T (value arg)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ I F I X (value arg)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A S I N (value arg)
 *
 * Provide the function asin() in the ICL world detecting the exception when
 * the argument is not between -1 and 1.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A C O S (value arg)
 *
 * Provide the function acos() in the ICL world detecting the exception when
 * the argument is not between -1 and 1.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A S I N D (value arg)
 *
 * Provide the function asind() in the ICL world detecting the exception when
 * the argument is not between -1 and 1.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A C O S D (value arg)
 *
 * Provide the function asin() in the ICL world detecting the exception when
 * the argument is not between -1 and 1.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A T A N 2 (value y, value x)
 *
 * Provide the function atan2() in the ICL world detecting the exception when
 * the arguments are both zero.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A T A N 2 D (value y, value x)
 *
 * Provide the function atan2d() in the ICL world detecting the exception when
 * the arguments are both zero.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L O G (value arg)
 *
 * Provide the function log(x) trapping the exception of log(x)<0.
 *
 * The argument x by this time is guaranteed to be real or integer by the use
 * of interpret_to_numeric in unary_numeric_func_interpret().
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ L O G 1 0 (value arg)
 *
 * Provide the function log10(x) trapping the exception of log10<0.
 *
 * The argument x by this time is guaranteed to be real or integer by the use
 * of interpret_to_numeric in unary_numeric_func_interpret().
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S Q R T (value arg)
 *
 * Provide sqrt(x) taking care of the exception of sqare root of a negative.
 *
 * The argument x by this time is guaranteed to be real or integer by the use
 * of interpret_to_numeric in unary_numeric_func_interpret().
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ R E A L (value arg)
 *
 * Real(x) - Returns the value of x converted to real.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S I N (value arg)
 *
 * Provide sind(x) - x in in radians.
 *
 * The argument x by this time is guarenteed to be real or integer by
 * the use of interpret_to_numeric in unary_numeric_func_interpret()
 *
 * finite(x) returns 1 if the double x is zero, normal or subnormal
 * ANSI/IEEE Std 754-1985 floating point number.  !finite(x)
 * indicates an exceptional floating point value (such as NaN or infinity)
 *
 * isnan(x) returns 1 if the double x is NaN (not-a-number)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ C O S (value arg)
 *
 * Provide cosd(x) - x in in radians.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ T A N (value arg)
 *
 * Provide tand(x) - x in in radians.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A T A N (value arg)
 *
 * Provide atan(x). Result is in radians.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ E X P (value arg)
 *
 * Provide exp(x).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S I N H (value arg)
 *
 * Provide sinh(x). x is in radians.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ C O S H (value arg)
 *
 * Provide cosh(x). x is in radians.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ T A N H (value arg)
 *
 * Provide tanh(x).
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S I N D (value arg)
 *
 * Provide sind(x). x is in degrees.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ C O S D (value arg)
 *
 * Provide cosd(x). x is in degrees.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ T A N D (value arg)
 *
 * Provide tand(x). x is in degrees.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ A T A N D (value arg)
 *
 * Provide atand(x). Result is in degrees.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ M O D (value left, value right)
 *
 * Provide mod(X1,X2) = x1-int(x1/x2) * x2;  Integer or real args
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ D I M (value left, value right)
 *
 * Provide DIM(X1,x2) positive difference - x1-min(x1,x2)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ S I G N (value left, value right)
 *
 * Provide sign(x1,x2) gives |x1| if x2 >= 0 else -|x1| if x2 < 0.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F U N C _ F L O A T (value arg)
 *
 * Provide float(x) - the value of integer x converted to real.
 *
 * interpret_to_numeric() has been used in unary_numeric_func_interpret()
 * to force the argument to a numeric type.  We exception if the argument
 * did not deliver an integer value.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T R I N G T O I N T (char **thestringptr)
 *
 * Given a pointer to a pointer to a string we convert the string in decimal
 * format into an integer icl value returning an exception if the integer
 * overflows in evaluation or if the input is in an invalid format.  We return
 * with the string pointer pointing to the character that terminated conversion.
 * The format accepted is {+|-}dd+
 ******************************************************************************
 */


/******************************************************************************
 *
 *	H E X D I G I T ( char ch )
 *
 * A small utility that, given a character ch, checks to see if it is a
 * hexadecimal digit and if so returns its binary value, otherwise
 * returns (-1)
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *     	S T R I N G T O I C L I N T V A L U E (char **thestringptr)
 *
 * Given a pointer to a pointer to a string we convert the string in decimal
 * format into an integer ICL value returning an exception if the integer
 * overflows in evaluation or if the input is in an invalid format.
 *
 * We return with the string pointer pointing to the character that
 * terminated conversion.
 * The bases are indicated by a prefix on the string of digits
 *        %x or %X                    for hexadecimal
 *        %b or %B                    for binary
 *        %o or %O                    for octal
 *        + or - or decimal digit     for decimal
 * Care must be taken to ensure that if there is an overflow in evaluating the
 * value that we return an exception
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *     	S T R I N G T O I C L L O G V A L U E (char **thestringptr)
 *
 * Given a pointer to a pointer to a string we convert the string into an
 * ICL logical value returning an exception if the input is not one of
 * TRUE, FALSE, true, false, YES, NO, yes, no.
 *
 * We return with the string pointer pointing to the character that
 * terminated conversion.
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	F T O D (char **as, int *afc)
 *
 * Given a pointer to a pointer to a string this routine converts a fixed point
 * fraction string:
 *
 * ie  d+ or .d+ or d+.  or d+.d+
 *
 * to a real integer valued icl value (ie ignores the decimal point) returning
 * with the pointer to the string pointing to the character that terminated the
 * conversion or an exception if an ovreflow of format error is detected.
 *
 * Further, on return, afc is set to a count of the number of fractional
 * digits encoutered.
 *
 * For example 36.4 is evaluated as 364.0 with afc set to 1
 *
 ******************************************************************************
 */


/******************************************************************************
 *
 *	S T R I N G T O I C L R E A L V A L U E (char **thestringptr)
 *
 * Given a pointer to a pointer to a string we convert the string into a ICL
 * real value returning an exception if the input causes overflow or is an
 * invalid format.
 *
 * We return with the string pointer pointing to the character that terminated
 * conversion.
 *
 ******************************************************************************
 */