/*
* error_id(+Number, ?Message)
*
* Returns the appropriate error message. Fails if the
* message string is empty or out of range, so that it
* can be used to check whether the given error exists.
*/
static int
p_error_id(value valn, type tagn, value vale, type tage)
{
Error_If_Ref(tagn);
Check_Output_String(tage);
if (IsInteger(tagn))
{
if
(
valn.nint < 1
||
valn.nint >= MAX_ERRORS
||
!ErrorMessage[valn.nint]
)
{
Fail_;
}
{
value v;
Cstring_To_Prolog(ErrorMessage[valn.nint], v);
Return_Unify_String(vale, tage, v.ptr);
}
}
else if (IsAtom(tagn))
{
Return_Unify_String(vale, tage, DidString(valn.did));
}
else
{
Bip_Error(TYPE_ERROR);
}
}
static int
p_text_to_string(value v, type t, value vs, type ts)
{
pword *pw, *list;
char *s;
int len;
pword *old_tg = Gbl_Tg;
if (IsRef(t))
{
Bip_Error(PDELAY_1);
}
if (IsString(t))
{
Kill_DE;
Return_Unify_Pw(v, t, vs, ts);
}
if (IsAtom(t)) /* not including [] ! */
{
Kill_DE;
Return_Unify_String(vs, ts, DidString(v.did));
}
if (IsNil(t))
{
Kill_DE;
Return_Unify_String(vs, ts, empty_string);
}
if (IsList(t)) /* make a string from a list */
{
int element_type = 0;
list = v.ptr; /* space for the string header */
Push_Buffer(1); /* make minimum buffer */
s = (char *) BufferStart(old_tg); /* start of the new string */
for(;;) /* loop through the list */
{
int c;
pw = list++;
Dereference_(pw); /* get the list element */
if (IsRef(pw->tag)) /* check it */
{
Gbl_Tg = old_tg;
Push_var_delay(vs.ptr, ts.all);
Push_var_delay(pw, pw->tag.all);
Bip_Error(PDELAY);
}
else if (IsInteger(pw->tag)) /* char code */
{
element_type |= 1;
c = pw->val.nint;
if (c < 0 || 255 < c)
{
Gbl_Tg = old_tg;
Bip_Error(RANGE_ERROR);
}
}
else if (IsAtom(pw->tag)) /* char atom */
{
element_type |= 2;
if (DidLength(pw->val.did) != 1)
{
Gbl_Tg = old_tg;
Bip_Error(RANGE_ERROR);
}
c = DidName(pw->val.did)[0];
}
else
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
*s++ = c;
if (s == (char *) Gbl_Tg) /* we need another pword */
{
Gbl_Tg += 1;
Check_Gc;
}
Dereference_(list); /* get the list tail */
if (IsRef(list->tag))
{
Gbl_Tg = old_tg;
Push_var_delay(vs.ptr, ts.all);
Push_var_delay(list, list->tag.all);
Bip_Error(PDELAY);
}
else if (IsList(list->tag))
list = list->val.ptr;
else if (IsNil(list->tag))
break; /* end of the list */
else
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
}
if (element_type != 1 && element_type != 2) /* mixed type list? */
{
Gbl_Tg = old_tg;
Bip_Error(TYPE_ERROR);
}
*s = '\0'; /* terminate the string */
Set_Buffer_Size(old_tg, s - (char *)(old_tg + 1) + 1);
Kill_DE;
Return_Unify_String(vs, ts, old_tg);
}
Bip_Error(TYPE_ERROR);
}