Skip to content

Commit

Permalink
Make FFI callabacks work properly on 64 bit Windows OSes.
Browse files Browse the repository at this point in the history
  • Loading branch information
arbv committed Sep 26, 2016
1 parent 24302d6 commit 2156983
Show file tree
Hide file tree
Showing 3 changed files with 40 additions and 2 deletions.
2 changes: 2 additions & 0 deletions CormanLispServer/include/Lisp.h
Expand Up @@ -883,6 +883,8 @@ LispDeclare(Get_Time_Units_Per_Second);
LispDeclare(Probe_File);
LispDeclare(Memory_Report);

LispDeclare(Safecall);

//
// QV pointers
//
Expand Down
31 changes: 31 additions & 0 deletions CormanLispServer/src/Lispfunc.cpp
Expand Up @@ -4481,6 +4481,9 @@ FunctEntry functTable[] =
{ "consoleUnderflow", (LispFunc)consoleUnderflow },
{ "garbageCollect", (LispFunc)garbageCollect },

// We need this built-in function to support callback in FFI on 64-bit versions of Windows
// It seems one can not throw Access Violation Exceptions through the Windows API functions on 64 bit OSes.
{ "%SAFECALL", (LispFunc)Safecall },
// ----------------------------------------------------------
};
long sizeFunctTable = sizeof(functTable)/sizeof(FunctEntry);
Expand Down Expand Up @@ -4810,3 +4813,31 @@ LispFunction(Lisp_Shutdown)
ret = NIL;
LISP_FUNC_RETURN(ret);
}


// We need this to implement %SAFECALL primitive to support callbacks on 64 bit versions of Windows.
volatile static LispObj doSafecall(LispObj func)
{
LispObj res = NIL;
__try
{
res = LispCall1(Funcall, func);
}
__except (handleStructuredException(GetExceptionCode(), GetExceptionInformation()))
{

}
return res;
}

LispFunction(Safecall)
{
LISP_FUNC_BEGIN(1);
LispObj obj = LISP_ARG(0);
checkFunction(obj);

ret = doSafecall(obj);

LISP_FUNC_RETURN(ret);
}

9 changes: 7 additions & 2 deletions Sys/ffi.lisp
Expand Up @@ -1617,7 +1617,12 @@ Example:
(declare (ignore doc))
(when bad-decls (error "Declarations found in body of callback"))
(setq lisp-func
`(defun ,internal-name ,syms (let () ,@decls (block ,name ,@body))))
`(defun ,internal-name ,syms
(let ()
(cl::%safecall #'(lambda ()
,@decls
(block ,name
,@body))))))
(setq docstring doc))
(let ((param-offset 0))
(dolist (x arg-list)
Expand Down Expand Up @@ -2389,4 +2394,4 @@ Example:
(in-package :cl)

(setq cl::*compiler-warn-on-undefined-function* t)


6 comments on commit 2156983

@rgcorman
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Artem, thanks so much for this fix!!!!! I believe this was the one the caused me to stop working on it for some time, and ultimately just open source it. I wasn't sure anyone else would be able (or willing) to track it down. I had dealt with and fixed many such issues during corman lisp development. However when I hit this issue specific to 64-bit OS (and those were fairly rare then, but of course now ubiquitous) I spent some evenings and just decided I couldn't do it any more. I got as far as noticing that the callback code broke and was getting a garbled address (I think an 8 byte address/4 byte address mismatch), and this probably happened when an access violation occurs (these are employed for garbage collection heap management). Now that I see it is working well on 64-bit systems I am inspired to get back into it.

@arbv
Copy link
Member Author

@arbv arbv commented on 2156983 Dec 21, 2016

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thank you for your kind words! Should I say getting this message from Corman Lisp author is very inspiring too!

To be fair, I do not really know how I tracked down this issue. At some point, something clicked in my head that it might be SEH-related. I decided to check it and voila!

I am really glad you are inspired to start working on it again. I did not do any work on it for a last month or so but it always was on the back of my mind. I initially planned to make 3.1 release before this New Year but have not had enough spare time recently. All in all, this is a very interesting project with a lot of interesting and well-written code - I hope I will return to working on it soon. I am generally interested in programming languages and their implementation and this project seems to be a good one for understanding important techniques (at this point this is kind of hobby).

Again, thank you for open sourcing this project! I believe it is of great educational value.

@rgcorman
Copy link
Collaborator

@rgcorman rgcorman commented on 2156983 Dec 25, 2016 via email

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@arbv
Copy link
Member Author

@arbv arbv commented on 2156983 Dec 25, 2016

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Merry Christmas! That's great news!

By the way, you should have direct access to this repository at the moment.

@luismbo
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I've invited you both to the @sharplispers/cormanlisp-maintainers team. Happy holidays!

@arbv
Copy link
Member Author

@arbv arbv commented on 2156983 Dec 25, 2016 via email

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please sign in to comment.