Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 843cbb8cae
Fetching contributors…

Cannot retrieve contributors at this time

76 lines (65 sloc) 2.719 kb
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; indent-tabs-mode: nil -*-
;;;;
;;;; Copyright © 2009 Adlai Chandrasekhar
;;;;
;;;; Trivial Compare-and-Swap
;;;;
;;;; Sketches of a Concurrency Primitive
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defpackage :trivial-compare-and-swap
(:use :cl)
(:nicknames :trivial-cas)
#+ (and sbcl compare-and-swap-vops)
(:import-from :sb-ext :compare-and-swap)
#+ ccl
(:import-from :ccl :defx86lapfunction)
(:export #:compare-and-swap
#:atomic-incf))
(in-package :trivial-cas)
(defmacro atomic-incf (place &optional (delta 1))
(let ((old (gensym)) (new (gensym)))
`(loop for ,old = ,place for ,new = (+ ,delta ,old)
when (eq ,old (compare-and-swap ,place ,old ,new))
return ,new)))
#+ (and sbcl (not compare-and-swap-vops))
(defmacro compare-and-swap (place old new)
(warn "COMPARE-AND-SWAP is not implemented atomically on this platform.")
`(sb-ext:compare-and-swap ,place ,old ,new))
#+ (and ccl (or x86 x86-64))
(progn
(warn "COMPARE-AND-SWAP on x86-based CCL is experimental and buggy. Beware.")
(defmacro compare-and-swap (place old new)
(if (atom place)
(error 'type-error :datum place :expected-type 'cons)
(ecase (car place)
(car `(%compare-and-swap-car ,(cadr place) ,old ,new))
(cdr `(%compare-and-swap-cdr ,(cadr place) ,old ,new))
(svref `(%compare-and-swap-svref ,(cadr place) ,(caddr place) ,old ,new)))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defvar cons.car
#+x86-64 x8664::cons.car #-x86-64 x8632::cons.car)
(defvar cons.cdr
#+x86-64 x8664::cons.cdr #-x86-64 x8632::cons.cdr)
(defvar node-size
#+x86-64 x8664::node-size #-x86-64 x8632::node-size)
(defvar misc-data-offset
#+x86-64 x8664::misc-data-offset #-x86-64 x8632::misc-data-offset))
(defx86lapfunction %compare-and-swap-cdr ((cons arg_x) (old arg_y) (new arg_z))
(movq (% old) (% rax))
(lock) (cmpxchgq (% new) (@ cons.cdr (% cons)))
(movq (% rax) (% arg_z))
(single-value-return))
(defx86lapfunction %compare-and-swap-car ((cons arg_x) (old arg_y) (new arg_z))
(movq (% old) (% rax))
(lock) (cmpxchgq (% new) (@ cons.car (% cons)))
(movq (% rax) (% arg_z))
(single-value-return))
(ccl::defx86lapfunction %compare-and-swap-svref
((vec node-size) (idx arg_x) (old arg_y) (new arg_z))
(let ((vec-ptr temp0))
(movq (% old) (% rax))
(movq (@ vec (% rsp)) (% vec-ptr))
(lock) (cmpxchgq (% new) (@ misc-data-offset (% idx) (% vec-ptr)))
(movq (% rax) (% arg_z))
(single-value-return 3))))
Jump to Line
Something went wrong with that request. Please try again.