Permalink
Browse files

Epic: Moved out Erlang external format code to its own library.

  • Loading branch information...
1 parent 23d12a8 commit 42279d859062eb7dff42c6ad749df41f10c6125a @flambard committed Nov 17, 2012
View
@@ -9,7 +9,7 @@
:author "Markus Flambard <mflambard@common-lisp.net>"
:version "0.1.2"
:license "MIT License"
- :depends-on (:usocket :flexi-streams :md5 :alexandria :nibbles)
+ :depends-on (:erlang-term :usocket :flexi-streams :md5 :alexandria :nibbles)
:components
((:module :src
:components
@@ -18,153 +18,38 @@
:depends-on ("packages"))
(:file "local-node"
:depends-on ("packages"))
- (:file "macros"
- :depends-on ("packages"))
- (:file "generic-functions"
- :depends-on ("packages"
- "constants"))
(:file "remote-node"
:depends-on ("packages"
"handshake"
"listen"
"local-node"
"atom-cache"))
- (:file "conditions"
- :depends-on ("packages"))
- (:file "constants"
- :depends-on ("packages"))
(:file "atom-cache"
:depends-on ("packages"))
(:file "atom-cache-entries"
:depends-on ("packages"
- "atom-cache"
- "special-variables"))
- (:file "special-variables"
- :depends-on ("packages"))
- (:file "bops"
- :depends-on ("packages"))
- (:file "classes"
- :depends-on ("packages"))
- (:file "type-erlang-translatable"
- :depends-on ("packages"
- "classes"))
+ "atom-cache"))
(:file "distribution-header"
:depends-on ("packages"
- "atom-cache"
- "bops"))
+ "atom-cache"))
(:file "epmd"
:depends-on ("packages"
"listen"
"local-node"
- "remote-node"
- "bops"))
- (:file "decode"
- :depends-on ("packages"
- "conditions"
- "bops"
- "generic-functions"
- "constants"
- "special-variables"
- "classes"
- "atom-cache"
- "erlang-atom"
- "erlang-binary"
- "erlang-float"
- "erlang-fun"
- "erlang-integer"
- "erlang-list"
- "erlang-pid"
- "erlang-port"
- "erlang-reference"
- "erlang-tuple"))
+ "remote-node"))
(:file "handshake"
:depends-on ("packages"
"local-node"
- "bops"
"md5"))
(:file "md5" ;; Needs MD5 library
:depends-on ("packages"))
(:file "control-message"
- :depends-on ("packages"
- "classes"
- "decode"))
+ :depends-on ("packages"))
(:file "node-protocol"
:depends-on ("packages"
"distribution-header"
- "classes"
- "bops"
"control-message"
"remote-node"))
- (:file "erlang-atom"
- :depends-on ("packages"
- "constants"
- "conditions"
- "special-variables"
- "bops"))
- (:file "erlang-binary"
- :depends-on ("packages"
- "constants"
- "conditions"
- "special-variables"
- "classes"
- "bops"))
- (:file "erlang-float"
- :depends-on ("packages"
- "constants"
- "conditions"
- "bops"))
- (:file "erlang-fun"
- :depends-on ("packages"
- "macros"
- "constants"
- "conditions"
- "special-variables"
- "classes"
- "bops"))
- (:file "erlang-integer"
- :depends-on ("packages"
- "constants"
- "conditions"
- "bops"))
- (:file "erlang-list"
- :depends-on ("packages"
- "macros"
- "constants"
- "conditions"
- "special-variables"
- "bops"))
- (:file "erlang-pid"
- :depends-on ("packages"
- "local-node"
- "constants"
- "conditions"
- "special-variables"
- "classes"
- "bops"))
- (:file "erlang-port"
- :depends-on ("packages"
- "constants"
- "conditions"
- "classes"
- "bops"))
- (:file "erlang-reference"
- :depends-on ("packages"
- "constants"
- "conditions"
- "classes"
- "bops"))
- (:file "erlang-string"
- :depends-on ("packages"
- "constants"
- "conditions"
- "special-variables"
- "bops"))
- (:file "erlang-tuple"
- :depends-on ("packages"
- "constants"
- "conditions"
- "classes"
- "bops"))
))))
(asdf:defsystem :cleric-test
View
@@ -1,86 +0,0 @@
-(in-package :cleric-bops)
-
-(defun bytes-to-unsigned-integer (bytes &optional (number-of-bytes nil) (pos 0))
- (loop
- with n = (if number-of-bytes number-of-bytes (length bytes))
- with uint = 0
- for b upfrom pos
- for i from (ash (1- n) 3) downto 0 by 8
- do (setf (ldb (byte 8 i) uint) (aref bytes b))
- finally (return uint)))
-
-(defun bytes-to-uint16 (bytes &optional (pos 0))
- (nibbles:ub16ref/be bytes pos))
-
-(defun bytes-to-uint32 (bytes &optional (pos 0))
- (nibbles:ub32ref/be bytes pos))
-
-
-(defun read-uint16 (stream)
- (nibbles:read-ub16/be stream))
-
-(defun read-uint32 (stream)
- (nibbles:read-ub32/be stream))
-
-
-(defun write-uint16 (int stream)
- (nibbles:write-ub16/be int stream)
- t)
-
-(defun write-uint32 (int stream)
- (nibbles:write-ub32/be int stream)
- t)
-
-
-(defun bytes-to-signed-int32 (bytes &optional (pos 0))
- (nibbles:sb32ref/be bytes pos))
-
-(defun read-signed-int32 (stream)
- (nibbles:read-sb32/be stream))
-
-
-(defun unsigned-integer-to-bytes (uint number-of-bytes)
- (loop
- with bytes = (nibbles:make-octet-vector number-of-bytes)
- for b upfrom 0
- for i from (ash (1- number-of-bytes) 3) downto 0 by 8
- do (setf (aref bytes b) (ldb (byte 8 i) uint))
- finally (return bytes)))
-
-(defun uint16-to-bytes (int)
- (let ((bytes (nibbles:make-octet-vector 2)))
- (setf (nibbles:ub16ref/be bytes 0) int)
- bytes))
-
-(defun uint32-to-bytes (int)
- (let ((bytes (nibbles:make-octet-vector 4)))
- (setf (nibbles:ub32ref/be bytes 0) int)
- bytes))
-
-
-(defun string-to-bytes (string)
- (map 'simple-vector #'char-code string))
-
-(defun bytes-to-string (bytes &optional length (pos 0))
- (map 'string #'code-char (subseq bytes pos (when length (+ pos length)))))
-
-
-(defun read-bytes (n stream)
- (let ((bytes (nibbles:make-octet-vector n)))
- (read-sequence bytes stream)
- ;; Does it block until the whole sequence is filled when reading from a socket?
- bytes))
-
-(defun read-string (n stream)
- (let ((str (make-string n)))
- (read-sequence str stream)
- str))
-
-
-(defun double-float-to-bytes (f)
- (let ((bytes (nibbles:make-octet-vector 8)))
- (setf (nibbles:ieee-double-ref/be bytes 0) f)
- bytes))
-
-(defun bytes-to-double-float (bytes)
- (nibbles:ieee-double-ref/be bytes 0))
View
@@ -1,45 +0,0 @@
-(in-package :cleric-etf)
-
-(defclass erlang-object ()
- ())
-
-(defmethod make-instance :around ((class (eql 'erlang-object)) &rest initargs &key &allow-other-keys)
- (declare (ignore initargs))
- (error "Not possible to make an instance of class ~s" class))
-
-
-(defclass erlang-fun (erlang-object)
- ((module :reader module :initarg :module)
- (arity :reader arity :initarg :arity :documentation "The arity of an Erlang Fun."))
- (:documentation "Erlang fun."))
-
-(defmethod make-instance :around ((class (eql 'erlang-fun)) &rest initargs &key &allow-other-keys)
- (declare (ignore initargs))
- (error "Not possible to make an instance of class ~s" class))
-
-
-(defclass erlang-internal-fun (erlang-fun)
- ((pid :initarg :pid)
- (index :initarg :index)
- (uniq :initarg :uniq)
- (free-vars :reader free-vars :initarg :free-vars))
- (:documentation "Erlang fun in internal format."))
-
-(defmethod make-instance :around ((class (eql 'erlang-internal-fun)) &rest initargs &key &allow-other-keys)
- (declare (ignore initargs))
- (error "Not possible to make an instance of class ~s" class))
-
-
-(defclass erlang-identifier (erlang-object)
- ((node :reader node :initarg :node)
- (id :initarg :id)
- (creation :initarg :creation)))
-
-(defmethod make-instance :around ((class (eql 'erlang-identifier)) &rest initargs &key &allow-other-keys)
- (declare (ignore initargs))
- (error "Not possible to make an instance of class ~s" class))
-
-(defmethod match-p ((a erlang-identifier) (b erlang-identifier))
- (and (eq (node a) (node b))
- (every #'= (slot-value a 'id) (slot-value b 'id))
- (= (slot-value a 'creation) (slot-value b 'creation))))
View
@@ -1,27 +0,0 @@
-(in-package :cleric-etf)
-
-(define-condition not-implemented-error (program-error)
- ((comment :reader comment :initarg :comment))
- (:documentation "The signaling function is not implemented yet."))
-
-(define-condition malformed-message-error (error)
- ((bytes :reader bytes :initarg :bytes))
- (:documentation "This error is signaled when a protocol message is malformed."))
-
-(define-condition malformed-external-erlang-term-error (error)
- ((bytes :reader bytes :initarg :bytes))
- (:documentation "This error is signaled when an encoded Erlang term is malformed."))
-
-(define-condition untranslatable-lisp-object-error (error)
- ((object :reader object :initarg :object))
- (:documentation "This error is signaled when trying to encode an unencodable object."))
-
-(define-condition unexpected-message-length-error (malformed-message-error)
- ((received-length :reader received-length :initarg :received-length)
- (expected-length :reader expected-length :initarg :expected-length))
- (:documentation "This error is signaled when the specified length of a message is not the expected length."))
-
-(define-condition unexpected-message-tag-error (malformed-message-error)
- ((received-tag :reader received-tag :initarg :received-tag)
- (expected-tags :reader expected-tags :initarg :expected-tags))
- (:documentation "This error is signaled when an unexpected message tag is read."))
View
@@ -1,29 +0,0 @@
-;;;; Constants
-
-(in-package :cleric-etf)
-
-;;; Erlang data tags
-(defconstant +compressed-term+ 80)
-(defconstant +new-float-ext+ 70)
-(defconstant +bit-binary-ext+ 77)
-(defconstant +atom-cache-ref+ 82)
-(defconstant +small-integer-ext+ 97)
-(defconstant +integer-ext+ 98)
-(defconstant +float-ext+ 99)
-(defconstant +atom-ext+ 100)
-(defconstant +reference-ext+ 101)
-(defconstant +port-ext+ 102)
-(defconstant +pid-ext+ 103)
-(defconstant +small-tuple-ext+ 104)
-(defconstant +large-tuple-ext+ 105)
-(defconstant +nil-ext+ 106)
-(defconstant +string-ext+ 107)
-(defconstant +list-ext+ 108)
-(defconstant +binary-ext+ 109)
-(defconstant +small-big-ext+ 110)
-(defconstant +large-big-ext+ 111)
-(defconstant +new-fun-ext+ 112)
-(defconstant +export-ext+ 113)
-(defconstant +new-reference-ext+ 114)
-(defconstant +small-atom-ext+ 115)
-(defconstant +fun-ext+ 117)
Oops, something went wrong.

0 comments on commit 42279d8

Please sign in to comment.