home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 3 / CDPDIII.bin / pd / programming / gnusmalltalk / mstcallin.c < prev    next >
C/C++ Source or Header  |  1992-02-15  |  12KB  |  609 lines
  1. /***********************************************************************
  2.  *
  3.  *    C Callin facility
  4.  *
  5.  *    This module provides the routines necessary to allow C code to
  6.  *    invoke Smalltalk messages on objects.
  7.  *
  8.  ***********************************************************************/
  9.  
  10.  
  11. /***********************************************************************
  12.  *
  13.  * Copyright (C) 1990, 1991, 1992 Free Software Foundation, Inc.
  14.  * Written by Steve Byrne.
  15.  *
  16.  * This file is part of GNU Smalltalk.
  17.  *
  18.  * GNU Smalltalk is free software; you can redistribute it and/or modify it
  19.  * under the terms of the GNU General Public License as published by the Free
  20.  * Software Foundation; either version 1, or (at your option) any later 
  21.  * version.
  22.  * 
  23.  * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
  24.  * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or 
  25.  * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
  26.  * more details.
  27.  * 
  28.  * You should have received a copy of the GNU General Public License along with
  29.  * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
  30.  * Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  
  31.  *
  32.  ***********************************************************************/
  33.  
  34. /*
  35.  *    Change Log
  36.  * ============================================================================
  37.  * Author      Date       Change 
  38.  * sbb          1 Jan 92      Fixed to auto-initialize Smalltalk when the public
  39.  *              routines are invoked.
  40.  *
  41.  * sbb         31 Dec 91      Created.
  42.  *
  43.  */
  44.  
  45. #include <varargs.h>
  46. #include <stdio.h>
  47.  
  48. #include "mst.h"
  49. #include "mstlib.h"
  50. #include "mstinterp.h"
  51. #include "mstcallin.h"
  52. #include "mstdict.h"
  53. #include "mstsym.h"
  54. #include "mstoop.h"
  55.  
  56. /* Simple control over oop registry size */
  57. #define INITIAL_REGISTRY_SIZE    100
  58.  
  59. /*
  60.  * The registry of OOPs which have been passed to C code.  A vector of
  61.  * of oops, running from 0 to registryIndex, some of which may be nilOOP.
  62.  * the current allocated size of the registry is registrySize, and the
  63.  * registry may be reallocated to a larger size as need.  The registry
  64.  * is examined at GC time to ensure that OOPs that C code knows about don't
  65.  * go away.  "C code" here means user level C code, not Smalltalk internal
  66.  * code.
  67.  */
  68. static OOP    *oopRegistry;
  69. static int    registrySize, registryIndex;
  70.  
  71.  
  72. OOP msgSend(va_alist)
  73. va_dcl
  74. {
  75.   va_list    args;
  76.   OOP         receiver, selector, anArg, result;
  77.   int        numArgs;
  78.  
  79.   va_start(args);
  80.  
  81.   if (!smalltalkInitialized) { initSmalltalk(); }
  82.  
  83.   receiver = va_arg(args, OOP);
  84.   selector = va_arg(args, OOP);
  85.   
  86.   prepareExecutionEnvironment();
  87.   pushOOP(receiver);
  88.   for (numArgs = 0; (anArg = va_arg(args, OOP)) != nil; numArgs++) {
  89.     pushOOP(anArg);
  90.   }
  91.  
  92.   sendMessage(selector, numArgs, false);
  93.   interpret();
  94.   result = popOOP();
  95.   finishExecutionEnvironment();
  96.  
  97.   return (result);
  98. }
  99.  
  100. OOP strMsgSend(va_alist)
  101. va_dcl
  102. {
  103.   va_list    args;
  104.   OOP         receiver, selector, anArg, result;
  105.   int        numArgs;
  106.  
  107.   va_start(args);
  108.  
  109.   if (!smalltalkInitialized) { initSmalltalk(); }
  110.  
  111.   receiver = va_arg(args, OOP);
  112.   selector = internString(va_arg(args, char *));
  113.   
  114.   prepareExecutionEnvironment();
  115.   pushOOP(receiver);
  116.   for (numArgs = 0; (anArg = va_arg(args, OOP)) != nil; numArgs++) {
  117.     pushOOP(anArg);
  118.   }
  119.  
  120.   sendMessage(selector, numArgs, false);
  121.   interpret();
  122.   result = popOOP();
  123.   finishExecutionEnvironment();
  124.  
  125.   return (result);
  126. }
  127.  
  128. #ifdef looks_goofy_to_me /* Tue Dec 31 20:41:01 1991 */
  129. /**/voidPtr cMsgSend(va_alist)
  130. /**/va_dcl
  131. /**/{
  132. /**/  va_list    args;
  133. /**/  OOP         receiver, selector, anArg, result;
  134. /**/  int        numArgs, bool;
  135. /**/  char        *argStr, *s;
  136. /**/  union {
  137. /**/    voidPtr    v;
  138. /**/    float    f;
  139. /**/  } conv;
  140. /**/
  141. /**/  va_start(args);
  142. /**/
  143. /**/  argStr = va_arg(args, char *);
  144. /**/  selector = internString(va_arg(args, char *));
  145. /**/  
  146. /**/  prepareExecutionEnvironment();
  147. /**/
  148. /**/  s = argStr + 2;        /* <type>= */
  149. /**/  for (numArgs = -1; *s; numArgs++, s++) {
  150. /**/    switch (*s) {
  151. /**/    case 'i':
  152. /**/      pushInt(va_arg(args, long));
  153. /**/      break;
  154. /**/
  155. /**/    case 'f':
  156. /**/      anArg = floatNew(va_arg(args, double));
  157. /**/      pushOOP(anArg);
  158. /**/      break;
  159. /**/
  160. /**/    case 'b':
  161. /**/      if (va_arg(args, int)) {
  162. /**/    pushOOP(trueOOP);
  163. /**/      } else {
  164. /**/    pushOOP(falseOOP);
  165. /**/      }
  166. /**/      break;
  167. /**/
  168. /**/    case 'c':
  169. /**/      anArg = charOOPAt(va_arg(args, char));
  170. /**/      pushOOP(anArg);
  171. /**/      break;
  172. /**/
  173. /**/    case 'C':
  174. /**/      anArg = cObjectNew(va_arg(args, voidPtr));
  175. /**/      pushOOP(anArg);
  176. /**/      break;
  177. /**/
  178. /**/    case 's':
  179. /**/      anArg = stringNew(va_arg(args, char *));
  180. /**/      pushOOP(anArg);
  181. /**/      break;
  182. /**/
  183. /**/    case 'S':
  184. /**/      anArg = internString(va_arg(args, char *));
  185. /**/      pushOOP(anArg);
  186. /**/      break;
  187. /**/    }
  188. /**/  }
  189. /**/
  190. /**/  sendMessage(selector, numArgs, false);
  191. /**/  interpret();
  192. /**/  result = popOOP();
  193. /**/  finishExecutionEnvironment();
  194. /**/
  195. /**/  switch (*argStr) {
  196. /**/  case 'i':
  197. /**/    return ((voidPtr)toInt(result));
  198. /**/
  199. /**/  case 'c':
  200. /**/    return ((voidPtr)charOOPValue(result));
  201. /**/
  202. /**/  case 'C':
  203. /**/    return (cObjectValue(result));
  204. /**/
  205. /**/  case 's':
  206. /**/    return (toCString(result));
  207. /**/
  208. /**/  case 'b':
  209. /**/    return ((voidPtr)(result == trueOOP));
  210. /**/
  211. /**/  case 'f':
  212. /**/    conv.f = floatOOPValue(result);
  213. /**/    return (conv.v);
  214. /**/
  215. /**/  default:
  216. /**/    return (result);
  217. /**/  }
  218. /**/}
  219. #endif /* looks_goofy_to_me Tue Dec 31 20:41:01 1991 */
  220.  
  221. /* like printf */
  222. void msgSendf(va_alist)
  223. va_dcl
  224. {
  225.   va_list    args;
  226.   OOP         receiver, selector, anArg, result;
  227.   int        numArgs, bool;
  228.   voidPtr    *resultPtr;
  229.   char        *fmt, *fp, *s, selectorBuf[256];
  230.  
  231.   va_start(args);
  232.  
  233.   if (!smalltalkInitialized) { initSmalltalk(); }
  234.  
  235.   resultPtr = va_arg(args, voidPtr *);
  236.  
  237.   fmt = va_arg(args, char *);
  238.   
  239.   prepareExecutionEnvironment();
  240.  
  241.   numArgs = -1;
  242.   for (s = selectorBuf, fp = &fmt[2]; *fp; fp++) {
  243.     if (*fp == '%') {
  244.       fp++;
  245.       numArgs++;
  246.       switch (*fp) {
  247.       case 'i':
  248.     pushInt(va_arg(args, long));
  249.     break;
  250.  
  251.       case 'f':
  252.     anArg = floatNew(va_arg(args, double));
  253.     pushOOP(anArg);
  254.     break;
  255.  
  256.       case 'b':
  257.     if (va_arg(args, int)) {
  258.       pushOOP(trueOOP);
  259.     } else {
  260.       pushOOP(falseOOP);
  261.     }
  262.     break;
  263.  
  264.       case 'c':
  265.     anArg = charOOPAt(va_arg(args, char));
  266.     pushOOP(anArg);
  267.     break;
  268.  
  269.       case 'C':
  270.     anArg = cObjectNew(va_arg(args, voidPtr));
  271.     pushOOP(anArg);
  272.     break;
  273.     
  274.       case 's':
  275.     anArg = stringNew(va_arg(args, char *));
  276.     pushOOP(anArg);
  277.     break;
  278.  
  279.       case 'S':
  280.     anArg = internString(va_arg(args, char *));
  281.     pushOOP(anArg);
  282.     break;
  283.  
  284.       case 'o':
  285.     anArg = va_arg(args, OOP);
  286.     pushOOP(anArg);
  287.     break;
  288.  
  289.       case '%':
  290.     *s++ = '%';
  291.     numArgs--;
  292.     break;
  293.       }
  294.     } else if (*fp != ' ' && *fp != '\t') {
  295.       *s++ = *fp;
  296.     }
  297.   }
  298.  
  299.   *s = '\0';
  300.  
  301.   selector = internString(selectorBuf);
  302.  
  303.   sendMessage(selector, numArgs, false);
  304.   interpret();
  305.   result = popOOP();
  306.   finishExecutionEnvironment();
  307.  
  308.   if (resultPtr) {
  309.     switch (fmt[1]) {
  310.     case 'i':
  311.       *(int *)resultPtr = toInt(result);
  312.       break;
  313.  
  314.     case 'c':
  315.       *(char *)resultPtr = charOOPValue(result);
  316.       break;
  317.  
  318.     case 'C':
  319.       *resultPtr = cObjectValue(result);
  320.       break;
  321.  
  322.     case 's':
  323.       *(char **)resultPtr = (char *)toCString(result);
  324.       break;
  325.  
  326.     case 'b':
  327.       *(int *)resultPtr = (result == trueOOP);
  328.       break;
  329.  
  330.     case 'f':
  331.       *(double *)resultPtr = floatOOPValue(result);
  332.       break;
  333.  
  334.     case 'o':
  335.     default:
  336.       *(OOP *)resultPtr = result;
  337.       break;
  338.     }
  339.   }
  340. }
  341.  
  342. void evalCode(str)
  343. char    *str;
  344. {
  345.   if (!smalltalkInitialized) { initSmalltalk(); }
  346.   prepareExecutionEnvironment();
  347.   initLexer(false);
  348.   pushCString(str);
  349.   yyparse();
  350.   popStream(false);
  351.   finishExecutionEnvironment();
  352. }
  353.  
  354.  
  355. /*
  356.  *    OOP evalExpr(str)
  357.  *
  358.  * Description
  359.  *
  360.  *    Evaluate a single Smalltalk expression and return the result.
  361.  *
  362.  * Inputs
  363.  *
  364.  *    str   : A Smalltalk method body.  Can have local variables, but no
  365.  *        parameters.  This is much like the immediate expression
  366.  *        evaluation that the command interpreter provides.
  367.  *
  368.  * Outputs
  369.  *
  370.  *    
  371.  */
  372. OOP evalExpr(str)
  373. char    *str;
  374. {
  375.   OOP        result;
  376.  
  377.   if (!smalltalkInitialized) { initSmalltalk(); }
  378.  
  379.   /* !!! not done yet */
  380.   prepareExecutionEnvironment();
  381.   initLexer(false);
  382.   pushCString(str);
  383.   yyparse();
  384.   popStream(false);
  385.   result = finishExecutionEnvironment();
  386.   return (result);
  387. }
  388.  
  389. /***********************************************************************
  390.  *
  391.  *    Conversion *to* Smalltalk datatypes routines
  392.  *
  393.  ***********************************************************************/
  394.  
  395. OOP intToOOP(i)
  396. long    i;
  397. {
  398.   if (!smalltalkInitialized) { initSmalltalk(); }
  399.  
  400.   return (fromInt(i));
  401. }
  402.  
  403. OOP floatToOOP(f)
  404. double    f;
  405. {
  406.   return (registerOOP(floatNew(f)));
  407. }
  408.  
  409. OOP boolToOOP(b)
  410. int    b;
  411. {
  412.   if (!smalltalkInitialized) { initSmalltalk(); }
  413.  
  414.   if (b) {
  415.     return (trueOOP);
  416.   } else {
  417.     return (falseOOP);
  418.   }
  419. }
  420.  
  421.  
  422. OOP charToOOP(c)
  423. char    c;
  424. {
  425.   if (!smalltalkInitialized) { initSmalltalk(); }
  426.  
  427.   return (charOOPAt(c));
  428. }
  429.  
  430.  
  431. /* !!! Add in byteArray support sometime soon */
  432.  
  433. OOP stringToOOP(str)
  434. char    *str;
  435. {
  436.   if (!smalltalkInitialized) { initSmalltalk(); }
  437.  
  438.   if (str == nil) {
  439.     return (nilOOP);
  440.   } else {
  441.     return (registerOOP(stringNew(str)));
  442.   }
  443. }
  444.  
  445. OOP symbolToOOP(str)
  446. char    *str;
  447. {
  448.   if (!smalltalkInitialized) { initSmalltalk(); }
  449.  
  450.   if (str == nil) {
  451.     return (nilOOP);
  452.   } else {
  453.     return (internString(str));
  454.   }
  455. }
  456.  
  457. OOP cObjectToOOP(co)
  458. voidPtr co;
  459. {
  460.   if (!smalltalkInitialized) { initSmalltalk(); }
  461.  
  462.   if (co == nil) {
  463.     return (nilOOP);
  464.   } else {
  465.     return (registerOOP(cObjectNew(co)));
  466.   }
  467. }
  468.  
  469.  
  470. /***********************************************************************
  471.  *
  472.  *    Conversion *from* Smalltalk datatypes routines
  473.  *
  474.  ***********************************************************************/
  475.  
  476. /* ### need a type inquiry routine */
  477.  
  478.  
  479. long OOPToInt(oop)
  480. OOP    oop;
  481. {
  482.   if (!smalltalkInitialized) { initSmalltalk(); }
  483.  
  484.   return (toInt(oop));
  485. }
  486.  
  487. double OOPToFloat(oop)
  488. OOP    oop;
  489. {
  490.   if (!smalltalkInitialized) { initSmalltalk(); }
  491.  
  492.   return (floatOOPValue(oop));
  493. }
  494.  
  495. int OOPToBool(oop) 
  496. OOP    oop;
  497. {
  498.   if (!smalltalkInitialized) { initSmalltalk(); }
  499.  
  500.   return (oop == trueOOP);
  501. }
  502.  
  503. char  OOPToChar(oop)
  504. OOP    oop;
  505. {
  506.   if (!smalltalkInitialized) { initSmalltalk(); }
  507.  
  508.   return (charOOPValue(oop));
  509. }
  510.  
  511. char *OOPToString(oop)
  512. OOP    oop;
  513. {
  514.   if (!smalltalkInitialized) { initSmalltalk(); }
  515.  
  516.   if (isNil(oop)) {
  517.     return (nil);
  518.   } else {
  519.     return ((char *)toCString(oop));
  520.   }
  521. }
  522.  
  523. /* !!! add in byteArray support soon */
  524.  
  525. voidPtr OOPToCObject(oop)
  526. OOP    oop;
  527. {
  528.   if (!smalltalkInitialized) { initSmalltalk(); }
  529.  
  530.   if (isNil(oop)) {
  531.     return (nil);
  532.   } else {
  533.     return (cObjectValue(oop));
  534.   }
  535. }
  536.  
  537.  
  538.  
  539. /***********************************************************************
  540.  *
  541.  *    Bookkeeping routines
  542.  *
  543.  ***********************************************************************/
  544.  
  545.  
  546. void initOOPRegistry()
  547. {
  548.   oopRegistry = (OOP *)malloc(INITIAL_REGISTRY_SIZE * sizeof(OOP));
  549.   registrySize = INITIAL_REGISTRY_SIZE;
  550.   registryIndex = 0;
  551. }
  552.  
  553. OOP registerOOP(oop)
  554. OOP    oop;
  555. {
  556.   if (!smalltalkInitialized) { initSmalltalk(); }
  557.  
  558.   if (registryIndex >= registrySize) {
  559.     registrySize += INITIAL_REGISTRY_SIZE;
  560.     oopRegistry = (OOP *)realloc(oopRegistry, registrySize);
  561.   }
  562.  
  563.   oopRegistry[registryIndex++] = oop;
  564.   return (oop);
  565. }
  566.  
  567. void unregisterOOP(oop)
  568. OOP    oop;
  569. {
  570.   int        i;
  571.  
  572.   if (!smalltalkInitialized) { initSmalltalk(); }
  573.  
  574.   for (i = 0; i < registryIndex; i++) {
  575.     if (oopRegistry[i] == oop) {
  576.       oopRegistry[i] = nilOOP;
  577.     }
  578.   }
  579. }
  580.  
  581.  
  582. /*
  583.  *    void copyRegisteredOOPs()
  584.  *
  585.  * Description
  586.  *
  587.  *    Called at gcFlip time, copies registered objects to the new space,
  588.  *    and compresses out unregistered objects and those which are duplicates.
  589.  *
  590.  */
  591. void copyRegisteredOOPs()
  592. {
  593.   int        maxIndex, i;
  594.   OOP        oop;
  595.  
  596.   maxIndex = 0;
  597.   for (i = 0; i < registryIndex; i++) {
  598.     oop = oopRegistry[i];
  599.     if (!isNil(oop) && inFromSpace(oop)) {
  600.       oopRegistry[maxIndex++] = oop;
  601.       localMaybeMoveOOP(oop);
  602.     }
  603.   }
  604.  
  605.   registryIndex = maxIndex;
  606. }
  607.  
  608.  
  609.