/* * 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 p_char_int(value chval, type chtag, value ival, type itag) { /* Case of: converting an integer to a character. */ if (IsRef(chtag)) { value v; register char *s; if (IsRef(itag)) { Bip_Error(PDELAY_1_2); } else if (!IsInteger(itag)) { Bip_Error(TYPE_ERROR); } if ((ival.nint < 0) || (ival.nint > 255)) { Bip_Error(RANGE_ERROR) } Make_Stack_String(1, v, s); *s++ = ival.nint; *s = '\0'; Return_Unify_String(chval, chtag, v.ptr); } else if (IsString(chtag) && StringLength(chval) == 1)
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); }
static int p_string_list(value vs, type ts, value vl, type tl) { register pword *pw, *list; register char *s; register int len; pword *old_tg = Gbl_Tg; if (IsRef(ts)) /* no string given */ { if (IsRef(tl)) /* we need at least one */ { Bip_Error(PDELAY_1_2); } else if (IsList(tl)) /* make a string from a list */ { list = vl.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 */ { 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)) { Gbl_Tg = old_tg; Bip_Error(TYPE_ERROR); } else if (pw->val.nint < 0 || pw->val.nint > 255) { Gbl_Tg = old_tg; Bip_Error(RANGE_ERROR); } *s++ = pw->val.nint; 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); } } *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); } else if (IsNil(tl)) { Kill_DE; Return_Unify_String(vs, ts, empty_string); } else { Bip_Error(TYPE_ERROR); } } else if (IsString(ts)) { Kill_DE; Check_Output_List(tl); s = StringStart(vs); /* get a pointer to the string */ len = StringLength(vs); if (len == 0) { Return_Unify_Nil(vl, tl); } /* Additional a-priori overflow check because adding to TG may * may wrap around the address space and break Check_Gc below */ Check_Available_Pwords(2*len); pw = Gbl_Tg; /* reserve space for the list */ Gbl_Tg += 2*len; Check_Gc; pw->val.nint = *s++ & 0xFFL; /* construct the list */ pw++->tag.kernel = TINT; while (--len > 0) { pw->val.ptr = pw + 1; pw++->tag.kernel = TLIST; pw->val.nint = *s++ & 0xFFL; pw++->tag.kernel = TINT; } pw->tag.kernel = TNIL; Return_Unify_List(vl, tl, old_tg); } else { Bip_Error(TYPE_ERROR); } }