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, Devid 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 typedef cell (*CFunc0)( void );
  22 typedef cell (*CFunc1)( cell P1 );
  23 typedef cell (*CFunc2)( cell P1, cell P2 );
  24 typedef cell (*CFunc3)( cell P1, cell P2, cell P3 );
  25 typedef cell (*CFunc4)( cell P1, cell P2, cell P3, cell P4 );
  26 typedef cell (*CFunc5)( cell P1, cell P2, cell P3, cell P4, cell P5 );
  27
  28
  29 extern void *CustomFunctionTable[];
  30
  31 /***************************************************************/
  32 int32 CallUserFunction( int32 Index, int32 ReturnMode, int32 NumParams )
  33 {
  34         cell P1, P2, P3, P4, P5;
  35         cell Result = 0;
  36         void *CF;
  37
  38 DBUG(("CallUserFunction: Index = %d, ReturnMode = %d, NumParams = %d\n",
  39         Index, ReturnMode, NumParams ));
  40
  41         CF = CustomFunctionTable[Index];
  42
  43         switch( NumParams )
  44         {
  45         case 0:
  46                 Result = ((CFunc0) CF) ( );
  47                 break;
  48         case 1:
  49                 P1 = POP_DATA_STACK;
  50                 Result = ((CFunc1) CF) ( P1 );
  51                 break;
  52         case 2:
  53                 P2 = POP_DATA_STACK;
  54                 P1 = POP_DATA_STACK;
  55                 Result = ((CFunc2) CF) ( P1, P2 );
  56                 break;
  57         case 3:
  58                 P3 = POP_DATA_STACK;
  59                 P2 = POP_DATA_STACK;
  60                 P1 = POP_DATA_STACK;
  61                 Result = ((CFunc3) CF) ( P1, P2, P3 );
  62                 break;
  63         case 4:
  64                 P4 = POP_DATA_STACK;
  65                 P3 = POP_DATA_STACK;
  66                 P2 = POP_DATA_STACK;
  67                 P1 = POP_DATA_STACK;
  68                 Result = ((CFunc4) CF) ( P1, P2, P3, P4 );
  69                 break;
  70         case 5:
  71                 P5 = POP_DATA_STACK;
  72                 P4 = POP_DATA_STACK;
  73                 P3 = POP_DATA_STACK;
  74                 P2 = POP_DATA_STACK;
  75                 P1 = POP_DATA_STACK;
  76                 Result = ((CFunc5) CF) ( P1, P2, P3, P4, P5 );
  77                 break;
  78         default:
  79                 pfReportError("CallUserFunction", PF_ERR_NUM_PARAMS);
  80                 EXIT(1);
  81         }
  82
  83 /* Push result on Forth stack if requested. */
  84         if(ReturnMode == C_RETURNS_VALUE) PUSH_DATA_STACK( Result );
  85
  86         return Result;
  87 }
  88
  89 #if (!defined(PF_NO_INIT)) && (!defined(PF_NO_SHELL))
  90 /***************************************************************/
  91 Err CreateGlueToC( const char *CName, uint32 Index, int32 ReturnMode, int32 NumParams )
  92 {
  93         uint32 Packed;
  94         char FName[40];
  95
  96         CStringToForth( FName, CName );
  97         Packed = (Index & 0xFFFF) | 0 | (NumParams << 24) |
  98                 (ReturnMode << 31);
  99         DBUG(("Packed = 0x%8x\n", Packed));
 100
 101         ffCreateSecondaryHeader( FName );
 102         CODE_COMMA( ID_CALL_C );
 103         CODE_COMMA(Packed);
 104         ffFinishSecondary();
 105
 106         return 0;
 107 }
 108 #endif