Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

renaming protocol directories, phase one

  • Loading branch information...
commit c2728cab9978be30d434658949f14bbb4c4a2cce 1 parent 119076c
@lisp authored
Showing with 317 additions and 269 deletions.
  1. +2 −2 README.md
  2. +2 −3 {AMQP-1-1-0-8-0 → amqp-1-1-0-8-0a}/abstract-classes.lisp
  3. 0  AMQP-1-1-0-8-0/AMQP-1-1-0-8-0.asd → amqp-1-1-0-8-0a/amqp-1-1-0-8-0.asd
  4. +2 −3 {AMQP-1-1-0-8-0 → amqp-1-1-0-8-0a}/classes.lisp
  5. +2 −3 {AMQP-1-1-0-8-0 → amqp-1-1-0-8-0a}/data-wire-coding.lisp
  6. +2 −3 {AMQP-1-1-0-8-0 → amqp-1-1-0-8-0a}/device-level.lisp
  7. 0  {AMQP-1-1-0-8-0 → amqp-1-1-0-8-0a}/package.lisp
  8. +2 −3 {AMQP-1-1-0-9-0 → amqp-1-1-0-9-0a}/abstract-classes.lisp
  9. 0  AMQP-1-1-0-9-0/AMQP-1-1-0-9-0.asd → amqp-1-1-0-9-0a/amqp-1-1-0-9-0.asd
  10. +2 −3 {AMQP-1-1-0-9-0 → amqp-1-1-0-9-0a}/classes.lisp
  11. 0  {AMQP-1-1-0-9-0 → amqp-1-1-0-9-0a}/data-wire-coding.lisp
  12. +2 −3 {AMQP-1-1-0-9-0 → amqp-1-1-0-9-0a}/device-level.lisp
  13. 0  {AMQP-1-1-0-9-0 → amqp-1-1-0-9-0a}/package.lisp
  14. +2 −3 {AMQP-1-1-0-9-1 → amqp-1-1-0-9-1a}/abstract-classes.lisp
  15. 0  AMQP-1-1-0-9-1/AMQP-1-1-0-9-1.asd → amqp-1-1-0-9-1a/amqp-1-1-0-9-1.asd
  16. +2 −3 {AMQP-1-1-0-9-1 → amqp-1-1-0-9-1a}/classes.lisp
  17. +2 −3 {AMQP-1-1-0-9-1 → amqp-1-1-0-9-1a}/data-wire-coding.lisp
  18. +2 −3 {AMQP-1-1-0-9-1 → amqp-1-1-0-9-1a}/device-level.lisp
  19. 0  {AMQP-1-1-0-9-1 → amqp-1-1-0-9-1a}/package.lisp
  20. +2 −3 amqp-device.lisp
  21. +2 −3 amqp-uri.lisp
  22. +4 −5 classes.lisp
  23. +2 −3 commands.lisp
  24. +2 −3 conditions.lisp
  25. +166 −74 data-wire-coding.lisp
  26. +4 −5 device-level.lisp
  27. +2 −3 device-stream.lisp
  28. +3 −3 extremely-simple-stream.lisp
  29. +2 −3 frames.lisp
  30. +3 −3 macros.lisp
  31. +6 −9 package.lisp
  32. +2 −3 parameters.lisp
  33. +71 −95 processing.lisp
  34. +1 −1  readmes/README-build-ccl.md
  35. +1 −2  states.lisp
  36. +3 −3 stream.lisp
  37. +4 −4 tools/spec.lisp
  38. +13 −9 utilities.lisp
View
4 README.md
@@ -208,8 +208,8 @@ in this combined form, under the GAL as well
- 2003 [Kevin Rosenberg](mailto:kevin@rosenberg.net)
- [5]: agpl.txt
- [6]: http://common-lisp.net/project/bordeaux-threads/darcs/bordeaux-threads/CONTRIBUTORS
+> [5]: agpl.txt
+> [6]: http://common-lisp.net/project/bordeaux-threads/darcs/bordeaux-threads/CONTRIBUTORS
--------
![made with mcl](http://www.digitool.com/img/mcl-made-1.gif "Made With MCL")
View
5 AMQP-1-1-0-8-0/abstract-classes.lisp → amqp-1-1-0-8-0a/abstract-classes.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines abstract protocol classes for AMPQ version 0.8 components of the
- `de.setf.amqp` library.")
+(:documentation "This file defines abstract protocol classes for AMPQ version 0.8 components of the
+ `de.setf.amqp` library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
0  AMQP-1-1-0-8-0/AMQP-1-1-0-8-0.asd → amqp-1-1-0-8-0a/amqp-1-1-0-8-0.asd
File renamed without changes
View
5 AMQP-1-1-0-8-0/classes.lisp → amqp-1-1-0-8-0a/classes.lisp
@@ -5,9 +5,8 @@
(in-package "DE.SETF.AMQP.IMPLEMENTATION")
-(document :file
- (description "This file contains generated protocol classes and wire-level codecs for AMQP based on the
- xml-encoded protocol specification.")
+(:documentation "This file contains generated protocol classes and wire-level codecs for AMQP based on the
+ xml-encoded protocol specification."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de)"
"'setf.amqp' is free software: you can redistribute it and/or modify
View
5 AMQP-1-1-0-8-0/data-wire-coding.lisp → amqp-1-1-0-8-0a/data-wire-coding.lisp
@@ -3,9 +3,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines buffer accessors for AMPQ version 0.9r1 components of the `de.setf.amqp`
- library.")
+(:documentation "This file defines buffer accessors for AMPQ version 0.9r1 components of the `de.setf.amqp`
+ library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
5 AMQP-1-1-0-8-0/device-level.lisp → amqp-1-1-0-8-0a/device-level.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines version-specific connecttion and channel operators for AMPQ version 0.8
- of the `de.setf.amqp` library.")
+(:documentation "This file defines version-specific connecttion and channel operators for AMPQ version 0.8
+ of the `de.setf.amqp` library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
0  AMQP-1-1-0-8-0/package.lisp → amqp-1-1-0-8-0a/package.lisp
File renamed without changes
View
5 AMQP-1-1-0-9-0/abstract-classes.lisp → amqp-1-1-0-9-0a/abstract-classes.lisp
@@ -3,9 +3,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines abstract protocol classes for AMPQ version 0.9r0 components of the
- `de.setf.amqp` library.")
+(:documentation "This file defines abstract protocol classes for AMPQ version 0.9r0 components of the
+ `de.setf.amqp` library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
0  AMQP-1-1-0-9-0/AMQP-1-1-0-9-0.asd → amqp-1-1-0-9-0a/amqp-1-1-0-9-0.asd
File renamed without changes
View
5 AMQP-1-1-0-9-0/classes.lisp → amqp-1-1-0-9-0a/classes.lisp
@@ -5,9 +5,8 @@
(in-package "DE.SETF.AMQP.IMPLEMENTATION")
-(document :file
- (description "This file contains generated protocol classes and wire-level codecs for AMQP based on the
- xml-encoded protocol specification.")
+(:documentation "This file contains generated protocol classes and wire-level codecs for AMQP based on the
+ xml-encoded protocol specification."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de)"
"'setf.amqp' is free software: you can redistribute it and/or modify
View
0  AMQP-1-1-0-9-0/data-wire-coding.lisp → amqp-1-1-0-9-0a/data-wire-coding.lisp
File renamed without changes
View
5 AMQP-1-1-0-9-0/device-level.lisp → amqp-1-1-0-9-0a/device-level.lisp
@@ -3,9 +3,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines version-specific connecttion and channel operators for AMPQ version 0.9r0
- of the `de.setf.amqp` library.")
+(:documentation "This file defines version-specific connecttion and channel operators for AMPQ version 0.9r0
+ of the `de.setf.amqp` library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
0  AMQP-1-1-0-9-0/package.lisp → amqp-1-1-0-9-0a/package.lisp
File renamed without changes
View
5 AMQP-1-1-0-9-1/abstract-classes.lisp → amqp-1-1-0-9-1a/abstract-classes.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines abstract protocol classes for AMPQ version 0.9r1 components of the
- `de.setf.amqp` library.")
+(:documentation "This file defines abstract protocol classes for AMPQ version 0.9r1 components of the
+ `de.setf.amqp` library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
0  AMQP-1-1-0-9-1/AMQP-1-1-0-9-1.asd → amqp-1-1-0-9-1a/amqp-1-1-0-9-1.asd
File renamed without changes
View
5 AMQP-1-1-0-9-1/classes.lisp → amqp-1-1-0-9-1a/classes.lisp
@@ -5,9 +5,8 @@
(in-package "DE.SETF.AMQP.IMPLEMENTATION")
-(document :file
- (description "This file contains generated protocol classes and wire-level codecs for AMQP based on the
- xml-encoded protocol specification.")
+(:documentation "This file contains generated protocol classes and wire-level codecs for AMQP based on the
+ xml-encoded protocol specification."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de)"
"'setf.amqp' is free software: you can redistribute it and/or modify
View
5 AMQP-1-1-0-9-1/data-wire-coding.lisp → amqp-1-1-0-9-1a/data-wire-coding.lisp
@@ -2,9 +2,8 @@
(in-package "DE.SETF.AMQP.IMPLEMENTATION")
-(document :file
- (description "This file defines buffer accessors for AMPQ version 0.9r1 components of the `de.setf.amqp`
- library.")
+(:documentation "This file defines buffer accessors for AMPQ version 0.9r1 components of the `de.setf.amqp`
+ library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
5 AMQP-1-1-0-9-1/device-level.lisp → amqp-1-1-0-9-1a/device-level.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines version-specific connecttion and channel operators for AMPQ version 0.9r1
- of the `de.setf.amqp` library.")
+(:documentation "This file defines version-specific connecttion and channel operators for AMPQ version 0.9r1
+ of the `de.setf.amqp` library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
0  AMQP-1-1-0-9-1/package.lisp → amqp-1-1-0-9-1a/package.lisp
File renamed without changes
View
5 amqp-device.lisp
@@ -3,9 +3,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the `amqp-device` class to extend `simple-stream` devices as part of the
- 'de.setf.amqp' library.")
+(:documentation "This file defines the `amqp-device` class to extend `simple-stream` devices as part of the
+ 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
5 amqp-uri.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the amqp-uri class to specialize `puri:uri` for use with the 'de.setf.amqp'
- library.")
+(:documentation "This file defines the amqp-uri class to specialize `puri:uri` for use with the 'de.setf.amqp'
+ library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
9 classes.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the CLOS model for AMQP `object` and `method` entities for the
- 'de.setf.amqp' library.")
+(:documentation "This file defines the CLOS model for AMQP `object` and `method` entities for the
+ 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -502,7 +501,7 @@
(:documentation "The abstract tunnel class is specialized for each protocol version."))
-(document "class and connection relative id-to-abstract-type maps"
+(:documentation "class and connection relative id-to-abstract-type maps"
"to version-specific classes. the primary operators (ensure-method ensure-object)
combine a context and a designator - either a code when parsing, or an abstract
name in processing functions, and produce an instance of the concrete
@@ -562,7 +561,7 @@
)
-(document (amqp:ensure-method amqp:ensure-object)
+(:documentation (amqp:ensure-method amqp:ensure-object)
"Each class combines with its operators to perform commands. In addition each channel is associated with
class.command instances which apply to it and a connection is assocaiated with it channels. In order that
subsequent operations reflect previous settings, each context caches constituents. In the case of the
View
5 commands.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the protocol operators for AMQP `class` and `METHOD` entities for the
- 'de.setf.amqp' library.")
+(:documentation "This file defines the protocol operators for AMQP `class` and `METHOD` entities for the
+ 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
5 conditions.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines AMQP conditions respective versions 0-8, 0-9 as part of the 'de.setf.amqp'
- library.")
+(:documentation "This file defines AMQP conditions respective versions 0-8, 0-9 as part of the 'de.setf.amqp'
+ library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
240 data-wire-coding.lisp
@@ -3,8 +3,7 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines buffer accessors for AMQP data as part of the 'de.setf.amqp' library.")
+(:documentation "This file defines buffer accessors for AMQP data as part of the 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -70,7 +69,7 @@
-(document (with-argument-decoders with-property-decoders)
+(:documentation (with-argument-decoders with-property-decoders)
"The wire-level representation presents three patterns:
- a fixed record structure for fields universally present - eg, frame type, channel, and size
@@ -275,7 +274,7 @@
-(document "The individual AMQP field types all resolve to common lisp types. Some directly, but most in
+(:documentation "The individual AMQP field types all resolve to common lisp types. Some directly, but most in
terms of custom type definitions. This applies, for example, to types where the AMQP size specifies the bit
count of the respective size field rather than the length of the data. For example, string-8. These type
definitions for these base types follow below. All names are in the :amqp package.
@@ -283,13 +282,14 @@
Given these, the operator def-encodings (see below) defines version specific type predicates, elementary
buffer accessors and composite codecs.")
-#-sbcl
+#+digitool
(deftype amqp:frame-buffer (&optional length)
(if length
`(simple-array (unsigned-byte 8) (*))
`(simple-array (unsigned-byte 8) (,length))))
-#+sbcl ;; don't tell it more than it needs to know, otherwise shorter vectors conflict with declarations
+#+(or clozure sbcl)
+;; don't tell it more than it needs to know, otherwise shorter vectors conflict with declarations
(deftype amqp:frame-buffer (&optional length)
(declare (ignore length))
`(simple-array (unsigned-byte 8) (*)))
@@ -308,6 +308,18 @@
(string (map-into buffer #'char-code initial-contents))
(vector (replace buffer initial-contents)))))
+#+digitool
+(deftype amqp::string-buffer (&optional length)
+ (if length
+ `(simple-array character (*))
+ `(simple-array character (,length))))
+
+#+(or clozure sbcl)
+;; don't tell it more than it needs to know, otherwise shorter vectors conflict with declarations
+(deftype amqp::string-buffer (&optional length)
+ (declare (ignore length))
+ `(simple-array character (*)))
+
(deftype amqp:bit ()
"The bit type is a common lisp boolean which is coded to a bit array"
@@ -438,7 +450,7 @@
-(document (compute-type-initform field-type-initform)
+(:documentation (compute-type-initform field-type-initform)
"Where class slots definitions and codec keyword arguments require default values, these
are imputed from the respective field type. This occurs as the specifications are translated into
class and method definitions, at which point any version specific types are generalized and yield
@@ -499,7 +511,7 @@
(compute-field-type-initform field type))
-(document (def-encodings def-byte-accessors def-string-accessors)
+(:documentation (def-encodings def-byte-accessors def-string-accessors)
"The codecs implement transformations between lisp objects and byte sequences. The buffer type,
frame-buffer, is defined as (vector (unsigned-byte 8) (*)). It serves as a declaration and an argument
constraint. Each version's codecs are are expressed in terms of that version's types and its operators.
@@ -759,10 +771,9 @@ In addition compound buffer accessors are defined for the types
-(document (encode-ieee-754-32 encode-ieee-754-64)
- " codec operators
-
- The protocol data domain names vary from version to version, but they
+(:documentation ieee-754-32-integer-to-float ieee-754-64-integer-to-float
+ ieee-754-32-float-to-integer ieee-754-64-float-to-integer
+ "The protocol data domain names vary from version to version, but they
resolve to a limited number of lisp types, mostly
string
@@ -783,44 +794,128 @@ In addition compound buffer accessors are defined for the types
;;;
;;; floating point is brute force.
-(defun encode-ieee-754-32 (integer)
+(defun ieee-754-32-integer-to-float (integer)
(let* ((negative-p (logbitp 31 integer))
(sign (if negative-p -1 +1))
- (exponent (- (ash (logand #x7f800000 integer) -23) 127))
+ (raw-exponent (ash (logand #x7f800000 integer) -23))
+ (exponent (- raw-exponent 127))
(fraction (logand #x007fffff integer)))
- (cond ((zerop exponent)
- (if (zerop fraction)
- (float 0 single-float-epsilon)
- (float (* sign (* fraction #.(expt 2 -23)) (expt 2 exponent)) single-float-epsilon)))
- ((= exponent #.(1- (expt 2 8)))
- (if (zerop fraction)
- (if negative-p single-float-negative-infinity single-float-positive-infinity)
- single-float-nan))
- (t
- (float (* sign (1+ (* fraction #.(expt 2 -23))) (expt 2 exponent))
- single-float-epsilon)))))
-
-(defun encode-ieee-754-64 (integer)
+ (case raw-exponent
+ (#xff
+ (if (zerop fraction)
+ (if negative-p single-float-negative-infinity single-float-positive-infinity)
+ single-float-nan))
+ (#x00
+ ;; (print (list :to-float sign raw-exponent exponent fraction))
+ (if (zerop fraction)
+ (if negative-p -0.0s0 0.0s0)
+ (float (* sign (* fraction (expt 2 (- exponent 22)))) single-float-epsilon)))
+ (t
+ ;; (print (list :to-float sign raw-exponent exponent fraction))
+ (float (* sign (1+ (* fraction #.(expt 2 -23))) (expt 2 exponent))
+ single-float-epsilon)))))
+
+(defun ieee-754-64-integer-to-float (integer)
(let* ((negative-p (logbitp 63 integer))
(sign (if negative-p -1 +1))
- (exponent (- (ash (logand #x7ff0000000000000 integer) -52) 2043))
+ (raw-exponent (ash (logand #x7ff0000000000000 integer) -52))
+ (exponent (- raw-exponent 1023))
(fraction (logand #x000fffffffffffff integer)))
- (cond ((zerop exponent)
- (if (zerop fraction)
- (float 0 single-float-epsilon)
- (float (* sign (* fraction #.(expt 2 -52)) (expt 2 exponent)) double-float-epsilon)))
- ((= exponent #.(1- (expt 2 11)))
- (if (zerop fraction)
- (if negative-p double-float-negative-infinity double-float-positive-infinity)
- double-float-nan))
- (t
- (float (* sign (1+ (* fraction #.(expt 2 -52))) (expt 2 (- exponent 127)))
- double-float-epsilon)))))
-
-;; (eql (encode-ieee-754-32 #b00111110001000000000000000000000) 0.15625)
-;; (eql (encode-ieee-754-32 #b11000010111011010100000000000000) -118.625)
-
-
+ (case raw-exponent
+ (#x7ff
+ (if (zerop fraction)
+ (if negative-p double-float-negative-infinity double-float-positive-infinity)
+ double-float-nan))
+ (#x000
+ ;; (print (list :to-float sign raw-exponent exponent fraction))
+ (if (zerop fraction)
+ (if negative-p -0.0d0 0.0d0)
+ (float (* sign (* fraction (expt 2 (- exponent 51)))) double-float-epsilon)))
+ (t
+ ;; (print (list :to-float sign raw-exponent exponent fraction))
+ (float (* sign (1+ (* fraction #.(expt 2 -52))) (expt 2 exponent))
+ double-float-epsilon)))))
+
+;; (eql (ieee-754-32-integer-to-float #b00111110001000000000000000000000) 0.15625)
+;; (eql (ieee-754-32-integer-to-float #b11000010111011010100000000000000) -118.625)
+
+(defun raw-decode-short-float (float)
+ (etypecase float
+ (short-float )
+ (long-float (setf float (float float 1.0s0))))
+ #+ccl (multiple-value-bind (fraction exponent sign)
+ (ccl::fixnum-decode-short-float float)
+ (values fraction exponent (plusp sign)))
+ ;; from sbcl:src;code;float.lisp
+ #+sbcl (let* ((bits (sb-kernel::single-float-bits (abs float)))
+ (exp (ldb sb-vm:single-float-exponent-byte bits))
+ (sig (ldb sb-vm:single-float-significand-byte bits))
+ (sign (minusp (float-sign float))))
+ (values sig exp sign))
+ #-(or ccl sbcl) (error "NYI: fixnum-decode-short-float"))
+
+(defun raw-decode-long-float (float)
+ (etypecase float
+ (short-float (setf float (float float 1.0d0)))
+ (long-float ))
+ #+ccl (multiple-value-bind (hi lo exp sign) (ccl::%integer-decode-double-float float)
+ (values (logior (ash hi 28) lo) exp (minusp sign)))
+ #+sbcl (let* ((abs (abs float))
+ (hi (sb-kernel::double-float-high-bits abs))
+ (lo (sb-kernel::double-float-low-bits abs))
+ (exp (ldb sb-vm:double-float-exponent-byte hi))
+ ;(sig (ldb sb-vm:double-float-significand-byte hi))
+ (sign (minusp (float-sign float))))
+ (values
+ (logior (ash (logior (ldb sb-vm:double-float-significand-byte hi)
+ sb-vm:double-float-hidden-bit)
+ 32)
+ lo)
+ exp sign))
+ #-(or ccl sbcl) (error "NYI: fixnum-decode-long-float"))
+
+
+(defun ieee-754-32-float-to-integer (float)
+ (cond ((= float single-float-negative-infinity)
+ #xff800000)
+ ((= float single-float-positive-infinity)
+ #x7f800000)
+ ((eql float single-float-nan)
+ ;; http://en.wikipedia.org/wiki/NaN#Encodings
+ ;; http://java.sun.com/javase/6/docs/api/java/lang/Double.html#doubleToLongBits(double)
+ #x7fc00000)
+ ((= float 0.0s0)
+ (if (minusp (float-sign float)) #x80000000 #x00000000))
+ (t
+ (multiple-value-bind (fraction exponent sign)
+ (raw-decode-short-float float)
+ (if (zerop exponent)
+ (logior (if sign #x80000000 0)
+ (logand fraction #x007fffff))
+ (logior (if sign #x80000000 0)
+ (ash exponent 23)
+ (logand fraction #x007fffff)))))))
+
+(defun ieee-754-64-float-to-integer (float)
+ (cond ((= float double-float-negative-infinity)
+ #xfff0000000000000)
+ ((= float double-float-positive-infinity)
+ #x7ff0000000000000)
+ ((eql float double-float-nan)
+ ;; http://en.wikipedia.org/wiki/NaN#Encodings
+ ;; http://java.sun.com/javase/6/docs/api/java/lang/Double.html#doubleToLongBits(double)
+ #x7ff8000000000000)
+ ((= float 0.0d0)
+ (if (minusp (float-sign float)) #x8000000000000000 #x0000000000000000))
+ (t
+ (multiple-value-bind (fraction exponent sign)
+ (raw-decode-long-float float)
+ (if (zerop exponent)
+ (logior (if sign #x8000000000000000 0)
+ (logand fraction #x000fffffffffffff))
+ (logior (if sign #x8000000000000000 0)
+ (ash exponent 52)
+ (logand fraction #x000fffffffffffff)))))))
#+ignore ; not used as the logic is protocol-specific
@@ -928,21 +1023,21 @@ In addition compound buffer accessors are defined for the types
(defun buffer-short-float (buffer position)
- (values (encode-ieee-754-32 (buffer-integer buffer position 4))
+ (values (ieee-754-32-integer-to-float (buffer-integer buffer position 4))
(+ position 4)))
(defun (setf buffer-short-float) (value buffer position)
- (declare (ignore value buffer position))
- (error "NYI: (setf buffer-short-float)"))
+ (setf (buffer-integer buffer position) (ieee-754-32-float-to-integer value))
+ (values value (+ position 4)))
(defun buffer-double-float (buffer position)
- (values (encode-ieee-754-64 (buffer-integer buffer position 8))
+ (values (ieee-754-64-integer-to-float (buffer-integer buffer position 8))
(+ position 8)))
(defun (setf buffer-double-float) (value buffer position)
- (declare (ignore value buffer position))
- (error "NYI: (setf buffer-double-float)"))
+ (setf (buffer-integer buffer position) (ieee-754-64-float-to-integer value))
+ (values value (+ position 8)))
#+(or )
@@ -986,8 +1081,7 @@ In addition compound buffer accessors are defined for the types
:de.setf.amqp.implementation))
(bytes (floor length 8)))
`(progn (defun ,buffer-unsigned-name (buffer position &optional (assert-conditions t))
- #-sbcl (declare (type (frame-buffer ,*frame-size*) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type fixnum position))
(when assert-conditions
(assert-argument-type ,buffer-unsigned-name buffer frame-buffer)
@@ -1004,8 +1098,7 @@ In addition compound buffer accessors are defined for the types
(values value position)))
(defun (setf ,buffer-unsigned-name) (value buffer position &optional (assert-conditions t))
- #-sbcl (declare (type (frame-buffer ,*frame-size*) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type fixnum position)
(type ,(if (<= (expt 2 length) most-positive-fixnum) 'fixnum 'integer) value))
(assert-condition (and (integerp value) (>= value 0) (< value ,(expt 2 length)))
@@ -1055,7 +1148,7 @@ In addition compound buffer accessors are defined for the types
(64 (setf (buffer-unsigned-byte-64 buffer position) value))))
-(document (buffer-timestamp (setf buffer-stimestamp))
+(:documentation (buffer-timestamp (setf buffer-stimestamp))
"Timestamps are '64-bit POSIX time_t format with an accuracy of one second[1].
The UNIX epoch is 1970-01-01T00:00:00Z. This is specified by the amqp:*timestamp-epoch*,
which the buffer accessors use to shift to/from universal time.
@@ -1094,8 +1187,7 @@ In addition compound buffer accessors are defined for the types
(length-bytes (floor length-bits 8)))
(declare (ignore buffer-utf16-name buffer-utf32-name))
`(progn (defun ,buffer-iso-name (buffer position)
- #-sbcl (declare (type (simple-array (unsigned-byte 8) (,*frame-size*)) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type fixnum position))
(assert-argument-type ,buffer-iso-name buffer frame-buffer)
(assert-condition (and (typep position 'fixnum) (<= (+ position ,length-bytes) (length buffer)))
@@ -1106,8 +1198,7 @@ In addition compound buffer accessors are defined for the types
(incf position ,length-bytes)
(if (plusp length)
(let ((result (make-array length :element-type +string-element-type+)))
- #-sbcl (declare (type (simple-array character (,*frame-size*)) result))
- #+sbcl (declare (type (simple-array character (*)) result))
+ (declare (type amqp::string-buffer result))
(assert-condition (<= (+ position length) (length buffer))
,buffer-iso-name "string overflows buffer: (~s + ~s), ~s"
position length (length buffer))
@@ -1118,13 +1209,13 @@ In addition compound buffer accessors are defined for the types
(values result position))
(values "" position))))
(defun (setf ,buffer-iso-name) (value buffer position)
- #-sbcl (declare (type (simple-array (unsigned-byte 8) (,*frame-size*)) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type fixnum position)
(type string value))
- (assert-argument-type ,buffer-iso-name buffer frame-buffer)
- (assert-argument-type ,buffer-iso-name value string) ; no remorse
+ (assert-argument-type (setf ,buffer-iso-name) buffer frame-buffer)
+ (assert-argument-type (setf ,buffer-iso-name) value string) ; no remorse
(let* ((length (length value)))
+ ; (print (list length value buffer (+ position length ,length-bytes) (length buffer)))
(assert-condition (< length ,(expt 2 length-bits))
(setf ,buffer-iso-name) "String overflows the size constraint")
(assert-condition (and (typep position 'fixnum) (<= (+ position length ,length-bytes) (length buffer)))
@@ -1133,13 +1224,13 @@ In addition compound buffer accessors are defined for the types
(setf (,buffer-unsigned-name buffer position nil) length)
(incf position ,length-bytes)
(dotimes (i length)
+ ; (print (list length value buffer position i (aref value i)))
(setf (aref buffer position) (char-code (aref value i)))
(incf position))
(values value position buffer)))
(defun ,buffer-utf8-name (buffer position)
- #-sbcl (declare (type (simple-array (unsigned-byte 8) (,*frame-size*)) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type fixnum position))
(assert-argument-type ,buffer-iso-name buffer frame-buffer)
(assert-condition (and (typep position 'fixnum) (<= (+ position ,length-bytes) (length buffer)))
@@ -1152,12 +1243,12 @@ In addition compound buffer accessors are defined for the types
(incf position ,length-bytes)
(if (plusp length)
(let ((result (make-array length :element-type +string-element-type+)))
- (declare (type (simple-array character (,*frame-size*)) result))
+ (declare (type amqp::string-buffer result))
(assert-condition (<= (setf end (+ position length)) (length buffer))
,buffer-iso-name "string size overflows buffer: (~s + ~s), ~s"
position length (length buffer))
(flet ((buffer-extract-byte (buffer)
- (declare (type (simple-array (unsigned-byte 8) (,*frame-size*)) buffer))
+ (declare (type amqp::frame-buffer buffer))
(assert-condition (< position end)
,buffer-iso-name "string overflows own size: ~s, ~s"
position end)
@@ -1169,24 +1260,24 @@ In addition compound buffer accessors are defined for the types
(values result end))
(values "" end))))
(defun (setf ,buffer-utf8-name) (value buffer position)
- #-sbcl (declare (type (simple-array (unsigned-byte 8) (,*frame-size*)) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type fixnum position)
(type string value))
(assert-argument-type (setf ,buffer-utf8-name) buffer frame-buffer)
- (assert-argument-type ,buffer-iso-name value string)
+ (assert-argument-type (setf ,buffer-utf8-name) value string)
(let* ((length (length value))
(max-position 0)
(start position)
(encoder (load-time-value (content-encoding-byte-encoder (content-encoding :utf-8)))))
- ;; can't check bounds here as the object length does not signify
+ ;; can't check bounds here as the object length does not signify, but still limit
+ ;; to the maximum buffer size
(incf position ,length-bytes)
- (setf max-position (+ position ,(expt 2 length-bits)))
+ (setf max-position (min (+ position ,(expt 2 length-bits)) (length buffer)))
+ ; (print (list length value buffer (+ position length ,length-bytes) (length buffer) max-position))
(assert-condition (< length ,(expt 2 length-bits))
(setf ,buffer-utf8-name) "String overflows the size constraint")
(flet ((buffer-insert-byte (buffer byte)
- #-sbcl (declare (type (simple-array (unsigned-byte 8) (,*frame-size*)) buffer))
- #+sbcl (declare (type (simple-array (unsigned-byte 8) (*)) buffer))
+ (declare (type amqp:frame-buffer buffer))
(declare (type (unsigned-byte 8) byte))
;; check bounds here as it's finally the encoded positioning
(assert-condition (< position max-position)
@@ -1196,6 +1287,7 @@ In addition compound buffer accessors are defined for the types
(incf position)))
(declare (dynamic-extent #'buffer-insert-byte)) ; just in case
(dotimes (i length) ; can't check bounds here either
+ ; (print (list length value buffer position i (aref value i)))
(funcall encoder (char value i) #'buffer-insert-byte buffer))
;; update the length prefix after the fact
(setf (,buffer-unsigned-name buffer start nil) (- position (+ start ,length-bytes)))
View
9 device-level.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file implements device-level support for streams based on AMQP connections as part of the
- 'de.setf.amqp' library.")
+(:documentation "This file implements device-level support for streams based on AMQP connections as part of the
+ 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -761,7 +760,7 @@ as well as the discussions of the the alternative fu interface.[5]
(values version frame)))))))
-(document (negotiate-client-connection open-connection)
+(:documentation (negotiate-client-connection open-connection)
"AMQP connection negotiation occurs in two steps. First, the peers agree on a protocol version. Second
they exchange authentication and control information to set up the connection. The first step is
implemented by open-connection. It negotiates with the broker to agree on a supported protocol version
@@ -808,7 +807,7 @@ returned.")
device))
-(document (device-read-content device-write-content)
+(:documentation (device-read-content device-write-content)
"The content processing interface comprises the two operators
* device-read-message (channel &rest)
* device-write-message (channel body &rest)
View
5 device-stream.lisp
@@ -2,9 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines a stream interface for AMQP channel and connection instances for the
- 'de.setf.amqp' library.")
+(:documentation "This file defines a stream interface for AMQP channel and connection instances for the
+ 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
6 extremely-simple-stream.lisp
@@ -2,9 +2,9 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines defines the absolutely minimal `simple-stream` class for the
- 'de.setf.amqp' library.")
+(:documentation "This file defines defines the absolutely minimal `simple-stream` class for the
+ 'de.setf.amqp' library."
+
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
5 frames.lisp
@@ -2,8 +2,7 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the wire-level frame model for for the `de.setf.amqp` Connon Lisp library.")
+(:documentation "This file defines the wire-level frame model for for the `de.setf.amqp` Connon Lisp library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -659,7 +658,7 @@
(+ end 12)))
-(document (read-7-byte-header-frame read-8-byte-header-frame read-12-byte-header-frame)
+(:documentation (read-7-byte-header-frame read-8-byte-header-frame read-12-byte-header-frame)
"The abstract frame structure (header . payload), is implemented variously in the respective versions.
The header size varies. The end marker is eliminated. The field sizes change. To allow for this, each
connection uses a specialized frame class and that class implements the general frame format.
View
6 macros.lisp
@@ -3,9 +3,9 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the macros to declare protocol objects and methods for the
- 'de.setf.amqp' library.")
+(:documentation "This file defines the macros to declare protocol objects and methods for the
+ 'de.setf.amqp' library."
+
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
15 package.lisp
@@ -2,11 +2,10 @@
(in-package :cl-user)
-(de.setf.utility:document :file
- (description "This file defines the packages for the 'de.setf.amqp' library.")
- (copyright
- "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
- "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
+(:documentation "This file defines the packages for the 'de.setf.amqp' library."
+ (copyright
+ "Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
+ "'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
of the GNU Affero General Public License as published by the Free Software Foundation.
'setf.amqp' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
@@ -15,8 +14,8 @@
A copy of the GNU Affero General Public License should be included with 'de.setf.amqp' as `AMQP:agpl.txt`.
If not, see the GNU [site](http://www.gnu.org/licenses/).")
-
- (long-description "Several packages are used
+
+ (long-description "Several packages are used
- `_` isolates macro symbols
- `de.setf.amqp` (`amqp`) : exports the names of protocol classes and operators.
@@ -708,8 +707,6 @@
:double-float-negative-infinity ; variable
:double-float-positive-infinity ; variable
:dtx-channel ; function
- :encode-ieee-754-32 ; function
- :encode-ieee-754-64 ; function
:encode-method ; function
:enqueue
:error-class-code ; function
View
5 parameters.lisp
@@ -2,8 +2,7 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines global parameters for the 'de.setf.amqp' library.")
+(:documentation "This file defines global parameters for the 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -146,4 +145,4 @@
(defconstant single-float-nan
(+ single-float-positive-infinity single-float-negative-infinity))
(defconstant double-float-nan
- (+ double-float-positive-infinity double-float-negative-infinity)))
+ (+ double-float-positive-infinity double-float-negative-infinity)))
View
166 processing.lisp
@@ -2,8 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the AMQP input processing pipeline for the 'de.setf.amqp' library.")
+(:documentation "This file defines the AMQP input processing pipeline for the 'de.setf.amqp' library."
+
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -55,7 +55,72 @@
a class, that is passed, otherwise - for headers and body, the frame
itself is passed.
- For an other takes on processing patterns see alternative implementations:
+
+ In general application processing and output frame generation is coordinated with the stream of
+input frames. input and output frame streams are both queue mediated. each channel is associated with a
+single process, but multiple channels share a single connection. There are three separate issues
+involved in application-specific request/response processing:
+
+ - control : asynchronous/synchronous binding of control flow to the command;
+ - protocol: which operations and which logic apply to which read/to-be-written commands;
+ - visibility : the scope and extent of the definition;
+
+ The _control_ mechanism must allow for several variations:
+
+ process channel connection control
+ 1-1-1-s single single single sync
+ 1-1-1-a single single single async
+ 1-*-1-s single multiple single sync
+ 1-*-1-a single multiple single async
+ *-*-1-s multiple multiple single sync
+ *-*-1-a multiple multiple single async
+ 1-*-*-s single multiple multiple sync
+ 1-*-*-a single multiple multiple async
+ *-*-*-s multiple multiple multiple sync
+ *-*-*-a multiple multiple multiple async
+
+ This includes just a subset of all possible combinations, as multi-process/single-channel processing is not
+supported, and single-channel/multi-connection is not plausible. The async control mechanism does not
+necessarily imply an additional "event" process, just that input processong can occur other than as a response
+to an explicit read/poll. this would happen when input frames are processed
+as a side-effect of output, or frames are processed in addition to those which the
+application is intending to read.
+
+ The _protocol_ issues are managed through conventions for class and method naming and maps between
+line codes and abstract and protocl-version specific names.
+
+ Each possible response to _visibility_ issues supports a different the application architecture
+
+ - specialize the standard request-/respond-to operators with an additional protocol class for
+ synchronous message processing. this can follow a clim/presentation `with-` pattern, or
+ it can be in terms of an intrinsic element, such as the connection or channel. in the latter
+ case, where the aim is to avoid the additional parameter, pervasiv specialization is accomplished by
+ - specializing the ensure-object constructor for the connection or the channel classes
+ - implementing a dynamic, context-specific type->class map for connections and/or channels
+ this approach is supported by the static `request-` / `respond-to-` operators, for which the base generic
+ operators incorporate an initial channel argument.
+ - establish command filters as part of the applications dynamic state / call-stack to implement arbitrary
+ state machines. this is accomplished with the `command-case` and
+ `command-loop` forms which conditionalize processing clauses by command (object x method) types.
+ static state machine.
+ - bind handlers to the communication stream - in the form of the connection or channel
+ to implement custom behavior with arbitrary universal or selective operations on frames.
+
+In combination, these approaches yield the generic interface structure
+
+ ;; read frame
+ handle-frame (frame) ->
+ ;; parse class, method, arguments
+ handle-class-and-method (class . method) ->
+ ;; delegate to a dynamic handler stack
+ statically-declared/dynamically-extent handlers (case class method)
+ ;; alternatively, to channel/instance handlers
+ dynamically-declare/indefinite-extent handlers (funcall (channel-handler class method))
+ ;; ultimately, to static functions
+ (apply-static-method method class)
+
+
+ For other takes on processing patterns see alternative implementations:
RabbitMQ's java library interposes the AMPCommand [1] class on the channel, which
acts as a state machine to filter the incoming frames. It releases composed
commands which combine the operator/arguments, an envelope with content header
@@ -64,7 +129,7 @@
that all message content is the correct length, w/o interleaving that with application
processing. On the other hand, it impedes streaming.
-
+---
[1]: http://www.rabbitmq.com/releases/rabbitmq-java-client/v1.7.0/rabbitmq-java-client-javadoc-1.7.0/com/rabbitmq/client/impl/AMQCommand.html"))
@@ -439,7 +504,7 @@ processing. On the other hand, it impedes streaming.
-(document (process-command dynamic-process-command)
+(:documentation (process-command dynamic-process-command)
"Interface Operators :
@@ -632,7 +697,7 @@ processing. On the other hand, it impedes streaming.
(setf (ccl:assq 'command-case ccl::*fred-special-indent-alist*) 1)
-(document (compute-channel-command-handler channel-command-handler channel-command)
+(:documentation (compute-channel-command-handler channel-command-handler channel-command)
"Instance-scoped Commands :
Instance-scoped commands are integrated into a channel's command-handler function.
@@ -703,92 +768,3 @@ processing. On the other hand, it impedes streaming.
(apply ,function channel class method args)))))
-#|
-
-;;; initial thoughts on how to process. for the most part adopted by the implementation...
-;;;
-;;; various methods can intervene in the request/response process. they differ
-;;; according to the application architecture
-;;;
-;;; - a specialized protocol class can be used to extend the request-/respond-to
-;;; operators to implement synchronous message processing.
-;;; - it can be introduced by specializing the connection or the channel
-;;; classes and the ensure-object constructor
-;;; - it can be introduced by modifying the connection's type->class map
-;;; either statically or dynamically
-;;; - custom behavior can be implemented strictly in command-case forms as a
-;;; static state machine.
-;;; - custom behavior can be implemented by adding a handler to the channel
-;;; to apply arbitrary functions to frames universally or selectively.
-
-
-handle-frame (frame) ->
- handle-class-and-method (class . command) ->
- loop handlers (funcall handler class command)
- ;; if none handles
- (apply-method method class)
-
-? using the (with- ) pattern: (consuming , or (with-comsumer ?
-analogous to clim accept contexts, it affects the (connection? channel? )input within its dynamic context
-
-define message processing protocol by specializing individual functions and providing a specialized protocol class instance,
-that is, by implementing a protocol interface, or by providing a processing object which defines all the requisite methods
-in terms of the data.
-
-as clos is not a containment model for specialization, the operators would need an additional initial arguement, event
-though it is mostly redundant, since most commands apply to just one class.
-it is more succinct to juet spread the method instance's arguments in the function call and apply it, by name to the class.
-
-this leaves class specialization as the customization method.
-if the method operators are statially defined, this s easier to comprehend and maintain, but harder to change the behaviour dynamically.
-one must substitute a different "factory" class - connection, channel, etc in order to get specialized command method discriminators.
-
-which makes it difficult to achieve (with semantics
-
-
-three separate issues
- - protocol: which operations and which logic apply to which read/to-be-written commands.
- - control : asynchronous/synchronous binding of control flow to the command.
- - visibility : the scope and extent of the definition.
-
-the protocol is specified by combining send-*/receive, command-case with
-implicit encoding and decoding operations and logic which interprets/specifies
-class and command fields and properties.
-
-the control structure concerns how the stream of input frames is coordinated with
-the stream of output frames and with other application processing. the input and
-output streams are both queue mediated. each channel is associated with a single
-process, but multiple channels share a single connection. This must allow for several variations:
-
- process channel connection control
-1-1-1-s single single single sync
-1-1-1-a single single single async
-1-*-1-s single multiple single sync
-1-*-1-a single multiple single async
-*-*-1-s multiple multiple single sync
-*-*-1-a multiple multiple single async
-1-*-*-s single multiple multiple sync
-1-*-*-a single multiple multiple async
-*-*-*-s multiple multiple multiple sync
-*-*-*-s multiple multiple multiple async
-
-the "single" process / "async" control does not necessarily imply an additional
-"event" process, just that input processong can occur other than as a response
-to an explicit read/poll
-
-the variations are implemented in an amqp:client instance, which also caches
-properties which would be used for connection establishment. one would like to
-be able to specify as little as possible in advance, but the control adjust to
-contingencies. thus the input/output queues are always present to arbitrate
-access to a given connection.
-
-(defclass amqp:client ()
- (user)
- (password))
-
-with a 1-1-1-S, in synchronous mode, the process writes frames or reads
-them as explicit operations. nothing happens to read implicitly when writing
-and write block, so they leave nothing queued.
-
-
-|#
View
2  readmes/README-build-ccl.md
@@ -4,7 +4,7 @@ DE.SETF.AMQP: build it with Clozure Common Lisp
The system can be built and saved as a run-time image from the command line
- $ export CCL=/Development/Applications/LISP/ccl-1.4/dppccl
+ $ export CCL=/Development/Applications/LISP/ccl-1-4/dppccl
$ $CCL --no-init --load readmes/build-init.lisp \
--eval "(asdf:operate 'asdf:load-op :de.setf.amqp.amqp-1-1-0-8-0)" \
--eval "(asdf:operate 'asdf:load-op :de.setf.amqp.amqp-1-1-0-9-0)" \
View
3  states.lisp
@@ -2,8 +2,7 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines the state model for AMQP classes for the 'de.setf.amqp' library.")
+(:documentation "This file defines the state model for AMQP classes for the 'de.setf.amqp' library."
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
6 stream.lisp
@@ -2,9 +2,9 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines a stream interface for AMQP channel and connection instances for the
- 'de.setf.amqp' library.")
+(:documentation "This file defines a stream interface for AMQP channel and connection instances for the
+ 'de.setf.amqp' library."
+
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
View
8 tools/spec.lisp
@@ -3,9 +3,9 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file generates protocol classes and wire-level codecs for AMQP based on the
- xml-encoded protocol specification.")
+(:documentation "This file generates protocol classes and wire-level codecs for AMQP based on the
+ xml-encoded protocol specification."
+
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de)"
"'setf.amqp' is free software: you can redistribute it and/or modify
@@ -41,7 +41,7 @@
,@body))
(defparameter *license*
- '(document :file
+ '(:documentation :file
(description "This file contains generated protocol classes and wire-level codecs for AMQP based on the
xml-encoded protocol specification.")
(copyright
View
22 utilities.lisp
@@ -2,8 +2,8 @@
(in-package :de.setf.amqp.implementation)
-(document :file
- (description "This file defines utility operators for the 'de.setf.amqp' library.")
+(:documentation "This file defines utility operators for the 'de.setf.amqp' library."
+
(copyright
"Copyright 2010 [james anderson](mailto:james.anderson@setf.de) All Rights Reserved"
"'de.setf.amqp' is free software: you can redistribute it and/or modify it under the terms of version 3
@@ -21,23 +21,27 @@
;;; macros
(defmacro assert-condition (form &rest args)
- (let ((format-string nil) (format-arguments nil) (operator nil))
+ (let ((format-control nil) (format-arguments nil) (operator nil))
(when (or (typep (first args) '(and symbol (not keyword)))
(and (consp (first args)) (eq (caar args) 'setf)))
(setf operator (pop args)))
+ ;; if there control is first, assume (control . args)
(when (stringp (first args))
- (setf format-string (pop args)
+ (setf format-control (pop args)
format-arguments (shiftf args nil)))
- (destructuring-bind (&key (operator operator) (format-string format-string) (format-arguments format-arguments)
+ (destructuring-bind (&key (operator operator)
+ (format-string format-control) (format-control format-string)
+ (format-arguments format-arguments)
(type (if (and (consp form) (eq (first form) 'typep)) (third form) `(satisfies ,form))))
args
`(unless ,form
(error 'simple-type-error
:expected-type (quote ,type)
- :format-string ,(format nil "~@[~a: ~]condition failed: ~s~:[.~; ~~@?~]"
- operator form
- format-string)
- :format-arguments ,(when format-string `(list ,format-string ,@format-arguments)))))))
+ :format-control ,(format nil "~@[~a: ~]condition failed: ~s~:[.~; ~~@?~]"
+ operator form
+ ;; if a control is present include the recursive format
+ format-control)
+ :format-arguments ,(when format-control `(list ,format-control ,@format-arguments)))))))
(defmacro def-delegate-slot ((class slot) &rest operators)
`(progn ,@(mapcar #'(lambda (op)
Please sign in to comment.
Something went wrong with that request. Please try again.