rcl/alien-macros.lisp

   1 ;; Copyright (c) 2006 Carlos Ungil
   2
   3 ;; Permission is hereby granted, free of charge, to any person obtaining
   4 ;; a copy of this software and associated documentation files (the
   5 ;; "Software"), to deal in the Software without restriction, including
   6 ;; without limitation the rights to use, copy, modify, merge, publish,
   7 ;; distribute, sublicense, and/or sell copies of the Software, and to
   8 ;; permit persons to whom the Software is furnished to do so, subject to
   9 ;; the following conditions:
  10
  11 ;; The above copyright notice and this permission notice shall be
  12 ;; included in all copies or substantial portions of the Software.
  13
  14 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  15 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  16 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  17 ;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
  18 ;; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
  19 ;; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
  20 ;; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  21
  22 (in-package :rcl)
  23
  24 (defmacro new-language-construct (n)
  25   `(rf-allocvector langsxp ,n))
  26
  27 (defmacro new-integer (n)
  28   `(rf-allocvector intsxp ,n))
  29
  30 (defmacro new-real (n)
  31   `(rf-allocvector realsxp ,n))
  32
  33 (defmacro new-complex (n)
  34   `(rf-allocvector cplxsxp ,n))
  35
  36 (defmacro new-list (n)
  37   `(rf-allocvector vecsxp ,n))
  38
  39 (defmacro new-logical (n)
  40   `(rf-allocvector lglsxp ,n))
  41
  42 (defmacro new-character (n)
  43   `(rf-allocvector strsxp ,n))
  44
  45 (defmacro new-string (n)
  46   `(rf-allocvector strsxp ,n))
  47
  48 (defmacro new-string-single (string)
  49   `(rf-mkstring ,string))
  50
  51 (defmacro new-internal-char (string)
  52   `(rf-mkchar ,string))
  53
  54 (defmacro sexp-attrib (sexp)
  55   `(cffi:foreign-slot-value ,sexp 'SEXPREC 'attrib))
  56
  57 (defmacro sexp-union (sexp)
  58   `(cffi:foreign-slot-value ,sexp 'SEXPREC 'u))
  59
  60 (defmacro sexp-vecsxp (sexp)
  61   `(cffi:foreign-slot-value ,sexp 'VECTOR_SEXPREC 'vecsxp))
  62
  63 (defmacro sexp-sxpinfo (sexp)
  64   `(cffi:foreign-slot-value ,sexp 'SEXPREC 'sxpinfo))
  65
  66 (defmacro sxpinfo-bitfield (sxpinfo)
  67   `(cffi:foreign-slot-value ,sxpinfo 'sxpinfo_struct 'bitfield))
  68
  69 (defmacro vecsxp-length (vecsxp)
  70   `(cffi:foreign-slot-value ,vecsxp 'vecsxp_struct 'length))
  71
  72 (defmacro vecsxp-true-length (vecsxp)
  73   `(cffi:foreign-slot-value ,vecsxp 'vecsxp_struct 'truelength))
  74
  75 (defmacro listsxp-car (listsxp)
  76   `(cffi:foreign-slot-value ,listsxp 'listsxp_struct 'carval))
  77
  78 (defmacro listsxp-cdr (listsxp)
  79   `(cffi:foreign-slot-value ,listsxp 'listsxp_struct 'cdrval))
  80
  81 (defmacro listsxp-tag (listsxp)
  82   `(cffi:foreign-slot-value ,listsxp 'listsxp_struct 'tagval))
  83
  84 ;; #define TAG(e)               ((e)->u.listsxp.tagval)
  85
  86 (defmacro symsxp-pname (symsxp)
  87     `(cffi:foreign-slot-value ,symsxp 'symsxp_struct 'pname))
  88
  89 (defmacro symsxp-value (symsxp)
  90     `(cffi:foreign-slot-value ,symsxp 'symsxp_struct 'value))
  91
  92 (defmacro symsxp-internal (symsxp)
  93     `(cffi:foreign-slot-value ,symsxp 'symsxp_struct 'internal))