cgit.sxemacs.org Git - sxemacs/blob - src/events/workers.c

   1 /*
   2   workers.c -- worker threads
   3   Copyright (C) 2006, 2007, 2008 Sebastian Freundt
   4
   5   Author:  Sebastian Freundt <hroptatyr@sxemacs.org>
   6
   7   * This file is part of SXEmacs.
   8   *
   9   * Redistribution and use in source and binary forms, with or without
  10   * modification, are permitted provided that the following conditions
  11   * are met:
  12   *
  13   * 1. Redistributions of source code must retain the above copyright
  14   *    notice, this list of conditions and the following disclaimer.
  15   *
  16   * 2. Redistributions in binary form must reproduce the above copyright
  17   *    notice, this list of conditions and the following disclaimer in the
  18   *    documentation and/or other materials provided with the distribution.
  19   *
  20   * 3. Neither the name of the author nor the names of any contributors
  21   *    may be used to endorse or promote products derived from this
  22   *    software without specific prior written permission.
  23   *
  24   * THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25   * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26   * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27   * DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28   * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29   * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30   * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31   * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32   * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33   * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34   * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35   */
  36
  37 /* Synched up with: Not in FSF. */
  38
  39 #include <config.h>
  40 #include "lisp.h"
  41 #include "workers.h"
  42
  43 Lisp_Object Qworker_jobp;
  44 Lisp_Object Qunknown, Qrunning, Qfinished, Qqueued;
  45
  46 \f
  47 /* worker sorcery */
  48 static inline void
  49 eq_make_worker_scratch(eq_worker_t eqw, size_t size)
  50 {
  51         if (size > 0) {
  52                 eq_worker_scratch(eqw) = xmalloc_atomic(size);
  53                 eq_worker_scratch_alloc_size(eqw) = size;
  54                 return;
  55         } else {
  56                 eq_worker_scratch(eqw) = NULL;
  57                 eq_worker_scratch_alloc_size(eqw) = 0;
  58                 return;
  59         }
  60 }
  61
  62 eq_worker_t
  63 eq_make_worker(void)
  64 {
  65         eq_worker_t res = xnew_and_zero(struct eq_worker_s);
  66
  67         SXE_MUTEX_INIT(&eq_worker_mtx(res));
  68         eq_worker_gcprolist(res) = NULL;
  69         eq_make_worker_scratch(res, 0);
  70         return res;
  71 }
  72
  73 static inline void
  74 eq_free_worker_scratch(eq_worker_t eqw)
  75 {
  76         if (!eq_worker_scratch(eqw)) {
  77                 return;
  78         }
  79         /* clean sweep */
  80         memset(eq_worker_scratch(eqw), 0, eq_worker_scratch_alloc_size(eqw));
  81         xfree(eq_worker_scratch(eqw));
  82         eq_worker_scratch(eqw) = NULL;
  83         eq_worker_scratch_alloc_size(eqw) = 0;
  84         return;
  85 }
  86
  87 void
  88 eq_free_worker(eq_worker_t eqw)
  89 {
  90         if (eqw == NULL)
  91                 return;
  92
  93         SXE_MUTEX_FINI(&eq_worker_mtx(eqw));
  94         eq_free_worker_scratch(eqw);
  95         xfree(eqw);
  96         return;
  97 }
  98
  99 void
 100 resize_worker_scratch(eq_worker_t eqw, size_t new_size)
 101 {
 102         eq_lock_meself(eqw);
 103         eq_free_worker_scratch(eqw);
 104         WORKERS_DEBUG_SCRATCH("resize to %ld\n", (long int)new_size);
 105         eq_make_worker_scratch(eqw, new_size);
 106         eq_unlock_meself(eqw);
 107         return;
 108 }
 109
 110 \f
 111 /* worker jobs machinery */
 112 static inline void
 113 init_worker_job_mtx(worker_job_t job)
 114 {
 115         SXE_MUTEX_INIT(&worker_job_mtx(job));
 116 }
 117
 118 static inline void
 119 fini_worker_job_mtx(worker_job_t job)
 120 {
 121         SXE_MUTEX_FINI(&worker_job_mtx(job));
 122 }
 123
 124 worker_job_t
 125 make_noseeum_worker_job(work_handler_t handler)
 126 {
 127         worker_job_t res = xnew(struct worker_job_s);
 128
 129         worker_job_queue(res) = Qnil;
 130         worker_job_handler(res) = handler;
 131         init_worker_job_mtx(res);
 132         worker_job_result(res) = Qnil;
 133         worker_job_plist(res) = Qnil;
 134         return res;
 135 }
 136
 137 worker_job_t
 138 make_worker_job(work_handler_t handler)
 139 {
 140         worker_job_t res =
 141                 alloc_lcrecord_type(struct worker_job_s, &lrecord_worker_job);
 142
 143         worker_job_queue(res) = Qnil;
 144         worker_job_handler(res) = handler;
 145         worker_job_buffer(res) = NULL;
 146         worker_job_buffer_alloc_size(res) = 0;
 147 #ifndef EF_USE_POM
 148         /* we have to care ourselves about mutex initialisation */
 149         init_worker_job_mtx(res);
 150 #endif
 151         worker_job_state(res) = WORKER_JOB_UNKNOWN;
 152         worker_job_result(res) = Qnil;
 153         worker_job_plist(res) = Qnil;
 154         return res;
 155 }
 156
 157 Lisp_Object
 158 make_worker_job_ts(Lisp_Object *into, work_handler_t handler)
 159 {
 160         worker_job_t job;
 161
 162 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
 163         lock_allocator();
 164 #endif
 165         job = make_worker_job(handler);
 166         *into = (Lisp_Object)job;
 167 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
 168         unlock_allocator();
 169 #endif
 170         return *into;
 171 }
 172
 173 static Lisp_Object
 174 worker_job_mark(Lisp_Object obj)
 175 {
 176         work_handler_t hdl;
 177         worker_job_t job = XWORKER_JOB(obj);
 178
 179         lock_worker_job(job);
 180         if ((hdl = worker_job_handler(job)) &&
 181             (work_handler_marker(hdl))) {
 182                 work_handler_marker(hdl)(job);
 183         }
 184         mark_object(worker_job_result(job));
 185         mark_object(worker_job_plist(job));
 186         unlock_worker_job(job);
 187         return worker_job_queue(job);
 188 }
 189
 190 static void
 191 worker_job_finalise(void *header, int SXE_UNUSED(for_disksave))
 192 {
 193         work_handler_t hdl;
 194         worker_job_t job = header;
 195         if ((hdl = worker_job_handler(job)) &&
 196             (work_handler_finaliser(hdl))) {
 197                 work_handler_finaliser(hdl)(job);
 198         }
 199 }
 200
 201 static void
 202 worker_job_print(Lisp_Object obj, Lisp_Object pcf, int escapeflag)
 203 {
 204         work_handler_t hdl;
 205         worker_job_t job = XWORKER_JOB(obj);
 206
 207         lock_worker_job(job);
 208         write_c_string("#<worker-job", pcf);
 209         if ((hdl = worker_job_handler(job)) &&
 210             (work_handler_printer(hdl))) {
 211                 work_handler_printer(hdl)(job, pcf);
 212         }
 213         switch (worker_job_state(job)) {
 214         case WORKER_JOB_QUEUED:
 215                 write_c_string(" :state 'queued>", pcf);
 216                 break;
 217         case WORKER_JOB_RUNNING:
 218                 write_c_string(" :state 'running>", pcf);
 219                 break;
 220         case WORKER_JOB_FINISHED:
 221                 write_c_string(" :state 'finished :result ", pcf);
 222                 print_internal(worker_job_result(job), pcf, escapeflag);
 223                 write_c_string(">", pcf);
 224                 break;
 225         case WORKER_JOB_UNKNOWN:
 226         case NUMBER_OF_WORKER_JOB_STATES:
 227         default:
 228                 write_c_string(" :state 'unknown>", pcf);
 229                 break;
 230         }
 231         unlock_worker_job(job);
 232 }
 233
 234 static int
 235 worker_job_equal(Lisp_Object obj1, Lisp_Object obj2, int SXE_UNUSED(depth))
 236 {
 237         return (obj1 == obj2);
 238 }
 239
 240 static unsigned long
 241 worker_job_hash (Lisp_Object obj, int SXE_UNUSED(depth))
 242 {
 243         return (unsigned long)obj;
 244 }
 245
 246 static Lisp_Object
 247 worker_job_getprop(Lisp_Object obj, Lisp_Object property)
 248 {
 249         Lisp_Object result = Qnil;
 250         worker_job_t job = XWORKER_JOB(obj);
 251
 252         lock_worker_job(job);
 253         result = external_plist_get(
 254                 &worker_job_plist(job), property, 0, ERROR_ME);
 255         unlock_worker_job(job);
 256         return result;
 257 }
 258
 259 static int
 260 worker_job_putprop(Lisp_Object obj, Lisp_Object property, Lisp_Object value)
 261 {
 262         worker_job_t job = XWORKER_JOB(obj);
 263
 264         lock_worker_job(job);
 265         external_plist_put(
 266                 &worker_job_plist(job), property, value, 0, ERROR_ME);
 267         unlock_worker_job(job);
 268         return 1;
 269 }
 270
 271 static int
 272 worker_job_remprop(Lisp_Object obj, Lisp_Object property)
 273 {
 274         Lisp_Object result = Qnil;
 275         worker_job_t job = XWORKER_JOB(obj);
 276
 277         lock_worker_job(job);
 278         result = external_remprop(
 279                 &worker_job_plist(job), property, 0, ERROR_ME);
 280         unlock_worker_job(job);
 281         return result;
 282 }
 283
 284 DEFUN("worker-job-plist", Fworker_job_plist, 1, 1, 0, /*
 285 Return the property list of WORKER-JOB.
 286 */
 287       (worker_job))
 288 {
 289         Lisp_Object result = Qnil;
 290         worker_job_t job;
 291
 292         CHECK_WORKER_JOB(worker_job);
 293         job = XWORKER_JOB(worker_job);
 294
 295         lock_worker_job(job);
 296         result = worker_job_plist(job);
 297         unlock_worker_job(job);
 298         return result;
 299 }
 300
 301 static const struct lrecord_description worker_job_description[] = {
 302         {XD_LISP_OBJECT, offsetof(struct worker_job_s, queue)},
 303         {XD_OPAQUE_DATA_PTR, offsetof(struct worker_job_s, handler)},
 304         {XD_OPAQUE_PTR, offsetof(struct worker_job_s, data)},
 305 #if !defined(EF_USE_POM) && defined(HAVE_THREADS)
 306         {XD_OPAQUE_PTR, offsetof(struct worker_job_s, mtx)},
 307 #endif
 308         {XD_LISP_OBJECT, offsetof(struct worker_job_s, result)},
 309         {XD_LISP_OBJECT, offsetof(struct worker_job_s, plist)},
 310         {XD_INT, offsetof(struct worker_job_s, state)},
 311
 312         {XD_OPAQUE_PTR, offsetof(struct worker_job_s, buffer)},
 313         {XD_SIZE_T, offsetof(struct worker_job_s, buffer_alloc_size)},
 314
 315         {XD_END}
 316 };
 317
 318 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(
 319         "worker_job", worker_job,
 320         worker_job_mark, worker_job_print,
 321         worker_job_finalise,
 322         worker_job_equal, worker_job_hash,
 323         worker_job_description,
 324         worker_job_getprop, worker_job_putprop,
 325         worker_job_remprop, Fworker_job_plist,
 326         struct worker_job_s);
 327
 328 void
 329 free_noseeum_worker_job(worker_job_t job)
 330 {
 331         worker_job_finalise(job, 0);
 332         fini_worker_job_mtx(job);
 333         xfree(job);
 334         return;
 335 }
 336
 337 DEFUN("get-worker-job-result", Fget_worker_job_result, 1, 1, 0, /*
 338 Return the result slot of JOB.
 339 */
 340       (job))
 341 {
 342         Lisp_Object res;
 343
 344         CHECK_WORKER_JOB(job);
 345
 346         lock_worker_job(XWORKER_JOB(job));
 347         res = XWORKER_JOB_RESULT(job);
 348         unlock_worker_job(XWORKER_JOB(job));
 349         return res;
 350 }
 351
 352 DEFUN("worker-job-p", Fworker_job_p, 1, 1, 0, /*
 353 Return non-nil iff JOB is a valid worker-job object.
 354 */
 355       (job))
 356 {
 357         if (WORKER_JOBP(job)) {
 358                 return Qt;
 359         } else {
 360                 return Qnil;
 361         }
 362 }
 363
 364 DEFUN("get-worker-job-state", Fget_worker_job_state, 1, 1, 0, /*
 365 Return the state of JOB, will be one of
 366 'unknown  when the job is in an unknown state
 367 'queued   when the job is on the queue but not yet processed
 368 'running  when the job is currently processed
 369 'finished when the job has finished
 370 */
 371       (job))
 372 {
 373         Lisp_Object result;
 374
 375         CHECK_WORKER_JOB(job);
 376
 377         lock_worker_job(XWORKER_JOB(job));
 378         switch (XWORKER_JOB_STATE(job)) {
 379         case WORKER_JOB_QUEUED:
 380                 result = Qqueued;
 381                 break;
 382         case WORKER_JOB_RUNNING:
 383                 result = Qrunning;
 384                 break;
 385         case WORKER_JOB_FINISHED:
 386                 result = Qfinished;
 387                 break;
 388         case WORKER_JOB_UNKNOWN:
 389         case NUMBER_OF_WORKER_JOB_STATES:
 390         default:
 391                 result = Qunknown;
 392                 break;
 393         }
 394         unlock_worker_job(XWORKER_JOB(job));
 395
 396         return result;
 397 }
 398
 399 \f
 400 void syms_of_workers(void)
 401 {
 402         INIT_LRECORD_IMPLEMENTATION(worker_job);
 403
 404         DEFSUBR(Fget_worker_job_result);
 405         DEFSUBR(Fget_worker_job_state);
 406         DEFSUBR(Fworker_job_p);
 407         DEFSUBR(Fworker_job_plist);
 408         defsymbol(&Qworker_jobp, "worker-job-p");
 409
 410         DEFSYMBOL(Qunknown);
 411         DEFSYMBOL(Qrunning);
 412         DEFSYMBOL(Qfinished);
 413         DEFSYMBOL(Qqueued);
 414 }
 415
 416 void vars_of_workers(void)
 417 {
 418         Fprovide(intern("workers"));
 419 }
 420
 421 /* workers.c ends here */