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>
Removed unused variables:
......
......@@ -41,15 +41,12 @@
;;; ============================================================
;;; 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.
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
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
optional in the constructor argument list.
......@@ -64,16 +61,57 @@ Legal fiels properties are:
the constructor.
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)
(mutators nil)
(predicate nil)
(constructor nil)
(access-method (if (eq ':nil-safe flags) 'elt 'aref))
(type-sym (intern (upcase (symbol-name type)))))
(access-method 'aref)
(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
(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
`(defsubst ,(intern (format "lyskom-create-%S" type))
,(delq nil (mapcar (lambda (arg)
......@@ -82,20 +120,7 @@ Only one of :automatic, :filter or :default may be supplied.
args))
,(format "Create a `%S' from arguments.
Automatically created with def-komtype." type)
(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))))))
,constructor-body))
;; Create predicate
......@@ -528,7 +553,7 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
(size :read-only t)
(later-texts-exist :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))
;;UNUSED: text-pair->local-number
......@@ -536,6 +561,11 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
;;UNUSED: text-pair->global-number
(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
(defun text-mapping->local-to-global (map local)
(cond ((or (< local (text-mapping->range-begin map))
......@@ -571,6 +601,63 @@ The MAPS must be consecutive. No gaps or overlaps are currently allowed."
(setq i (1+ i))))
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
......
......@@ -727,7 +727,7 @@ If CONF is nil, check the first conf on the to-do list."
(progn
(setq continue nil))))
)
;;; Return the result
continue))
......@@ -3279,27 +3279,46 @@ If the full membership hase been read do nothing."
(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)
"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."
(let ((read (membership->read-texts membership))
(first (map->first-local map))
(i (length (map->text-nos map)))
(the-map (map->text-nos map)))
(first (text-mapping->range-begin map))
(iter (text-mapping->iterator map))
(el nil))
(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))))
(while (setq el (text-mapping-iterator->next iter))
(when (lyskom-binsearch (text-pair->local-number el) read)
(text-mapping->remove-local map (text-pair->local-number el)))))
(text-mapping->global-numbers map)))
......
......@@ -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."
(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)
"Block fetching map for MEMBERSHIP until we see a text.
Start the prefetch for the remainder of the map."
(let ((first-local (1+ (membership->last-text-read membership)))
(last-local (1- (+ (conf-stat->no-of-texts conf-stat)
(conf-stat->first-local-no conf-stat))))
(done nil))
(while (not done)
(let ((map (blocking-do 'get-map
(membership->conf-no membership)
first-local
lyskom-fetch-map-nos)))
(setq first-local (+ first-local lyskom-fetch-map-nos))
(lyskom-enter-map-in-to-do-list map conf-stat 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)))))))
(let* ((first-local (1+ (membership->last-text-read membership)))
(map (blocking-do 'local-to-global
(membership->conf-no membership)
first-local
lyskom-fetch-map-nos)))
(when map
(lyskom-enter-map-in-to-do-list map conf-stat membership)
(when (text-mapping->later-texts-exist map)
(lyskom-prefetch-map-using-conf-stat conf-stat
(text-mapping->range-end map)
membership)))))
(defun lyskom-prefetch-conf (conf-no &optional queue)
"Prefetch the conf-stat for the conference with number CONF-NO.
......@@ -305,13 +320,12 @@ prefetched the prefetch is not done."
(defun lyskom-prefetch-map (conf-no membership &optional queue)
"Prefetches a map for conf CONFNO."
(lyskom-prefetch-map-from conf-no
(1+ (membership->last-text-read membership))
membership
queue))
(1+ (membership->last-text-read membership))
membership
queue))
(defun lyskom-prefetch-map-from (conf-no first-local membership
&optional queue)
&optional queue)
"Prefetches a map for conf CONFNO starting att FIRST-LOCAL."
(if queue
(lyskom-queue-enter queue (list 'CONFSTATFORMAP
......@@ -493,7 +507,8 @@ Return t if an element was prefetched, otherwise return nil."
((and (listp element)
(memq (car element)
'(TEXTAUTH TEXT-ALL TEXTTREE ONE-MEMBERSHIP
CONFSTATFORMAP MAP MARKS
CONFSTATFORMAP
MAP MARKS
MEMBERSHIP WHOBUFFER TEXTS)))
(let ((queue (lyskom-queue-create)))
(setcar prefetch-list queue)
......@@ -585,20 +600,23 @@ Return t if an element was prefetched, otherwise return nil."
queue)
; We are done
(lyskom-prefetch-handler)))
((eq (car request) 'CONFSTATFORMAP)
(initiate-get-conf-stat 'prefetch 'lyskom-prefetch-confstatformap-handler
(nth 1 request) (nth 2 request) (nth 3 request)
queue))
((eq (car request) 'MAP)
(initiate-get-map 'prefetch 'lyskom-prefetch-map-handler
(conf-stat->conf-no
(nth 1 request)) ; conf-stat
(nth 2 request) ; first-local
lyskom-fetch-map-nos
(nth 1 request) ; conf-stat
(nth 2 request) ; first-local
(nth 3 request) ; membership
queue))
(initiate-local-to-global 'prefetch 'lyskom-prefetch-map-handler
(conf-stat->conf-no
(nth 1 request)) ; conf-stat
(nth 2 request) ; first-local
lyskom-fetch-map-nos
(nth 1 request) ; conf-stat
(nth 2 request) ; first-local
(nth 3 request) ; membership
queue))
((eq (car request) 'MARKS)
(initiate-get-marks 'prefetch 'lyskom-prefetch-marks-handler queue))
((eq (car request) 'WHOBUFFER)
......@@ -753,22 +771,17 @@ Put the requests on QUEUE."
(-- lyskom-pending-prefetch)
(lyskom-start-prefetch))
(defun lyskom-prefetch-map-handler (map conf-stat first-local membership queue)
"Handle the return of the membership prefetch call.
Maps are `cached' in lyskom-to-do-list."
(lyskom-stop-prefetch)
(let ((next-start (+ first-local lyskom-fetch-map-nos))
(last-local (1- (+ (conf-stat->no-of-texts conf-stat)
(conf-stat->first-local-no conf-stat)))))
(let ((next-start (and map (text-mapping->range-end map))))
(when map
;; An old version of this function tester if the map contained no
;; texts. That is not a correct termination condition.
(when (< next-start last-local)
(when (text-mapping->later-texts-exist map)
(lyskom-prefetch-map-using-conf-stat conf-stat
next-start
membership
queue))
next-start
membership
queue))
(lyskom-enter-map-in-to-do-list map conf-stat membership)))
(lyskom-queue-enter queue 'FINISHED)
(-- lyskom-pending-prefetch)
......
......@@ -1241,13 +1241,33 @@ Args: KOM-QUEUE HANDLER SESSION-NO &rest DATA"
no-of-texts &rest data)
"Send local-to-global to server."
(lyskom-server-call
(lyskom-call kom-queue lyskom-ref-no handler data
'lyskom-parse-text-mapping no-of-texts)
(lyskom-send-packet kom-queue
(lyskom-format-objects 103
conf-no
first-local-no
no-of-texts))))
(cond ((lyskom-have-call 103)
(lyskom-call kom-queue lyskom-ref-no handler data
'lyskom-parse-text-mapping no-of-texts)
(lyskom-send-packet kom-queue
(lyskom-format-objects 103
conf-no
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
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