Source File c-delegate/c-delegate.ils

    1 ;;; c-delegate.ils --- Solution to "Link C++ - SKILL"
    2 
    3 ;; Copyright (C) 2013  Damien Diederen
    4 
    5 ;; @author Damien Diederen <dd@crosstwine.com>
    6 
    7 ;; Permission is hereby granted, free of charge, to any person
    8 ;; obtaining a copy of this software and associated documentation
    9 ;; files (the "Software"), to deal in the Software without
   10 ;; restriction, including without limitation the rights to use, copy,
   11 ;; modify, merge, publish, distribute, sublicense, and/or sell copies
   12 ;; of the Software, and to permit persons to whom the Software is
   13 ;; furnished to do so, subject to the following conditions:
   14 ;;
   15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
   16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
   17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
   18 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
   19 ;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
   20 ;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
   21 ;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
   22 ;; SOFTWARE.
   23 
   24 ;;; Commentary:
   25 
   26 ;; Cf. http://www.cadence.com/Community/forums/p/24699/1318711.aspx#1318711.
   27 ;;
   28 ;; The goal of this small package is to demonstrate communication
   29 ;; between SKILL and an external executable program (the "delegate").
   30 ;;
   31 ;; Inputs are passed as command-line arguments, results are parsed out
   32 ;; from the delegate's standard output.  The delegate is written in C,
   33 ;; and can be found in the c-delegate.c source file.  It must be
   34 ;; compiled prior to use; e.g. by running:
   35 ;;
   36 ;;     $ make CC=<your-c-compiler> CFLAGS=<your-c-flags>
   37 ;;
   38 ;; from the package's directory.
   39 ;;
   40 ;; The main entry point is MyInvokeCDelegate; here are basic usage
   41 ;; instructions:
   42 ;;
   43 ;;     $ $CDSHOME/tools/dfII/bin/skill
   44 ;;     (load "pkg/c-delegate/c-delegate.ils")
   45 ;;     |- t
   46 ;;     (MyInvokeCDelegate 1.1 1.2 1.3 1.4 5)
   47 ;;     |- ((1.1 1.2)
   48 ;;     |   (2.4 2.6)
   49 ;;     |   (3.7 4.0)
   50 ;;     |   (5.0 5.4)
   51 ;;     |   (6.3 6.8))
   52 ;;
   53 ;; This has been tested on a Linux box, using Veda 0.2.0
   54 ;; (http://crosstwine.com/veda/):
   55 ;;
   56 ;;     $ make
   57 ;;     cc  -o c-delegate c-delegate.c
   58 ;;     $ veda test-package
   59 ;;         Testing c-delegate
   60 ;;     === RUN Test_InvokeCDelegate
   61 ;;     --- PASS: Test_InvokeCDelegate
   62 
   63 ;;; Code:
   64 
   65 ;; Predeclaration of our globally visible entry point.
   66 ;; @ignore
   67 (define MyInvokeCDelegate nil)
   68 
   69 ;; Scope/hide utility functions and related data.
   70 (let ()
   71   ;; The base name of the executable to invoke.
   72   (define cDelegate
   73       "c-delegate")
   74 
   75   ;; The full path to this SKILL++ file, as seen by (load "..."); used
   76   ;; by FindSibling.
   77   (define thisFilename
   78       (when (isCallable 'get_filename)
   79         (get_filename piport)))
   80 
   81   ;; FindSibling returns the complete path to filename, which is a
   82   ;; sibling to this file, or nil if no such readable file could be
   83   ;; found.
   84   (defun FindSibling (filename)
   85     (when thisFilename
   86       (let ((suffix (rindex thisFilename "/")))
   87         (when suffix
   88           (letseq ((diff ((strlen thisFilename) - (strlen suffix)))
   89                    (prefix (substring thisFilename 1 (diff + 1)))
   90                    (pathname (strcat prefix filename)))
   91             (when (isReadable pathname)
   92               pathname))))))
   93 
   94   ;; PrepareCommand builds the command line to be used to invoke the
   95   ;; delegate.  It takes the same arguments as InvokeCDelegate, and
   96   ;; massages them into string form.
   97   (defun PrepareCommand (x0 y0 dx dy steps)
   98     (let ((path (or (FindSibling cDelegate)
   99                     (strcat "./" cDelegate))))
  100       (sprintf nil "%L %L %L %L %L %L"
  101                path x0 y0 dx dy steps)))
  102 
  103   ;; ParseFloatPair expects two (and exactly two)
  104   ;; whitespace-separated, atof-parseable values in string, and
  105   ;; returns them as a SKILL list of floating-point values.
  106   ;;
  107   ;; It returns nil on failure.
  108   (defun ParseFloatPair (string)
  109     ;; This could be anything; from a simple sscanf to a very complex
  110     ;; parser depending on the chosen data format.
  111     (let ((pair (mapcar atof (parseString string))))
  112       (when (and (equal (length pair) 2)
  113                  (not (memq nil pair)))
  114         pair)))
  115 
  116   ;; InvokeCDelegate passes its arguments to an external program which
  117   ;; implements an extremely complicated algorithm involving legacy
  118   ;; code, and which cannot possibly be rewritten in SKILL(++).
  119   ;;
  120   ;; See that program's detailed documentation for more information.
  121   ;;
  122   ;; This function takes care of the I/O, and parses the results back
  123   ;; into a list of 2-lists of floating-point values.
  124   (defun InvokeCDelegate (x0 y0 dx dy steps)
  125     (let ((cmd (PrepareCommand x0 y0 dx dy steps)))
  126       (let ((ipc (ipcBeginProcess cmd))
  127             ;; Accumulator.
  128             (pairs nil)
  129             ;; Temporary.
  130             (data nil))
  131         ;; Nothing to be provided on standard input.
  132         (ipcCloseProcess ipc)
  133         (while (setq data (ipcReadProcess ipc))
  134           (let ((pair (ParseFloatPair data)))
  135             ;; Error strategy?
  136             (when pair
  137               (push pair pairs))))
  138         (ipcWait ipc)
  139         (let ((status (ipcGetExitStatus ipc)))
  140           (unless (zerop status)
  141             ;; Nonzero means something went wrong.
  142             (error "Command %L exited with %L." cmd status)))
  143         (reverse pairs))))
  144 
  145   ;; Exports the local function.
  146   (setq MyInvokeCDelegate InvokeCDelegate))
  147 
  148 ;;; c-delegate.ils ends here