Commit 88be939a authored by Zach Beane's avatar Zach Beane
Browse files

Enough to get a request accepted and initially handled.

Now triggers a stream error regarding prepend-streams.
parent 6194e036
......@@ -9,7 +9,7 @@
#:macroexpand
#:read-sequence
#:streamp
#:stream-external-format)
#:read-char)
,@clauses)))
(defun zacl-cl:read-sequence (sequence stream &key start end partial-fill)
......@@ -31,3 +31,10 @@
(defun zacl-cl:streamp (object)
(or (streamp object)
(usocket-p object)))
(defgeneric zacl-cl:read-char (stream &optional eof-error-p eof-value)
(:method ((stream usocket) &optional (eof-error-p t) eof-value)
(read-char (socket-stream stream) eof-error-p eof-value))
(:method ((stream stream) &optional (eof-error-p t) eof-value)
(read-char stream eof-error-p eof-value)))
......@@ -21,13 +21,13 @@
(unless class-table
(setf class-table
(setf (gethash class-name *fake-slots-table*)
(make-hash-table)))
(let ((slot-table (gethash slot-name class-table)))
(unless slot-table
(setf slot-table
(setf (gethash slot-name class-table)
(make-weak-hash-table))))
slot-table))))
(make-hash-table))))
(let ((slot-table (gethash slot-name class-table)))
(unless slot-table
(setf slot-table
(setf (gethash slot-name class-table)
(make-weak-hash-table))))
slot-table)))
(defun fake-slot-table (slot-name class-name)
(gethash slot-name (gethash class-name *fake-slots-table*)))
......
......@@ -127,7 +127,9 @@ values otherwise."
(string-to-octets string
:external-format (translate-external-format external-format)))
(defun excl:string-to-octets (string &key external-format)
(defun excl:string-to-octets (string &key external-format null-terminate)
(when null-terminate
(error "No null terminating!"))
(string-to-octets string
:external-format (translate-external-format external-format)))
......@@ -220,3 +222,8 @@ values otherwise."
(defun excl::make-basic-lock (&key name)
(make-basic-lock :name name))
(define-condition excl:socket-error (error)
((identifier
:initarg :identifier
:reader excl:stream-error-identifier)))
......@@ -40,6 +40,9 @@
:reader process-run-reasons
;; private to zacl
:writer (setf process-run-reasons))
(run-reasons-lock
:initform (make-lock)
:reader run-reasons-lock)
(property-list
:initform nil
:accessor mp:process-property-list)))
......@@ -65,8 +68,15 @@
(defgeneric mp:process-add-run-reason (process object)
(:method (process object)
;; XXX Needs to start process running
(push object (process-run-reasons process))))
(with-lock-held ((run-reasons-lock process))
(push object (process-run-reasons process)))
(process-enable process)))
(defgeneric mp:process-revoke-run-reason (process object)
(:method (process object)
(with-lock-held ((run-reasons-lock process))
(setf (process-run-reasons process)
(delete object (process-run-reasons process))))))
(defgeneric mp:process-allow-schedule ()
(:method ()
......@@ -76,23 +86,20 @@
(:method (process)
(process-kill process)))
(defgeneric mp:process-preset (process fun)
(:method (process fun)
(process-preset process fun)))
(defgeneric mp:process-revoke-run-reason (process object)
(:method (process object)
;; XXX Needs to stop process if no more run reasons left
(setf (process-run-reasons process)
(delete object (process-run-reasons process)))))
(defgeneric mp:process-preset (process fun &rest args)
(:method (process fun &rest args)
(apply #'process-preset process fun args )))
(defgeneric mp:process-run-function (name-or-plist function &rest arguments)
(:method ((name string) function &rest arguments)
(apply #'mp:process-run-function (list :name name) function arguments))
(:method ((plist list) function &rest arguments)
(apply #'process-run-function plist function arguments)))
(apply #'process-run-function (list* :class 'zacl-process plist)
function arguments)))
(defgeneric mp:process-run-reasons (process))
(defgeneric mp:process-run-reasons (process)
(:method (process)
(process-run-reasons process)))
;;; Queues
......
......@@ -46,7 +46,9 @@
#:get-local-port
#:socket-option
#:get-peer-address
#:usocket-p)
#:usocket-p
#:usocket
#:socket-stream)
(:import-from #:bordeaux-threads
#:make-thread
#:current-thread
......@@ -94,7 +96,9 @@
(:export #:read-sequence
#:macroexpand
#:stream-external-format
#:streamp))
#:streamp
#:read-char
#:read-char-no-hang))
;;; Allegro packages
......@@ -109,6 +113,7 @@
#:thenret
#:else)
(:export #:synchronizing-structure
#:socket-error
#:with-locked-structure
#:incf-atomic
#:decf-atomic
......@@ -156,6 +161,7 @@
(defpackage #:socket
(:use)
(:export #:make-socket
#:socket-error
#:accept-connection
#:socket-control
#:local-port
......
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