Changeset 497 for abuse/trunk/src/lisp/lisp.cpp
- Timestamp:
- Apr 17, 2011, 11:56:59 PM (12 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
abuse/trunk/src/lisp/lisp.cpp
r496 r497 180 180 void *lmalloc(int size, int which_space) 181 181 { 182 return malloc(size); 182 return malloc(size); /* XXX: temporary hack */ 183 183 184 184 #ifdef WORD_ALIGN … … 1431 1431 void *eval_sys_function(LSysFunction *fun, void *arg_list); 1432 1432 1433 void *eval_function(LSymbol *sym,void *arg_list)1433 LObject *LSymbol::EvalFunction(void *arg_list) 1434 1434 { 1435 1435 #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); 1450 1451 1451 1452 #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 } 1493 1492 #endif 1494 1493 1495 1494 #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 } 1540 1539 1541 1540 #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; 1547 1546 } 1548 1547 … … 1576 1575 switch ((short)item_type(sym)) 1577 1576 { 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(); 1585 1584 lbreak(" is not a function\n"); 1586 1585 exit(0); … … 1637 1636 { 1638 1637 LList *c = LList::Create(); 1639 c->car = ( LObject *)eval_function((LSymbol *)sym,first);1638 c->car = ((LSymbol *)sym)->EvalFunction(first); 1640 1639 if (return_list) 1641 1640 last_return->cdr=c; … … 2259 2258 { 2260 2259 void *n1 = CAR(arg_list)->Eval(); 2261 ret =eval_function((LSymbol *)n1,CDR(arg_list));2260 ret = ((LSymbol *)n1)->EvalFunction(CDR(arg_list)); 2262 2261 } break; 2263 2262 case SYS_FUNC_GT: … … 2299 2298 break; 2300 2299 case SYS_FUNC_SYMBOL_NAME: 2301 void*symb;2302 symb = CAR(arg_list)->Eval();2300 LSymbol *symb; 2301 symb = (LSymbol *)CAR(arg_list)->Eval(); 2303 2302 #ifdef TYPE_CHECKING 2304 2303 if (item_type(symb)!=L_SYMBOL) 2305 2304 { 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; 2312 2311 break; 2313 2312 case SYS_FUNC_TRACE: … … 2942 2941 { 2943 2942 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); } 2945 2944 l_user_stack.push(CAR(arg_list)->Eval()); 2946 2945 f_arg=CDR(f_arg); … … 2959 2958 2960 2959 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); } 2962 2961 2963 2962 … … 2977 2976 #ifdef L_PROFILE 2978 2977 time_marker end; 2979 ((LSymbol *)sym)->time_taken+=end.diff_time(&start);2978 sym->time_taken += end.diff_time(&start); 2980 2979 #endif 2981 2980 … … 3030 3029 break; 3031 3030 case L_CONS_CELL: 3032 ret = ( LObject *)eval_function((LSymbol *)CAR(this),CDR(this));3031 ret = ((LSymbol *)CAR(this))->EvalFunction(CDR(this)); 3033 3032 break; 3034 3033 default :
Note: See TracChangeset
for help on using the changeset viewer.