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 ** Permission to use, copy, modify, and/or distribute this
   9 ** software for any purpose with or without fee is hereby granted.
  10 **
  11 ** THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  12 ** WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  13 ** WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  14 ** THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  15 ** CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  16 ** FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  17 ** CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  18 ** OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  19 **
  20 ***************************************************************/
  21
  22 #include "pf_all.h"
  23
  24 extern CFunc0 CustomFunctionTable[];
  25
  26 /***************************************************************/
  27 cell_t CallUserFunction( cell_t Index, int32_t ReturnMode, int32_t NumParams )
  28 {
  29     cell_t P1, P2, P3, P4, P5;
  30     cell_t Result = 0;
  31     CFunc0 CF;
  32
  33 DBUG(("CallUserFunction: Index = %d, ReturnMode = %d, NumParams = %d\n",
  34     Index, ReturnMode, NumParams ));
  35
  36     CF = CustomFunctionTable[Index];
  37
  38     switch( NumParams )
  39     {
  40     case 0:
  41         Result = ((CFunc0) CF) ( );
  42         break;
  43     case 1:
  44         P1 = POP_DATA_STACK;
  45         Result = ((CFunc1) CF) ( P1 );
  46         break;
  47     case 2:
  48         P2 = POP_DATA_STACK;
  49         P1 = POP_DATA_STACK;
  50         Result = ((CFunc2) CF) ( P1, P2 );
  51         break;
  52     case 3:
  53         P3 = POP_DATA_STACK;
  54         P2 = POP_DATA_STACK;
  55         P1 = POP_DATA_STACK;
  56         Result = ((CFunc3) CF) ( P1, P2, P3 );
  57         break;
  58     case 4:
  59         P4 = POP_DATA_STACK;
  60         P3 = POP_DATA_STACK;
  61         P2 = POP_DATA_STACK;
  62         P1 = POP_DATA_STACK;
  63         Result = ((CFunc4) CF) ( P1, P2, P3, P4 );
  64         break;
  65     case 5:
  66         P5 = POP_DATA_STACK;
  67         P4 = POP_DATA_STACK;
  68         P3 = POP_DATA_STACK;
  69         P2 = POP_DATA_STACK;
  70         P1 = POP_DATA_STACK;
  71         Result = ((CFunc5) CF) ( P1, P2, P3, P4, P5 );
  72         break;
  73     default:
  74         pfReportError("CallUserFunction", PF_ERR_NUM_PARAMS);
  75         EXIT(1);
  76     }
  77
  78 /* Push result on Forth stack if requested. */
  79     if(ReturnMode == C_RETURNS_VALUE) PUSH_DATA_STACK( Result );
  80
  81     return Result;
  82 }
  83
  84 #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
  85 /***************************************************************/
  86 Err CreateGlueToC( const char *CName, ucell_t Index, cell_t ReturnMode, int32_t NumParams )
  87 {
  88     ucell_t Packed;
  89     char FName[40];
  90
  91     CStringToForth( FName, CName, sizeof(FName) );
  92     Packed = (Index & 0xFFFF) | 0 | (NumParams << 24) |
  93         (ReturnMode << 31);
  94     DBUG(("Packed = 0x%8x\n", Packed));
  95
  96     ffCreateSecondaryHeader( FName );
  97     CODE_COMMA( ID_CALL_C );
  98     CODE_COMMA(Packed);
  99     ffFinishSecondary();
 100
 101     return 0;
 102 }
 103 #endif