home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / comp / lang / lisp / mcl / 1215 < prev    next >
Encoding:
Text File  |  1992-08-13  |  2.2 KB  |  64 lines
  1. Path: sparky!uunet!sun-barr!apple!cambridge.apple.com!bill@cambridge.apple.com
  2. From: bill@cambridge.apple.com (Bill St. Clair)
  3. Newsgroups: comp.lang.lisp.mcl
  4. Subject: Re: Is this a bug or am I just not understanding applying Wood?
  5. Message-ID: <9208131621.AA12953@cambridge.apple.com>
  6. Date: 13 Aug 92 17:23:30 GMT
  7. Sender: info-mcl-request@cambridge.apple.com
  8. Lines: 50
  9. Approved: comp.lang.lisp.mcl@Cambridge.Apple.C0M
  10. Full-Name: Bill St. Clair
  11. Original-To: cornell@freya.cs.umass.edu
  12. Original-Cc: info-mcl
  13.  
  14. >Bill: I think the definition of set-slot-value-in-both-worlds
  15. >(repeated below) is buggy. I'm pretty sure the second WHEN should use
  16. >slot-value, not p-slot-value. (P-slot-value does nothing if its arg is
  17. >not a pptr).
  18. >
  19. >matt
  20. >
  21. >    (defun wood::set-slot-value-in-both-worlds (pheap instance slot-name value)
  22. >      (let ((in-memory (wood::in-memory-p instance))
  23. >        (on-disk (wood::on-disk-p pheap instance)))
  24. >    (when on-disk
  25. >      (setf (p-slot-value on-disk slot-name) value))
  26. >    (when in-memory
  27. >      (setf (p-slot-value in-memory slot-name) value))) ;should be slot-value
  28. >      value)
  29.  
  30. You're right, though this code should work since (setf p-slot-value)
  31. simply calls (setf slot-value) if the instance is not a PPTR.
  32.  
  33. Well, that's what it was supposed to do, but (setf p-slot-value)
  34. had a bug as well. Here's a patch:
  35.  
  36. ------------------------------------------------------------------------
  37.  
  38. ; setf-p-slot-value-patch.lisp
  39. ;
  40. ; (setf (p-slot-value instance slot) value)
  41. ; now calls (setf slot-value) when instance is not a PPTR.
  42.  
  43. (in-package :wood)
  44.  
  45. (let ((*warn-if-redefine* nil))
  46.  
  47. (defun (setf p-slot-value) (value p slot-name)
  48.   (if (pptr-p p)
  49.     (let* ((pheap (pptr-pheap p))
  50.            (disk-cache (pheap-disk-cache pheap))
  51.            (pointer (pptr-pointer p)))
  52.       (multiple-value-bind (slots index)
  53.                            (dc-%slot-vector-and-index disk-cache pointer slot-name)
  54.         (unless slots
  55.           (dc-slot-missing disk-cache pointer slot-name '(setf p-slot-value)))
  56.         (multiple-value-bind (v imm?) (%p-store pheap value)
  57.           (setf (dc-%svref disk-cache slots index imm?) v)
  58.           (if imm?
  59.             v
  60.             (pptr pheap v)))))
  61.     (setf (slot-value p slot-name) value)))
  62.  
  63. )
  64.