Peter Bex  committed 82739ea

Make ioctl interface a little less verbose by generating some stuff that's always the same in a macro. This should also inline it

  • Participants
  • Parent commits a618ccd
  • Branches default

Comments (0)

Files changed (1)

File bpf-interface.scm

 (define error-string (foreign-lambda c-string "strerror" int))
-;; From the IOCTL egg, with tweaks.  Would be overkill to use it as a dependency
+;; From the IOCTL egg, with some tweaks for brevity and convenience
 (define ioctl0
   (foreign-lambda* int (((c-pointer int) err) (int fd) (unsigned-long req))
     "int res = ioctl(fd, req);"
     "*err = errno;"
-(define (ioctl port request #!optional arg)
-  (let ((fd (if (port? port) (port->fileno port) port)))
-    (let-location ((err int))
-      (let ((res (if arg
-                     (ioctl1 (location err) fd request arg)
-                     (ioctl0 (location err) fd request))))
-        (if (= res -1)
-            (error (error-string err))
-            res)))))
+(define-syntax ioctl
+  (ir-macro-transformer
+   (lambda (e i c)
+     (let ((fd `(bpf-fd ,(cadr e)))     ; Always a bpf object
+           (request `(foreign-value ,(->string (strip-syntax (caddr e))) int))
+           (arg (and (pair? (cdddr e)) `(location ,(cadddr e)))))
+       `(let-location ((err int))
+          (let ((res ,(if arg
+                          `(ioctl1 (location err) ,fd ,request ,arg)
+                          `(ioctl0 (location err) ,fd ,request))))
+            (if (= res -1)
+                (error (error-string err))
+                res)))))))
             (bpf-interface-set! bpf interface)
             ;; Rather pointless to expose this as a "setter" procedure(?)
             (when promiscuous
-              (ioctl fd (foreign-value "BIOCPROMISC" int)))
+              (ioctl bpf BIOCPROMISC))
 (define (bpf-close bpf)
 (define (bpf-flush! bpf)
-  (ioctl (bpf-fd bpf) (foreign-value "BIOCFLUSH" int)))
+  (ioctl bpf BIOCFLUSH))
 ;; Returns the *actual* size that was set, the requested size is too big
 ;; Remember, this can only be done *before* setting the interface.
 ;; no way to set a new interface *and* buffer-length...
 (define (bpf-buffer-length-set! bpf requested-length)
   (let-location ((new-length int requested-length))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCSBLEN" int) (location new-length))
+    (ioctl bpf BIOCSBLEN new-length)
 (define interface-name-maximum-length (foreign-value "IF_NAMESIZE" int))
        "char *ifname = ((struct ifreq *)i)->ifr_name;"
        "strncpy(ifname, s, len);"
        "ifname[len] = '\\0';") ifreq interface len)
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCSETIF" int) (location ifreq))
+    (ioctl bpf BIOCSETIF ifreq)
 (define (bpf-interface bpf)
   (let ((ifreq (make-blob (foreign-value "sizeof(struct ifreq)" int))))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCGETIF" int) (location ifreq))
+    (ioctl bpf BIOCGETIF ifreq)
     ((foreign-lambda* c-string ((scheme-pointer i))
        "C_return(((struct ifreq *)i)->ifr_name);") ifreq)))
 (define (bpf-buffer-length bpf)
   (let-location ((length unsigned-int))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCGBLEN" int) (location length))
+    (ioctl bpf BIOCGBLEN length)
 ;; These are a bit problematic: there is a shitload of known types.
 ;; more-or-less what C is doing with its #defines.
 (define (bpf-datalink-type bpf)
   (let-location ((type unsigned-int))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLT" int) (location type))
+    (ioctl bpf BIOCGDLT type)
 (define (bpf-datalink-type-set! bpf type)
   (let-location ((type unsigned-int type))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCSDLT" int) (location type))
+    (ioctl bpf BIOCSDLT type)
 (define (bpf-list-datalink-types bpf)
   (let ((in (make-blob (foreign-value "sizeof(struct bpf_dltlist)" int))))
     ((foreign-lambda* void (((c-pointer "struct bpf_dltlist") p))
        "p->bfl_list = NULL;") (location in))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLTLIST" int) (location in))
+    (ioctl bpf BIOCGDLTLIST in)
     (let* ((length ((foreign-lambda* unsigned-int
                         (((c-pointer "struct bpf_dltlist") p))
                       "C_return(p->bfl_len);") (location in)))
       ((foreign-lambda* void (((c-pointer "struct bpf_dltlist") p)
                               ((c-pointer "u_int") list))
          "p->bfl_list = list;") (location in) (location types))
-      (ioctl (bpf-fd bpf) (foreign-value "BIOCGDLTLIST" int) (location in))
+      (ioctl bpf BIOCGDLTLIST in)
        (lambda (i)
 (define (bpf-read-timeout bpf)
   (let ((tv (make-blob (foreign-value "sizeof(struct timeval)" int))))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCGRTIMEOUT" int) (location tv))
+    (ioctl bpf BIOCGRTIMEOUT tv)
     ((foreign-lambda* double (((c-pointer "struct timeval") tv))
        "C_return(tv->tv_sec + tv->tv_usec / 1000000.0);") (location tv))))
        "double i;"
        "tv->tv_usec = (int)(modf(timeout, &i) * 1000000);"
        "tv->tv_sec = (int)timeout;") (location tv) timeout)
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCSRTIMEOUT" int) (location tv))
+    (ioctl bpf BIOCSRTIMEOUT tv)
 (define (bpf-stats bpf)
   (let ((st (make-blob (foreign-value "sizeof(struct bpf_stat)" int))))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCGSTATS" int) (location st))
+    (ioctl bpf BIOCGSTATS st)
     (let ((result '()))
       (let-syntax ((add-stat!
                     (syntax-rules ()
   (let ((expected-major (foreign-value "BPF_MAJOR_VERSION" int))
         (expected-minor (foreign-value "BPF_MINOR_VERSION" int))
         (v (make-blob (foreign-value "sizeof(struct bpf_version)" int))))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCVERSION" int) (location v))
+    (ioctl bpf BIOCVERSION v)
     (let-location ((major int) (minor int))
       ((foreign-lambda* void (((c-pointer "struct bpf_version") v)
                               ((c-pointer int) major) ((c-pointer int) minor))
                             (scheme-pointer i) (unsigned-int len))
        "p->bf_len = len;"
        "p->bf_insns = i;") (location prog) insns (fx/ (##sys#size insns) 8))
-    (ioctl (bpf-fd bpf) (foreign-value "BIOCSETF" int) (location prog))
+    (ioctl bpf BIOCSETF prog)