static SourceFile lookupSourceFile_unlocked(atom_t name, int create) { GET_LD SourceFile file; if ( !GD->files.table ) { GD->files.table = newHTable(32); GD->files.table->free_symbol = freeSymbolSourceFile; GD->files.no_hole_before = 1; } if ( (file=lookupHTable(GD->files.table, (void*)name)) ) { ; } else if ( create ) { file = allocHeapOrHalt(sizeof(*file)); memset(file, 0, sizeof(*file)); file->name = name; file->system = GD->bootsession; #ifdef O_PLMT file->mutex = allocSimpleMutex(PL_atom_chars(name)); #endif PL_register_atom(file->name); file->magic = SF_MAGIC; registerSourceFile(file); addNewHTable(GD->files.table, (void*)name, file); } else { file = NULL; } return file; }
static int defOperator(Module m, atom_t name, int type, int priority, int force) { GET_LD Symbol s; operator *op; int t = (type & OP_MASK); /* OP_PREFIX, ... */ DEBUG(7, Sdprintf(":- op(%d, %s, %s) in module %s\n", priority, PL_atom_chars(operatorTypeToAtom(type)), PL_atom_chars(name), PL_atom_chars(m->name))); assert(t>=OP_PREFIX && t<=OP_POSTFIX); if ( !force && !SYSTEM_MODE ) { if ( name == ATOM_comma || (name == ATOM_bar && ((t&OP_MASK) != OP_INFIX || (priority < 1001 && priority != 0))) ) { GET_LD atom_t action = (name == ATOM_comma ? ATOM_modify : ATOM_create); term_t t = PL_new_term_ref(); PL_put_atom(t, name); return PL_error(NULL, 0, NULL, ERR_PERMISSION, action, ATOM_operator, t); } } LOCK(); if ( !m->operators ) m->operators = newOperatorTable(8); if ( (s = lookupHTable(m->operators, (void *)name)) ) { op = s->value; } else if ( priority < 0 ) { UNLOCK(); /* already inherited: do not change */ return TRUE; } else { op = allocHeapOrHalt(sizeof(*op)); op->priority[OP_PREFIX] = -1; op->priority[OP_INFIX] = -1; op->priority[OP_POSTFIX] = -1; op->type[OP_PREFIX] = OP_INHERIT; op->type[OP_INFIX] = OP_INHERIT; op->type[OP_POSTFIX] = OP_INHERIT; } op->priority[t] = priority; op->type[t] = (priority >= 0 ? type : OP_INHERIT); if ( !s ) { PL_register_atom(name); addHTable(m->operators, (void *)name, op); } UNLOCK(); return TRUE; }
static const uri_component_ranges * base_ranges(term_t t) { atom_t a; if ( PL_get_atom(t, &a) ) { base_cache *base = myBase(); if ( base->atom != a ) { size_t len; pl_wchar_t *s; if ( base->atom ) { PL_unregister_atom(base->atom); PL_free(base->text); } if ( !PL_get_wchars(t, &len, &s, CVT_ATOM|BUF_MALLOC) ) return NULL; base->atom = a; PL_register_atom(a); base->text = s; parse_uri(&base->ranges, len, s); } return &base->ranges; } else { type_error("atom", t); return NULL; } }
functor_t lookupFunctorDef(atom_t atom, size_t arity) { GET_LD int v; FunctorDef *table; int buckets; FunctorDef f, head; redo: acquire_functor_table(table, buckets); v = (int)pointerHashValue(atom, buckets); head = table[v]; DEBUG(9, Sdprintf("Lookup functor %s/%d = ", stringAtom(atom), arity)); for(f = table[v]; f; f = f->next) { if (atom == f->name && f->arity == arity) { DEBUG(9, Sdprintf("%p (old)\n", f)); if ( !FUNCTOR_IS_VALID(f->flags) ) { goto redo; } release_functor_table(); return f->functor; } } if ( functorDefTable->buckets * 2 < GD->statistics.functors ) { LOCK(); rehashFunctors(); UNLOCK(); } if ( !( head == table[v] && table == functorDefTable->table ) ) goto redo; f = (FunctorDef) allocHeapOrHalt(sizeof(struct functorDef)); f->functor = 0L; f->name = atom; f->arity = arity; f->flags = 0; f->next = table[v]; if ( !( COMPARE_AND_SWAP(&table[v], head, f) && table == functorDefTable->table) ) { PL_free(f); goto redo; } registerFunctor(f); ATOMIC_INC(&GD->statistics.functors); PL_register_atom(atom); DEBUG(9, Sdprintf("%p (new)\n", f)); release_functor_table(); return f->functor; }
static foreign_t archive_open_entry(term_t archive, term_t stream) { archive_wrapper *ar; IOSTREAM *s; if ( !get_archive(archive, &ar) ) return FALSE; if ( (s=Snew(ar, SIO_INPUT|SIO_RECORDPOS, &ar_entry_functions)) ) { ar->status = AR_OPENED_ENTRY; if ( PL_unify_stream(stream, s) ) { PL_register_atom(ar->symbol); /* We may no longer reference the */ return TRUE; /* archive itself */ } Sclose(s); return FALSE; } return PL_resource_error("memory"); }
functor_t lookupFunctorDef(atom_t atom, unsigned int arity) { int v; FunctorDef f; LOCK(); v = (int)pointerHashValue(atom, functor_buckets); DEBUG(9, Sdprintf("Lookup functor %s/%d = ", stringAtom(atom), arity)); for(f = functorDefTable[v]; f; f = f->next) { if (atom == f->name && f->arity == arity) { DEBUG(9, Sdprintf("%p (old)\n", f)); UNLOCK(); return f->functor; } } f = (FunctorDef) allocHeapOrHalt(sizeof(struct functorDef)); f->functor = 0L; f->name = atom; f->arity = arity; if ( atom == ATOM_call && arity > 8 ) f->flags = CONTROL_F; else f->flags = 0; f->next = functorDefTable[v]; functorDefTable[v] = f; registerFunctor(f); GD->statistics.functors++; PL_register_atom(atom); DEBUG(9, Sdprintf("%p (new)\n", f)); if ( functor_buckets * 2 < GD->statistics.functors ) rehashFunctors(); UNLOCK(); return f->functor; }
static int get_lang_stemmer(term_t t, struct sb_stemmer **stemmer) { stem_cache *cache = get_cache(); atom_t lang; int i; if ( !PL_get_atom(t, &lang) ) return type_error("atom", t); for(i=0; i<CACHE_SIZE; i++) { if ( cache->stemmers[i].language == lang ) { *stemmer = cache->stemmers[i].stemmer; return TRUE; } } for(i=0; i<CACHE_SIZE; i++) { if ( !cache->stemmers[i].stemmer ) { struct sb_stemmer *st; if ( !(st= sb_stemmer_new(PL_atom_chars(lang), NULL)) ) { if ( errno == ENOMEM ) return resource_error("memory"); else return domain_error("snowball_algorithm", t); } cache->stemmers[i].language = lang; cache->stemmers[i].stemmer = st; PL_register_atom(cache->stemmers[i].language); *stemmer = cache->stemmers[i].stemmer; return TRUE; } } assert(0); /* TBD: clean cache */ return FALSE; }
static foreign_t pl_rl_add_history(term_t text) { atom_t a; static atom_t last = 0; if ( PL_get_atom(text, &a) ) { if ( a != last ) { TCHAR *s; if ( last ) PL_unregister_atom(last); last = a; PL_register_atom(last); PL_get_wchars(text, NULL, &s, CVT_ATOM); rlc_add_history(PL_current_console(), s); } return TRUE; } return FALSE; }