/*-------------------------------------------------------------------------* * PL_GET_PRED_INDICATOR * * * * returns the functor and initializes the arity of the predicate indicator* * func= -1 if it is a variable, arity= -1 if it is a variable * *-------------------------------------------------------------------------*/ int Pl_Get_Pred_Indicator(WamWord pred_indic_word, Bool must_be_ground, int *arity) { WamWord word, tag_mask; int func; DEREF(pred_indic_word, word, tag_mask); if (tag_mask == TAG_REF_MASK && must_be_ground) Pl_Err_Instantiation(); if (!Pl_Get_Structure(ATOM_CHAR('/'), 2, pred_indic_word)) { if (!Flag_Value(FLAG_STRICT_ISO) && Pl_Rd_Callable(word, &func, arity) != NULL) return func; Pl_Err_Type(pl_type_predicate_indicator, pred_indic_word); } pl_pi_name_word = Pl_Unify_Variable(); pl_pi_arity_word = Pl_Unify_Variable(); if (must_be_ground) func = Pl_Rd_Atom_Check(pl_pi_name_word); else { DEREF(pl_pi_name_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) func = -1; else func = Pl_Rd_Atom_Check(pl_pi_name_word); } if (must_be_ground) { *arity = Pl_Rd_Positive_Check(pl_pi_arity_word); if (*arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); } else { DEREF(pl_pi_arity_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) *arity = -1; else { *arity = Pl_Rd_Positive_Check(pl_pi_arity_word); if (*arity > MAX_ARITY) Pl_Err_Representation(pl_representation_max_arity); } } return func; }
/*-------------------------------------------------------------------------* * PL_OPEN_INPUT_TERM_STREAM_2 * * * *-------------------------------------------------------------------------*/ void Pl_Open_Input_Term_Stream_2(WamWord sink_term_word, WamWord stm_word) { char *str; int stm; int n; if (SYS_VAR_OPTION_MASK == TERM_STREAM_ATOM) str = pl_atom_tbl[Pl_Rd_Atom_Check(sink_term_word)].name; else { n = Pl_List_Length(sink_term_word); /* -1 if not a list */ if (n >= 0) str = Malloc(n + 1); /* +1 for \0 */ else str = pl_glob_buff; if (SYS_VAR_OPTION_MASK == TERM_STREAM_CHARS) Pl_Rd_Chars_Str_Check(sink_term_word, str); else Pl_Rd_Codes_Str_Check(sink_term_word, str); } stm = Pl_Add_Str_Stream(str, SYS_VAR_OPTION_MASK); Pl_Get_Integer(stm, stm_word); }
/*-------------------------------------------------------------------------* * PL_ATOM_LENGTH_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Atom_Length_2(WamWord atom_word, WamWord length_word) { int atom; atom = Pl_Rd_Atom_Check(atom_word); return Pl_Un_Positive_Check(pl_atom_tbl[atom].prop.length, length_word); }
/*-------------------------------------------------------------------------* * PL_AUX_NAME_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Aux_Name_1(WamWord name_word) { int func; func = Pl_Rd_Atom_Check(name_word); return Pl_Detect_If_Aux_Name(func) != NULL; }
/*-------------------------------------------------------------------------* * PL_ADD_STREAM_ALIAS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Add_Stream_Alias_2(WamWord sora_word, WamWord alias_word) { int stm; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); return Pl_Add_Alias_To_Stream(Pl_Rd_Atom_Check(alias_word), stm); }
/*-------------------------------------------------------------------------* * PL_FROM_ALIAS_TO_STREAM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_From_Alias_To_Stream_2(WamWord alias_word, WamWord stm_word) { int stm; stm = Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(alias_word)); return stm >= 0 && Pl_Get_Integer(stm, stm_word); }
/*-------------------------------------------------------------------------* * ARG_ATOM * * * *-------------------------------------------------------------------------*/ static char * Arg_Atom(WamWord **lst_adr) { WamWord word; word = Read_Arg(lst_adr); return pl_atom_tbl[Pl_Rd_Atom_Check(word)].name; }
/*-------------------------------------------------------------------------* * PL_NEW_ATOM_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_New_Atom_2(WamWord prefix_word, WamWord atom_word) { int atom; atom = Pl_Rd_Atom_Check(prefix_word); Pl_Check_For_Un_Variable(atom_word); return Pl_Get_Atom(Pl_Gen_New_Atom(pl_atom_tbl[atom].name), atom_word); }
/*-------------------------------------------------------------------------* * PL_PRED_WITHOUT_AUX_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Pred_Without_Aux_4(WamWord name_word, WamWord arity_word, WamWord name1_word, WamWord arity1_word) { int func, arity; int func1, arity1; func = Pl_Rd_Atom_Check(name_word); arity = Pl_Rd_Integer_Check(arity_word); func1 = Pl_Pred_Without_Aux(func, arity, &arity1); return Pl_Un_Atom_Check(func1, name1_word) && Pl_Un_Integer_Check(arity1, arity1_word); }
/*-------------------------------------------------------------------------* * PL_FATHER_OF_AUX_NAME_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Father_Of_Aux_Name_3(WamWord name_word, WamWord father_name_word, WamWord father_arity_word) { int func, father_func, father_arity; func = Pl_Rd_Atom_Check(name_word); father_func = Pl_Father_Pred_Of_Aux(func, &father_arity); if (father_func < 0) return FALSE; return Pl_Un_Atom_Check(father_func, father_name_word) && Pl_Un_Integer_Check(father_arity, father_arity_word); }
/*-------------------------------------------------------------------------* * PL_CURRENT_ALIAS_2 * * * *-------------------------------------------------------------------------*/ Bool Pl_Current_Alias_2(WamWord stm_word, WamWord alias_word) { WamWord word, tag_mask; int stm; HashScan scan; AliasInf *alias; AliasInf *save_alias; stm = Pl_Rd_Integer_Check(stm_word); /* stm is a valid stream entry */ DEREF(alias_word, word, tag_mask); if (tag_mask != TAG_REF_MASK) return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(word)) == stm; for (alias = (AliasInf *) Pl_Hash_First(pl_alias_tbl, &scan); alias; alias = (AliasInf *) Pl_Hash_Next(&scan)) if (alias->stm == stm) break; if (alias == NULL) return FALSE; save_alias = alias; for (;;) { alias = (AliasInf *) Pl_Hash_Next(&scan); if (alias == NULL || alias->stm == stm) break; } if (alias) /* non deterministic case */ { A(0) = stm; A(1) = alias_word; A(2) = (WamWord) scan.endt; A(3) = (WamWord) scan.cur_t; A(4) = (WamWord) scan.cur_p; A(5) = (WamWord) alias; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_ALIAS_ALT, 0), 6); } Pl_Get_Atom(save_alias->atom, alias_word); return TRUE; }
/*-------------------------------------------------------------------------* * PL_MAKE_AUX_NAME_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Make_Aux_Name_4(WamWord name_word, WamWord arity_word, WamWord aux_nb_word, WamWord aux_name_word) { int func, arity; int aux_nb; int aux_name; func = Pl_Rd_Atom_Check(name_word); arity = Pl_Rd_Integer_Check(arity_word); aux_nb = Pl_Rd_Integer_Check(aux_nb_word); aux_name = Pl_Make_Aux_Name(func, arity, aux_nb); return Pl_Un_Atom_Check(aux_name, aux_name_word); }
/*-------------------------------------------------------------------------* * PL_SEEK_4 * * * *-------------------------------------------------------------------------*/ Bool Pl_Seek_4(WamWord sora_word, WamWord whence_word, WamWord offset_word, WamWord new_loc_word) { int stm; StmInf *pstm; int whence; PlLong offset; int atom; PlLong p[4]; stm = Pl_Get_Stream_Or_Alias(sora_word, STREAM_CHECK_EXIST); pstm = pl_stm_tbl[stm]; if (!pstm->prop.reposition) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_stream, sora_word); if (pstm->prop.text) Pl_Err_Permission(pl_permission_operation_reposition, pl_permission_type_text_stream, sora_word); atom = Pl_Rd_Atom_Check(whence_word); if (atom == pl_atom_bof) whence = SEEK_SET; else if (atom == pl_atom_current) whence = SEEK_CUR; else if (atom == pl_atom_eof) whence = SEEK_END; else Pl_Err_Domain(pl_domain_stream_seek_method, whence_word); offset = Pl_Rd_Integer_Check(offset_word); Pl_Check_For_Un_Integer(new_loc_word); if (Pl_Stream_Set_Position(pstm, whence, offset, offset, 0, 0) != 0) return FALSE; Pl_Stream_Get_Position(pstm, &offset, p + 1, p + 2, p + 3); return Pl_Get_Integer(offset, new_loc_word); }
/*-------------------------------------------------------------------------* * PL_SET_PREDICATE_FILE_INFO_3 * * * *-------------------------------------------------------------------------*/ Bool Pl_Set_Predicate_File_Info_3(WamWord pred_indic_word, WamWord pl_file_word, WamWord pl_line_word) { int func, arity; int pl_file, pl_line; PredInf *pred; func = Pl_Get_Pred_Indicator(pred_indic_word, TRUE, &arity); if ((pred = Pl_Lookup_Pred(func, arity)) == NULL) return FALSE; pl_file = Pl_Rd_Atom_Check(pl_file_word); pl_line = Pl_Rd_Integer_Check(pl_line_word); if (pl_line < 0) return FALSE; pred->pl_file = pl_file; pred->pl_line = pl_line; return TRUE; }
/*-------------------------------------------------------------------------* * PL_OPEN_3 * * * *-------------------------------------------------------------------------*/ void Pl_Open_3(WamWord source_sink_word, WamWord mode_word, WamWord stm_word) { WamWord word, tag_mask; int atom; int mode; Bool text; StmProp prop; char *path; int atom_file_name; int stm; FILE *f; int mask = SYS_VAR_OPTION_MASK; Bool reposition; DEREF(source_sink_word, word, tag_mask); if (tag_mask == TAG_REF_MASK) Pl_Err_Instantiation(); if (tag_mask != TAG_ATM_MASK) Pl_Err_Domain(pl_domain_source_sink, source_sink_word); atom_file_name = UnTag_ATM(word); path = pl_atom_tbl[atom_file_name].name; if ((path = Pl_M_Absolute_Path_Name(path)) == NULL) Pl_Err_Existence(pl_existence_source_sink, source_sink_word); text = mask & 1; mask >>= 1; atom = Pl_Rd_Atom_Check(mode_word); if (atom == pl_atom_read) mode = STREAM_MODE_READ; else if (atom == pl_atom_write) mode = STREAM_MODE_WRITE; else if (atom == pl_atom_append) mode = STREAM_MODE_APPEND; else Pl_Err_Domain(pl_domain_io_mode, mode_word); stm = Pl_Add_Stream_For_Stdio_File(path, mode, text); if (stm < 0) { if (errno == ENOENT || errno == ENOTDIR) Pl_Err_Existence(pl_existence_source_sink, source_sink_word); else Pl_Err_Permission(pl_permission_operation_open, pl_permission_type_source_sink, source_sink_word); } prop = pl_stm_tbl[stm]->prop; f = (FILE *) pl_stm_tbl[stm]->file; /* change properties wrt to specified ones */ if ((mask & 2) != 0) /* reposition specified */ { reposition = mask & 1; if (reposition && !prop.reposition) { fclose(f); word = Pl_Put_Structure(pl_atom_reposition, 1); Pl_Unify_Atom(pl_atom_true); Pl_Err_Permission(pl_permission_operation_open, pl_permission_type_source_sink, word); } prop.reposition = reposition; } mask >>= 2; if ((mask & 4) != 0) /* eof_action specified */ prop.eof_action = mask & 3; mask >>= 3; if ((mask & 4) != 0) /* buffering specified */ if (prop.buffering != (unsigned) (mask & 3)) /* cast for MSVC warning */ { prop.buffering = mask & 3; Pl_Stdio_Set_Buffering(f, prop.buffering); } mask >>= 3; pl_stm_tbl[stm]->atom_file_name = atom_file_name; pl_stm_tbl[stm]->prop = prop; Pl_Get_Integer(stm, stm_word); }
/*-------------------------------------------------------------------------* * PL_SUB_ATOM_5 * * * *-------------------------------------------------------------------------*/ Bool Pl_Sub_Atom_5(WamWord atom_word, WamWord before_word, WamWord length_word, WamWord after_word, WamWord sub_atom_word) { WamWord word, tag_mask; AtomInf *patom; AtomInf *psub_atom = NULL; /* only for the compiler */ int length; PlLong b, l, a; int b1, l1, a1; Bool nondet; int mask = 0; char *str; patom = pl_atom_tbl + Pl_Rd_Atom_Check(atom_word); length = patom->prop.length; DEREF_LG(before_word, b); DEREF_LG(length_word, l); DEREF_LG(after_word, a); DEREF(sub_atom_word, word, tag_mask); if (tag_mask != TAG_REF_MASK && tag_mask != TAG_ATM_MASK) Pl_Err_Type(pl_type_atom, word); sub_atom_word = word; if (tag_mask == TAG_ATM_MASK) { psub_atom = pl_atom_tbl + UnTag_ATM(word); l = psub_atom->prop.length; if (!Pl_Get_Integer(l, length_word)) return FALSE; if ((mask & 5) == 5 && length != b + l + a) /* B and A fixed */ return FALSE; if (mask & 4) /* B fixed */ { a = length - b - l; return strncmp(patom->name + b, psub_atom->name, l) == 0 && Pl_Get_Integer(a, after_word); } if (mask & 1) /* A fixed */ { b = length - l - a; return strncmp(patom->name + b, psub_atom->name, l) == 0 && Pl_Get_Integer(b, before_word); } mask = 8; /* set sub_atom as fixed */ } switch (mask) /* mask <= 7, B L A (1: fixed, 0: var) */ { case 0: /* nothing fixed */ case 2: /* L fixed */ case 4: /* B fixed */ a = length - b - l; nondet = TRUE; break; case 1: /* A fixed */ l = length - b - a; nondet = TRUE; break; case 3: /* L A fixed */ b = length - l - a; nondet = FALSE; break; case 5: /* B A fixed */ l = length - b - a; nondet = FALSE; break; case 6: /* B L fixed */ case 7: /* B L A fixed */ a = length - b - l; nondet = FALSE; break; default: /* sub_atom fixed */ if ((str = strstr(patom->name + b, psub_atom->name)) == NULL) return FALSE; b = str - patom->name; a = length - b - l; nondet = TRUE; break; } if (b < 0 || l < 0 || a < 0) return FALSE; if (nondet && Compute_Next_BLA(mask, patom, psub_atom, b, l, a, &b1, &l1, &a1)) { /* non deterministic case */ A(0) = before_word; A(1) = length_word; A(2) = after_word; A(3) = sub_atom_word; A(4) = (WamWord) patom; A(5) = (WamWord) psub_atom; A(6) = mask; A(7) = b1; A(8) = l1; A(9) = a1; Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(SUB_ATOM_ALT, 0), 10); } if (mask <= 7) { MALLOC_STR(l); strncpy(str, patom->name + b, l); str[l] = '\0'; Pl_Get_Atom(Create_Malloc_Atom(str), sub_atom_word); Pl_Get_Integer(l, length_word); } return Pl_Get_Integer(b, before_word) && Pl_Get_Integer(a, after_word); }
/*-------------------------------------------------------------------------* * PL_TEST_ALIAS_NOT_ASSIGNED_1 * * * *-------------------------------------------------------------------------*/ Bool Pl_Test_Alias_Not_Assigned_1(WamWord alias_word) { return Pl_Find_Stream_By_Alias(Pl_Rd_Atom_Check(alias_word)) < 0; }