Ignore:
Timestamp:
Apr 17, 2011, 11:56:59 PM (10 years ago)
Author:
Sam Hocevar
Message:

lisp: implement LSymbol::EvalFunction? and ensure all local pointers are
protected against collection.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • abuse/trunk/src/lisp/lisp.cpp

    r496 r497  
    180180void *lmalloc(int size, int which_space)
    181181{
    182   return malloc(size);
     182  return malloc(size); /* XXX: temporary hack */
    183183
    184184#ifdef WORD_ALIGN
    … …  
    14311431void *eval_sys_function(LSysFunction *fun, void *arg_list);
    14321432
    1433 void *eval_function(LSymbol *sym, void *arg_list)
     1433LObject *LSymbol::EvalFunction(void *arg_list)
    14341434{
    14351435#ifdef TYPE_CHECKING
    1436   int args, req_min, req_max;
    1437   if (item_type(sym)!=L_SYMBOL)
    1438   {
    1439     sym->Print();
    1440     lbreak("EVAL : is not a function name (not symbol either)");
    1441     exit(0);
    1442   }
    1443 #endif
    1444 
    1445   void *fun=(LSysFunction *)(((LSymbol *)sym)->function);
    1446   PtrRef ref2( fun  );
    1447 
    1448   // make sure the arguments given to the function are the correct number
    1449   ltype t=item_type(fun);
     1436    int args, req_min, req_max;
     1437    if (item_type(this) != L_SYMBOL)
     1438    {
     1439        Print();
     1440        lbreak("EVAL: is not a function name (not symbol either)");
     1441        exit(0);
     1442    }
     1443#endif
     1444
     1445    LObject *fun = function;
     1446    PtrRef ref2(fun);
     1447    PtrRef ref3(arg_list);
     1448
     1449    // make sure the arguments given to the function are the correct number
     1450    ltype t = item_type(fun);
    14501451
    14511452#ifdef TYPE_CHECKING
    1452   switch (t)
    1453   {
    1454     case L_SYS_FUNCTION :
    1455     case L_C_FUNCTION :
    1456     case L_C_BOOL :
    1457     case L_L_FUNCTION :
    1458     {
    1459       req_min=((LSysFunction *)fun)->min_args;
    1460       req_max=((LSysFunction *)fun)->max_args;
    1461     } break;
    1462     case L_USER_FUNCTION :
    1463     {
    1464       return eval_user_fun(sym, arg_list);
    1465     } break;
    1466     default :
    1467     {
    1468       sym->Print();
    1469       lbreak(" is not a function name");
    1470       exit(0);
    1471     } break;
    1472   }
    1473 
    1474   if (req_min!=-1)
    1475   {
    1476     void *a=arg_list;
    1477     for (args=0; a; a=CDR(a)) args++;    // count number of paramaters
    1478 
    1479     if (args<req_min)
    1480     {
    1481       ((LObject *)arg_list)->Print();
    1482       sym->name->Print();
    1483       lbreak("\nToo few parameters to function\n");
    1484       exit(0);
    1485     } else if (req_max!=-1 && args>req_max)
    1486     {
    1487       ((LObject *)arg_list)->Print();
    1488       sym->name->Print();
    1489       lbreak("\nToo many parameters to function\n");
    1490       exit(0);
    1491     }
    1492   }
     1453    switch (t)
     1454    {
     1455    case L_SYS_FUNCTION:
     1456    case L_C_FUNCTION:
     1457    case L_C_BOOL:
     1458    case L_L_FUNCTION:
     1459        req_min = ((LSysFunction *)fun)->min_args;
     1460        req_max = ((LSysFunction *)fun)->max_args;
     1461        break;
     1462    case L_USER_FUNCTION:
     1463        return (LObject *)eval_user_fun(this, arg_list);
     1464    default:
     1465        Print();
     1466        lbreak(" is not a function name");
     1467        exit(0);
     1468        break;
     1469    }
     1470
     1471    if (req_min != -1)
     1472    {
     1473        void *a = arg_list;
     1474        for (args = 0; a; a = CDR(a))
     1475            args++; // count number of parameters
     1476
     1477        if (args < req_min)
     1478        {
     1479            ((LObject *)arg_list)->Print();
     1480            name->Print();
     1481            lbreak("\nToo few parameters to function\n");
     1482            exit(0);
     1483        }
     1484        else if (req_max != -1 && args > req_max)
     1485        {
     1486            ((LObject *)arg_list)->Print();
     1487            name->Print();
     1488            lbreak("\nToo many parameters to function\n");
     1489            exit(0);
     1490        }
     1491    }
    14931492#endif
    14941493
    14951494#ifdef L_PROFILE
    1496   time_marker start;
    1497 #endif
    1498 
    1499 
    1500   PtrRef ref1(arg_list);
    1501   void *ret=NULL;
    1502 
    1503   switch (t)
    1504   {
    1505     case L_SYS_FUNCTION :
    1506     { ret=eval_sys_function( ((LSysFunction *)fun), arg_list); } break;
    1507     case L_L_FUNCTION :
    1508     { ret=l_caller( ((LSysFunction *)fun)->fun_number, arg_list); } break;
    1509     case L_USER_FUNCTION :
    1510     {
    1511       return eval_user_fun(sym, arg_list);
    1512     } break;
    1513     case L_C_FUNCTION :
    1514     case L_C_BOOL :
    1515     {
    1516       void *first=NULL, *cur=NULL, *tmp;
    1517       PtrRef r1(first), r2(cur);
    1518       while (arg_list)
    1519       {
    1520         if (first) {
    1521           tmp = LList::Create();
    1522           ((LList *)cur)->cdr = (LObject *)tmp;
    1523           cur=tmp;
    1524         } else
    1525           cur=first = LList::Create();
    1526 
    1527         LObject *val = CAR(arg_list)->Eval();
    1528         ((LList *)cur)->car = val;
    1529         arg_list=lcdr(arg_list);
    1530       }
    1531       if(t == L_C_FUNCTION)
    1532         ret = LNumber::Create(c_caller( ((LSysFunction *)fun)->fun_number, first));
    1533       else if (c_caller( ((LSysFunction *)fun)->fun_number, first))
    1534         ret=true_symbol;
    1535       else ret=NULL;
    1536     } break;
    1537     default :
    1538       fprintf(stderr, "not a fun, shouldn't happen\n");
    1539   }
     1495    time_marker start;
     1496#endif
     1497
     1498    LObject *ret = NULL;
     1499
     1500    switch (t)
     1501    {
     1502    case L_SYS_FUNCTION:
     1503        ret = (LObject *)eval_sys_function(((LSysFunction *)fun), arg_list);
     1504        break;
     1505    case L_L_FUNCTION:
     1506        ret = (LObject *)l_caller(((LSysFunction *)fun)->fun_number, arg_list);
     1507        break;
     1508    case L_USER_FUNCTION:
     1509        return (LObject *)eval_user_fun(this, arg_list);
     1510    case L_C_FUNCTION:
     1511    case L_C_BOOL:
     1512    {
     1513        LList *first = NULL, *cur = NULL;
     1514        PtrRef r1(first), r2(cur), r3(arg_list);
     1515        while (arg_list)
     1516        {
     1517            LList *tmp = LList::Create();
     1518            if (first)
     1519                cur->cdr = tmp;
     1520            else
     1521                first = tmp;
     1522            cur = tmp;
     1523
     1524            LObject *val = CAR(arg_list)->Eval();
     1525            ((LList *)cur)->car = val;
     1526            arg_list = lcdr(arg_list);
     1527        }
     1528        if (t == L_C_FUNCTION)
     1529            ret = LNumber::Create(c_caller(((LSysFunction *)fun)->fun_number, first));
     1530        else if (c_caller(((LSysFunction *)fun)->fun_number, first))
     1531            ret = true_symbol;
     1532        else
     1533            ret = NULL;
     1534        break;
     1535    }
     1536    default:
     1537        fprintf(stderr, "not a fun, shouldn't happen\n");
     1538    }
    15401539
    15411540#ifdef L_PROFILE
    1542   time_marker end;
    1543   ((LSymbol *)sym)->time_taken+=end.diff_time(&start);
    1544 #endif
    1545 
    1546   return ret;
     1541    time_marker end;
     1542    time_taken += end.diff_time(&start);
     1543#endif
     1544
     1545    return ret;
    15471546}
    15481547
    … …  
    15761575  switch ((short)item_type(sym))
    15771576  {
    1578     case L_SYS_FUNCTION :
    1579     case L_USER_FUNCTION :
    1580     case L_SYMBOL :
    1581     break;
    1582     default :
    1583     {
    1584       ((LObject *)sym)->Print();
     1577    case L_SYS_FUNCTION:
     1578    case L_USER_FUNCTION:
     1579    case L_SYMBOL:
     1580      break;
     1581    default:
     1582    {
     1583      sym->Print();
    15851584      lbreak(" is not a function\n");
    15861585      exit(0);
    … …  
    16371636    {
    16381637      LList *c = LList::Create();
    1639       c->car = (LObject *)eval_function((LSymbol *)sym, first);
     1638      c->car = ((LSymbol *)sym)->EvalFunction(first);
    16401639      if (return_list)
    16411640        last_return->cdr=c;
    … …  
    22592258    {
    22602259      void *n1 = CAR(arg_list)->Eval();
    2261       ret=eval_function((LSymbol *)n1, CDR(arg_list));
     2260      ret = ((LSymbol *)n1)->EvalFunction(CDR(arg_list));
    22622261    } break;
    22632262    case SYS_FUNC_GT:
    … …  
    22992298    break;
    23002299    case SYS_FUNC_SYMBOL_NAME:
    2301       void *symb;
    2302       symb = CAR(arg_list)->Eval();
     2300      LSymbol *symb;
     2301      symb = (LSymbol *)CAR(arg_list)->Eval();
    23032302#ifdef TYPE_CHECKING
    23042303      if (item_type(symb)!=L_SYMBOL)
    23052304      {
    2306     ((LObject *)symb)->Print();
    2307     lbreak(" is not a symbol (symbol-name)\n");
    2308     exit(0);
    2309       }
    2310 #endif
    2311       ret=((LSymbol *)symb)->name;
     2305        symb->Print();
     2306        lbreak(" is not a symbol (symbol-name)\n");
     2307        exit(0);
     2308      }
     2309#endif
     2310      ret = symb->name;
    23122311    break;
    23132312    case SYS_FUNC_TRACE:
    … …  
    29422941    {
    29432942      if (!arg_list)
    2944       { ((LObject *)sym)->Print(); lbreak("too few parameter to function\n"); exit(0); }
     2943      { sym->Print(); lbreak("too few parameter to function\n"); exit(0); }
    29452944      l_user_stack.push(CAR(arg_list)->Eval());
    29462945      f_arg=CDR(f_arg);
    … …  
    29592958
    29602959  if (f_arg)
    2961   { ((LObject *)sym)->Print(); lbreak("too many parameter to function\n"); exit(0); }
     2960  { sym->Print(); lbreak("too many parameter to function\n"); exit(0); }
    29622961
    29632962
    … …  
    29772976#ifdef L_PROFILE
    29782977  time_marker end;
    2979   ((LSymbol *)sym)->time_taken+=end.diff_time(&start);
     2978  sym->time_taken += end.diff_time(&start);
    29802979#endif
    29812980
    … …  
    30303029            break;
    30313030        case L_CONS_CELL:
    3032             ret = (LObject *)eval_function((LSymbol *)CAR(this), CDR(this));
     3031            ret = ((LSymbol *)CAR(this))->EvalFunction(CDR(this));
    30333032            break;
    30343033        default :
Note: See TracChangeset for help on using the changeset viewer.