git.gag.com Git - debian/pforth/blob - csrc/pf_cglue.c

   1 /* @(#) pf_cglue.c 98/02/11 1.4 */
   2 /***************************************************************
   3 ** 'C' Glue support for Forth based on 'C'
   4 **
   5 ** Author: Phil Burk
   6 ** Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
   7 **
   8 ** The pForth software code is dedicated to the public domain,
   9 ** and any third party may reproduce, distribute and modify
  10 ** the pForth software code or any derivative works thereof
  11 ** without any compensation or license.  The pForth software
  12 ** code is provided on an "as is" basis without any warranty
  13 ** of any kind, including, without limitation, the implied
  14 ** warranties of merchantability and fitness for a particular
  15 ** purpose and their equivalents under the laws of any jurisdiction.
  16 **
  17 ***************************************************************/
  18
  19 #include "pf_all.h"
  20
  21 extern CFunc0 CustomFunctionTable[];
  22
  23 /***************************************************************/
  24 cell_t CallUserFunction( cell_t Index, int32_t ReturnMode, int32_t NumParams )
  25 {
  26     cell_t P1, P2, P3, P4, P5;
  27     cell_t Result = 0;
  28     CFunc0 CF;
  29
  30 DBUG(("CallUserFunction: Index = %d, ReturnMode = %d, NumParams = %d\n",
  31     Index, ReturnMode, NumParams ));
  32
  33     CF = CustomFunctionTable[Index];
  34
  35     switch( NumParams )
  36     {
  37     case 0:
  38         Result = ((CFunc0) CF) ( );
  39         break;
  40     case 1:
  41         P1 = POP_DATA_STACK;
  42         Result = ((CFunc1) CF) ( P1 );
  43         break;
  44     case 2:
  45         P2 = POP_DATA_STACK;
  46         P1 = POP_DATA_STACK;
  47         Result = ((CFunc2) CF) ( P1, P2 );
  48         break;
  49     case 3:
  50         P3 = POP_DATA_STACK;
  51         P2 = POP_DATA_STACK;
  52         P1 = POP_DATA_STACK;
  53         Result = ((CFunc3) CF) ( P1, P2, P3 );
  54         break;
  55     case 4:
  56         P4 = POP_DATA_STACK;
  57         P3 = POP_DATA_STACK;
  58         P2 = POP_DATA_STACK;
  59         P1 = POP_DATA_STACK;
  60         Result = ((CFunc4) CF) ( P1, P2, P3, P4 );
  61         break;
  62     case 5:
  63         P5 = POP_DATA_STACK;
  64         P4 = POP_DATA_STACK;
  65         P3 = POP_DATA_STACK;
  66         P2 = POP_DATA_STACK;
  67         P1 = POP_DATA_STACK;
  68         Result = ((CFunc5) CF) ( P1, P2, P3, P4, P5 );
  69         break;
  70     default:
  71         pfReportError("CallUserFunction", PF_ERR_NUM_PARAMS);
  72         EXIT(1);
  73     }
  74
  75 /* Push result on Forth stack if requested. */
  76     if(ReturnMode == C_RETURNS_VALUE) PUSH_DATA_STACK( Result );
  77
  78     return Result;
  79 }
  80
  81 #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
  82 /***************************************************************/
  83 Err CreateGlueToC( const char *CName, ucell_t Index, cell_t ReturnMode, int32_t NumParams )
  84 {
  85     ucell_t Packed;
  86     char FName[40];
  87
  88     CStringToForth( FName, CName, sizeof(FName) );
  89     Packed = (Index & 0xFFFF) | 0 | (NumParams << 24) |
  90         (ReturnMode << 31);
  91     DBUG(("Packed = 0x%8x\n", Packed));
  92
  93     ffCreateSecondaryHeader( FName );
  94     CODE_COMMA( ID_CALL_C );
  95     CODE_COMMA(Packed);
  96     ffFinishSecondary();
  97
  98     return 0;
  99 }
 100 #endif