From: Chris Hanson Date: Tue, 29 Jan 2008 06:09:55 +0000 (+0000) Subject: Update RC-code tables for version 4.6. Implement Scheme program to X-Git-Tag: 20090517-FFI~375 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3f0d2f2bfe7c16c0b981910e1ad903aa77781c29;p=mit-scheme.git Update RC-code tables for version 4.6. Implement Scheme program to generate the tables automatically. --- diff --git a/v7/src/microcode/prdb4.c b/v7/src/microcode/prdb4.c index a876c5850..bf613048c 100644 --- a/v7/src/microcode/prdb4.c +++ b/v7/src/microcode/prdb4.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: prdb4.c,v 1.8 2007/04/22 16:31:23 cph Exp $ +$Id: prdb4.c,v 1.9 2008/01/29 06:09:54 cph Exp $ Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, @@ -26,7 +26,8 @@ USA. */ /* Interface to the Berkeley DB library - Tested with versions 4.2 and 4.3 */ + Compiles under versions 4.2 through 4.6. + Tested with versions 4.2 and 4.3. */ #include "scheme.h" #include "prims.h" @@ -41,13 +42,6 @@ USA. + (DB_VERSION_MINOR * 0x100) \ + DB_VERSION_PATCH) -#if (UNIFIED_VERSION >= 0x040300) -# define VERSION_43 1 -#endif -#if (UNIFIED_VERSION >= 0x040400) -# define VERSION_44 1 -#endif - #define ARG_DB(n) ((DB *) (arg_ulong_integer (n))) #define ARG_DB_ENV(n) ((DB_ENV *) (arg_ulong_integer (n))) #define ARG_DB_TXN(n) ((DB_TXN *) (arg_ulong_integer (n))) @@ -72,68 +66,94 @@ DEFINE_PRIMITIVE ("DB4:RC->NAME", Prim_db4_rc_to_name, 1, 1, 0) switch (rc) { RC_TO_NAME_CASE (0, "ok"); -#ifdef VERSION_43 + RC_TO_NAME_CASE (EINVAL, "einval"); + RC_TO_NAME_CASE (ENOMEM, "enomem"); + RC_TO_NAME_CASE (EAGAIN, "eagain"); + RC_TO_NAME_CASE (ENOSPC, "enospc"); + RC_TO_NAME_CASE (ENOENT, "enoent"); + RC_TO_NAME_CASE (EACCES, "eacces"); + + /* The remainder of this switch is generated by "prdb4.scm". + Make no changes here! */ + + RC_TO_NAME_CASE (DB_ALREADY_ABORTED, "db_already_aborted"); +#if (UNIFIED_VERSION >= 040300) RC_TO_NAME_CASE (DB_BUFFER_SMALL, "db_buffer_small"); #endif + RC_TO_NAME_CASE (DB_DELETED, "db_deleted"); RC_TO_NAME_CASE (DB_DONOTINDEX, "db_donotindex"); -#ifndef VERSION_43 +#if (UNIFIED_VERSION >= 040600) + RC_TO_NAME_CASE (DB_EVENT_NOT_HANDLED, "db_event_not_handled"); +#endif +#if (UNIFIED_VERSION < 040300) RC_TO_NAME_CASE (DB_FILEOPEN, "db_fileopen"); #endif RC_TO_NAME_CASE (DB_KEYEMPTY, "db_keyempty"); RC_TO_NAME_CASE (DB_KEYEXIST, "db_keyexist"); RC_TO_NAME_CASE (DB_LOCK_DEADLOCK, "db_lock_deadlock"); +#if (UNIFIED_VERSION < 040400) + RC_TO_NAME_CASE (DB_LOCK_NOTEXIST, "db_lock_notexist"); +#endif RC_TO_NAME_CASE (DB_LOCK_NOTGRANTED, "db_lock_notgranted"); -#ifdef VERSION_43 +#if (UNIFIED_VERSION >= 040300) RC_TO_NAME_CASE (DB_LOG_BUFFER_FULL, "db_log_buffer_full"); #endif + RC_TO_NAME_CASE (DB_NEEDSPLIT, "db_needsplit"); RC_TO_NAME_CASE (DB_NOSERVER, "db_noserver"); RC_TO_NAME_CASE (DB_NOSERVER_HOME, "db_noserver_home"); RC_TO_NAME_CASE (DB_NOSERVER_ID, "db_noserver_id"); RC_TO_NAME_CASE (DB_NOTFOUND, "db_notfound"); RC_TO_NAME_CASE (DB_OLD_VERSION, "db_old_version"); RC_TO_NAME_CASE (DB_PAGE_NOTFOUND, "db_page_notfound"); +#if (UNIFIED_VERSION >= 040400) + RC_TO_NAME_CASE (DB_REP_BULKOVF, "db_rep_bulkovf"); +#endif RC_TO_NAME_CASE (DB_REP_DUPMASTER, "db_rep_dupmaster"); +#if (UNIFIED_VERSION >= 040300) + RC_TO_NAME_CASE (DB_REP_EGENCHG, "db_rep_egenchg"); +#endif RC_TO_NAME_CASE (DB_REP_HANDLE_DEAD, "db_rep_handle_dead"); RC_TO_NAME_CASE (DB_REP_HOLDELECTION, "db_rep_holdelection"); +#if (UNIFIED_VERSION >= 040400) + RC_TO_NAME_CASE (DB_REP_IGNORE, "db_rep_ignore"); +#endif RC_TO_NAME_CASE (DB_REP_ISPERM, "db_rep_isperm"); +#if (UNIFIED_VERSION >= 040400) + RC_TO_NAME_CASE (DB_REP_JOIN_FAILURE, "db_rep_join_failure"); +#endif +#if (UNIFIED_VERSION >= 040600) + RC_TO_NAME_CASE (DB_REP_LEASE_EXPIRED, "db_rep_lease_expired"); +#endif +#if (UNIFIED_VERSION >= 040400) + RC_TO_NAME_CASE (DB_REP_LOCKOUT, "db_rep_lockout"); +#endif +#if (UNIFIED_VERSION >= 040300) + RC_TO_NAME_CASE (DB_REP_LOGREADY, "db_rep_logready"); +#endif RC_TO_NAME_CASE (DB_REP_NEWMASTER, "db_rep_newmaster"); RC_TO_NAME_CASE (DB_REP_NEWSITE, "db_rep_newsite"); RC_TO_NAME_CASE (DB_REP_NOTPERM, "db_rep_notperm"); -#ifndef VERSION_43 +#if (UNIFIED_VERSION < 040300) RC_TO_NAME_CASE (DB_REP_OUTDATED, "db_rep_outdated"); #endif -#ifdef VERSION_43 +#if (UNIFIED_VERSION >= 040300) + RC_TO_NAME_CASE (DB_REP_PAGEDONE, "db_rep_pagedone"); +#endif +#if (UNIFIED_VERSION >= 040300) && (UNIFIED_VERSION < 040500) RC_TO_NAME_CASE (DB_REP_STARTUPDONE, "db_rep_startupdone"); #endif RC_TO_NAME_CASE (DB_REP_UNAVAIL, "db_rep_unavail"); RC_TO_NAME_CASE (DB_RUNRECOVERY, "db_runrecovery"); RC_TO_NAME_CASE (DB_SECONDARY_BAD, "db_secondary_bad"); - RC_TO_NAME_CASE (DB_VERIFY_BAD, "db_verify_bad"); -#ifdef VERSION_43 - RC_TO_NAME_CASE (DB_VERSION_MISMATCH, "db_version_mismatch"); -#endif - RC_TO_NAME_CASE (DB_ALREADY_ABORTED, "db_already_aborted"); - RC_TO_NAME_CASE (DB_DELETED, "db_deleted"); -#ifndef VERSION_44 - RC_TO_NAME_CASE (DB_LOCK_NOTEXIST, "db_lock_notexist"); -#endif - RC_TO_NAME_CASE (DB_NEEDSPLIT, "db_needsplit"); -#ifdef VERSION_43 - RC_TO_NAME_CASE (DB_REP_EGENCHG, "db_rep_egenchg"); - RC_TO_NAME_CASE (DB_REP_LOGREADY, "db_rep_logready"); - RC_TO_NAME_CASE (DB_REP_PAGEDONE, "db_rep_pagedone"); -#endif RC_TO_NAME_CASE (DB_SURPRISE_KID, "db_surprise_kid"); RC_TO_NAME_CASE (DB_SWAPBYTES, "db_swapbytes"); RC_TO_NAME_CASE (DB_TIMEOUT, "db_timeout"); RC_TO_NAME_CASE (DB_TXN_CKP, "db_txn_ckp"); + RC_TO_NAME_CASE (DB_VERIFY_BAD, "db_verify_bad"); RC_TO_NAME_CASE (DB_VERIFY_FATAL, "db_verify_fatal"); - RC_TO_NAME_CASE (EINVAL, "einval"); - RC_TO_NAME_CASE (ENOMEM, "enomem"); - RC_TO_NAME_CASE (EAGAIN, "eagain"); - RC_TO_NAME_CASE (ENOSPC, "enospc"); - RC_TO_NAME_CASE (ENOENT, "enoent"); - RC_TO_NAME_CASE (EACCES, "eacces"); +#if (UNIFIED_VERSION >= 040300) + RC_TO_NAME_CASE (DB_VERSION_MISMATCH, "db_version_mismatch"); +#endif } } PRIMITIVE_RETURN (SHARP_F); @@ -149,68 +169,94 @@ DEFINE_PRIMITIVE ("DB4:NAME->RC", Prim_db4_name_to_rc, 1, 1, 0) { const char * name = (arg_interned_symbol (1)); NAME_TO_RC_CASE ("ok", 0); -#ifdef VERSION_43 + NAME_TO_RC_CASE ("einval", EINVAL); + NAME_TO_RC_CASE ("enomem", ENOMEM); + NAME_TO_RC_CASE ("eagain", EAGAIN); + NAME_TO_RC_CASE ("enospc", ENOSPC); + NAME_TO_RC_CASE ("enoent", ENOENT); + NAME_TO_RC_CASE ("eacces", EACCES); + + /* The remainder of this switch is generated by "prdb4.scm". + Make no changes here! */ + + NAME_TO_RC_CASE ("db_already_aborted", DB_ALREADY_ABORTED); +#if (UNIFIED_VERSION >= 040300) NAME_TO_RC_CASE ("db_buffer_small", DB_BUFFER_SMALL); #endif + NAME_TO_RC_CASE ("db_deleted", DB_DELETED); NAME_TO_RC_CASE ("db_donotindex", DB_DONOTINDEX); -#ifndef VERSION_43 +#if (UNIFIED_VERSION >= 040600) + NAME_TO_RC_CASE ("db_event_not_handled", DB_EVENT_NOT_HANDLED); +#endif +#if (UNIFIED_VERSION < 040300) NAME_TO_RC_CASE ("db_fileopen", DB_FILEOPEN); #endif NAME_TO_RC_CASE ("db_keyempty", DB_KEYEMPTY); NAME_TO_RC_CASE ("db_keyexist", DB_KEYEXIST); NAME_TO_RC_CASE ("db_lock_deadlock", DB_LOCK_DEADLOCK); +#if (UNIFIED_VERSION < 040400) + NAME_TO_RC_CASE ("db_lock_notexist", DB_LOCK_NOTEXIST); +#endif NAME_TO_RC_CASE ("db_lock_notgranted", DB_LOCK_NOTGRANTED); -#ifdef VERSION_43 +#if (UNIFIED_VERSION >= 040300) NAME_TO_RC_CASE ("db_log_buffer_full", DB_LOG_BUFFER_FULL); #endif + NAME_TO_RC_CASE ("db_needsplit", DB_NEEDSPLIT); NAME_TO_RC_CASE ("db_noserver", DB_NOSERVER); NAME_TO_RC_CASE ("db_noserver_home", DB_NOSERVER_HOME); NAME_TO_RC_CASE ("db_noserver_id", DB_NOSERVER_ID); NAME_TO_RC_CASE ("db_notfound", DB_NOTFOUND); NAME_TO_RC_CASE ("db_old_version", DB_OLD_VERSION); NAME_TO_RC_CASE ("db_page_notfound", DB_PAGE_NOTFOUND); +#if (UNIFIED_VERSION >= 040400) + NAME_TO_RC_CASE ("db_rep_bulkovf", DB_REP_BULKOVF); +#endif NAME_TO_RC_CASE ("db_rep_dupmaster", DB_REP_DUPMASTER); +#if (UNIFIED_VERSION >= 040300) + NAME_TO_RC_CASE ("db_rep_egenchg", DB_REP_EGENCHG); +#endif NAME_TO_RC_CASE ("db_rep_handle_dead", DB_REP_HANDLE_DEAD); NAME_TO_RC_CASE ("db_rep_holdelection", DB_REP_HOLDELECTION); +#if (UNIFIED_VERSION >= 040400) + NAME_TO_RC_CASE ("db_rep_ignore", DB_REP_IGNORE); +#endif NAME_TO_RC_CASE ("db_rep_isperm", DB_REP_ISPERM); +#if (UNIFIED_VERSION >= 040400) + NAME_TO_RC_CASE ("db_rep_join_failure", DB_REP_JOIN_FAILURE); +#endif +#if (UNIFIED_VERSION >= 040600) + NAME_TO_RC_CASE ("db_rep_lease_expired", DB_REP_LEASE_EXPIRED); +#endif +#if (UNIFIED_VERSION >= 040400) + NAME_TO_RC_CASE ("db_rep_lockout", DB_REP_LOCKOUT); +#endif +#if (UNIFIED_VERSION >= 040300) + NAME_TO_RC_CASE ("db_rep_logready", DB_REP_LOGREADY); +#endif NAME_TO_RC_CASE ("db_rep_newmaster", DB_REP_NEWMASTER); NAME_TO_RC_CASE ("db_rep_newsite", DB_REP_NEWSITE); NAME_TO_RC_CASE ("db_rep_notperm", DB_REP_NOTPERM); -#ifndef VERSION_43 +#if (UNIFIED_VERSION < 040300) NAME_TO_RC_CASE ("db_rep_outdated", DB_REP_OUTDATED); #endif -#ifdef VERSION_43 +#if (UNIFIED_VERSION >= 040300) + NAME_TO_RC_CASE ("db_rep_pagedone", DB_REP_PAGEDONE); +#endif +#if (UNIFIED_VERSION >= 040300) && (UNIFIED_VERSION < 040500) NAME_TO_RC_CASE ("db_rep_startupdone", DB_REP_STARTUPDONE); #endif NAME_TO_RC_CASE ("db_rep_unavail", DB_REP_UNAVAIL); NAME_TO_RC_CASE ("db_runrecovery", DB_RUNRECOVERY); NAME_TO_RC_CASE ("db_secondary_bad", DB_SECONDARY_BAD); - NAME_TO_RC_CASE ("db_verify_bad", DB_VERIFY_BAD); -#ifdef VERSION_43 - NAME_TO_RC_CASE ("db_version_mismatch", DB_VERSION_MISMATCH); -#endif - NAME_TO_RC_CASE ("db_already_aborted", DB_ALREADY_ABORTED); - NAME_TO_RC_CASE ("db_deleted", DB_DELETED); -#ifndef VERSION_44 - NAME_TO_RC_CASE ("db_lock_notexist", DB_LOCK_NOTEXIST); -#endif - NAME_TO_RC_CASE ("db_needsplit", DB_NEEDSPLIT); -#ifdef VERSION_43 - NAME_TO_RC_CASE ("db_rep_egenchg", DB_REP_EGENCHG); - NAME_TO_RC_CASE ("db_rep_logready", DB_REP_LOGREADY); - NAME_TO_RC_CASE ("db_rep_pagedone", DB_REP_PAGEDONE); -#endif NAME_TO_RC_CASE ("db_surprise_kid", DB_SURPRISE_KID); NAME_TO_RC_CASE ("db_swapbytes", DB_SWAPBYTES); NAME_TO_RC_CASE ("db_timeout", DB_TIMEOUT); NAME_TO_RC_CASE ("db_txn_ckp", DB_TXN_CKP); + NAME_TO_RC_CASE ("db_verify_bad", DB_VERIFY_BAD); NAME_TO_RC_CASE ("db_verify_fatal", DB_VERIFY_FATAL); - NAME_TO_RC_CASE ("einval", EINVAL); - NAME_TO_RC_CASE ("enomem", ENOMEM); - NAME_TO_RC_CASE ("eagain", EAGAIN); - NAME_TO_RC_CASE ("enospc", ENOSPC); - NAME_TO_RC_CASE ("enoent", ENOENT); - NAME_TO_RC_CASE ("eacces", EACCES); +#if (UNIFIED_VERSION >= 040300) + NAME_TO_RC_CASE ("db_version_mismatch", DB_VERSION_MISMATCH); +#endif } error_bad_range_arg (1); PRIMITIVE_RETURN (UNSPECIFIC); @@ -274,7 +320,7 @@ DEFINE_PRIMITIVE ("DB4:DB-GET-ENV", Prim_db4_db_get_env, 2, 2, 0) { DB * db = (ARG_DB (1)); SCHEME_OBJECT p = (ARG_REF (2)); -#ifdef VERSION_43 +#if (UNIFIED_VERSION >= 0x040300) DB_ENV * db_env = ((db -> get_env) (db)); SET_PAIR_CAR (p, (ANY_TO_UINT (db_env))); RETURN_RC (0); @@ -360,7 +406,7 @@ DEFINE_PRIMITIVE ("DB4:DB-GET-TRANSACTIONAL", Prim_db4_db_get_transactional, 2, { DB * db = (ARG_DB (1)); SCHEME_OBJECT p = (ARG_REF (2)); -#ifdef VERSION_43 +#if (UNIFIED_VERSION >= 0x040300) SET_PAIR_CAR (p, (BOOLEAN_TO_OBJECT ((db -> get_transactional) (db)))); RETURN_RC (0); #else diff --git a/v7/src/microcode/prdb4.scm b/v7/src/microcode/prdb4.scm new file mode 100644 index 000000000..88db23a79 --- /dev/null +++ b/v7/src/microcode/prdb4.scm @@ -0,0 +1,361 @@ +#| -*-Scheme-*- + +$Id: prdb4.scm,v 1.1 2008/01/29 06:09:55 cph Exp $ + +Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994, + 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, + 2006, 2007 Massachusetts Institute of Technology + +This file is part of MIT/GNU Scheme. + +MIT/GNU Scheme is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 2 of the License, or (at +your option) any later version. + +MIT/GNU Scheme is distributed in the hope that it will be useful, but +WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +General Public License for more details. + +You should have received a copy of the GNU General Public License +along with MIT/GNU Scheme; if not, write to the Free Software +Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, +USA. + +|# + +;;;; Program to generate db4 code tables + +(declare (usual-integrations)) + +(define (write-forward-map entries port) + (write-map entries port + (lambda (name port) + (write-string " RC_TO_NAME_CASE (" port) + (write-string name port) + (write-string ", \"" port) + (write-string (string-downcase name) port) + (write-string "\");" port) + (newline port)))) + +(define (write-backward-map entries port) + (write-map entries port + (lambda (name port) + (write-string " NAME_TO_RC_CASE (\"" port) + (write-string (string-downcase name) port) + (write-string "\", " port) + (write-string name port) + (write-string ");" port) + (newline port)))) + +(define (write-map entries port write-entry) + (for-each (lambda (entry) + (let ((name (car entry)) + (changes (cdr entry))) + (if (pair? changes) + (begin + (write-conditional-start changes port) + (write-entry name port) + (write-conditional-end port)) + (write-entry name port)))) + entries)) + +(define (write-conditional-start changes port) + (write-string "#if " port) + (write-predicate changes port) + (newline port)) + +(define (write-conditional-end port) + (write-string "#endif" port) + (newline port)) + +(define (write-predicate changes port) + (write-comparison (caar changes) (cadar changes) port) + (for-each (lambda (change) + (write-string " && " port) + (write-comparison (car change) (cadr change) port)) + (cdr changes))) + +(define (write-comparison action version port) + (write-string "(UNIFIED_VERSION " port) + (write-string (case action + ((added) ">=") + ((removed) "<") + (else (error "Unknown action:" action))) + port) + (write-string " " port) + (write-string version port) + (write-string ")" port)) + +(define (generate-changes) + (let ((table (make-string-hash-table)) + (groups + (sort (map (lambda (group) + (cons (car group) + (sort (cdr group) stringalist table)) + (lambda (e1 e2) + (string