Menu
▾
▴
clisp-cvs digest, Vol 1 #632 - 10 msgs
|
From: <cli...@li...> - 2004-08-02 19:44:03
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/modules/berkeley-db bdb.c,1.45,1.46 (Sam Steingold) 2. clisp/src ChangeLog,1.3360,1.3361 (Sam Steingold) 3. clisp/modules/berkeley-db bdb.c,1.46,1.47 (Sam Steingold) 4. clisp/src ChangeLog,1.3361,1.3362 (Sam Steingold) 5. clisp/src clos-methcomb3.lisp,1.4,1.5 (Bruno Haible) 6. clisp/src clos-methcomb4.lisp,1.2,1.3 (Bruno Haible) 7. clisp/src/po Makefile.devel,1.29,1.30 (Bruno Haible) 8. clisp/src clos.lisp,1.90,1.91 clos-methcomb1.lisp,1.11,1.12 clos-methcomb2.lisp,1.33,1.34 clos-genfun3.lisp,1.11,1.12 clos-genfun5.lisp,1.8,1.9 makemake.in,1.461,1.462 ChangeLog,1.3362,1.3363 (Bruno Haible) 9. clisp/src ChangeLog,1.3363,1.3364 (Sam Steingold) 10. clisp/modules/berkeley-db bdb.c,1.47,1.48 (Sam Steingold) --__--__-- Message: 1 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/modules/berkeley-db bdb.c,1.45,1.46 Date: Mon, 02 Aug 2004 03:58:01 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/berkeley-db In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23788 Modified Files: bdb.c Log Message: (BDB:LOG-FILE): use BUFSIZ instead of non-existent MAX_PATH Index: bdb.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/bdb.c,v retrieving revision 1.45 retrieving revision 1.46 diff -u -d -r1.45 -r1.46 --- bdb.c 27 Jul 2004 15:34:47 -0000 1.45 +++ bdb.c 2 Aug 2004 03:57:58 -0000 1.46 @@ -1934,9 +1934,9 @@ { /* return the name of the file containing the record named by lsn. */ DB_LSN lsn; DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); - char path[MAX_PATH]; + char path[BUFSIZ]; check_lsn(&STACK_0,&lsn); - SYSCALL(dbe->log_file,(dbe,&lsn,path,MAX_PATH)); + SYSCALL(dbe->log_file,(dbe,&lsn,path,BUFSIZ)); VALUES1(asciz_to_string(path,GLO(pathname_encoding))); skipSTACK(2); } --__--__-- Message: 2 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3360,1.3361 Date: Mon, 02 Aug 2004 03:58:32 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23857/src Modified Files: ChangeLog Log Message: (BDB:LOG-FILE): use BUFSIZ instead of non-existent MAX_PATH Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3360 retrieving revision 1.3361 diff -u -d -r1.3360 -r1.3361 --- ChangeLog 30 Jul 2004 21:34:18 -0000 1.3360 +++ ChangeLog 2 Aug 2004 03:58:23 -0000 1.3361 @@ -1,3 +1,8 @@ +2004-07-31 Sam Steingold <sd...@gn...> + + * modules/berkeley-db/bdb.c (BDB:LOG-FILE): use BUFSIZ instead of + non-existent MAX_PATH + 2004-07-30 Sam Steingold <sd...@gn...> * modules/syscalls/calls.c (POSIX:SYSCONF, POSIX:CONFSTR) --__--__-- Message: 3 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/modules/berkeley-db bdb.c,1.46,1.47 Date: Mon, 02 Aug 2004 04:00:17 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/berkeley-db In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24135/modules/berkeley-db Modified Files: bdb.c Log Message: (BDB:DB-PUT): do not discard db->put() return value Index: bdb.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/bdb.c,v retrieving revision 1.46 retrieving revision 1.47 diff -u -d -r1.46 -r1.47 --- bdb.c 2 Aug 2004 03:57:58 -0000 1.46 +++ bdb.c 2 Aug 2004 04:00:14 -0000 1.47 @@ -1269,7 +1269,7 @@ case DB_NODUPDATA: case DB_NOOVERWRITE: { int status; begin_system_call(); - db->put(db,txn,&key,&val,action | flags); + status = db->put(db,txn,&key,&val,action | flags); free(val.data); free(key.data); end_system_call(); switch (status) { --__--__-- Message: 4 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3361,1.3362 Date: Mon, 02 Aug 2004 04:00:16 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv24135/src Modified Files: ChangeLog Log Message: (BDB:DB-PUT): do not discard db->put() return value Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3361 retrieving revision 1.3362 diff -u -d -r1.3361 -r1.3362 --- ChangeLog 2 Aug 2004 03:58:23 -0000 1.3361 +++ ChangeLog 2 Aug 2004 04:00:13 -0000 1.3362 @@ -2,6 +2,7 @@ * modules/berkeley-db/bdb.c (BDB:LOG-FILE): use BUFSIZ instead of non-existent MAX_PATH + (BDB:DB-PUT): do not discard db->put() return value 2004-07-30 Sam Steingold <sd...@gn...> --__--__-- Message: 5 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-methcomb3.lisp,1.4,1.5 Date: Mon, 02 Aug 2004 10:39:56 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11283/src Added Files: clos-methcomb3.lisp Log Message: initialize-instance methods for method-combination class. --- NEW FILE: clos-methcomb3.lisp --- ;;;; Common Lisp Object System for CLISP ;;;; Method Combination ;;;; Part n-2: make/initialize-instance methods. ;;;; Bruno Haible 2004-06-10 (in-package "CLOS") ;;; Lift the initialization protocol. (defmethod initialize-instance ((combination method-combination) &rest args &key name documentation check-options expander check-method-qualifiers call-next-method-allowed declarations qualifiers operator identity-with-one-argument long-expander arguments-lambda-list options) (declare (ignore name documentation check-options expander check-method-qualifiers call-next-method-allowed declarations qualifiers operator identity-with-one-argument long-expander arguments-lambda-list options)) (apply #'initialize-instance-<method-combination> combination args)) (defmethod reinitialize-instance ((instance method-combination) &rest initargs) (declare (ignore initargs)) (error (TEXT "~S: It is not allowed to reinitialize ~S") 'reinitialize-instance instance)) --__--__-- Message: 6 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos-methcomb4.lisp,1.2,1.3 Date: Mon, 02 Aug 2004 10:40:35 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11396/src Added Files: clos-methcomb4.lisp Log Message: Generic functions for method-combination. --- NEW FILE: clos-methcomb4.lisp --- ;;;; Common Lisp Object System for CLISP ;;;; Method Combination ;;;; Part n-1: Generic functions specified in the MOP. ;;;; Bruno Haible 2004-06-10 (in-package "CLOS") ;; Make creation of <method-combination> instances customizable. (setf (fdefinition 'make-instance-<method-combination>) #'make-instance) ;; MOP p. 54 (fmakunbound 'find-method-combination) (defgeneric find-method-combination (generic-function name options) (:method ((gf generic-function) (name symbol) options) (find-method-combination-<generic-function>-<symbol> gf name options))) --__--__-- Message: 7 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src/po Makefile.devel,1.29,1.30 Date: Mon, 02 Aug 2004 10:42:13 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src/po In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11446/src/po Modified Files: Makefile.devel Log Message: Define method-combination as a subclass of standard-object instead of structure-object, using defclass instead of defstruct. Index: Makefile.devel =================================================================== RCS file: /cvsroot/clisp/clisp/src/po/Makefile.devel,v retrieving revision 1.29 retrieving revision 1.30 diff -u -d -r1.29 -r1.30 --- Makefile.devel 26 Jul 2004 08:59:34 -0000 1.29 +++ Makefile.devel 2 Aug 2004 10:42:10 -0000 1.30 @@ -57,7 +57,7 @@ clos-class4 clos-class5 clos-class6 \ clos-slotdef2 clos-slotdef3 clos-slots1 clos-slots2 \ clos-method1 clos-method2 clos-method3 clos-method4 \ - clos-methcomb1 clos-methcomb2 \ + clos-methcomb1 clos-methcomb2 clos-methcomb3 clos-methcomb4 \ clos-genfun1 clos-genfun2 clos-genfun3 clos-genfun4 clos-genfun5 \ clos-print documentation \ fill-out disassem condition loadform gstream xcharin keyboard \ --__--__-- Message: 8 From: Bruno Haible <ha...@us...> To: cli...@li... Subject: clisp/src clos.lisp,1.90,1.91 clos-methcomb1.lisp,1.11,1.12 clos-methcomb2.lisp,1.33,1.34 clos-genfun3.lisp,1.11,1.12 clos-genfun5.lisp,1.8,1.9 makemake.in,1.461,1.462 ChangeLog,1.3362,1.3363 Date: Mon, 02 Aug 2004 10:42:12 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv11446/src Modified Files: clos.lisp clos-methcomb1.lisp clos-methcomb2.lisp clos-genfun3.lisp clos-genfun5.lisp makemake.in ChangeLog Log Message: Define method-combination as a subclass of standard-object instead of structure-object, using defclass instead of defstruct. Index: clos-genfun5.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun5.lisp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- clos-genfun5.lisp 29 Jul 2004 11:05:13 -0000 1.8 +++ clos-genfun5.lisp 2 Aug 2004 10:42:09 -0000 1.9 @@ -134,12 +134,6 @@ (sort-applicable-methods methods req-args (gf-argorder gf))) nil)))) ; rather no error -;; MOP p. 54 -(fmakunbound 'find-method-combination) -(defgeneric find-method-combination (generic-function name options) - (:method ((gf generic-function) (name symbol) options) - (find-method-combination-<generic-function>-<symbol> gf name options))) - ;; MOP p. 41 (fmakunbound 'compute-effective-method) (defgeneric compute-effective-method (gf combination methods) Index: clos-methcomb1.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-methcomb1.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- clos-methcomb1.lisp 12 Jul 2004 15:46:44 -0000 1.11 +++ clos-methcomb1.lisp 2 Aug 2004 10:42:09 -0000 1.12 @@ -6,6 +6,7 @@ (in-package "CLOS") +;;; =========================================================================== ;;; Global management of method-combinations and their names: @@ -22,6 +23,7 @@ (defun (setf get-method-combination) (new-value name) (setf (get name '%method-combination) new-value)) +;;; =========================================================================== ;;; The method-combination class definition. ;; A method-combination is used 1) without options when defined and attached @@ -30,57 +32,138 @@ ;; A structure definition is to be preferred, otherwise the compiled ;; load fails on type tests as the class can't be defined early enough ;; in the file. -(defstruct (method-combination) ; (:print-object print-object-<method-combination>) - "The method-combination class models all method combination. -The variations are handled by binding the expander function to the instance -and pairing the method-combination definition object with the option list -in the generic function instance." - - name ; a symbol naming the method combination - (documentation nil) ; an optional documentation string - (check-options nil) ; A function of 3 arguments +(defparameter <method-combination> + (defclass method-combination (metaobject) + ((name ; a symbol naming the method combination + :type symbol + :accessor method-combination-name) + (documentation ; an optional documentation string + :type (or null string) + :accessor method-combination-documentation) + (check-options ; A function of 3 arguments ; (function-name method-combination options) ; that checks the syntax of arguments to the ; method combination - (expander nil) ; A function of 4 arguments + :type function + :accessor method-combination-check-options) + (expander ; A function of 4 arguments ; (function method-combination options methods) ; which computes two values: 1. the inner body ; of the effective method, as a form containing ; (CALL-METHOD ...) forms, 2. a list of ; options describing the wrapper, such as ; (:ARGUMENTS ...) or (:GENERIC-FUNCTION ...). - (check-method-qualifiers nil) ; A function of 3 arguments + :type function + :accessor method-combination-expander) + (check-method-qualifiers ; A function of 3 arguments ; (function method-combination method) ; that checks whether the method's qualifiers ; are compatible with the method-combination. - (call-next-method-allowed nil) ; A function of 3 arguments + :type function + :accessor method-combination-check-method-qualifiers) + (call-next-method-allowed ; A function of 3 arguments ; (function method-combination method) ; telling whether call-next-method is allowed ; in the particular method. - (declarations nil) ; list to be prepended to the effective method + :type function + :accessor method-combination-call-next-method-allowed) + (declarations ; list to be prepended to the effective method ; body + :type list + :accessor method-combination-declarations) - ;; The following slots apply only to standard and short form - ;; method-combination. - (qualifiers nil) ; the allowed list of qualifiers + ;; The following slots apply only to standard and short form + ;; method-combination. + (qualifiers ; the allowed list of qualifiers + :type list + :accessor method-combination-qualifiers) - ;; The following slots apply only to short form method-combination. - (operator nil) ; a symbol - (identity-with-one-argument nil) ; true if `(operator ,x) should be replaced + ;; The following slots apply only to short form method-combination. + (operator ; a symbol + :type symbol + :accessor method-combination-operator) + (identity-with-one-argument ; true if `(operator ,x) should be replaced ; with x + :type boolean + :accessor method-combination-identity-with-one-argument) - ;; The following slots apply only to long form method-combination. - (long-expander nil) ; A function of 2+n variables + ;; The following slots apply only to long form method-combination. + (long-expander ; A function of 2+n variables ; (function methods . options) ; which computes the inner body of the effective ; method, as a form containing (CALL-METHOD ...) ; forms - (arguments-lambda-list nil) ; The :arguments option of the defined method + :type function + :accessor method-combination-long-expander) + (arguments-lambda-list ; The :arguments option of the defined method ; combination for inclusion in the effective ; method function. + :type list + :accessor method-combination-arguments-lambda-list) - ;; The following slots depend on the particular generic function. - (options nil)) ; arguments for the method combination + ;; The following slots depend on the particular generic function. + (options ; arguments for the method combination + :type list + :accessor method-combination-options)) + + (:fixed-slot-locations) + (:generic-accessors nil))) + +(defun initialize-instance-<method-combination> (combination &rest args + &key name + (documentation nil) + check-options + expander + check-method-qualifiers + call-next-method-allowed + (declarations '()) + qualifiers + operator + (identity-with-one-argument nil) + long-expander + arguments-lambda-list + (options '())) + (when *classes-finished* + (apply #'%initialize-instance combination args)) ; == (call-next-method) + (setf (method-combination-name combination) name) + (setf (method-combination-documentation combination) documentation) + (setf (method-combination-check-options combination) check-options) + (setf (method-combination-expander combination) expander) + (setf (method-combination-check-method-qualifiers combination) check-method-qualifiers) + (setf (method-combination-call-next-method-allowed combination) call-next-method-allowed) + (setf (method-combination-declarations combination) declarations) + (setf (method-combination-qualifiers combination) qualifiers) + (setf (method-combination-operator combination) operator) + (setf (method-combination-identity-with-one-argument combination) identity-with-one-argument) + (setf (method-combination-long-expander combination) long-expander) + (setf (method-combination-arguments-lambda-list combination) arguments-lambda-list) + (setf (method-combination-options combination) options) + combination) + +(defun make-instance-<method-combination> (class &rest args + &key &allow-other-keys) + ;; class = <method-combination> + ;; Don't add functionality here! This is a preliminary definition that is + ;; replaced with #'make-instance later. + (declare (ignore class)) + (let ((combination (%allocate-instance <method-combination>))) + (apply #'initialize-instance-<method-combination> combination args))) + +(defun copy-method-combination (combination) + (make-instance-<method-combination> <method-combination> + :name (method-combination-name combination) + :documentation (method-combination-documentation combination) + :check-options (method-combination-check-options combination) + :expander (method-combination-expander combination) + :check-method-qualifiers (method-combination-check-method-qualifiers combination) + :call-next-method-allowed (method-combination-call-next-method-allowed combination) + :declarations (method-combination-declarations combination) + :qualifiers (method-combination-qualifiers combination) + :operator (method-combination-operator combination) + :identity-with-one-argument (method-combination-identity-with-one-argument combination) + :long-expander (method-combination-long-expander combination) + :arguments-lambda-list (method-combination-arguments-lambda-list combination) + :options (method-combination-options combination))) (defun print-object-<method-combination> (object stream) (print-unreadable-object (object stream :identity t :type t) Index: clos.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos.lisp,v retrieving revision 1.90 retrieving revision 1.91 diff -u -d -r1.90 -r1.91 --- clos.lisp 26 Jul 2004 08:59:31 -0000 1.90 +++ clos.lisp 2 Aug 2004 10:42:08 -0000 1.91 @@ -27,6 +27,7 @@ ; Now DEFGENERIC, DEFMETHOD work. DEFCLASS works fully. (load "clos-genfun5") (load "clos-method3") +(load "clos-methcomb3") (load "clos-slots2") (load "clos-slotdef2") (load "clos-stablehash2") @@ -39,6 +40,7 @@ (load "clos-specializer3") (load "clos-class6") (load "clos-method4") +(load "clos-methcomb4") (load "clos-print") (load "documentation") Index: clos-genfun3.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-genfun3.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- clos-genfun3.lisp 30 Jul 2004 11:58:43 -0000 1.11 +++ clos-genfun3.lisp 2 Aug 2004 10:42:09 -0000 1.12 @@ -305,7 +305,7 @@ ;; or, in the case of invocation from ensure-generic-function, ;; a method-combination object with options. (let ((designator (cadr option))) - (if (or (method-combination-p designator) + (if (or (typep designator <method-combination>) (and designator (symbolp designator))) (setf method-combination (rest option)) (error-of-type 'sys::source-program-error Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3362 retrieving revision 1.3363 diff -u -d -r1.3362 -r1.3363 --- ChangeLog 2 Aug 2004 04:00:13 -0000 1.3362 +++ ChangeLog 2 Aug 2004 10:42:09 -0000 1.3363 @@ -1,3 +1,23 @@ +2004-06-10 Bruno Haible <br...@cl...> + + * clos.lisp: Load clos-methcomb3, clos-methcomb4. + * clos-methcomb1.lisp (method-combination): Define using defclass, + as subclass of metaobject. + (<method-combination>): New variable. + (initialize-instance-<method-combination>, + make-instance-<method-combination>, copy-method-combination): New + functions. + * clos-methcomb2.lisp: Use make-instance-<method-combination> instead + of make-method-combination. + * clos-methcomb3.lisp: New file. + * clos-methcomb4.lisp: New file. + * clos-genfun3.lisp (analyze-defgeneric): Use typep instead of + method-combination-p. + * clos-genfun5.lisp (find-method-combination): Moved to + clos-methcomb4.lisp. + * makemake.in (LPARTS): Add clos-methcomb3, clos-methcomb4. + * po/Makefile.devel (LISPSOURCES): Likewise. + 2004-07-31 Sam Steingold <sd...@gn...> * modules/berkeley-db/bdb.c (BDB:LOG-FILE): use BUFSIZ instead of Index: makemake.in =================================================================== RCS file: /cvsroot/clisp/clisp/src/makemake.in,v retrieving revision 1.461 retrieving revision 1.462 diff -u -d -r1.461 -r1.462 --- makemake.in 26 Jul 2004 08:59:31 -0000 1.461 +++ makemake.in 2 Aug 2004 10:42:09 -0000 1.462 @@ -1436,7 +1436,7 @@ LPARTS=$LPARTS' clos-class4 clos-class5 clos-class6' LPARTS=$LPARTS' clos-slotdef2 clos-slotdef3 clos-slots1 clos-slots2' LPARTS=$LPARTS' clos-method1 clos-method2 clos-method3 clos-method4' -LPARTS=$LPARTS' clos-methcomb1 clos-methcomb2' +LPARTS=$LPARTS' clos-methcomb1 clos-methcomb2 clos-methcomb3 clos-methcomb4' LPARTS=$LPARTS' clos-genfun1 clos-genfun2 clos-genfun3 clos-genfun4 clos-genfun5' LPARTS=$LPARTS' clos-print documentation' LPARTS=$LPARTS' fill-out disassem condition loadform gstream xcharin keyboard' Index: clos-methcomb2.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/src/clos-methcomb2.lisp,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- clos-methcomb2.lisp 30 Jul 2004 11:58:43 -0000 1.33 +++ clos-methcomb2.lisp 2 Aug 2004 10:42:09 -0000 1.34 @@ -705,7 +705,7 @@ (or (equal qualifiers '()) (equal qualifiers '(:around))))) (setf (get-method-combination 'standard) - (make-method-combination + (make-instance-<method-combination> <method-combination> :name 'standard :documentation "the STANDARD METHOD-COMBINATION object" :qualifiers '(:before :after :around) @@ -770,7 +770,7 @@ ;;; Predefined method combinations. (dolist (name '(+ and append list max min nconc or progn)) (setf (get-method-combination name) - (make-method-combination + (make-instance-<method-combination> <method-combination> :name name :operator name :qualifiers (list name ':around) :identity-with-one-argument (not (eq name 'list)) @@ -1217,7 +1217,8 @@ "Support function for the DEFINE-METHOD-COMBINATION macro, which performs the instantiation and registration and returns NAME." (let ((method-combination - (apply #'make-method-combination :name name initargs))) + (apply #'make-instance-<method-combination> <method-combination> + :name name initargs))) (setf (get-method-combination name) method-combination) name)) --__--__-- Message: 9 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/src ChangeLog,1.3363,1.3364 Date: Mon, 02 Aug 2004 19:42:19 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17505/src Modified Files: ChangeLog Log Message: (object_handle): renamed to ... (bdb_handle): ... to avoid a non-existent conflict with foreign.d Index: ChangeLog =================================================================== RCS file: /cvsroot/clisp/clisp/src/ChangeLog,v retrieving revision 1.3363 retrieving revision 1.3364 diff -u -d -r1.3363 -r1.3364 --- ChangeLog 2 Aug 2004 10:42:09 -0000 1.3363 +++ ChangeLog 2 Aug 2004 19:42:14 -0000 1.3364 @@ -1,3 +1,8 @@ +2004-08-02 Sam Steingold <sd...@gn...> + + * modules/berkeley-db/bdb.c (object_handle): renamed to ... + (bdb_handle): ... to avoid a non-existent conflict with foreign.d + 2004-06-10 Bruno Haible <br...@cl...> * clos.lisp: Load clos-methcomb3, clos-methcomb4. --__--__-- Message: 10 From: Sam Steingold <sd...@us...> To: cli...@li... Subject: clisp/modules/berkeley-db bdb.c,1.47,1.48 Date: Mon, 02 Aug 2004 19:42:19 +0000 Reply-To: cli...@li... Update of /cvsroot/clisp/clisp/modules/berkeley-db In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17505/modules/berkeley-db Modified Files: bdb.c Log Message: (object_handle): renamed to ... (bdb_handle): ... to avoid a non-existent conflict with foreign.d Index: bdb.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/bdb.c,v retrieving revision 1.47 retrieving revision 1.48 diff -u -d -r1.47 -r1.48 --- bdb.c 2 Aug 2004 04:00:14 -0000 1.47 +++ bdb.c 2 Aug 2004 19:42:17 -0000 1.48 @@ -120,15 +120,15 @@ /* check whether the OBJ has type TYPE and return its handle can trigger GC */ typedef enum { - OH_VALID, /* return a valid handle */ - OH_INVALIDATE, /* invalidate and return handle, NULL for invalid FP */ - OH_NIL_IS_NULL, /* return either NULL for NIL or a valid handle */ - OH_INVALID_IS_NULL /* return either NULL for invalid or a valid handle */ -} object_handle_t; -static void* object_handle (object obj, object type, object_handle_t oh) { - object_handle_restart: + BH_VALID, /* return a valid handle */ + BH_INVALIDATE, /* invalidate and return handle, NULL for invalid FP */ + BH_NIL_IS_NULL, /* return either NULL for NIL or a valid handle */ + BH_INVALID_IS_NULL /* return either NULL for invalid or a valid handle */ +} bdb_handle_t; +static void* bdb_handle (object obj, object type, bdb_handle_t oh) { + bdb_handle_restart: while (!typep_classname(obj,type)) { - if (missingp(obj) && oh == OH_NIL_IS_NULL) return NULL; + if (missingp(obj) && oh == BH_NIL_IS_NULL) return NULL; pushSTACK(type); /* save */ pushSTACK(NIL); /* no PLACE */ pushSTACK(obj); /* TYPE-ERROR slot DATUM */ @@ -140,7 +140,7 @@ { Fpointer fp = TheFpointer(TheStructure(obj)->recdata[1]); if (!fp_validp(fp)) { switch (oh) { - case OH_INVALIDATE: case OH_INVALID_IS_NULL: + case BH_INVALIDATE: case BH_INVALID_IS_NULL: return NULL; default: pushSTACK(type); /* save */ @@ -148,10 +148,10 @@ pushSTACK(obj); pushSTACK(TheSubr(subr_self)->name); check_value(type_error,GETTEXT("~S: ~S has been closed or comes from a previous Lisp session")); obj = value1; type = popSTACK(); /* restore */ - goto object_handle_restart; + goto bdb_handle_restart; } } - if (oh == OH_INVALIDATE) mark_fp_invalid(fp); + if (oh == BH_INVALIDATE) mark_fp_invalid(fp); return fp->fp_pointer; } } @@ -207,7 +207,7 @@ status = dbe->set_rpc_server(dbe,NULL,hostz,cl_timeout,sv_timeout,0); end_system_call(); }); - } else if ((dbe_cl = object_handle(STACK_2,`BDB::DBE`,OH_NIL_IS_NULL))) { + } else if ((dbe_cl = bdb_handle(STACK_2,`BDB::DBE`,BH_NIL_IS_NULL))) { /* reuse client */ begin_system_call(); status = dbe->set_rpc_server(dbe,dbe_cl->cl_handle,NULL, @@ -236,7 +236,7 @@ DEFUN(BDB:DBE-CLOSE, dbe) { /* close DB environment */ - DB_ENV *dbe = object_handle(STACK_0,`BDB::DBE`,OH_INVALIDATE); + DB_ENV *dbe = bdb_handle(STACK_0,`BDB::DBE`,BH_INVALIDATE); if (dbe) { funcall(`BDB::KILL-HANDLE`,1); SYSCALL(dbe->close,(dbe,0)); @@ -247,8 +247,8 @@ DEFUN(BDB:ENV-DBREMOVE, dbe file database &key :TRANSACTION :AUTO_COMMIT) { /* remove DATABASE from FILE or the whole FILE */ u_int32_t flags = (missingp(STACK_0) ? 0 : DB_AUTO_COMMIT); - DB_TXN *txn = object_handle(STACK_1,`BDB::TXN`,OH_NIL_IS_NULL); - DB_ENV *dbe = object_handle(STACK_4,`BDB::DBE`,OH_VALID); + DB_TXN *txn = bdb_handle(STACK_1,`BDB::TXN`,BH_NIL_IS_NULL); + DB_ENV *dbe = bdb_handle(STACK_4,`BDB::DBE`,BH_VALID); if (!nullp(STACK_2)) STACK_2 = check_string(STACK_2); /* DATABASE */ STACK_3 = physical_namestring(STACK_3); /* FILE */ with_string_0(STACK_3,GLO(pathname_encoding),file, { @@ -265,8 +265,8 @@ &key :TRANSACTION :AUTO_COMMIT) { /* rename DATABASE to NEWNAME in FILE */ u_int32_t flags = (missingp(STACK_0) ? 0 : DB_AUTO_COMMIT); - DB_TXN *txn = object_handle(STACK_1,`BDB::TXN`,OH_NIL_IS_NULL); - DB_ENV *dbe = object_handle(STACK_5,`BDB::DBE`,OH_VALID); + DB_TXN *txn = bdb_handle(STACK_1,`BDB::TXN`,BH_NIL_IS_NULL); + DB_ENV *dbe = bdb_handle(STACK_5,`BDB::DBE`,BH_VALID); with_string_0(physical_namestring(STACK_4),GLO(pathname_encoding),file, { with_string_0(check_string(STACK_3),GLO(misc_encoding),database, { with_string_0(check_string(STACK_2),GLO(misc_encoding),newname, { @@ -287,7 +287,7 @@ { /* open DB environment */ int mode = posfixnum_default(popSTACK()); u_int32_t flags = dbe_open_flags(); - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); if (!missingp(STACK_0)) { with_string_0(physical_namestring(STACK_0),GLO(pathname_encoding),home, { SYSCALL(dbe->open,(dbe,home,flags,mode)); }); @@ -299,7 +299,7 @@ DEFUN(BDB:DBE-REMOVE, dbe &key :HOME :FORCE :USE_ENVIRON :USE_ENVIRON_ROOT) { /* destroy an environment */ u_int32_t flags = dbe_remove_flags(); - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); if (!missingp(STACK_0)) { with_string_0(physical_namestring(STACK_0),GLO(pathname_encoding),home, { SYSCALL(dbe->remove,(dbe,home,flags)); }); @@ -385,7 +385,7 @@ :VERB_CHKPOINT :VERB_DEADLOCK :VERB_RECOVERY :VERB_REPLICATION \ :VERB_WAITSFOR :VERBOSE) { /* set many options */ - DB_ENV *dbe = object_handle(STACK_(40),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_(40),`BDB::DBE`,BH_VALID); { /* verbose */ object verbosep = popSTACK(); /* :VERBOSE - all */ set_verbose(dbe,verbosep,DB_VERB_WAITSFOR); @@ -671,9 +671,8 @@ DEFUNR(BDB:DBE-GET-OPTIONS, dbe &optional what) { object what = STACK_0; /* dbe may be NULL only for DB_XIDDATASIZE */ - DB_ENV *dbe = - object_handle(STACK_1,`BDB::DBE`, - eq(what,`:DB_XIDDATASIZE`) ? OH_NIL_IS_NULL : OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,eq(what,`:DB_XIDDATASIZE`) + ? BH_NIL_IS_NULL : BH_VALID); what = STACK_0; skipSTACK(2); restart_DBE_GET_OPTIONS: if (missingp(what)) { /* get everything */ @@ -825,7 +824,7 @@ DEFUN(BDB:DB-CREATE, dbe &key :XA) { /* create database */ u_int32_t flags = missingp(STACK_0) ? 0 : DB_XA_CREATE; - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_NIL_IS_NULL); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_NIL_IS_NULL); DB *db; SYSCALL(db_create,(&db,dbe,flags)); if (!dbe){ /* set error callback */ @@ -840,7 +839,7 @@ DEFUN(BDB:DB-CLOSE, db &key :NOSYNC) { /* Close a database */ u_int32_t flags = missingp(STACK_0) ? 0 : DB_NOSYNC; - DB *db = object_handle(STACK_1,`BDB::DB`,OH_INVALIDATE); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_INVALIDATE); if (db) { pushSTACK(STACK_1); funcall(`BDB::KILL-HANDLE`,1); SYSCALL(db->close,(db,flags)); @@ -1022,8 +1021,8 @@ DEFUN(BDB:DB-DEL, dbe key &key :TRANSACTION :AUTO_COMMIT) { /* Delete items from a database */ u_int32_t flags = (missingp(STACK_0) ? 0 : DB_AUTO_COMMIT); - DB_TXN *txn = object_handle(STACK_1,`BDB::TXN`,OH_NIL_IS_NULL); - DB *db = object_handle(STACK_3,`BDB::DB`,OH_VALID); + DB_TXN *txn = bdb_handle(STACK_1,`BDB::TXN`,BH_NIL_IS_NULL); + DB *db = bdb_handle(STACK_3,`BDB::DB`,BH_VALID); DBT key; fill_dbt(STACK_2,&key,record_length(db)); SYSCALL1(db->del,(db,txn,&key,flags),{free(key.data);}); @@ -1033,7 +1032,7 @@ DEFUN(BDB:DB-FD, db) { /* Return a file descriptor from a database */ - DB *db = object_handle(popSTACK(),`BDB::DB`,OH_VALID); + DB *db = bdb_handle(popSTACK(),`BDB::DB`,BH_VALID); int fd; SYSCALL(db->fd,(db,&fd)); VALUES1(fixnum(fd)); @@ -1046,9 +1045,9 @@ { /* Get items from a database */ dbt_o_t out_type = check_dbt_type(popSTACK()); int no_error = nullp(popSTACK()); - DB_TXN *txn = object_handle(popSTACK(),`BDB::TXN`,OH_NIL_IS_NULL); + DB_TXN *txn = bdb_handle(popSTACK(),`BDB::TXN`,BH_NIL_IS_NULL); u_int32_t flags = db_get_options() | db_get_action(popSTACK()); - DB *db = object_handle(STACK_1,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_VALID); DBT key, val; int status; fill_dbt(STACK_0,&key,record_length(db)); @@ -1072,7 +1071,7 @@ DEFUN(BDB:DB-STAT, db &key :FAST_STAT) { /* Return database statistics */ u_int32_t flags = missingp(STACK_0) ? 0 : DB_FAST_STAT; - DB *db = object_handle(STACK_1,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_VALID); int swapped_p; DBTYPE db_type; unsigned int count = 0; @@ -1177,11 +1176,11 @@ DEFUN(BDB:DB-OPEN, db file &key :DATABASE :TYPE :MODE :CREATE :DIRTY_READ \ :EXCL :NOMMAP :RDONLY :THREAD :TRUNCATE :AUTO_COMMIT :TRANSACTION) { /* Open a database */ - DB_TXN *txn = object_handle(popSTACK(),`BDB::TXN`,OH_NIL_IS_NULL); + DB_TXN *txn = bdb_handle(popSTACK(),`BDB::TXN`,BH_NIL_IS_NULL); u_int32_t flags = db_open_flags(); int mode = posfixnum_default2(popSTACK(),0644); DBTYPE db_type = check_dbtype(popSTACK()); - DB *db = object_handle(STACK_2,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_2,`BDB::DB`,BH_VALID); /* string is resolved by Berkeley-DB relative to data_dirs */ with_string_0(stringp(STACK_1) ? STACK_1 : physical_namestring(STACK_1), GLO(pathname_encoding),file, { @@ -1199,7 +1198,7 @@ DEFUN(BDB:DB-SYNC, db) { /* Flush a database to stable storage */ - DB *db = object_handle(popSTACK(),`BDB::DB`,OH_VALID); + DB *db = bdb_handle(popSTACK(),`BDB::DB`,BH_VALID); SYSCALL(db->sync,(db,0)); VALUES0; } @@ -1207,8 +1206,8 @@ DEFUN(BDB:DB-TRUNCATE, db &key :TRANSACTION :AUTO_COMMIT) { /* Empty a database */ u_int32_t flags = (missingp(STACK_0) ? 0 : DB_AUTO_COMMIT); - DB_TXN *txn = object_handle(STACK_1,`BDB::TXN`,OH_NIL_IS_NULL); - DB *db = object_handle(STACK_2,`BDB::DB`,OH_VALID); + DB_TXN *txn = bdb_handle(STACK_1,`BDB::TXN`,BH_NIL_IS_NULL); + DB *db = bdb_handle(STACK_2,`BDB::DB`,BH_VALID); u_int32_t count; SYSCALL(db->truncate,(db,txn,&count,flags)); VALUES1(UL_to_I(count)); skipSTACK(3); @@ -1217,7 +1216,7 @@ DEFUN(BDB:DB-UPGRADE, db file &key :DUPSORT) { /* Upgrade a database */ u_int32_t flags = (missingp(STACK_0) ? 0 : DB_DUPSORT); - DB *db = object_handle(STACK_2,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_2,`BDB::DB`,BH_VALID); with_string_0(physical_namestring(STACK_1),GLO(pathname_encoding),file, { SYSCALL(db->upgrade,(db,file,flags)); }); @@ -1226,7 +1225,7 @@ DEFUN(BDB:DB-RENAME, db file database newname) { /* Rename a database */ - DB *db = object_handle(STACK_3,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_3,`BDB::DB`,BH_VALID); with_string_0(physical_namestring(STACK_2),GLO(pathname_encoding),file, { with_string_0(check_string(STACK_1),GLO(misc_encoding),database, { with_string_0(check_string(STACK_0),GLO(misc_encoding),newname, { @@ -1239,7 +1238,7 @@ DEFUN(BDB:DB-REMOVE, db file database) { /* Remove a database */ - DB *db = object_handle(STACK_2,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_2,`BDB::DB`,BH_VALID); with_string_0(physical_namestring(STACK_1),GLO(pathname_encoding),file, { with_string_0(check_string(STACK_0),GLO(misc_encoding),database, { SYSCALL(db->remove,(db,file,database,0)); @@ -1252,10 +1251,10 @@ DEFFLAGSET(db_put_flags, DB_AUTO_COMMIT) DEFUN(BDB:DB-PUT, db key val &key :AUTO_COMMIT :ACTION :TRANSACTION) { /* Store items into a database */ - DB_TXN *txn = object_handle(popSTACK(),`BDB::TXN`,OH_NIL_IS_NULL); + DB_TXN *txn = bdb_handle(popSTACK(),`BDB::TXN`,BH_NIL_IS_NULL); u_int32_t action = db_put_action(popSTACK()); u_int32_t flags = db_put_flags(); - DB *db = object_handle(STACK_2,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_2,`BDB::DB`,BH_VALID); DBT key, val; u_int32_t re_len = record_length(db); fill_dbt(STACK_0,&val,re_len); @@ -1292,7 +1291,7 @@ DEFUN(BDB:DB-JOIN, db cursors &key :JOIN_NOSORT) { /* create a specialized join cursor */ u_int32_t flags = db_join_flags(), length, pos; - DB *db = object_handle(STACK_1,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_VALID); DBC **curslist, *dbc; pushSTACK(STACK_0); funcall(L(length),1); length = posfixnum_to_L(value1); curslist = alloca((1+length)*sizeof(DBC*)); @@ -1303,11 +1302,11 @@ curslist[length] = 0; if (listp(STACK_0)) { /* list */ for (pos=0; pos<length; pos++, STACK_0 = Cdr(STACK_0)) - curslist[pos] = object_handle(Car(STACK_0),`BDB::DBC`,OH_VALID); + curslist[pos] = bdb_handle(Car(STACK_0),`BDB::DBC`,BH_VALID); } else { /* vector */ for (pos=0; pos<length; pos++) { pushSTACK(STACK_0); pushSTACK(fixnum(pos)); funcall(L(aref),2); - curslist[pos] = object_handle(value1,`BDB::DBC`,OH_VALID); + curslist[pos] = bdb_handle(value1,`BDB::DBC`,BH_VALID); } } SYSCALL(db->join,(db,curslist,&dbc,flags)); @@ -1330,10 +1329,10 @@ { /* return an estimate of the proportion of keys that are less than, equal to, and greater than the specified key. The underlying database must be of type Btree. */ - DB_TXN *txn = object_handle(popSTACK(),`BDB::TXN`,OH_NIL_IS_NULL); + DB_TXN *txn = bdb_handle(popSTACK(),`BDB::TXN`,BH_NIL_IS_NULL); DBT key; DB_KEY_RANGE key_range; - DB *db = object_handle(STACK_1,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_VALID); fill_dbt(STACK_0,&key,record_length(db)); SYSCALL1(db->key_range,(db,txn,&key,&key_range,0),{free(key.data);}); pushSTACK(c_double_to_DF((dfloatjanus*)&(key_range.less))); @@ -1347,7 +1346,7 @@ :NOORDERCHK) { /* Verify/salvage a database */ u_int32_t flags = db_verify_flags(); - DB *db = object_handle(STACK_3,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_3,`BDB::DB`,BH_VALID); FILE *outfile = NULL; int status; if (!missingp(STACK_0)) { /* SALVAGE */ @@ -1437,7 +1436,7 @@ :CHKSUM :ENCRYPT :TXN_NOT_DURABLE :DUP :DUPSORT :RECNUM \ :REVSPLITOFF :RENUMBER :SNAPSHOT) { /* set database options */ - DB *db = object_handle(STACK_(25),`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_(25),`BDB::DB`,BH_VALID); { /* flags */ u_int32_t flags_on = 0, flags_off = 0; set_flags(popSTACK(),&flags_on,&flags_off,DB_SNAPSHOT); @@ -1586,7 +1585,7 @@ FLAG_EXTRACTOR(db_get_flags_num,DB*) DEFUNR(BDB:DB-GET-OPTIONS, db &optional what) { /* retrieve database options */ - DB *db = object_handle(STACK_1,`BDB::DB`,OH_VALID); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_VALID); object what = STACK_0; skipSTACK(2); restart_DB_GET_OPTIONS: if (missingp(what)) { /* get everything */ @@ -1674,8 +1673,8 @@ DEFUN(BDB:MAKE-DBC,db &key :TRANSACTION :DIRTY_READ :WRITECURSOR) { /* create a cursor */ u_int32_t flags = make_dbc_flags(); - DB_TXN *txn = object_handle(STACK_0,`BDB::TXN`,OH_NIL_IS_NULL); - DB *db = object_handle(STACK_1,`BDB::DB`,OH_VALID); + DB_TXN *txn = bdb_handle(STACK_0,`BDB::TXN`,BH_NIL_IS_NULL); + DB *db = bdb_handle(STACK_1,`BDB::DB`,BH_VALID); DBC *cursor; SYSCALL(db->cursor,(db,txn,&cursor,flags)); if (txn) { @@ -1687,7 +1686,7 @@ DEFUN(BDB:DBC-CLOSE, cursor) { /* close a cursor */ - DBC *cursor = object_handle(STACK_0,`BDB::DBC`,OH_INVALIDATE); + DBC *cursor = bdb_handle(STACK_0,`BDB::DBC`,BH_INVALIDATE); if (cursor) { funcall(`BDB::KILL-HANDLE`,1); SYSCALL(cursor->c_close,(cursor)); @@ -1698,7 +1697,7 @@ DEFUN(BDB:DBC-COUNT, cursor) { /* return a count of the number of data items for the key to which the cursor refers */ - DBC *cursor = object_handle(popSTACK(),`BDB::DBC`,OH_VALID); + DBC *cursor = bdb_handle(popSTACK(),`BDB::DBC`,BH_VALID); db_recno_t count; SYSCALL(cursor->c_count,(cursor,&count,0)); VALUES1(UL_to_I(count)); @@ -1706,7 +1705,7 @@ DEFUN(BDB:DBC-DEL, cursor) { /* delete the key/data pair to which the cursor refers */ - DBC *cursor = object_handle(popSTACK(),`BDB::DBC`,OH_VALID); + DBC *cursor = bdb_handle(popSTACK(),`BDB::DBC`,BH_VALID); SYSCALL(cursor->c_del,(cursor,0)); VALUES0; } @@ -1716,7 +1715,7 @@ { /* create a new cursor that uses the same transaction and locker ID as the original cursor */ u_int32_t flags = dbc_dup_flags(); - DBC *cursor = object_handle(STACK_0,`BDB::DBC`,OH_VALID); + DBC *cursor = bdb_handle(STACK_0,`BDB::DBC`,BH_VALID); DBC *new_cursor; SYSCALL(cursor->c_dup,(cursor,&new_cursor,flags)); wrap_finalize(cursor,Parents(STACK_0),`BDB::MKDBC`,``BDB::DBC-CLOSE``); @@ -1739,7 +1738,7 @@ { /* retrieve key/data pairs from the database */ int no_error = nullp(popSTACK()); u_int32_t flag = dbc_get_options() | dbc_get_action(popSTACK()); - DBC *cursor = object_handle(STACK_2,`BDB::DBC`,OH_VALID); + DBC *cursor = bdb_handle(STACK_2,`BDB::DBC`,BH_VALID); u_int32_t re_len = record_length(cursor->dbp); DBT key, val; dbt_o_t val_type = fill_or_init(popSTACK(),&val,re_len); @@ -1770,7 +1769,7 @@ DEFUN(BDB:DBC-PUT, cursor key data flag) { /* retrieve key/data pairs from the database */ u_int32_t flag = dbc_put_flag(popSTACK()); - DBC *cursor = object_handle(STACK_2,`BDB::DBC`,OH_VALID); + DBC *cursor = bdb_handle(STACK_2,`BDB::DBC`,BH_VALID); DBT key, val; u_int32_t re_len = record_length(cursor->dbp); fill_dbt(STACK_1,&key,re_len); @@ -1790,7 +1789,7 @@ { /* Perform deadlock detection */ u_int32_t flags = 0; u_int32_t action = check_lk_detect(popSTACK()); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); int aborted = false; SYSCALL(dbe->lock_detect,(dbe,flags,action,&aborted)); VALUES_IF(aborted); @@ -1805,7 +1804,7 @@ u_int32_t flags = lock_get_flags(); db_lockmode_t mode = check_lockmode(popSTACK()); u_int32_t locker = I_to_uint32(check_uint32(popSTACK())); - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); DBT obj; DB_LOCK *dblock; int status; @@ -1827,7 +1826,7 @@ DEFUN(BDB:LOCK-ID, dbe) { /* Acquire a locker ID */ - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); u_int32_t id; SYSCALL(dbe->lock_id,(dbe,&id)); VALUES1(uint32_to_I(id)); @@ -1835,24 +1834,24 @@ DEFUN(BDB:LOCK-ID-FREE, dbe id) { /* Release a locker ID */ u_int32_t id = I_to_uint32(check_uint32(popSTACK())); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); SYSCALL(dbe->lock_id_free,(dbe,id)); VALUES0; } DEFUN(BDB:LOCK-PUT, dbe lock) { /* Release a lock */ - DB_LOCK *lock = object_handle(popSTACK(),`BDB::DBLOCK`,OH_INVALIDATE); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_LOCK *lock = bdb_handle(popSTACK(),`BDB::DBLOCK`,BH_INVALIDATE); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); SYSCALL1(dbe->lock_put,(dbe,lock),{free(lock);}); VALUES0; } DEFUN(BDB:LOCK-CLOSE, lock) { /* Close a lock and free the memory */ - DB_LOCK *lock = object_handle(STACK_0,`BDB::DBLOCK`,OH_INVALID_IS_NULL); + DB_LOCK *lock = bdb_handle(STACK_0,`BDB::DBLOCK`,BH_INVALID_IS_NULL); if (lock) { object parent = Parents(STACK_0); /* parent of DBLOCK is a single DBE! */ - DB_ENV *dbe = object_handle(parent,`BDB::DBE`,OH_INVALID_IS_NULL); + DB_ENV *dbe = bdb_handle(parent,`BDB::DBE`,BH_INVALID_IS_NULL); if (dbe == NULL) { /* the DBE has been closed */ pushSTACK(`BDB::BDB-ERROR`); /* error type */ pushSTACK(`:ERRNO`); pushSTACK(Fixnum_0); @@ -1872,7 +1871,7 @@ DEFUN(BDB:LOCK-STAT,dbe &key :STAT_CLEAR) { /* Return lock subsystem statistics */ u_int32_t flags = stat_flags(); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); DB_LOCK_STAT *ls; SYSCALL(dbe->lock_stat,(dbe,&ls,flags)); pushSTACK(uint32_to_I(ls->st_id)); @@ -1910,7 +1909,7 @@ DEFUN(BDB:LOG-ARCHIVE, dbe &key :ARCH_ABS :ARCH_DATA :ARCH_LOG :ARCH_REMOVE) { /* return a list of log or database filenames. */ u_int32_t flags = log_archive_flags(); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); char **list = NULL; SYSCALL(dbe->log_archive,(dbe,&list,flags)); if (list) { @@ -1933,7 +1932,7 @@ DEFUN(BDB:LOG-FILE, dbe lsn) { /* return the name of the file containing the record named by lsn. */ DB_LSN lsn; - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); char path[BUFSIZ]; check_lsn(&STACK_0,&lsn); SYSCALL(dbe->log_file,(dbe,&lsn,path,BUFSIZ)); @@ -1944,7 +1943,7 @@ DEFUN(BDB:LOG-FLUSH, dbe lsn) { /* flush log records to disk */ DB_LSN lsn; - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); check_lsn(&STACK_0,&lsn); SYSCALL(dbe->log_flush,(dbe,&lsn)); VALUES0; @@ -1965,7 +1964,7 @@ { /* write a log record */ u_int32_t flags = log_put_flags(); DB_LSN lsn; - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); DBT data; fill_dbt(STACK_0,&data,0); skipSTACK(2); SYSCALL1(dbe->log_put,(dbe,&lsn,&data,flags),{free(data.data);}); @@ -1975,7 +1974,7 @@ DEFUN(BDB:LOG-STAT, dbe &key :STAT_CLEAR) { /* logging subsystem statistics */ u_int32_t flags = stat_flags(); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); DB_LOG_STAT *stat; SYSCALL(dbe->log_stat,(dbe,&stat,flags)); pushSTACK(uint32_to_I(stat->st_magic)); @@ -2005,7 +2004,7 @@ DEFUN(BDB:LOG-CURSOR, dbe) { /* create a log cursor. */ - DB_ENV *dbe = object_handle(STACK_0,`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(STACK_0,`BDB::DBE`,BH_VALID); DB_LOGC *cursor; SYSCALL(dbe->log_cursor,(dbe,&cursor,0)); wrap_finalize(cursor,STACK_0,`BDB::MKLOGC`,``BDB::LOGC-CLOSE``); @@ -2013,7 +2012,7 @@ DEFUN(BDB:LOGC-CLOSE, logc) { /* discard the log cursor. */ - DB_LOGC *logc = object_handle(STACK_0,`BDB::LOGC`,OH_INVALIDATE); + DB_LOGC *logc = bdb_handle(STACK_0,`BDB::LOGC`,BH_INVALIDATE); if (logc) { funcall(`BDB::KILL-HANDLE`,1); SYSCALL(logc->close,(logc,0)); @@ -2026,7 +2025,7 @@ { /* return records from the log. */ int no_error = nullp(popSTACK()); dbt_o_t out_type = check_dbt_type(popSTACK()); - DB_LOGC *logc = object_handle(STACK_1,`BDB::LOGC`,OH_VALID); + DB_LOGC *logc = bdb_handle(STACK_1,`BDB::LOGC`,BH_VALID); DB_LSN lsn; u_int32_t action; DBT data; @@ -2074,8 +2073,8 @@ DEFUN(BDB:TXN-BEGIN, dbe &key :PARENT :DIRTY_READ :NOSYNC :NOWAIT :SYNC) { /* create a transaction */ u_int32_t flags = txn_begin_flags(); - DB_TXN *parent = object_handle(STACK_0,`BDB::TXN`,OH_NIL_IS_NULL), *ret; - DB_ENV *dbe = object_handle(STACK_1,`BDB::DBE`,OH_VALID); + DB_TXN *parent = bdb_handle(STACK_0,`BDB::TXN`,BH_NIL_IS_NULL), *ret; + DB_ENV *dbe = bdb_handle(STACK_1,`BDB::DBE`,BH_VALID); SYSCALL(dbe->txn_begin,(dbe,parent,&ret,flags)); if (parent) { object parents = listof(2); @@ -2087,7 +2086,7 @@ DEFUN(BDB:TXN-ABORT, txn) { /* Abort a transaction */ - DB_TXN *txn = object_handle(STACK_0,`BDB::TXN`,OH_INVALIDATE); + DB_TXN *txn = bdb_handle(STACK_0,`BDB::TXN`,BH_INVALIDATE); if (txn) { funcall(`BDB::KILL-HANDLE`,1); SYSCALL(txn->abort,(txn)); @@ -2099,7 +2098,7 @@ DEFUN(BDB:TXN-COMMIT, txn &key :SYNC) { /* Commit a transaction */ u_int32_t flags = txn_check_sync(popSTACK()); - DB_TXN *txn = object_handle(STACK_0,`BDB::TXN`,OH_INVALIDATE); + DB_TXN *txn = bdb_handle(STACK_0,`BDB::TXN`,BH_INVALIDATE); if (txn) { funcall(`BDB::KILL-HANDLE`,1); SYSCALL(txn->commit,(txn,flags)); @@ -2109,7 +2108,7 @@ DEFUN(BDB:TXN-DISCARD, txn) { /* Discard a transaction */ - DB_TXN *txn = object_handle(STACK_0,`BDB::TXN`,OH_INVALIDATE); + DB_TXN *txn = bdb_handle(STACK_0,`BDB::TXN`,BH_INVALIDATE); if (txn) { funcall(`BDB::KILL-HANDLE`,1); SYSCALL(txn->discard,(txn,0)); @@ -2119,7 +2118,7 @@ DEFUN(BDB:TXN-ID, txn) { /* Return the transaction's ID */ - DB_TXN *txn = object_handle(popSTACK(),`BDB::TXN`,OH_VALID); + DB_TXN *txn = bdb_handle(popSTACK(),`BDB::TXN`,BH_VALID); u_int32_t id; begin_system_call(); id = txn->id(txn); end_system_call(); VALUES1(UL_to_I(id)); @@ -2132,7 +2131,7 @@ u_int32_t flags = txn_checkpoint_flags(); u_int32_t min = posfixnum_default(popSTACK()); u_int32_t kbyte = posfixnum_default(popSTACK()); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); SYSCALL(dbe->txn_checkpoint,(dbe,kbyte,min,flags)); VALUES0; } @@ -2150,7 +2149,7 @@ DEFUN(BDB:TXN-PREPARE, txn gid) { /* initiate the beginning of a two-phase commit */ - DB_TXN *txn = object_handle(STACK_1,`BDB::TXN`,OH_VALID); + DB_TXN *txn = bdb_handle(STACK_1,`BDB::TXN`,BH_VALID); u_int8_t *gid = check_gid(&STACK_0); SYSCALL(txn->prepare,(txn,gid)); VALUES0; skipSTACK(2); @@ -2170,7 +2169,7 @@ DEFUN(BDB:TXN-RECOVER, dbe &key :FIRST :NEXT) { /* return a list of prepared but not yet resolved transactions */ u_int32_t flags = txn_recover_flags(); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); u_int32_t tx_max; DB_PREPLIST *preplist; int status, ii; @@ -2202,7 +2201,7 @@ transaction */ u_int32_t which = txn_timeout_check(popSTACK()); db_timeout_t timeout = I_to_uint32(check_uint32(popSTACK())); - DB_TXN *txn = object_handle(popSTACK(),`BDB::TXN`,OH_VALID); + DB_TXN *txn = bdb_handle(popSTACK(),`BDB::TXN`,BH_VALID); SYSCALL(txn->set_timeout,(txn,timeout,which)); VALUES0; } @@ -2210,7 +2209,7 @@ DEFUN(BDB:TXN-STAT, dbe &key :STAT_CLEAR) { /* transaction subsystem statistics */ u_int32_t flags = stat_flags(); - DB_ENV *dbe = object_handle(popSTACK(),`BDB::DBE`,OH_VALID); + DB_ENV *dbe = bdb_handle(popSTACK(),`BDB::DBE`,BH_VALID); DB_TXN_STAT *stat; SYSCALL(dbe->txn_stat,(dbe,&stat,flags)); pushSTACK(make_lsn(&(stat->st_last_ckp))); --__--__-- _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest |