/*- * See the file LICENSE for redistribution information. * * Copyright (c) 1999-2001 * Sleepycat Software. All rights reserved. */ #include "db_config.h" #ifndef lint static const char revid[] = "$Id: tcl_mp.c,v 1.1.1.1 2003/02/15 04:56:14 zarzycki Exp $"; #endif /* not lint */ #ifndef NO_SYSTEM_INCLUDES #include #include #include #include #endif #include "db_int.h" #include "dbinc/tcl_db.h" /* * Prototypes for procedures defined later in this file: */ static int mp_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); static int pg_Cmd __P((ClientData, Tcl_Interp *, int, Tcl_Obj * CONST*)); static int tcl_MpGet __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_MPOOLFILE *, DBTCL_INFO *)); static int tcl_Pg __P((Tcl_Interp *, int, Tcl_Obj * CONST*, void *, DB_MPOOLFILE *, DBTCL_INFO *, int)); static int tcl_PgInit __P((Tcl_Interp *, int, Tcl_Obj * CONST*, void *, DBTCL_INFO *)); static int tcl_PgIsset __P((Tcl_Interp *, int, Tcl_Obj * CONST*, void *, DBTCL_INFO *)); /* * _MpInfoDelete -- * Removes "sub" mp page info structures that are children * of this mp. * * PUBLIC: void _MpInfoDelete __P((Tcl_Interp *, DBTCL_INFO *)); */ void _MpInfoDelete(interp, mpip) Tcl_Interp *interp; /* Interpreter */ DBTCL_INFO *mpip; /* Info for mp */ { DBTCL_INFO *nextp, *p; for (p = LIST_FIRST(&__db_infohead); p != NULL; p = nextp) { /* * Check if this info structure "belongs" to this * mp. Remove its commands and info structure. */ nextp = LIST_NEXT(p, entries); if (p->i_parent == mpip && p->i_type == I_PG) { (void)Tcl_DeleteCommand(interp, p->i_name); _DeleteInfo(p); } } } #if CONFIG_TEST /* * tcl_MpSync -- * * PUBLIC: int tcl_MpSync __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); */ int tcl_MpSync(interp, objc, objv, envp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { DB_LSN lsn, *lsnp; int result, ret; result = TCL_OK; lsnp = NULL; /* * No flags, must be 3 args. */ if (objc == 3) { result = _GetLsn(interp, objv[2], &lsn); if (result == TCL_ERROR) return (result); lsnp = &lsn; } else if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, "lsn"); return (TCL_ERROR); } _debug_check(); ret = envp->memp_sync(envp, lsnp); result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp sync"); return (result); } /* * tcl_MpTrickle -- * * PUBLIC: int tcl_MpTrickle __P((Tcl_Interp *, int, * PUBLIC: Tcl_Obj * CONST*, DB_ENV *)); */ int tcl_MpTrickle(interp, objc, objv, envp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { int pages; int percent; int result; int ret; Tcl_Obj *res; result = TCL_OK; /* * No flags, must be 3 args. */ if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "percent"); return (TCL_ERROR); } result = Tcl_GetIntFromObj(interp, objv[2], &percent); if (result == TCL_ERROR) return (result); _debug_check(); ret = envp->memp_trickle(envp, percent, &pages); result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp trickle"); if (result == TCL_ERROR) return (result); res = Tcl_NewIntObj(pages); Tcl_SetObjResult(interp, res); return (result); } /* * tcl_Mp -- * * PUBLIC: int tcl_Mp __P((Tcl_Interp *, int, * PUBLIC: Tcl_Obj * CONST*, DB_ENV *, DBTCL_INFO *)); */ int tcl_Mp(interp, objc, objv, envp, envip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ DBTCL_INFO *envip; /* Info pointer */ { static char *mpopts[] = { "-create", "-mode", "-nommap", "-pagesize", "-rdonly", NULL }; enum mpopts { MPCREATE, MPMODE, MPNOMMAP, MPPAGE, MPRDONLY }; DBTCL_INFO *ip; DB_MPOOLFILE *mpf; Tcl_Obj *res; u_int32_t flag; int i, pgsize, mode, optindex, result, ret; char *file, newname[MSG_SIZE]; result = TCL_OK; i = 2; flag = 0; mode = 0; pgsize = 0; memset(newname, 0, MSG_SIZE); while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], mpopts, "option", TCL_EXACT, &optindex) != TCL_OK) { /* * Reset the result so we don't get an errant * error message if there is another error. * This arg is the file name. */ if (IS_HELP(objv[i]) == TCL_OK) return (TCL_OK); Tcl_ResetResult(interp); break; } i++; switch ((enum mpopts)optindex) { case MPCREATE: flag |= DB_CREATE; break; case MPNOMMAP: flag |= DB_NOMMAP; break; case MPPAGE: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-pagesize size?"); result = TCL_ERROR; break; } /* * Don't need to check result here because * if TCL_ERROR, the error message is already * set up, and we'll bail out below. If ok, * the mode is set and we go on. */ result = Tcl_GetIntFromObj(interp, objv[i++], &pgsize); break; case MPRDONLY: flag |= DB_RDONLY; break; case MPMODE: if (i >= objc) { Tcl_WrongNumArgs(interp, 2, objv, "?-mode mode?"); result = TCL_ERROR; break; } /* * Don't need to check result here because * if TCL_ERROR, the error message is already * set up, and we'll bail out below. If ok, * the mode is set and we go on. */ result = Tcl_GetIntFromObj(interp, objv[i++], &mode); break; } if (result != TCL_OK) goto error; } /* * Any left over arg is a file name. It better be the last arg. */ file = NULL; if (i != objc) { if (i != objc - 1) { Tcl_WrongNumArgs(interp, 2, objv, "?args? ?file?"); result = TCL_ERROR; goto error; } file = Tcl_GetStringFromObj(objv[i++], NULL); } snprintf(newname, sizeof(newname), "%s.mp%d", envip->i_name, envip->i_envmpid); ip = _NewInfo(interp, NULL, newname, I_MP); if (ip == NULL) { Tcl_SetResult(interp, "Could not set up info", TCL_STATIC); return (TCL_ERROR); } _debug_check(); if ((ret = envp->memp_fcreate(envp, &mpf, 0)) != 0) { result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool"); _DeleteInfo(ip); goto error; } /* * XXX * Interface doesn't currently support DB_MPOOLFILE configuration. */ if ((ret = mpf->open(mpf, file, flag, mode, (size_t)pgsize)) != 0) { result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mpool"); _DeleteInfo(ip); (void)mpf->close(mpf, 0); goto error; } /* * Success. Set up return. Set up new info and command widget for * this mpool. */ envip->i_envmpid++; ip->i_parent = envip; ip->i_pgsz = pgsize; _SetInfoData(ip, mpf); Tcl_CreateObjCommand(interp, newname, (Tcl_ObjCmdProc *)mp_Cmd, (ClientData)mpf, NULL); res = Tcl_NewStringObj(newname, strlen(newname)); Tcl_SetObjResult(interp, res); error: return (result); } /* * tcl_MpStat -- * * PUBLIC: int tcl_MpStat __P((Tcl_Interp *, int, Tcl_Obj * CONST*, DB_ENV *)); */ int tcl_MpStat(interp, objc, objv, envp) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_ENV *envp; /* Environment pointer */ { DB_MPOOL_STAT *sp; DB_MPOOL_FSTAT **fsp, **savefsp; int result; int ret; Tcl_Obj *res; Tcl_Obj *res1; result = TCL_OK; savefsp = NULL; /* * No args for this. Error if there are some. */ if (objc != 2) { Tcl_WrongNumArgs(interp, 2, objv, NULL); return (TCL_ERROR); } _debug_check(); ret = envp->memp_stat(envp, &sp, &fsp, 0); result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "memp stat"); if (result == TCL_ERROR) return (result); /* * Have our stats, now construct the name value * list pairs and free up the memory. */ res = Tcl_NewObj(); /* * MAKE_STAT_LIST assumes 'res' and 'error' label. */ MAKE_STAT_LIST("Cache size (gbytes)", sp->st_gbytes); MAKE_STAT_LIST("Cache size (bytes)", sp->st_bytes); MAKE_STAT_LIST("Number of caches", sp->st_ncache); MAKE_STAT_LIST("Region size", sp->st_regsize); MAKE_STAT_LIST("Pages mapped into address space", sp->st_map); MAKE_STAT_LIST("Cache hits", sp->st_cache_hit); MAKE_STAT_LIST("Cache misses", sp->st_cache_miss); MAKE_STAT_LIST("Pages created", sp->st_page_create); MAKE_STAT_LIST("Pages read in", sp->st_page_in); MAKE_STAT_LIST("Pages written", sp->st_page_out); MAKE_STAT_LIST("Clean page evictions", sp->st_ro_evict); MAKE_STAT_LIST("Dirty page evictions", sp->st_rw_evict); MAKE_STAT_LIST("Dirty pages trickled", sp->st_page_trickle); MAKE_STAT_LIST("Cached pages", sp->st_pages); MAKE_STAT_LIST("Cached clean pages", sp->st_page_clean); MAKE_STAT_LIST("Cached dirty pages", sp->st_page_dirty); MAKE_STAT_LIST("Hash buckets", sp->st_hash_buckets); MAKE_STAT_LIST("Hash lookups", sp->st_hash_searches); MAKE_STAT_LIST("Longest hash chain found", sp->st_hash_longest); MAKE_STAT_LIST("Hash elements examined", sp->st_hash_examined); MAKE_STAT_LIST("Number of hash bucket nowaits", sp->st_hash_nowait); MAKE_STAT_LIST("Number of hash bucket waits", sp->st_hash_wait); MAKE_STAT_LIST("Maximum number of hash bucket waits", sp->st_hash_max_wait); MAKE_STAT_LIST("Number of region lock nowaits", sp->st_region_nowait); MAKE_STAT_LIST("Number of region lock waits", sp->st_region_wait); MAKE_STAT_LIST("Page allocations", sp->st_alloc); MAKE_STAT_LIST("Buckets examined during allocation", sp->st_alloc_buckets); MAKE_STAT_LIST("Maximum buckets examined during allocation", sp->st_alloc_max_buckets); MAKE_STAT_LIST("Pages examined during allocation", sp->st_alloc_pages); MAKE_STAT_LIST("Maximum pages examined during allocation", sp->st_alloc_max_pages); /* * Save global stat list as res1. The MAKE_STAT_LIST * macro assumes 'res' so we'll use that to build up * our per-file sublist. */ res1 = res; for (savefsp = fsp; fsp != NULL && *fsp != NULL; fsp++) { res = Tcl_NewObj(); result = _SetListElem(interp, res, "File Name", strlen("File Name"), (*fsp)->file_name, strlen((*fsp)->file_name)); if (result != TCL_OK) goto error; MAKE_STAT_LIST("Page size", (*fsp)->st_pagesize); MAKE_STAT_LIST("Pages mapped into address space", (*fsp)->st_map); MAKE_STAT_LIST("Cache hits", (*fsp)->st_cache_hit); MAKE_STAT_LIST("Cache misses", (*fsp)->st_cache_miss); MAKE_STAT_LIST("Pages created", (*fsp)->st_page_create); MAKE_STAT_LIST("Pages read in", (*fsp)->st_page_in); MAKE_STAT_LIST("Pages written", (*fsp)->st_page_out); /* * Now that we have a complete "per-file" stat list, append * that to the other list. */ result = Tcl_ListObjAppendElement(interp, res1, res); if (result != TCL_OK) goto error; } Tcl_SetObjResult(interp, res1); error: free(sp); if (savefsp != NULL) free(savefsp); return (result); } /* * mp_Cmd -- * Implements the "mp" widget. */ static int mp_Cmd(clientData, interp, objc, objv) ClientData clientData; /* Mp handle */ Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *mpcmds[] = { "close", "fsync", "get", NULL }; enum mpcmds { MPCLOSE, MPFSYNC, MPGET }; DB_MPOOLFILE *mp; int cmdindex, length, result, ret; DBTCL_INFO *mpip; Tcl_Obj *res; char *obj_name; Tcl_ResetResult(interp); mp = (DB_MPOOLFILE *)clientData; obj_name = Tcl_GetStringFromObj(objv[0], &length); mpip = _NameToInfo(obj_name); result = TCL_OK; if (mp == NULL) { Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); return (TCL_ERROR); } if (mpip == NULL) { Tcl_SetResult(interp, "NULL mp info pointer", TCL_STATIC); return (TCL_ERROR); } /* * Get the command name index from the object based on the dbcmds * defined above. */ if (Tcl_GetIndexFromObj(interp, objv[1], mpcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) return (IS_HELP(objv[1])); res = NULL; switch ((enum mpcmds)cmdindex) { case MPCLOSE: if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return (TCL_ERROR); } _debug_check(); ret = mp->close(mp, 0); result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "mp close"); _MpInfoDelete(interp, mpip); (void)Tcl_DeleteCommand(interp, mpip->i_name); _DeleteInfo(mpip); break; case MPFSYNC: if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, NULL); return (TCL_ERROR); } _debug_check(); ret = mp->sync(mp); res = Tcl_NewIntObj(ret); break; case MPGET: result = tcl_MpGet(interp, objc, objv, mp, mpip); break; } /* * Only set result if we have a res. Otherwise, lower * functions have already done so. */ if (result == TCL_OK && res) Tcl_SetObjResult(interp, res); return (result); } /* * tcl_MpGet -- */ static int tcl_MpGet(interp, objc, objv, mp, mpip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ DB_MPOOLFILE *mp; /* mp pointer */ DBTCL_INFO *mpip; /* mp info pointer */ { static char *mpget[] = { "-create", "-last", "-new", NULL }; enum mpget { MPGET_CREATE, MPGET_LAST, MPGET_NEW }; DBTCL_INFO *ip; Tcl_Obj *res; db_pgno_t pgno; u_int32_t flag; int i, ipgno, optindex, result, ret; char newname[MSG_SIZE]; void *page; result = TCL_OK; memset(newname, 0, MSG_SIZE); i = 2; flag = 0; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], mpget, "option", TCL_EXACT, &optindex) != TCL_OK) { /* * Reset the result so we don't get an errant * error message if there is another error. * This arg is the page number. */ if (IS_HELP(objv[i]) == TCL_OK) return (TCL_OK); Tcl_ResetResult(interp); break; } i++; switch ((enum mpget)optindex) { case MPGET_CREATE: flag |= DB_MPOOL_CREATE; break; case MPGET_LAST: flag |= DB_MPOOL_LAST; break; case MPGET_NEW: flag |= DB_MPOOL_NEW; break; } if (result != TCL_OK) goto error; } /* * Any left over arg is a page number. It better be the last arg. */ ipgno = 0; if (i != objc) { if (i != objc - 1) { Tcl_WrongNumArgs(interp, 2, objv, "?args? ?pgno?"); result = TCL_ERROR; goto error; } result = Tcl_GetIntFromObj(interp, objv[i++], &ipgno); if (result != TCL_OK) goto error; } snprintf(newname, sizeof(newname), "%s.pg%d", mpip->i_name, mpip->i_mppgid); ip = _NewInfo(interp, NULL, newname, I_PG); if (ip == NULL) { Tcl_SetResult(interp, "Could not set up info", TCL_STATIC); return (TCL_ERROR); } _debug_check(); pgno = ipgno; ret = mp->get(mp, &pgno, flag, &page); result = _ReturnSetup(interp, ret, DB_RETOK_MPGET(ret), "mpool get"); if (result == TCL_ERROR) _DeleteInfo(ip); else { /* * Success. Set up return. Set up new info * and command widget for this mpool. */ mpip->i_mppgid++; ip->i_parent = mpip; ip->i_pgno = pgno; ip->i_pgsz = mpip->i_pgsz; _SetInfoData(ip, page); Tcl_CreateObjCommand(interp, newname, (Tcl_ObjCmdProc *)pg_Cmd, (ClientData)page, NULL); res = Tcl_NewStringObj(newname, strlen(newname)); Tcl_SetObjResult(interp, res); } error: return (result); } /* * pg_Cmd -- * Implements the "pg" widget. */ static int pg_Cmd(clientData, interp, objc, objv) ClientData clientData; /* Page handle */ Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ { static char *pgcmds[] = { "init", "is_setto", "pgnum", "pgsize", "put", "set", NULL }; enum pgcmds { PGINIT, PGISSET, PGNUM, PGSIZE, PGPUT, PGSET }; DB_MPOOLFILE *mp; int cmdindex, length, result; char *obj_name; void *page; DBTCL_INFO *pgip; Tcl_Obj *res; Tcl_ResetResult(interp); page = (void *)clientData; obj_name = Tcl_GetStringFromObj(objv[0], &length); pgip = _NameToInfo(obj_name); mp = NAME_TO_MP(pgip->i_parent->i_name); result = TCL_OK; if (page == NULL) { Tcl_SetResult(interp, "NULL page pointer", TCL_STATIC); return (TCL_ERROR); } if (mp == NULL) { Tcl_SetResult(interp, "NULL mp pointer", TCL_STATIC); return (TCL_ERROR); } if (pgip == NULL) { Tcl_SetResult(interp, "NULL page info pointer", TCL_STATIC); return (TCL_ERROR); } /* * Get the command name index from the object based on the dbcmds * defined above. */ if (Tcl_GetIndexFromObj(interp, objv[1], pgcmds, "command", TCL_EXACT, &cmdindex) != TCL_OK) return (IS_HELP(objv[1])); res = NULL; switch ((enum pgcmds)cmdindex) { case PGNUM: res = Tcl_NewLongObj((long)pgip->i_pgno); break; case PGSIZE: res = Tcl_NewLongObj(pgip->i_pgsz); break; case PGSET: case PGPUT: result = tcl_Pg(interp, objc, objv, page, mp, pgip, cmdindex == PGSET ? 0 : 1); break; case PGINIT: result = tcl_PgInit(interp, objc, objv, page, pgip); break; case PGISSET: result = tcl_PgIsset(interp, objc, objv, page, pgip); break; } /* * Only set result if we have a res. Otherwise, lower * functions have already done so. */ if (result == TCL_OK && res) Tcl_SetObjResult(interp, res); return (result); } static int tcl_Pg(interp, objc, objv, page, mp, pgip, putop) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ void *page; /* Page pointer */ DB_MPOOLFILE *mp; /* Mpool pointer */ DBTCL_INFO *pgip; /* Info pointer */ int putop; /* Operation */ { static char *pgopt[] = { "-clean", "-dirty", "-discard", NULL }; enum pgopt { PGCLEAN, PGDIRTY, PGDISCARD }; u_int32_t flag; int i, optindex, result, ret; result = TCL_OK; i = 2; flag = 0; while (i < objc) { if (Tcl_GetIndexFromObj(interp, objv[i], pgopt, "option", TCL_EXACT, &optindex) != TCL_OK) return (IS_HELP(objv[i])); i++; switch ((enum pgopt)optindex) { case PGCLEAN: flag |= DB_MPOOL_CLEAN; break; case PGDIRTY: flag |= DB_MPOOL_DIRTY; break; case PGDISCARD: flag |= DB_MPOOL_DISCARD; break; } } _debug_check(); if (putop) ret = mp->put(mp, page, flag); else ret = mp->set(mp, page, flag); result = _ReturnSetup(interp, ret, DB_RETOK_STD(ret), "page"); if (putop) { (void)Tcl_DeleteCommand(interp, pgip->i_name); _DeleteInfo(pgip); } return (result); } static int tcl_PgInit(interp, objc, objv, page, pgip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ void *page; /* Page pointer */ DBTCL_INFO *pgip; /* Info pointer */ { Tcl_Obj *res; size_t pgsz; long *p, *endp, newval; int length, result; u_char *s; result = TCL_OK; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "val"); return (TCL_ERROR); } pgsz = pgip->i_pgsz; result = Tcl_GetLongFromObj(interp, objv[2], &newval); if (result != TCL_OK) { s = Tcl_GetByteArrayFromObj(objv[2], &length); if (s == NULL) return (TCL_ERROR); memcpy(page, s, ((size_t)length < pgsz) ? (size_t)length : pgsz); result = TCL_OK; } else { p = (long *)page; for (endp = p + (pgsz / sizeof(long)); p < endp; p++) *p = newval; } res = Tcl_NewIntObj(0); Tcl_SetObjResult(interp, res); return (result); } static int tcl_PgIsset(interp, objc, objv, page, pgip) Tcl_Interp *interp; /* Interpreter */ int objc; /* How many arguments? */ Tcl_Obj *CONST objv[]; /* The argument objects */ void *page; /* Page pointer */ DBTCL_INFO *pgip; /* Info pointer */ { Tcl_Obj *res; size_t pgsz; long *p, *endp, newval; int length, result; u_char *s; result = TCL_OK; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "val"); return (TCL_ERROR); } pgsz = pgip->i_pgsz; result = Tcl_GetLongFromObj(interp, objv[2], &newval); if (result != TCL_OK) { if ((s = Tcl_GetByteArrayFromObj(objv[2], &length)) == NULL) return (TCL_ERROR); result = TCL_OK; if (memcmp(page, s, ((size_t)length < pgsz) ? (size_t)length : pgsz ) != 0) { res = Tcl_NewIntObj(0); Tcl_SetObjResult(interp, res); return (result); } } else { p = (long *)page; /* * If any value is not the same, return 0 (is not set to * this value). Otherwise, if we finish the loop, we return 1 * (is set to this value). */ for (endp = p + (pgsz/sizeof(long)); p < endp; p++) if (*p != newval) { res = Tcl_NewIntObj(0); Tcl_SetObjResult(interp, res); return (result); } } res = Tcl_NewIntObj(1); Tcl_SetObjResult(interp, res); return (result); } #endif