Callback functions

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.

Simple CALLBACK functions

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.

An example. Creating a signal handler

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.

Implementation notes

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:

Callbacks using a C prototype.

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

User interface

: 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
;