macros.lisp 1.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445
  1. (in-package :hurd-translator)
  2. (defmacro define-interface (what name params &body body)
  3. "Defines a new interface callback of type 'what' and name 'name'."
  4. (with-gensyms (result)
  5. `(define-hurd-interface ,what ,name ,params
  6. ; Remove 'declare' declarative clauses first.
  7. ,(remove-declare body)
  8. ;(warn "enter at ~s ~s~%" (quote ,what) (quote ,name))
  9. (let ((,result (when *translator*
  10. ,@body)))
  11. (if (null ,result)
  12. :operation-not-supported
  13. ,result)))))
  14. ;; Specialize define-interface for the various stub modules.
  15. (defmacro def-io-interface (name params &body body)
  16. "IO callbacks."
  17. `(define-interface io-routine ,name ,params
  18. ,@body))
  19. (defmacro def-fs-interface (name params &body body)
  20. "FS callbacks."
  21. `(define-interface fs-routine ,name ,params
  22. ,@body))
  23. (defmacro def-fsys-interface (name params &body body)
  24. "FSYS callbacks."
  25. `(define-interface fsys-routine ,name ,params
  26. ,@body))
  27. (defmacro stack-servers (in out &body ls)
  28. "Generates a call to 'or' with arguments from 'ls'."
  29. `(or ,@(mapcar (lambda (fun) `(,fun ,in ,out)) ls)))
  30. (defmacro with-lookup (name port &body body)
  31. "Lookups 'port' on the translator bucket and assigns it to 'name'."
  32. `(let ((,name (bucket-lookup-port (port-bucket *translator*)
  33. ,port)))
  34. (refresh-node *translator* (get-node ,name) (get-user ,name))
  35. ,@body))