Pass a pointer for getting result through CFFI - lisp

Here's a function in C:
union Example {
int number;
void *pointer;
};
void return_a_value (union Example *ptr) {
(*ptr).number = 1;
}
Now I want to call it in Common Lisp through CFFI, how can I do it?
(defcunion Example
(number :int)
(ptr :pointer))
(defcfun "return_a_value" :void
(retval :pointer)) ; I'm not very sure here..

Everything's alright up to this point, including your definition of
return_a_value. That's how you may call the function:
(with-foreign-object (arg 'example)
(setf (foreign-slot-value arg 'example 'number) 123)
(return-a-value arg)
(foreign-slot-value arg 'example 'number))

Related

Issue logging within an embedded C function

I'd like to generate logging messages from within a C function embedded in a DML method. Take the example code below where the fib() function is called from the write() method of the regs bank. The log methods available to C all require a pointer to the current device.
Is there a way to get the device that calls the embedded function? Do I need to pass the device pointer into fib()?
dml 1.2;
device simple_embedded;
parameter documentation = "Embedding C code example for"
+ " Model Builder User's Guide";
parameter desc = "example of C code";
extern int fib(int x);
bank regs {
register r0 size 4 #0x0000 {
parameter allocate = false;
parameter configuration = "none";
method write(val) {
log "info": "Fibonacci(%d) = %d.", val, fib(val);
}
method read() -> (value) {
// Must be implemented to compile
}
}
}
header %{
int fib(int x);
%}
footer %{
int fib(int x) {
SIM_LOG_INFO(1, mydev, 0, "Generating Fibonacci for %d", x);
if (x < 2) return 1;
else return fib(x-1) + fib(x-2);
}
%}
I want to log from an embedded C function.
I solved this by passing the Simics conf_object_t pointer along to C. Just like implied in the question.
So you would use:
int fib(conf_object_t *mydev, int x) {
SIM_LOG_INFO(1, mydev, 0, "Generating Fibonacci for %d", x);
}
And
method write(val) {
log "info": "Fibonacci(%d) = %d.", val, fib(dev.obj,val);
}
Jakob's answer is the right one if your purpose is to offload some computations to C code (which makes sense in many situations, like when functionality is implemented by a lib).
However, if you just want a way to pass a callback to an API that asks for a function pointer, then it is easier to keep the implementation within DML and use a method reference, like:
method init() {
SIM_add_notifier(obj, trigger_fib_notifier_type, obj, &trigger_fib,
&dev.regs.r0.val);
}
method trigger_fib(conf_object_t *_, lang_void *aux) {
value = *cast(aux, uint64 *);
local int result = fib(value);
log info: "result: %d", result;
}
method fib(int x) -> (int) {
log info: "Generating Fibonacci for %d", x;
if (x < 2) return 1;
else return fib(x-1) + fib(x-2);
}

Why is Unit in PureScript's Prelude {} in JavaScript?

I'm a beginner to FP and Type-level programming.
I learned Void and Unit recently.
Prelude's unit is defined as {} in JavaScript.
"use strict";
exports.unit = {};
My question is "Why not null but {}?"
Maybe this is a trivial question, but I'd like to learn its philosophy.
From my understanding, unit corresponds to null in JavaScript.
For example, I can call a function with no arguments in JavaScript.
// hello :: Void -> String
function hello () {
return "hello"
}
const h1 = hello() // "hello"
// However, I do not have any members of `Void` in PureScript, so I cannot call like above.
If I have to specify some arguments of hello function, I choose null rather than {}.
// hello :: forall a. a -> String
function hello (a) {
return "hello"
}
// 'hello :: Unit -> String'-like
const h1 = hello(null) // "hello"
// undefined also works, but weird to me
const h2 = hello(undefined)
// also works, but weird
const h3 = hello(42)
const h4 = hello({})
const h5 = hello([])
If unit represents a side-effect, probably is it undefined or something null?
// 'log1 :: String -> Effect Void'-like
function log1 (s) {
return s => () => console.log(s) // console.log return undefined
}
// however, function must return a value
// 'log2 :: String -> Effect Unit'-like
function log2 (s) {
return s => () => {
console.log(s) // side-effect
return null
}
}
// foreign Effect.Console.log (ECMAScript-style)
function log3 (s) {
return s => () => {
console.log(s)
return {} // weird to me; it seems like 'return 42'
}
}
Am I missing something?
It doesn't actually matter what value you use for Unit. {} is a pretty arbitrary choice - undefined or null, or just not returning a value are all fine too if you're writing something in the FFI. Since Unit is only supposed to have one inhabitant, there's never a time that the actual runtime value for it is examined.
It's quite a long time since the choice of {} was made - it's probably a historical accident, leftover from the time that all non-Prim PS values were constructed as anonymous objects.

Get Agenda in CLIPS

i work with CLIPS.NET and wonder how i can access the agenda in clips.
i want to have some input values and let clips run so it can generate a solution based on the input values. But i also want to see what rules exactly are fired. I now have something like this
(deftemplate MAIN::action
(slot name (default ?NONE)))
(deftemplate MAIN::input
(slot name)
(slot value (default ?NONE)))
(defrule MAIN::rule0
(input (name test-input) (value 1))
=>
(assert (action (name do-something)))
)
The problem is i cant use (agenda) because that only prints something to the console and gives me no string i can work with or something like that. So
how can i get the agenda ? Or do i need to create a new fact in every rule to see what rules where executed (seems a bit inconvenient)? (For now i only need the names of the rules)
UPDATE
my try on function "all-next-activation" (now working):
void AllNextActivationFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
unsigned long count;
struct multifield *theList;
void *act;
if (EnvArgCountCheck(theEnv, "all-next-activation", EXACTLY, 0) == -1)
{
EnvSetMultifieldErrorValue(theEnv, returnValue);
return;
}
// Count activations
for (act = EnvGetNextActivation(theEnv, NULL), count = 0;
act != NULL;
act = EnvGetNextActivation(theEnv, act), count++)
{ /* Do Nothing */ }
// Create the multifield
SetpType(returnValue, MULTIFIELD);
SetpDOBegin(returnValue, 1);
SetpDOEnd(returnValue, (long)count);
theList = (struct multifield *) EnvCreateMultifield(theEnv, count);
SetpValue(returnValue, (void *)theList);
// Store values in multifield
for (act = EnvGetNextActivation(theEnv, NULL), count = 1;
act != NULL;
act = EnvGetNextActivation(theEnv, act), count++)
{
SetMFType(theList, count, SYMBOL);
SetMFValue(theList, count, EnvAddSymbol(theEnv, EnvGetActivationName(theEnv, act)));
}
}
void EnvUserFunctions(
void *environment)
{
EnvDefineFunction2(environment, "next-activation", 'w', PTIEF NextActivationFunction, "NextActivationFunction", "00");
EnvDefineFunction2(environment, "all-next-activation", 'm', PTIEF AllNextActivationFunction, "AllNextActivationFunction", "00");
}
You'd either have to extend the .NET API to include some of the C functions that allow you to iterate over the activations and grab information from them or add a user-defined function in CLIPS and use the Eval method from .NET to invoke that CLIPS function. For example, here's code you can add to the userfunctions.c that returns the name of the next activation:
void *NextActivationFunction(
void *theEnv)
{
void *act;
if (EnvArgCountCheck(theEnv,"next-activation",EXACTLY,0) == -1)
{ return EnvFalseSymbol(theEnv); }
act = EnvGetNextActivation(theEnv,NULL);
if (act == NULL)
{ return EnvFalseSymbol(theEnv); }
else
{ return EnvAddSymbol(theEnv,EnvGetActivationName(theEnv,act)); }
}
void EnvUserFunctions(
void *environment)
{
EnvDefineFunction2(environment,"next-activation", 'w', PTIEF NextActivationFunction, "NextActivationFunction", "00");
}
Recompiling CLIPS with that code allows you to use this function within CLIPS:
CLIPS> (next-activation)
FALSE
CLIPS> (defrule foo =>)
CLIPS> (defrule bar =>)
CLIPS> (next-activation)
bar
CLIPS> (run 1)
CLIPS> (next-activation)
foo
CLIPS>
Or from .NET using the Eval method:
clips.Eval("(next-activation)");

lispworks fli: cannot be converted to foreign type

I wanted to add a listbox based on the sample A here below.
The Common Lisp Cookbook - Using the Win32 API
I added a function, sendmessage which maps to its windows API counter part and call it from the wndproc.
But it complained type conversion error like below.
CL-USER 1 > (create-toplevel-window "ppp")
Error: #<Pointer to type (:UNSIGNED :SHORT) = #x01E902D8> cannot be
converted to foreign type (:UNSIGNED-INTEGER-TYPE 32).
Here are the functions related to the error. Any idea to fix the issue?
I tried to define sendmessage with lparam as (:unsigned :short) but no use.
(fli:define-foreign-function
(SendMessage "SendMessage" :dbcs)
((hwnd hwnd) (msg uint) (wparam ulong) (lparam (:unsigned :long)))
:result-type ulong :calling-convention :stdcall)
(fli:define-foreign-callable
(wndproc :result-type :long :calling-convention :stdcall)
((hwnd hwnd) (msg (:unsigned :long))
(wparam (:unsigned :long)) (lparam (:unsigned :long)))
(case msg
(#.WM_CREATE
(fli:with-foreign-string ;; class name pointer
(cn-p ec bc :external-format (external-format)) "LISTBOX"
(fli:with-foreign-string ;; window name pointer
(wn-p ec bc :external-format (external-format)) ""
(let ((lstbx (createwindowex hwnd cn-p wn-p
(logior ws_visible ws_child lbs_notify)
cw_usedefault cw_usedefault cw_usedefault cw_usedefault
0 0 200 100)))
(fli:with-foreign-string (msg ec bc :external-format (external-format)) "item1"
(sendmessage lstbx LB_ADDSTRING 0 msg ))))))
;;0 0 (GetModuleHandle-current 0) 0))))
;;(createwindowex "listbox4test" hwnd))
;;(#.WM_PAINT (wndproc-paint hwnd msg wparam lparam))
#+console (#.WM_DESTROY (PostQuitMessage 0) 0)
(t (DefWindowProc hwnd msg wparam lparam))))
I changed the sendmessage function as below.
And this time, it did not complain.
(fli:define-foreign-function
(SendMessage "SendMessage" :dbcs)
((hwnd hwnd) (msg uint) (wparam ulong) (lparam :pointer)) ;;;(lparam (:unsigned :long)))
:result-type ulong :calling-convention :stdcall)

New Emacs primitive does not show up

I wrote a new Emacs primitive (macroexpand-once) and recompiled Emacs
Now (macroexpand-once) fails with "Symbol's function definition is void".
What do I do about this?
UPDATE: Here is the code:
DEFUN ("macroexpand-once", Fmacroexpand_once, Smacroexpand_once, 1, 2, 0,
doc: /* Return result of expanding macros at top level of FORM.
If FORM is not a macro call, it is returned unchanged.
Otherwise, the macro is expanded and the expansion is returned.
The second optional arg ENVIRONMENT specifies an environment of macro
definitions to shadow the loaded ones for use in file byte-compilation. */)
(Lisp_Object form, Lisp_Object environment)
{
/* With cleanups from Hallvard Furuseth. */
register Lisp_Object expander, sym, def, tem;
do
{
/* Come back here each time we expand a macro call,
in case it expands into another macro call. */
if (!CONSP (form))
break;
/* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
def = sym = XCAR (form);
tem = Qnil;
/* Trace symbols aliases to other symbols
until we get a symbol that is not an alias. */
while (SYMBOLP (def))
{
QUIT;
sym = def;
tem = Fassq (sym, environment);
if (NILP (tem))
{
def = XSYMBOL (sym)->function;
if (!EQ (def, Qunbound))
continue;
}
break;
}
/* Right now TEM is the result from SYM in ENVIRONMENT,
and if TEM is nil then DEF is SYM's function definition. */
if (NILP (tem))
{
/* SYM is not mentioned in ENVIRONMENT.
Look at its function definition. */
struct gcpro gcpro1;
GCPRO1 (form);
def = Fautoload_do_load (def, sym, Qmacro);
UNGCPRO;
if (EQ (def, Qunbound) || !CONSP (def))
/* Not defined or definition not suitable. */
break;
if (!EQ (XCAR (def), Qmacro))
break;
else expander = XCDR (def);
}
else
{
expander = XCDR (tem);
if (NILP (expander))
break;
}
{
Lisp_Object newform = apply1 (expander, XCDR (form));
if (EQ (form, newform))
break;
else
form = newform;
}
} while (0);
return form;
}
It is just the code of macroexpand, but with do-while(0) instead of while(1).
You need to call defsubr. Do a search for Smacroexpand to see what I mean.