;;; This module binds the libproccpuinfo C library.
;;;
;;; ---------------------------------------------------------------------
;;;
;;; To see an example of a slightly more complicated C library binding
;;; that this binding was modelled on, see the stemmer egg.
;;;
;;; Many thanks to DerGuteMoritz, sjamaan, C-Keen, and the rest of
;;; the #chicken freenode crew!
;;;
;;; ---------------------------------------------------------------------
;;;
;;; Copyright (C) 2012 - Sergey Goldgaber, Moritz Heidkamp, Christian Kellermann
;;;
;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU Affero General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;; ---------------------------------------------------------------------

(module proccpuinfo
  ;; Exported procedures:
  (proccpuinfo)

  (import
    chicken     ; Standard import
    scheme      ; Standard import
    foreign)    ; For various C types and the following special forms:
                ;    foreign-lambda,
                ;    foreign-lambda*

  ;; Note: For some more complicated bindings, it may be useful to import
  ;;       the "foreigners" and/or "bind" eggs, which could reduce the amount
  ;;       of C code you'd need to write yourself, while introducing some
  ;;       mental overhead.  For the sake of simplicity we are avoiding them in
  ;;       this binding and writing a bit of hand-generated C code ourselves to
  ;;       access the proccupinfo struct.

  ;; The C header file you're binding goes here:
  ;;
  ;; Note: The string passed to foreign-declare is injected verbatim into
  ;;       the resulting C code's head (i.e. it isn't limited to including
  ;;       header files).
  (foreign-declare "#include <proccpuinfo.h>")

  ;; The creation of an instance of the following record will be done
  ;; to ensure that procedures accepting arguments of this type won't break.
  ;;
  ;; The procedures in question must always first extract the pointer from the
  ;; record.  Then the extraction procedure should check its argument.  If it's
  ;; not a cpuinfo record, it will raise an exception.  The goal is to prevent
  ;; segfaults caused by user mistakes.
  ;;
  ;; Record-types are the only way to create custom types that are distinct
  ;; from all others.
  ;;
  ;; The record also gives you a predicate for free, so people can check
  ;; whether an object is a cpuinfo object.
  (define-record cpuinfo pointer)

  ;; Here we create a binding to proccpuinfo_free(), which will be used
  ;; by a finalizer we'll register later, to free the proccpuinfo struct
  ;; allocated by get-cpuinfo.
  ;;
  ;; The first argument to this procedure, cpuinfo, should be a record
  ;; that was previously created by make-cpuinfo. This record should
  ;; contain a valid pointer to the proccpuinfo struct created earlier
  ;; by the get-cpuinfo procedure.
  (define (delete-cpuinfo cpuinfo)
    ;; We are only interested in the pointer from the cpuinfo record:
    (let ((cpuinfo* (cpuinfo-pointer cpuinfo)))
      ;; We should only try to free the proccpuinfo struct if it has
      ;; not been freed before.  We do this by making sure cpuinfo*
      ;; if not #f
      (when cpuinfo*
        ;; Now we need to make the actual binding to proccpuinfo_free()
        ;; We do this by using foreign-lambda.
        ;;
        ;; Note: foreign-lambdas are just like plain lambdas: they're
        ;; first-class, and can be passed around as values.
        ;;
        ((foreign-lambda
           void ; The return type of the following C function:
           proccpuinfo_free ; The name of the C function we want to bind
           ;; The type of the single argument to the C function we're binding:
           ;;
           ;; Note: if there are more arguments, just put their types in order,
           ;;       below the type of the first argument.
           (c-pointer (struct "proccpuinfo")))
         ;; The function created by the foreign-lambda above will now be called
         ;; with the variable containing the pointer to the proccpuinfo struct,
         ;; which was bound in the above let.
         ;;
         cpuinfo*)
        ;; Now the final step: we make sure that the proccpuinfo struct
        ;; can not be double-freed:
        (cpuinfo-pointer-set! cpuinfo #f))))

  ;; The purpose of the following procedure will be to return a cpuinfo record,
  ;; which will contain a pointer to the proccpuinfo struct, which
  ;; can be queried by the accessor procedures we'll define later.
  ;;
  ;; The proccpuinfo_read function is even easier to bind than
  ;; the proccpuinfo_free function, as it takes no arguments.  The binding
  ;; proceeds much the same as did the binding of the proccpuinfo_free function
  ;; above.  The only new and tricky part is registering the finalizer, which
  ;; will be used to free the memory allocated by proccpuinfo_read once it's
  ;; ready to be garbage collected.
  ;;
  (define (get-cpuinfo)
    ;; First we store the result of executing the procedure created by
    ;; the foreign-lambda binding
    ;;
    ;; We'll use cpuinfo* later to register a finalizer.
    (let ((cpuinfo* ((foreign-lambda
                       ;; The return type of the C function we're binding:
                       (c-pointer (struct "proccpuinfo"))
                       ;; The name of the C function we're binding:
                       proccpuinfo_read))))
      ;; If proccpuinfo_read() fails, it will return a null pointer, which
      ;; will be translated by Chicken to #f
      ;;
      ;; We test for that here, only proceeding with the rest of the function
      ;; if it's not #f, otherwise we'll throw an error.
      (if cpuinfo*
        ;; Since we now know that we have a valid cpuinfo* we're ready
        ;; to register a finalizer.
        ;;
        ;; (make-cpuinfo cupinfo*) returns the record with the cpuinfo pointer
        ;; in it, (which isn't exposed to the user, of course).  The finalizer
        ;; is registered on this pointer, but delete-cpuinfo won't be invoked
        ;; until cpuinfo* is ready to be freed by the garbage collector, which
        ;; will happen when there are no more references in Chicken to the
        ;; pointer.
        ;;
        ;; Setting the finalizer in this way will return a cpuinfo record,
        ;; and be used as the return value of (get-cpuinfo) itself.
        (set-finalizer! (make-cpuinfo cpuinfo*) delete-cpuinfo)
        (error "The call to proccpuinfo_read() failed."))))

  ;; ---------------------------------------------------------------------------
  ;;
  ;; GLOBAL VARIABLE GET- AND SET- PROCEDURES
  ;;
  ;; The purpose of the following series of get- and set- procedures
  ;; is to retreive and set the values of a couple of libproccpuinfo
  ;; global variables.  See the libproccpuinfo's documentation for more info.

  ;; The binding to proccpuinfo_get_arch is even easier still, as it takes
  ;; no arguments and simply returns an int.
  (define (get-arch)
    ;; A call to this procedure will return the result of a call to the
    ;; function returned by the following foreign-lambda:
    ((foreign-lambda
       int ; The type of the return value of the C function we wish to bind
       proccpuinfo_get_arch))) ; The name of the C function we wish to bind

  ;; Another easy binding, to a function which takes no arguments and
  ;; returns a char *
  (define (get-filename)
    ;; A call to this procedure will return the result of a call to the
    ;; function returned by the following foreign-lambda:
    ((foreign-lambda
       c-string ; The type of the return value of the C function we wish to bind
       proccpuinfo_get_filename))) ; The name of the C function we wish to bind

  ;; This binding is a bit tricker, as we have to call the foreign-lambda
  ;; with the given argument.
  (define (set-arch arch)
    ;; A call to this procedure will return the result of a call to the
    ;; function returned by the following foreign-lambda:
    ((foreign-lambda
       void ; The type of the return value of the C function we wish to bind
       proccpuinfo_set_arch ; The name of the C function we wish to bind
       int) ; The type of the first argument to the C function we wish to bind
     arch)) ; Call the foreign-lambda with this value as its argument.
            ; Note: The FFI automatically converts the chicken number to a C int,
            ;       (i.e. you don't need to any manual type casting)

  ;; The only difference with this binding is that the C function takes a c-string
  ;; as an argument, rather than an int.
  ;;
  ;; Note: Chicken strings are not c-strings, i.e. they may contain NUL
  ;;       and the FFI will throw an error when such strings are passed
  (define (set-filename filename)
    ;; A call to this procedure will return the result of a call to the
    ;; function returned by the following foreign-lambda:
    ((foreign-lambda
       void ; The type of the return value of the C function we wish to bind
       proccpuinfo_set_filename ; The name of the C function we wish to bind
       c-string) ; The type of the first argument to the C function we wish to bind
     filename)) ; Call the foreign-lambda with this value as its argument.

  ;; This binding is the same as the previous one, only it returns
  ;; an int rather than a void.
  (define (decode-arch arch)
    ;; A call to this procedure will return the result of a call to the
    ;; function returned by the following foreign-lambda:
    ((foreign-lambda
       int ; The type of the return value of the C function we wish to bind
       proccpuinfo_decode_arch ; The name of the C function we wish to bind
       c-string) ; The type of the first argument to the C function we wish to bind
     arch)) ; Call the foreign-lambda with this value as its argument.

  ;; ---------------------------------------------------------------------------
  ;;
  ;; ACCESSOR PROCEDURES
  ;;
  ;; Now we'll define accessor procedures that will use C code to dig in to the
  ;; proccpuinfo struct created by get-cpuinfo, and return a given member of
  ;; that struct.

  ;; This procedure will return the "architecture" member of the
  ;; proccpuinfo struct.
  (define (get-architecture)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ;; A call to (get-architecture) will return the result of a call to the
      ;; function returned by the following foreign-lambda*:
      ;;
      ;; Note: We use foreign-lambda* here instead of foreign-lambda
      ;;       because the former can be passed a string containing literal
      ;;       C code instead of being limited to calling a pre-cooked
      ;;       C function, like the latter does.
      ((foreign-lambda*
         ;; Return value of the C code we're binding:
         c-string
         ;; First and only argument to the C code we're binding:
         ;;
         ;; Note: If there were more arguments, you'd put their
         ;;       types and names right below the first one.
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; Note: The name of the argument specified above
         ;;       will be used inside the C code below.
         ;;
         ;; The C code that a call to the foreign-lambda* will execute:
         ;;
         ;; Note: according to the docs, you **must** use a C_return()
         ;;       instead of an ordinary return().
         "C_return(info->architecture);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  ;; This is nearly a duplicate of the previous procedure, except
  ;; now we're going to get the "hardware_platform" struct member.
  ;;
  ;; There are many ways to reduce code duplication of this sort in Scheme.
  ;; But we're not using any of them, to keep this example as simple as possible.
  (define (get-hardware-platform)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ((foreign-lambda*
         c-string ; The type of the return value of the C code we bind below.
         ;; The first and only argument to the C code we're binding:
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; The C code that a call to the foreign-lambda* will execute:
         "C_return(info->hardware_platform);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  ;; Now we're going to continue making nearly duplicate procedures to get
  ;; the rest of the members of the proccpuinfo struct.
  ;;
  ;; Note that some of the return values in these procedures differ from one
  ;; another, according to the prototype of the proccpuinfo structure in
  ;; libproccpuinfo.h
  (define (get-frequency)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ;; A call to (get-frequency) will return the result of a call to the
      ;; function returned by the following foreign-lambda:
      ((foreign-lambda*
         double ; The type of the return value of the C code we bind below.
         ;; The first and only argument to the C code we're binding:
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; The C code that a call to the foreign-lambda* will execute:
         "C_return(info->frequency);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  (define (get-bogomips)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ;; A call to (get-bogomips) will return the result of a call to the
      ;; function returned by the following foreign-lambda:
      ((foreign-lambda*
         double ; The type of the return value of the C code we bind below.
         ;; The first and only argument to the C code we're binding:
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; The C code that a call to the foreign-lambda* will execute:
         "C_return(info->bogomips);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  (define (get-cache)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ;; A call to (get-cache) will return the result of a call to the
      ;; function returned by the following foreign-lambda:
      ((foreign-lambda*
         unsigned-int ; The type of the return value of the C code we bind below.
         ;; The first and only argument to the C code we're binding:
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; The C code that a call to the foreign-lambda* will execute:
         "C_return(info->cache);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  (define (get-cpus)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ;; A call to (get-cpus) will return the result of a call to the
      ;; function returned by the following foreign-lambda:
      ((foreign-lambda*
         unsigned-int ; The type of the return value of the C code we bind below.
         ;; The first and only argument to the C code we're binding:
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; The C code that a call to the foreign-lambda* will execute:
         "C_return(info->cpus);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  (define (get-cputype)
    ;; First, we store the result of calling (get-cpuinfo), so we
    ;; can pass it on to the the foreign-lambda* below, which will
    ;; run the C code to get the struct member we're interested in.
    (let ((info* (cpuinfo-pointer (get-cpuinfo))))
      ;; A call to (get-cputype) will return the result of a call to the
      ;; function returned by the following foreign-lambda:
      ((foreign-lambda*
         c-string ; The type of the return value of the C code we bind below.
         ;; The first and only argument to the C code we're binding:
         (((c-pointer (struct "proccpuinfo")) ; The type of the argument
           info)) ; The name of the variable it is bound to.
         ;; The C code that a call to the foreign-lambda* will execute:
         "C_return(info->cputype);")
       ;; Now we call the foreign-lambda* with the variable we bound
       ;; in the above let.
       info*)))

  ;; ---------------------------------------------------------------------------
  ;;
  ;; MODULE INTERFACE PROCEDURE
  ;;
  ;; We could stop here and simply export the accessor procedures
  ;; we've defined above.  Instead, we'll go one step further
  ;; and create a convenience procedure, which will be the
  ;; only one we'll be exporting.
  ;;
  ;; This procedure will act as the interface to this entire library.
  ;; Through it, the user will be able to request any member
  ;; of the proccpuinfo struct.
  ;;
  ;; This procedure will take one mandatory argument, and two optional
  ;; keyword arguments, "filename:" and "arch:" which will be used
  ;; to call (set-filename) and (set-arch), respectively.
  ;;
  (define (proccpuinfo desired-info . args)
    (let ((filename (get-keyword filename: args (lambda () #f)))
          (arch     (get-keyword arch:     args (lambda () #f)))
          ;; We need to save the old value of arch,
          ;; so we can restore it later:
          (old-arch     (get-arch)))
      ;; Tell libproccpuinfo about the filename or arch to use,
      ;; if the user passed them along as arguments to this procedure:
      (when filename
        (set-filename filename))
      (when arch
        (set-arch arch))
      ;; The information the user desires is gotten and temporarily saved
      ;; here using the procedures we defined above:
      (let ((result (case desired-info
                      ((architecture)      (get-architecture))
                      ((hardware-platform) (get-hardware-platform))
                      ((frequency)         (get-frequency))
                      ((bogomips)          (get-bogomips))
                      ((cache)             (get-cache))
                      ((cpus)              (get-cpus))
                      ((cputype)           (get-cputype))
                      (else 'invalid-value))))
        ;; The old values of filename and arch are restored, so that they
        ;; won't interfere with future calls to this procedure:
        ;;
        ;; Note that #f has to be passed to set-filename to reset it.
        ;; Using (set-filename "/proc/cpuinfo") or even (set-filename old-filename)
        ;; where old-filename was the result of a previous (get-filename)
        ;; will not work.
        (when filename
          (set-filename #f))
        (when arch
          (set-arch old-arch))
        ;; Give the user what he asked for:
        result)))
)
; vim: ft=chicken