/*------------------------------------------------------------------------- * Function: parse_range * * Purpose: Tries to parse a range expression of the form `I1:I2' * where I1 and I2 are integer constants. * * Return: Success: A range object. * * Failure: &ErrorCell * * Programmer: Robb Matzke * [email protected] * Jan 3 1997 * * Modifications: * *------------------------------------------------------------------------- */ static obj_t parse_range (lex_t *f, int skipnl) { obj_t lt=NIL, rt=NIL, retval=NIL; int lo, hi; lt = parse_term (f, skipnl); if (&ErrorCell==lt) return &ErrorCell; if (TOK_COLON==lex_token (f, NULL, skipnl)) { lex_consume (f); rt = parse_term (f, skipnl); if (&ErrorCell==rt) { obj_dest (rt); return &ErrorCell; } /* * Both arguments must be integer constants. */ if (!num_isint(lt)) { out_error ("Range: left limit is not an integer constant: ", lt); obj_dest (lt); obj_dest (rt); return &ErrorCell; } if (!num_isint(rt)) { out_error ("Range: right limit is not an integer constant: ", rt); obj_dest (lt); obj_dest (rt); return &ErrorCell; } /* * The constants must be in a reasonable order. */ lo = num_int (lt); hi = num_int (rt); if (hi<lo) { out_errorn ("Range: inverted range %d:%d changed to %d:%d", lo, hi, hi, lo); lo = num_int (rt); hi = num_int (lt); } /* * Create the range object. */ lt = obj_dest (lt); rt = obj_dest (rt); retval = obj_new (C_RANGE, lo, hi); } else { retval = lt; } return retval; }
/*---------------------------------------------------------------------------
* Purpose: Returns the integer value of a built-in symbol. If the
* symbol is set to something not an integer then return 1.
*
* Programmer: Robb Matzke
* Thursday, June 1, 2000
*
* Modifications:
*---------------------------------------------------------------------------
*/
int
sym_bi_true(const char *name)
{
char fullname[1024];
int retval;
obj_t var_name, val;
/* Add built-in prefix */
if (*name!='$') {
fullname[0] = '$';
strcpy(fullname+1, name);
name = fullname;
}
/* Get value */
var_name = obj_new(C_SYM, name);
val = sym_vboundp(var_name);
var_name = obj_dest(var_name);
if (num_isint(val)) retval = num_int(val);
else retval = val ? 1 : 0;
val = obj_dest (val);
return retval;
}
