Commit 376b5225 authored by David Byers's avatar David Byers
Browse files

Fixed bug 408 (finally)

Detailed changes:
> 2003-07-20  David Byers  <byers@lysator.liu.se>
>
> 	Fix bug 409 (use local-to-global):
> 	* prefetch.el (lyskom-fetch-start-of-map): Use text-mapping
> 	instead of map.
> 	(lyskom-prefetch-map-handler): Use text-mapping instead of map.
> 	(lyskom-prefetch-one-request): Use local-to-global instead of
> 	get-map.
>
> 	* lyskom-rest.el (lyskom-list-unread): Handle text-mappings, not
> 	just maps.
> 	(lyskom-list-unread-mapping): New function.
>
> 	* services.el (initiate-local-to-global): Pretend to do
> 	local-to-global using get-map.
>
> 2003-07-19  David Byers  <byers@lysator.liu.se>
>
> 	Work on bug 409:
> 	* komtypes.el (def-komtype): Added :constructor-hook modifier.
> 	(text-mapping-iterator): New type.
> 	(text-mapping->iterator): New function.
> 	(text-mapping-iterator->init): New function.
> 	(text-mapping-iterator->next): New function.
> 	(text-mapping-iterator->step): New function.
> 	(text-mapping->remove-local): New function.
> 	(text-mapping->remove-local): New function.
>
parent cc17ab00
2003-07-20 David Byers <byers@lysator.liu.se>
Fix bug 409 (use local-to-global):
* prefetch.el (lyskom-fetch-start-of-map): Use text-mapping
instead of map.
(lyskom-prefetch-map-handler): Use text-mapping instead of map.
(lyskom-prefetch-one-request): Use local-to-global instead of
get-map.
* lyskom-rest.el (lyskom-list-unread): Handle text-mappings, not
just maps.
(lyskom-list-unread-mapping): New function.
* services.el (initiate-local-to-global): Pretend to do
local-to-global using get-map.
2003-07-19 David Byers <byers@lysator.liu.se>
Work on bug 409:
* komtypes.el (def-komtype): Added :constructor-hook modifier.
(text-mapping-iterator): New type.
(text-mapping->iterator): New function.
(text-mapping-iterator->init): New function.
(text-mapping-iterator->next): New function.
(text-mapping-iterator->step): New function.
(text-mapping->remove-local): New function.
(text-mapping->remove-local): New function.
2003-07-02 David Byers <byers@lysator.liu.se> 2003-07-02 David Byers <byers@lysator.liu.se>
Removed unused variables: Removed unused variables:
......
...@@ -41,15 +41,12 @@ ...@@ -41,15 +41,12 @@
;;; ============================================================ ;;; ============================================================
;;; Black magic... ;;; Black magic...
(defmacro def-komtype (type args &optional flags) (defmacro def-komtype (type args &rest flags)
"Define a new type named TYPE with fields ARGS and documentation DOC. "Define a new type named TYPE with fields ARGS and documentation DOC.
TYPE is the name of the new type; a symbol. TYPE is the name of the new type; a symbol.
ARGS is a list of arguments. Each element can be a symbol or a cons whose ARGS is a list of arguments. Each element can be a symbol or a cons whose
car is the name of the field and the cdr is a property list for the field. car is the name of the field and the cdr is a property list for the field.
If optional FLAGS is :nil-safe, then calling accessors on nil object
will return nil and not signal an error.
The special symbol &optional indicates start of fields that will be The special symbol &optional indicates start of fields that will be
optional in the constructor argument list. optional in the constructor argument list.
...@@ -64,16 +61,57 @@ Legal fiels properties are: ...@@ -64,16 +61,57 @@ Legal fiels properties are:
the constructor. the constructor.
Only one of :automatic, :filter or :default may be supplied. Only one of :automatic, :filter or :default may be supplied.
Optional FLAGS are additional modifiers.
If :nil-safe is included, then calling accessors on nil object will
return nil and not signal an error.
If :constructor-hook HOOK is included, HOOK will be inserted into the
constructor function. When HOOK is evaluated, OBJECT (uppercase) is
bound to the newly created object. It may be modified.
" "
(let ((accessors nil) (let ((accessors nil)
(mutators nil) (mutators nil)
(predicate nil) (predicate nil)
(constructor nil) (constructor nil)
(access-method (if (eq ':nil-safe flags) 'elt 'aref)) (access-method 'aref)
(type-sym (intern (upcase (symbol-name type))))) (type-sym (intern (upcase (symbol-name type))))
(constructor-body nil)
(constructor-hook nil))
(while flags
(cond ((eq (car flags) ':nil-safe) (setq access-method 'elt))
((eq (car flags) ':constructor-hook)
(setq flags (cdr flags))
(setq constructor-hook (car flags))))
(setq flags (cdr flags)))
;; Create constructor ;; Create constructor
(setq constructor-body
`(cons ',type-sym
(vector
,@(delq '&optional
(mapcar
(lambda (arg)
(cond ((plist-member (cdr-safe arg) ':automatic)
(plist-get (cdr-safe arg) ':automatic))
((plist-member (cdr-safe arg) ':filter)
(plist-get (cdr-safe arg) ':filter))
((plist-get (cdr-safe arg) ':default)
`(or ,(car arg) ,(plist-get (cdr arg) :default)))
(t (or (car-safe arg) arg))
))
args)))))
(when constructor-hook
(setq constructor-body
`(let ((OBJECT ,constructor-body))
,constructor-hook
OBJECT)))
(setq constructor (setq constructor
`(defsubst ,(intern (format "lyskom-create-%S" type)) `(defsubst ,(intern (format "lyskom-create-%S" type))
,(delq nil (mapcar (lambda (arg) ,(delq nil (mapcar (lambda (arg)
...@@ -82,20 +120,7 @@ Only one of :automatic, :filter or :default may be supplied. ...@@ -82,20 +120,7 @@ Only one of :automatic, :filter or :default may be supplied.
args)) args))
,(format "Create a `%S' from arguments. ,(format "Create a `%S' from arguments.
Automatically created with def-komtype." type) Automatically created with def-komtype." type)
(cons ',type-sym ,constructor-body))
(vector
,@(delq '&optional
(mapcar
(lambda (arg)
(cond ((plist-member (cdr-safe arg) ':automatic)
(plist-get (cdr-safe arg) ':automatic))
((plist-member (cdr-safe arg) ':filter)
(plist-get (cdr-safe arg) ':filter))
((plist-get (cdr-safe arg) ':default)
`(or ,(car arg) ,(plist-get (cdr arg) :default)))
(t (or (car-safe arg) arg))
))
args))))))
;; Create predicate ;; Create predicate
...@@ -528,7 +553,7 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed." ...@@ -528,7 +553,7 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
(size :read-only t) (size :read-only t)
(later-texts-exist :read-only t) (later-texts-exist :read-only t)
(type :read-only t) (type :read-only t)
(block :read-only t))) (block :read-only nil)))
(defsubst lyskom-create-text-pair (local global) (cons local global)) (defsubst lyskom-create-text-pair (local global) (cons local global))
;;UNUSED: text-pair->local-number ;;UNUSED: text-pair->local-number
...@@ -536,6 +561,11 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed." ...@@ -536,6 +561,11 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
;;UNUSED: text-pair->global-number ;;UNUSED: text-pair->global-number
(defsubst text-pair->global-number (pair) (cdr pair)) (defsubst text-pair->global-number (pair) (cdr pair))
(defsubst text-mapping->block-size (map)
(if (eq (text-mapping->type map) 'dense)
(length (map->text-nos (text-mapping->block map)))
(length (text-mapping->block map))))
;;UNUSED: text-mapping->local-to-global ;;UNUSED: text-mapping->local-to-global
(defun text-mapping->local-to-global (map local) (defun text-mapping->local-to-global (map local)
(cond ((or (< local (text-mapping->range-begin map)) (cond ((or (< local (text-mapping->range-begin map))
...@@ -571,6 +601,63 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed." ...@@ -571,6 +601,63 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
(setq i (1+ i)))) (setq i (1+ i))))
result)))) result))))
(defun text-mapping->remove-local (map local)
(cond ((eq (text-mapping->type map) 'dense)
(setq local (- local (text-mapping->range-begin map)))
(when (and (>= local 0)
(< local (text-mapping->block-size map)))
(aset local (map->text-nos (text-mapping->block map)) 0)))
((eq (text-mapping->type map) 'sparse)
(let ((el (assq local (text-mapping->block map))))
(when el
(set-text-mapping->block map
(delq el (text-mapping->block map))))))))
(def-komtype text-mapping-iterator
((map :read-only t)
(next-value :automatic nil)
(state :automatic nil))
:constructor-hook (text-mapping-iterator->init OBJECT))
(defun text-mapping->iterator (map)
(lyskom-create-text-mapping-iterator map))
(defun text-mapping-iterator->init (iter)
(if (eq (text-mapping->type (text-mapping-iterator->map iter)) 'dense)
(set-text-mapping-iterator->state iter 0)
(set-text-mapping-iterator->state
iter (text-mapping->block (text-mapping-iterator->map iter)))))
(defun text-mapping-iterator->next (iter)
(when (text-mapping-iterator->state iter)
(let ((map (text-mapping-iterator->map iter)))
(prog1
(if (eq (text-mapping->type map) 'dense)
(lyskom-create-text-pair (+ (text-mapping-iterator->state iter)
(text-mapping->range-begin map))
(aref (map->text-nos (text-mapping->block map))
(text-mapping-iterator->state iter)))
(car (text-mapping-iterator->state iter)))
(text-mapping-iterator->step iter)))))
(defun text-mapping-iterator->step (iter)
(let ((map (text-mapping-iterator->map iter))
(state (text-mapping-iterator->state iter)))
(cond
((eq (text-mapping->type map) 'dense)
(setq state (1+ state))
(while (and (< state (text-mapping->block-size map))
(eq 0 (aref (map->text-nos (text-mapping->block map)) state)))
(setq state (1+ state)))
(set-text-mapping-iterator->state
iter (and (< state (text-mapping->block-size map)) state)))
((eq (text-mapping->type map) 'sparse)
(set-text-mapping-iterator->state iter (cdr state))))))
;;; ================================================================ ;;; ================================================================
;;; mark ;;; mark
......
...@@ -727,7 +727,7 @@ If CONF is nil, check the first conf on the to-do list." ...@@ -727,7 +727,7 @@ If CONF is nil, check the first conf on the to-do list."
(progn (progn
(setq continue nil)))) (setq continue nil))))
) )
;;; Return the result ;;; Return the result
continue)) continue))
...@@ -3279,27 +3279,46 @@ If the full membership hase been read do nothing." ...@@ -3279,27 +3279,46 @@ If the full membership hase been read do nothing."
(lyskom-wait-for-membership)) (lyskom-wait-for-membership))
;; FIXME: Here we can handle both maps and mappings, but in
;; FIXME: reality this should *never* get called with a map
;; FIXME: anymore
(defun lyskom-list-unread (map membership) (defun lyskom-list-unread (map membership)
"Args: MAP MEMBERSHIP. Return a list of unread texts. "Args: MAP MEMBERSHIP. Return a list of unread texts.
The list consists of text-nos."
(if (lyskom-text-mapping-p map)
(lyskom-list-unread-mapping map membership)
(let ((read (membership->read-texts membership))
(first (map->first-local map))
(i (length (map->text-nos map)))
(the-map (map->text-nos map)))
(when (not (null read))
(while (> i 0)
(-- i)
;; The server always send the read texts in sorted order. This
;; means that we can use binary search to look for read texts.
;; It might be a good idea to check for zero, and not do a
;; sarch in that case, but it depends on how big holes there
;; are in the map. In general the extra test is probably a
;; slowdow, but when reading the initial part of the I]M map
;; it would most likely help a lot.
(when (lyskom-binsearch (+ i first) read)
(aset the-map i 0))))
(delq 0 (listify-vector the-map)))))
(defun lyskom-list-unread-mapping (map membership)
"Args: MAP MEMBERSHIP. Return a list of unread texts.
The list consists of text-nos." The list consists of text-nos."
(let ((read (membership->read-texts membership)) (let ((read (membership->read-texts membership))
(first (map->first-local map)) (first (text-mapping->range-begin map))
(i (length (map->text-nos map))) (iter (text-mapping->iterator map))
(the-map (map->text-nos map))) (el nil))
(when (not (null read)) (when (not (null read))
(while (> i 0) (while (setq el (text-mapping-iterator->next iter))
(-- i) (when (lyskom-binsearch (text-pair->local-number el) read)
;; The server always send the read texts in sorted order. This (text-mapping->remove-local map (text-pair->local-number el)))))
;; means that we can use binary search to look for read texts. (text-mapping->global-numbers map)))
;; It might be a good idea to check for zero, and not do a
;; sarch in that case, but it depends on how big holes there
;; are in the map. In general the extra test is probably a
;; slowdow, but when reading the initial part of the I]M map
;; it would most likely help a lot.
(when (lyskom-binsearch (+ i first) read)
(aset the-map i 0))))
(delq 0 (listify-vector the-map))))
......
...@@ -174,31 +174,46 @@ This is used to prevent the prefetch code to reenter itself.") ...@@ -174,31 +174,46 @@ This is used to prevent the prefetch code to reenter itself.")
"Return t if the while membership list has been fetched, and nil otherwise." "Return t if the while membership list has been fetched, and nil otherwise."
(eq lyskom-membership-is-read 't)) (eq lyskom-membership-is-read 't))
;;KILLME (defun lyskom-fetch-start-of-map (conf-stat membership)
;;KILLME "Block fetching map for MEMBERSHIP until we see a text.
;;KILLME Start the prefetch for the remainder of the map."
;;KILLME (let ((first-local (1+ (membership->last-text-read membership)))
;;KILLME (last-local (1- (+ (conf-stat->no-of-texts conf-stat)
;;KILLME (conf-stat->first-local-no conf-stat))))
;;KILLME (done nil))
;;KILLME (while (not done)
;;KILLME (let ((map (blocking-do 'get-map
;;KILLME (membership->conf-no membership)
;;KILLME first-local
;;KILLME lyskom-fetch-map-nos)))
;;KILLME (setq first-local (+ first-local lyskom-fetch-map-nos))
;;KILLME (lyskom-enter-map-in-to-do-list map conf-stat membership)
;;KILLME (cond ((and (map->text-nos map)
;;KILLME (< first-local last-local)
;;KILLME (> (length (map->text-nos map)) 0))
;;KILLME (setq done t)
;;KILLME (lyskom-prefetch-map-using-conf-stat conf-stat
;;KILLME first-local
;;KILLME membership)
;;KILLME )
;;KILLME
;;KILLME ((< first-local last-local))
;;KILLME (t (setq done t)))))))
(defun lyskom-fetch-start-of-map (conf-stat membership) (defun lyskom-fetch-start-of-map (conf-stat membership)
"Block fetching map for MEMBERSHIP until we see a text. "Block fetching map for MEMBERSHIP until we see a text.
Start the prefetch for the remainder of the map." Start the prefetch for the remainder of the map."
(let ((first-local (1+ (membership->last-text-read membership))) (let* ((first-local (1+ (membership->last-text-read membership)))
(last-local (1- (+ (conf-stat->no-of-texts conf-stat) (map (blocking-do 'local-to-global
(conf-stat->first-local-no conf-stat)))) (membership->conf-no membership)
(done nil)) first-local
(while (not done) lyskom-fetch-map-nos)))
(let ((map (blocking-do 'get-map (when map
(membership->conf-no membership) (lyskom-enter-map-in-to-do-list map conf-stat membership)
first-local (when (text-mapping->later-texts-exist map)
lyskom-fetch-map-nos))) (lyskom-prefetch-map-using-conf-stat conf-stat
(setq first-local (+ first-local lyskom-fetch-map-nos)) (text-mapping->range-end map)
(lyskom-enter-map-in-to-do-list map conf-stat membership) membership)))))
(cond ((and (map->text-nos map)
(< first-local last-local)
(> (length (map->text-nos map)) 0))
(setq done t)
(lyskom-prefetch-map-using-conf-stat conf-stat
first-local
membership)
)
((< first-local last-local))
(t (setq done t)))))))
(defun lyskom-prefetch-conf (conf-no &optional queue) (defun lyskom-prefetch-conf (conf-no &optional queue)
"Prefetch the conf-stat for the conference with number CONF-NO. "Prefetch the conf-stat for the conference with number CONF-NO.
...@@ -305,13 +320,12 @@ prefetched the prefetch is not done." ...@@ -305,13 +320,12 @@ prefetched the prefetch is not done."
(defun lyskom-prefetch-map (conf-no membership &optional queue) (defun lyskom-prefetch-map (conf-no membership &optional queue)
"Prefetches a map for conf CONFNO." "Prefetches a map for conf CONFNO."
(lyskom-prefetch-map-from conf-no (lyskom-prefetch-map-from conf-no
(1+ (membership->last-text-read membership)) (1+ (membership->last-text-read membership))
membership membership
queue)) queue))
(defun lyskom-prefetch-map-from (conf-no first-local membership (defun lyskom-prefetch-map-from (conf-no first-local membership
&optional queue) &optional queue)
"Prefetches a map for conf CONFNO starting att FIRST-LOCAL." "Prefetches a map for conf CONFNO starting att FIRST-LOCAL."
(if queue (if queue
(lyskom-queue-enter queue (list 'CONFSTATFORMAP (lyskom-queue-enter queue (list 'CONFSTATFORMAP
...@@ -493,7 +507,8 @@ Return t if an element was prefetched, otherwise return nil." ...@@ -493,7 +507,8 @@ Return t if an element was prefetched, otherwise return nil."
((and (listp element) ((and (listp element)
(memq (car element) (memq (car element)
'(TEXTAUTH TEXT-ALL TEXTTREE ONE-MEMBERSHIP '(TEXTAUTH TEXT-ALL TEXTTREE ONE-MEMBERSHIP
CONFSTATFORMAP MAP MARKS CONFSTATFORMAP
MAP MARKS
MEMBERSHIP WHOBUFFER TEXTS))) MEMBERSHIP WHOBUFFER TEXTS)))
(let ((queue (lyskom-queue-create))) (let ((queue (lyskom-queue-create)))
(setcar prefetch-list queue) (setcar prefetch-list queue)
...@@ -585,20 +600,23 @@ Return t if an element was prefetched, otherwise return nil." ...@@ -585,20 +600,23 @@ Return t if an element was prefetched, otherwise return nil."
queue) queue)
; We are done ; We are done
(lyskom-prefetch-handler))) (lyskom-prefetch-handler)))
((eq (car request) 'CONFSTATFORMAP) ((eq (car request) 'CONFSTATFORMAP)
(initiate-get-conf-stat 'prefetch 'lyskom-prefetch-confstatformap-handler (initiate-get-conf-stat 'prefetch 'lyskom-prefetch-confstatformap-handler
(nth 1 request) (nth 2 request) (nth 3 request) (nth 1 request) (nth 2 request) (nth 3 request)
queue)) queue))
((eq (car request) 'MAP) ((eq (car request) 'MAP)
(initiate-get-map 'prefetch 'lyskom-prefetch-map-handler (initiate-local-to-global 'prefetch 'lyskom-prefetch-map-handler
(conf-stat->conf-no (conf-stat->conf-no
(nth 1 request)) ; conf-stat (nth 1 request)) ; conf-stat
(nth 2 request) ; first-local (nth 2 request) ; first-local
lyskom-fetch-map-nos lyskom-fetch-map-nos
(nth 1 request) ; conf-stat (nth 1 request) ; conf-stat
(nth 2 request) ; first-local (nth 2 request) ; first-local
(nth 3 request) ; membership (nth 3 request) ; membership
queue)) queue))
((eq (car request) 'MARKS) ((eq (car request) 'MARKS)
(initiate-get-marks 'prefetch 'lyskom-prefetch-marks-handler queue)) (initiate-get-marks 'prefetch 'lyskom-prefetch-marks-handler queue))
((eq (car request) 'WHOBUFFER) ((eq (car request) 'WHOBUFFER)
...@@ -753,22 +771,17 @@ Put the requests on QUEUE." ...@@ -753,22 +771,17 @@ Put the requests on QUEUE."
(-- lyskom-pending-prefetch) (-- lyskom-pending-prefetch)
(lyskom-start-prefetch)) (lyskom-start-prefetch))
(defun lyskom-prefetch-map-handler (map conf-stat first-local membership queue) (defun lyskom-prefetch-map-handler (map conf-stat first-local membership queue)
"Handle the return of the membership prefetch call. "Handle the return of the membership prefetch call.
Maps are `cached' in lyskom-to-do-list." Maps are `cached' in lyskom-to-do-list."
(lyskom-stop-prefetch) (lyskom-stop-prefetch)
(let ((next-start (+ first-local lyskom-fetch-map-nos)) (let ((next-start (and map (text-mapping->range-end map))))
(last-local (1- (+ (conf-stat->no-of-texts conf-stat)
(conf-stat->first-local-no conf-stat)))))
(when map (when map
;; An old version of this function tester if the map contained no (when (text-mapping->later-texts-exist map)
;; texts. That is not a correct termination condition.
(when (< next-start last-local)
(lyskom-prefetch-map-using-conf-stat conf-stat (lyskom-prefetch-map-using-conf-stat conf-stat
next-start next-start
membership membership
queue)) queue))
(lyskom-enter-map-in-to-do-list map conf-stat membership))) (lyskom-enter-map-in-to-do-list map conf-stat membership)))
(lyskom-queue-enter queue 'FINISHED) (lyskom-queue-enter queue 'FINISHED)
(-- lyskom-pending-prefetch) (-- lyskom-pending-prefetch)
......
...@@ -1241,13 +1241,33 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA" ...@@ -1241,13 +1241,33 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
no-of-texts &rest data) no-of-texts &rest data)
"Send local-to-global to server." "Send local-to-global to server."
(lyskom-server-call (lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data (cond ((lyskom-have-call 103)
'lyskom-parse-text-mapping no-of-texts) (lyskom-call kom-queue lyskom-ref-no handler data
(lyskom-send-packet kom-queue 'lyskom-parse-text-mapping no-of-texts)
(lyskom-format-objects 103 (lyskom-send-packet kom-queue
conf-no (lyskom-format-objects 103
first-local-no conf-no
no-of-texts)))) first-local-no
no-of-texts)))
(t (lyskom-call kom-queue lyskom-ref-no
'lyskom-l2g-fake-callback
(cons handler data)
'lyskom-parse-map)
(lyskom-send-packet kom-queue
(lyskom-format-objects 34 conf-no
first-local-no
no-of-texts))))))
(defun lyskom-l2g-fake-callback (map handler &rest data)
(let ((mapping
(and map (lyskom-create-text-mapping (map->first-local map)
(+ (map->first-local map)
(length (map->text-nos map)))
(length (map->text-nos map))
t
'dense
map))))
(apply handler mapping data)))
(defun initiate-map-created-texts (kom-queue handler (defun initiate-map-created-texts (kom-queue handler
author author
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment