/*------------------------------------------------------------------------- * 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; }