The CALLBACK mechanism provides the facility to wrap Forth definitions in code which is callable by Linux. The Forth stacks and data areas are created as frames on the calling stack.
variable ip-default \ -- addr
Holds the default value of IP-HANDLE
that is set for
each CALLBACK entry.
variable op-default \ -- addr
Holds the default value of OP-HANDLE
that is set for
each CALLBACK entry.
: set-callback \ xt callback --
Make the xt be the action of the callback.
: callback, \ #in #out -- address
Lay down a callback data structure. The first cell contains
the address of the entry point. The address of the data structure
is returned.
: CALLBACK: \ #in #out "<name>" -- ; -- a-addr
Create a callback function. #IN and #OUT refer to
the number of input and output parameters required for the
callback. When the definition <name>
is executed it will
return the address of the callback function. For example
2 1 CallBack: Foo
creates a callback named Foo
with two inputs, and one output.
Executing Foo
returns the entry point used by Linux. To use
it, pass Foo
as the entry point required by Linux, e.g as the
address of a task action. Foo
is built to use the "C" calling
convention.
' FooAction to-callback foo
Having defined an action for the callback, you can now use the callback as if it was a C or assembler function called by the operating system.
: CallProc: \ #in #out "<name>" -- ; -- entry
Create a callback function and start compilation of its
action. #IN and #OUT refer to
the number of input and output parameters required for the
callback. When the definition <name>
is executed it will
return the entry point address of the callback function.
4 1 CallProc: <name> \ #in #out -- ; -- entry
\ Callback action ; x1 x2 x3 x4 -- op
...
;
<name> \ returns entry point address
: CB: \ xt #in "<name>" -- ; -- entry
Create a callback function that executes the action of xt.
action. #IN refers to the number of input parameters.
The number of output parameters is 1. When <name>
is
executed it will return the entry point address of the
callback function. This word is provided to ease porting
from other Forth systems.
:noname ( a b c -- d )
...
; 3 CB: <name>
: to-callback \ xt <"name"> --
Assign an XT as the action of a defined callback. This word is
state smart.
A Linux signal handler has the prototype
void sa_siginfo( int signum, siginfo_t * siginfo, ucontext_t * uc );
As far as Forth is concerned we need to execute a Forth word that receives three parameters and returns none.
(SigTrap) \ signum *siginfo *ucontext --
The code fragment below achives this.
3 0 callback: SigTrap \ -- addr
\ executing SigTrap in Forth returns the C entry point.
: (SigTrap) \ signum *siginfo *ucontext --
\ Action of SigTrap.
nip \ discard siginfo
cr
cr ." Signal number " swap .sigName
uc.*mcontext64 @ \ point at CPU context
cr ." at address " dup sc.RIP @ dup .dword
." , probably in " ip>nfa .name
cr
['] SigThrow swap sc.RIP ! \ force return to SigThrow
;
assign (SigTrap) to-callback SigTrap
The callback entry code provides you with a default I/O device
and sets BASE
to decimal. It does not set up a
default THROW
handler. If your callbacks must cope
with exceptions, you must provide a top-level CATCH
yourself.
Callbacks are (usually) C functions. In the case of VFX Forth
these functions create a Forth environment with two or more
stacks, a USER
area and so on. In a GUI environment,
callbacks are very common, and so must be established and
discarded quickly. The easiest place to do this is to use
the calling C stack and build the Forth stacks and data
areas on the C stack. This has several consequences:
USER
variables are initialised:
S0
, R0
, BASE
, IP-HANDLE
, OP-HANDLE
,
ThreadExit?
, ThreadTCB
, and ThreadSync
.The enhanced mechanism was developed to support more C types
accurately, and to be faster than the previous mechanism.
Code generators are provided for obtaining arguments from
the O/S and for returning data. The type notation is the
same as that of the EXTERN:
notation. Source code
is in the file VFXBase\CallDefWin64.fth, which also
contains an about box example.
The callback is in two portions. The first is a C prototype
for the callback. The second portion is a nameless Forth
word which forms the action of the callback. Note that
referencing the name of a CALLDEF:
returns the
address of a structure from which the entry point can be
found.
CallDef: uint * AboutVFXDialogProc(
HWND hDlg, UINT msg, WPARAM wparam1, LPARAM lparam1
):
{: hdlg message wparam lparam -- ior :}
message case
WM_INITDIALOG of
...
endof
WM_CLOSE of
hDlg WM_COMMAND IDOK 0 SendMessage drop 0
endof
drop 0
end-case
;
AboutVFXDialogProc get-CallDefEntry \ -- entrypoint
: set-CallDef \ xt struct --
Given an xt and a struct, place CALL XT at offset 5 in the code
sequence.
: get-CallDefEntry \ struct -- entrypoint
Given a calldef structure, return the entrypoint address that
is passed to Windows.
: CALLDEF: \ "<text>" -- ; -- struct
Parses a C_style prototype, and use the results to create
a callback from Win64 to Forth. The following example is
for a Windows winproc routine.
calldef: int WinProc2(
HWND myhandle, UINT message, WPARAM wparam1, LPARAM lparam
):
\ hwnd msg wparam lparam -- int
{: hwnd msg wparam lparam -- int :} \ can use local variables
case msg
...
endcase
;
When the CALLDEF:
's name is exexuted, it returns the
address of the calldef structure. This form is easier to
debug than DefCallProc:
below.
: dis-cd \ struct --
Disassemble the sequence forming the callback.
Use only with children of CallDef:
.
: dis-cdEntry \ struct --
Disassemble the sequence forming the callback entry code
Use only with children of CallDef:
.
: dis-cdAction \ struct --
Disassemble the sequence forming the callback action code
Use only with children of CallDef:
.
: dis-cdExit \ struct --
Disassemble the sequence forming the callback exit code
Use only with children of CallDef:
.
: DefCallProc: \ "<text>" -- ; -- entrypoint
Parses a C_style prototype, and use the results to create
a callback from Win64 to Forth. The following example is
for a Windows winproc routine.
calldef: int WinProc2(
HWND myhandle, UINT message, WPARAM wparam1, LPARAM lparam
):
\ hwnd msg wparam lparam -- int
{: hwnd msg wparam lparam -- int :} \ can use local variables
case msg
...
endcase
;
When a child of DefCallProc:
's name is executed, it returns the
address of the callback's entrypoint, which makes it more
suitable for everyday programming.
\ Text output device textbuff: abouttextdev \ About boxes NextID: IDD_ABOUT_VFX \ Bitmaps NextID: IDB_MPE_LOGO IDB_MPE_LOGO BITMAP "%LOAD_PATH%\Mpelogo.bmp" \ Control IDs NextID: IDD_ABOUT_VFX NextID: IDC_LOGO1 NextID: IDC_STATIC1 IDD_ABOUT_VFX DIALOG DISCARDABLE 0, 0, 272, 135 STYLE DS_MODALFRAME | DS_3DLOOK | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU CAPTION "About VFX Forth" FONT 8, 100, 0, "MS Sans Serif" BEGIN DEFPUSHBUTTON "OK",IDOK, 215,116, 50,14 CONTROL "",IDC_LOGO1,"Static",SS_BITMAP | SS_CENTERIMAGE | SS_REALSIZEIMAGE | SS_SUNKEN, 5,5, 40,35 CTEXT "VFX Forth 64 for Windows", IDC_STATIC1, 50,5, 215,106,SS_SUNKEN END CallDef: uint * AboutVFXDialogProc( HWND hDlg, UINT msg, WPARAM wparam1, LPARAM lparam1 ): {: hdlg message wparam lparam -- ior :} message case WM_INITDIALOG of lparam if hDlg lparam HIWORD STM_SETIMAGE IMAGE_BITMAP lparam LOWORD RESOURCE::CreateBitmap SendDlgItemMessage drop then abouttextdev dup ip-handle ! op-handle ! NULL 4096 0 open-gen nip if drop else .cold hdlg IDC_STATIC1 WM_SETTEXT 0 abouttextdev gen-handle @ dup 4096 bounds do i c@ 0= if bl i c! then loop SendDlgItemMessage drop close-gen drop then 1 endof WM_COMMAND of wparam LOWORD IDOK = if hdlg DlgDone endif wparam LOWORD IDCANCEL = if hdlg DlgDone endif 0 endof WM_CLOSE of hDlg WM_COMMAND IDOK 0 SendMessage drop 0 endof drop 0 end-case ; : AboutVFXDialog \ -- NULL GetModuleHandle \ -- inst IDD_ABOUT_VFX RESOURCE::GetDialogTemplate \ -- inst template console@ \ -- inst template hparent AboutVFXDialogProc get-CallDefEntry \ -- inst template hparent proc IDC_LOGO1 IDB_MPE_LOGO swap MAKELONG \ -- inst template hparent proc lparam DialogBoxIndirectParam drop ;