Changeset 496
- Timestamp:
- Apr 17, 2011, 11:56:55 PM (11 years ago)
- Location:
- abuse/trunk/src
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
abuse/trunk/src/chars.cpp
r494 r496 340 340 PtrRef r5(ab); 341 341 if (!NILP(ab)) 342 abil[i]=lnumber_value( eval(lcar(lcdr(ab))));342 abil[i]=lnumber_value(lcar(lcdr(ab))->Eval()); 343 343 } 344 344 } else if (f==l_funs) … … 361 361 Cell *ab=assoc(LSymbol::FindOrCreate(cflag_names[i]),l); 362 362 PtrRef r5(ab); 363 if (!NILP(ab) && eval(lcar(lcdr(ab))))363 if (!NILP(ab) && lcar(lcdr(ab))->Eval()) 364 364 cflags|=(1<<i); 365 365 } … … 373 373 } else if (f==l_range) 374 374 { 375 rangex=lnumber_value( eval(lcar(lcdr(lcar(field)))));376 rangey=lnumber_value( eval(lcar(lcdr(lcdr(lcar(field))))));375 rangex=lnumber_value(lcar(lcdr(lcar(field)))->Eval()); 376 rangey=lnumber_value(lcar(lcdr(lcdr(lcar(field))))->Eval()); 377 377 } else if (f==l_draw_range) 378 378 { 379 draw_rangex=lnumber_value( eval(lcar(lcdr(lcar(field)))));380 draw_rangey=lnumber_value( eval(lcar(lcdr(lcdr(lcar(field))))));379 draw_rangex=lnumber_value(lcar(lcdr(lcar(field)))->Eval()); 380 draw_rangey=lnumber_value(lcar(lcdr(lcdr(lcar(field))))->Eval()); 381 381 } else if (f==l_states) 382 382 { … … 384 384 PtrRef r4(l); 385 385 char fn[100]; 386 strcpy(fn,lstring_value( eval(CAR(l)))); l=CDR(l);386 strcpy(fn,lstring_value(CAR(l)->Eval())); l=CDR(l); 387 387 while (l) 388 388 { … … 391 391 sequence *mem; 392 392 index = add_state(CAR((CAR(l)))); 393 e = eval(CAR(CDR(CAR(l))));393 e = CAR(CDR(CAR(l)))->Eval(); 394 394 mem = new sequence(fn,e,NULL); 395 395 seq[index]=mem; … … 402 402 while (!NILP(mf)) 403 403 { 404 char *real=lstring_value( eval(lcar(lcar(mf))));405 char *fake=lstring_value( eval(lcar(lcdr(lcar(mf)))));404 char *real=lstring_value(lcar(lcar(mf))->Eval()); 405 char *fake=lstring_value(lcar(lcdr(lcar(mf)))->Eval()); 406 406 if (!isa_var_name(real)) 407 407 { … … 418 418 } else if (f==l_logo) 419 419 { 420 char *fn=lstring_value( eval(CAR(CDR(CAR(field)))));421 char *o=lstring_value( eval(CAR(CDR(CDR(CAR(field))))));420 char *fn=lstring_value(CAR(CDR(CAR(field)))->Eval()); 421 char *o=lstring_value(CAR(CDR(CDR(CAR(field))))->Eval()); 422 422 logo=cache.reg(fn,o,SPEC_IMAGE,1); 423 423 } else if (f==l_vars) -
abuse/trunk/src/clisp.cpp
r494 r496 573 573 case 0 : 574 574 { 575 current_object->set_aistate(lnumber_value( eval(CAR(args))));575 current_object->set_aistate(lnumber_value(CAR(args)->Eval())); 576 576 current_object->set_aistate_time(0); 577 577 void *ai=figures[current_object->otype]->get_fun(OFUN_AI); … … 587 587 { 588 588 game_object *old_cur=current_object; 589 current_object=(game_object *)lpointer_value( eval(CAR(args)));589 current_object=(game_object *)lpointer_value(CAR(args)->Eval()); 590 590 void *ret=eval_block(CDR(args)); 591 591 current_object=old_cur; … … 599 599 game_object *o; 600 600 if (args) 601 o=(game_object *)lpointer_value( eval(CAR(args)));601 o=(game_object *)lpointer_value(CAR(args)->Eval()); 602 602 else o=current_object; 603 603 game_object *hit=current_object->bmove(whit,o); … … 615 615 case 5 : return LPointer::Create(current_level->find_closest(current_object->x, 616 616 current_object->y, 617 lnumber_value( eval(CAR(args))),617 lnumber_value(CAR(args)->Eval()), 618 618 current_object)); break; 619 619 case 6 : return LPointer::Create(current_level->find_xclosest(current_object->x, 620 620 current_object->y, 621 lnumber_value( eval(CAR(args))),621 lnumber_value(CAR(args)->Eval()), 622 622 current_object 623 623 )); break; 624 624 case 7 : 625 625 { 626 long n1=lnumber_value( eval(CAR(args)));627 long n2=lnumber_value( eval(CAR(CDR(args))));626 long n1=lnumber_value(CAR(args)->Eval()); 627 long n2=lnumber_value(CAR(CDR(args))->Eval()); 628 628 return LPointer::Create(current_level->find_xrange(current_object->x, 629 629 current_object->y, … … 634 634 case 8 : 635 635 { 636 int type=lnumber_value( eval(CAR(args)));args=CDR(args);637 long x=lnumber_value( eval(CAR(args)));args=CDR(args);638 long y=lnumber_value( eval(CAR(args)));args=CDR(args);636 int type=lnumber_value(CAR(args)->Eval()); args=CDR(args); 637 long x=lnumber_value(CAR(args)->Eval()); args=CDR(args); 638 long y=lnumber_value(CAR(args)->Eval()); args=CDR(args); 639 639 game_object *o; 640 640 if (args) 641 o=create(type,x,y,0,lnumber_value( eval(CAR(args))));641 o=create(type,x,y,0,lnumber_value(CAR(args)->Eval())); 642 642 else 643 643 o=create(type,x,y); … … 648 648 case 22 : 649 649 { 650 int type=lnumber_value( eval(CAR(args)));args=CDR(args);651 long x=lnumber_value( eval(CAR(args)));args=CDR(args);652 long y=lnumber_value( eval(CAR(args)));args=CDR(args);650 int type=lnumber_value(CAR(args)->Eval()); args=CDR(args); 651 long x=lnumber_value(CAR(args)->Eval()); args=CDR(args); 652 long y=lnumber_value(CAR(args)->Eval()); args=CDR(args); 653 653 game_object *o; 654 654 if (args) 655 o=create(type,x,y,0,lnumber_value( eval(CAR(args))));655 o=create(type,x,y,0,lnumber_value(CAR(args)->Eval())); 656 656 else 657 657 o=create(type,x,y); … … 664 664 case 10 : 665 665 { 666 view *v=((game_object *)lpointer_value( eval(CAR(args))))->controller()->next;666 view *v=((game_object *)lpointer_value(CAR(args)->Eval()))->controller()->next; 667 667 if (v) 668 668 return LPointer::Create(v->focus); … … 672 672 { 673 673 return LPointer::Create 674 ((void *)current_object->get_object(lnumber_value( eval(CAR(args)))));674 ((void *)current_object->get_object(lnumber_value(CAR(args)->Eval()))); 675 675 } break; 676 676 case 12 : 677 677 { 678 678 return LPointer::Create 679 ((void *)current_object->get_light(lnumber_value( eval(CAR(args)))));679 ((void *)current_object->get_light(lnumber_value(CAR(args)->Eval()))); 680 680 } break; 681 681 case 13 : … … 686 686 { 687 687 current_object=old_cur->get_object(i); 688 ret =eval(CAR(args));688 ret = CAR(args)->Eval(); 689 689 } 690 690 current_object=old_cur; … … 693 693 case 14 : 694 694 { 695 int t=lnumber_value( eval(CAR(args))); args=lcdr(args);696 int x=lnumber_value( eval(CAR(args))); args=lcdr(args);697 int y=lnumber_value( eval(CAR(args))); args=lcdr(args);698 int r1=lnumber_value( eval(CAR(args))); args=lcdr(args);699 int r2=lnumber_value( eval(CAR(args))); args=lcdr(args);700 int xs=lnumber_value( eval(CAR(args))); args=lcdr(args);701 int ys=lnumber_value( eval(CAR(args)));695 int t=lnumber_value(CAR(args)->Eval()); args=lcdr(args); 696 int x=lnumber_value(CAR(args)->Eval()); args=lcdr(args); 697 int y=lnumber_value(CAR(args)->Eval()); args=lcdr(args); 698 int r1=lnumber_value(CAR(args)->Eval()); args=lcdr(args); 699 int r2=lnumber_value(CAR(args)->Eval()); args=lcdr(args); 700 int xs=lnumber_value(CAR(args)->Eval()); args=lcdr(args); 701 int ys=lnumber_value(CAR(args)->Eval()); 702 702 return LPointer::Create(add_light_source(t,x,y,r1,r2,xs,ys)); 703 703 } break; … … 714 714 case 17 : 715 715 { 716 long trials=lnumber_value( eval(CAR(args)));716 long trials=lnumber_value(CAR(args)->Eval()); 717 717 args=CDR(args); 718 718 time_marker start; … … 720 720 { 721 721 clear_tmp(); 722 eval(CAR(args));722 CAR(args)->Eval(); 723 723 } 724 724 time_marker end; … … 731 731 case 20 : 732 732 { 733 long x1=lnumber_value( eval(CAR(args))); args=CDR(args);734 long y1=lnumber_value( eval(CAR(args))); args=CDR(args);735 long x2=lnumber_value( eval(CAR(args))); args=CDR(args);736 long y2=lnumber_value( eval(CAR(args))); args=CDR(args);737 738 void *list =eval(CAR(args));733 long x1=lnumber_value(CAR(args)->Eval()); args=CDR(args); 734 long y1=lnumber_value(CAR(args)->Eval()); args=CDR(args); 735 long x2=lnumber_value(CAR(args)->Eval()); args=CDR(args); 736 long y2=lnumber_value(CAR(args)->Eval()); args=CDR(args); 737 738 void *list = CAR(args)->Eval(); 739 739 game_object *find=current_level->find_object_in_area(current_object->x, 740 740 current_object->y, … … 746 746 case 21 : 747 747 { 748 long a1=lnumber_value( eval(CAR(args))); args=CDR(args);749 long a2=lnumber_value( eval(CAR(args))); args=CDR(args);750 751 void *list =eval(CAR(args));748 long a1=lnumber_value(CAR(args)->Eval()); args=CDR(args); 749 long a2=lnumber_value(CAR(args)->Eval()); args=CDR(args); 750 751 void *list = CAR(args)->Eval(); 752 752 PtrRef r1(list); 753 753 game_object *find=current_level->find_object_in_angle(current_object->x, … … 787 787 case 24 : 788 788 { 789 int32_t x1=lnumber_value( eval(CAR(args)));args=CDR(args);790 int32_t y1=lnumber_value( eval(CAR(args)));args=CDR(args);791 int32_t x2=lnumber_value( eval(CAR(args)));args=CDR(args);792 int32_t y2=lnumber_value( eval(CAR(args)));789 int32_t x1=lnumber_value(CAR(args)->Eval()); args=CDR(args); 790 int32_t y1=lnumber_value(CAR(args)->Eval()); args=CDR(args); 791 int32_t x2=lnumber_value(CAR(args)->Eval()); args=CDR(args); 792 int32_t y2=lnumber_value(CAR(args)->Eval()); 793 793 current_level->foreground_intersect(x1,y1,x2,y2); 794 794 void *ret=NULL; … … 868 868 case 46 : 869 869 { 870 return LString::Create(start_argv[lnumber_value( eval(CAR(args)))]);870 return LString::Create(start_argv[lnumber_value(CAR(args)->Eval())]); 871 871 } break; 872 872 case 47 : … … 901 901 case 49 : 902 902 { 903 int32_t x=lnumber_value( eval(CAR(args))); args=CDR(args);904 int32_t y=lnumber_value( eval(CAR(args))); args=CDR(args);903 int32_t x=lnumber_value(CAR(args)->Eval()); args=CDR(args); 904 int32_t y=lnumber_value(CAR(args)->Eval()); args=CDR(args); 905 905 906 906 int32_t rx,ry; … … 916 916 case 50 : 917 917 { 918 int32_t x=lnumber_value( eval(CAR(args))); args=CDR(args);919 int32_t y=lnumber_value( eval(CAR(args))); args=CDR(args);918 int32_t x=lnumber_value(CAR(args)->Eval()); args=CDR(args); 919 int32_t y=lnumber_value(CAR(args)->Eval()); args=CDR(args); 920 920 921 921 int32_t rx,ry; … … 945 945 } break; 946 946 case 55 : 947 { system(lstring_value( eval(CAR(args)))); } break;947 { system(lstring_value(CAR(args)->Eval())); } break; 948 948 case 56 : 949 949 { 950 void *fn= eval(CAR(args)); args=CDR(args);950 void *fn=CAR(args)->Eval(); args=CDR(args); 951 951 char tmp[200]; 952 952 { 953 953 PtrRef r1(fn); 954 char *slash=lstring_value( eval(CAR(args)));954 char *slash=lstring_value(CAR(args)->Eval()); 955 955 char *filename=lstring_value(fn); 956 956 … … 972 972 int tfiles,tdirs,i; 973 973 974 get_directory(lstring_value( eval(CAR(args))),files,tfiles,dirs,tdirs);974 get_directory(lstring_value(CAR(args)->Eval()),files,tfiles,dirs,tdirs); 975 975 void *fl=NULL,*dl=NULL,*rl=NULL; 976 976 { … … 995 995 { 996 996 long x; 997 sscanf(lstring_value( eval(CAR(args))),"%lx",&x);997 sscanf(lstring_value(CAR(args)->Eval()),"%lx",&x); 998 998 return LPointer::Create((void *)(intptr_t)x); 999 999 } break; … … 1001 1001 { 1002 1002 char name[256],name2[256]; 1003 strcpy(name,lstring_value( eval(CAR(args)))); args=CDR(args);1004 long first=lnumber_value( eval(CAR(args))); args=CDR(args);1005 long last=lnumber_value( eval(CAR(args)));1003 strcpy(name,lstring_value(CAR(args)->Eval())); args=CDR(args); 1004 long first=lnumber_value(CAR(args)->Eval()); args=CDR(args); 1005 long last=lnumber_value(CAR(args)->Eval()); 1006 1006 long i; 1007 1007 void *ret=NULL; -
abuse/trunk/src/cop.cpp
r494 r496 256 256 if (!o->lvars[fire_delay1]) // make sur we are not waiting of previous fire 257 257 { 258 int32_t value=lnumber_value( eval(CAR(args)));258 int32_t value=lnumber_value(CAR(args)->Eval()); 259 259 if (value) // do we have ammo ? 260 260 { … … 298 298 if (!o->lvars[fire_delay1]) // make sur we are not waiting of previous fire 299 299 { 300 int32_t value=lnumber_value( eval(CAR(args)));300 int32_t value=lnumber_value(CAR(args)->Eval()); 301 301 if (value) // do we have ammo ? 302 302 { … … 325 325 if (!o->lvars[fire_delay1]) // make sur we are not waiting of previous fire 326 326 { 327 int32_t value=lnumber_value( eval(CAR(args)));327 int32_t value=lnumber_value(CAR(args)->Eval()); 328 328 if (value) // do we have ammo ? 329 329 { … … 349 349 if (!o->lvars[fire_delay1]) // make sur we are not waiting of previous fire 350 350 { 351 int32_t value=lnumber_value( eval(CAR(args)));351 int32_t value=lnumber_value(CAR(args)->Eval()); 352 352 if (value) // do we have ammo ? 353 353 { … … 376 376 if (!o->lvars[fire_delay1]) // make sur we are not waiting of previous fire 377 377 { 378 int32_t value=lnumber_value( eval(CAR(args)));378 int32_t value=lnumber_value(CAR(args)->Eval()); 379 379 if (value) // do we have ammo ? 380 380 { -
abuse/trunk/src/dev.cpp
r494 r496 56 56 char const *cs=prog; 57 57 strcpy(prog,"(setq section 'game_section)\n"); 58 eval(compile(cs));58 LObject::Compile(cs)->Eval(); 59 59 strcpy(prog,"(load \"lisp/english.lsp\")\n"); 60 60 cs=prog; 61 if (! eval(compile(cs)))61 if (!LObject::Compile(cs)->Eval()) 62 62 { 63 63 printf("unable to open file '%s'\n",lsf); … … 965 965 strcpy(prog,"(compile-file \"edit.lsp\")"); 966 966 cs=prog; 967 void *p=compile(cs);967 LObject *p = LObject::Compile(cs); 968 968 l_user_stack.push(p); 969 eval(p);969 p->Eval(); 970 970 l_user_stack.pop(1); 971 971 for (int i=0; i<total_pals; i++) … … 982 982 if (command[0]=='(') // is this a lisp command? 983 983 { 984 eval(compile(command));984 LObject::Compile(command)->Eval(); 985 985 return ; 986 986 } … … 2309 2309 atoi(mess_win->read(ID_MESS_STR2))); 2310 2310 char const *s=name; 2311 eval(compile(s));2311 LObject::Compile(s)->Eval(); 2312 2312 wm->push_event(new event(ID_CANCEL,NULL)); // close window 2313 2313 } break; -
abuse/trunk/src/game.cpp
r494 r496 1256 1256 1257 1257 int i; 1258 char *str = lstring_value( eval(LSymbol::FindOrCreate("plot_start")));1258 char *str = lstring_value(LSymbol::FindOrCreate("plot_start")->Eval()); 1259 1259 1260 1260 bFILE *fp = open_file("art/smoke.spe", "rb"); … … 2311 2311 while(*s) 2312 2312 { 2313 void *prog = compile(s);2313 LObject *prog = LObject::Compile(s); 2314 2314 l_user_stack.push(prog); 2315 2315 while(*s==' ' || *s=='\t' || *s=='\r' || *s=='\n') s++; 2316 ((LObject *)eval(prog))->Print();2316 prog->Eval()->Print(); 2317 2317 l_user_stack.pop(1); 2318 2318 } -
abuse/trunk/src/lisp/lisp.cpp
r494 r496 140 140 do 141 141 { 142 void *prog=compile(s); 143 PtrRef r1(prog); 144 while (*s==' ' || *s=='\t' || *s=='\r' || *s=='\n') s++; 145 ((LObject *)eval(prog))->Print(); 142 LObject *prog = LObject::Compile(s); 143 PtrRef r1(prog); 144 while (*s==' ' || *s=='\t' || *s=='\r' || *s=='\n') 145 s++; 146 prog->Eval()->Print(); 146 147 } while (*s); 147 148 } … … 215 216 while (list) 216 217 { 217 ret =eval(CAR(list));218 list =CDR(list);218 ret = CAR(list)->Eval(); 219 list = CDR(list); 219 220 } 220 221 return ret; … … 237 238 if (rest) 238 239 { 239 void *x = eval(CAR(rest));240 LObject *x = CAR(rest)->Eval(); 240 241 if (x == colon_initial_contents) 241 242 { 242 x = eval(CAR(CDR(rest)));243 x = CAR(CDR(rest))->Eval(); 243 244 data = p->GetData(); 244 245 for (size_t i = 0; i < len; i++, x = CDR(x)) … … 261 262 else if (x == colon_initial_element) 262 263 { 263 x = eval(CAR(CDR(rest)));264 x = CAR(CDR(rest))->Eval(); 264 265 data = p->GetData(); 265 266 for (size_t i = 0; i < len; i++) … … 563 564 } 564 565 565 void*lcdr(void *c)566 LObject *lcdr(void *c) 566 567 { 567 568 if (!c) return NULL; … … 572 573 } 573 574 574 void*lcar(void *c)575 LObject *lcar(void *c) 575 576 { 576 577 if (!c) return NULL; … … 877 878 } 878 879 879 void ldelete_syms(LSymbol *root)880 { 881 if (root)882 {883 ldelete_syms(root->left);884 ldelete_syms(root->right);885 free(root);886 }880 static void DeleteAllSymbols(LSymbol *root) 881 { 882 if (root) 883 { 884 DeleteAllSymbols(root->left); 885 DeleteAllSymbols(root->right); 886 free(root); 887 } 887 888 } 888 889 … … 1124 1125 void *comp_optimize(void *list); 1125 1126 1126 void *compile(char const *&s) 1127 { 1128 void *ret=NULL; 1129 if (!read_ltoken(s, n)) 1130 lerror(NULL, "unexpected end of program"); 1127 LObject *LObject::Compile(char const *&code) 1128 { 1129 LObject *ret = NULL; 1130 1131 if (!read_ltoken(code, n)) 1132 lerror(NULL, "unexpected end of program"); 1133 1131 1134 if (!strcmp(n, "nil")) 1132 1135 return NULL; … … 1135 1138 else if (n[0]=='\'') // short hand for quote function 1136 1139 { 1137 void*cs = LList::Create(), *c2=NULL, *tmp;1140 LObject *cs = LList::Create(), *c2=NULL, *tmp; 1138 1141 PtrRef r1(cs), r2(c2); 1139 1142 1140 1143 ((LList *)cs)->car=quote_symbol; 1141 1144 c2 = LList::Create(); 1142 tmp= compile(s);1145 tmp=Compile(code); 1143 1146 ((LList *)c2)->car = (LObject *)tmp; 1144 1147 ((LList *)c2)->cdr=NULL; … … 1148 1151 else if (n[0]=='`') // short hand for backquote function 1149 1152 { 1150 void*cs = LList::Create(), *c2=NULL, *tmp;1153 LObject *cs = LList::Create(), *c2=NULL, *tmp; 1151 1154 PtrRef r1(cs), r2(c2); 1152 1155 1153 1156 ((LList *)cs)->car=backquote_symbol; 1154 1157 c2 = LList::Create(); 1155 tmp= compile(s);1158 tmp=Compile(code); 1156 1159 ((LList *)c2)->car = (LObject *)tmp; 1157 1160 ((LList *)c2)->cdr=NULL; … … 1160 1163 } else if (n[0]==',') // short hand for comma function 1161 1164 { 1162 void*cs = LList::Create(), *c2=NULL, *tmp;1165 LObject *cs = LList::Create(), *c2=NULL, *tmp; 1163 1166 PtrRef r1(cs), r2(c2); 1164 1167 1165 1168 ((LList *)cs)->car=comma_symbol; 1166 1169 c2 = LList::Create(); 1167 tmp= compile(s);1170 tmp=Compile(code); 1168 1171 ((LList *)c2)->car = (LObject *)tmp; 1169 1172 ((LList *)c2)->cdr=NULL; … … 1178 1181 do 1179 1182 { 1180 char const *tmp= s;1183 char const *tmp=code; 1181 1184 if (!read_ltoken(tmp, n)) // check for the end of the list 1182 1185 lerror(NULL, "unexpected end of program"); … … 1184 1187 { 1185 1188 done=1; 1186 read_ltoken( s, n); // read off the ')'1189 read_ltoken(code, n); // read off the ')' 1187 1190 } 1188 1191 else … … 1191 1194 { 1192 1195 if (!first) 1193 lerror( s, "token '.' not allowed here\n");1196 lerror(code, "token '.' not allowed here\n"); 1194 1197 else 1195 1198 { 1196 1199 void *tmp; 1197 read_ltoken( s, n); // skip the '.'1198 tmp= compile(s);1200 read_ltoken(code, n); // skip the '.' 1201 tmp=Compile(code); 1199 1202 ((LList *)last)->cdr = (LObject *)tmp; // link the last cdr to 1200 1203 last=NULL; 1201 1204 } 1202 1205 } else if (!last && first) 1203 lerror( s, "illegal end of dotted list\n");1206 lerror(code, "illegal end of dotted list\n"); 1204 1207 else 1205 1208 { … … 1208 1211 PtrRef r1(cur); 1209 1212 if (!first) first=cur; 1210 tmp= compile(s);1213 tmp=Compile(code); 1211 1214 ((LList *)cur)->car = (LObject *)tmp; 1212 1215 if (last) … … 1216 1219 } 1217 1220 } while (!done); 1218 ret= comp_optimize(first);1221 ret=(LObject *)comp_optimize(first); 1219 1222 1220 1223 } else if (n[0]==')') 1221 lerror( s, "mismatched )");1224 lerror(code, "mismatched )"); 1222 1225 else if (isdigit(n[0]) || (n[0]=='-' && isdigit(n[1]))) 1223 1226 { … … 1227 1230 } else if (n[0]=='"') 1228 1231 { 1229 ret = LString::Create(str_token_len( s));1232 ret = LString::Create(str_token_len(code)); 1230 1233 char *start=lstring_value(ret); 1231 for (; * s && (*s!='"' || s[1]=='"'); s++, start++)1232 { 1233 if (* s=='\\')1234 { 1235 s++;1236 if (* s=='n') *start='\n';1237 if (* s=='r') *start='\r';1238 if (* s=='t') *start='\t';1239 if (* s=='\\') *start='\\';1240 } else *start=* s;1241 if (* s=='"') s++;1234 for (; *code && (*code!='"' || code[1]=='"'); code++, start++) 1235 { 1236 if (*code=='\\') 1237 { 1238 code++; 1239 if (*code=='n') *start='\n'; 1240 if (*code=='r') *start='\r'; 1241 if (*code=='t') *start='\t'; 1242 if (*code=='\\') *start='\\'; 1243 } else *start=*code; 1244 if (*code=='"') code++; 1242 1245 } 1243 1246 *start=0; 1244 s++;1247 code++; 1245 1248 } else if (n[0]=='#') 1246 1249 { 1247 1250 if (n[1]=='\\') 1248 1251 { 1249 read_ltoken( s, n); // read character name1252 read_ltoken(code, n); // read character name 1250 1253 if (!strcmp(n, "newline")) 1251 1254 ret = LChar::Create('\n'); … … 1257 1260 else if (n[1]==0) // short hand for function 1258 1261 { 1259 void*cs = LList::Create(), *c2=NULL, *tmp;1262 LObject *cs = LList::Create(), *c2=NULL, *tmp; 1260 1263 PtrRef r4(cs), r5(c2); 1261 1264 tmp = LSymbol::FindOrCreate("function"); 1262 1265 ((LList *)cs)->car = (LObject *)tmp; 1263 1266 c2 = LList::Create(); 1264 tmp= compile(s);1267 tmp=Compile(code); 1265 1268 ((LList *)c2)->car = (LObject *)tmp; 1266 1269 ((LList *)cs)->cdr = (LObject *)c2; … … 1522 1525 cur=first = LList::Create(); 1523 1526 1524 void *val=eval(CAR(arg_list));1525 ((LList *)cur)->car = (LObject *)val;1527 LObject *val = CAR(arg_list)->Eval(); 1528 ((LList *)cur)->car = val; 1526 1529 arg_list=lcdr(arg_list); 1527 1530 } … … 1570 1573 { 1571 1574 PtrRef ref1(arg_list); 1572 void *sym=eval(CAR(arg_list));1575 LObject *sym = CAR(arg_list)->Eval(); 1573 1576 switch ((short)item_type(sym)) 1574 1577 { … … 1593 1596 for (i=0; i<num_args; i++) 1594 1597 { 1595 arg_on[i] =(LList *)eval(CAR(list_on));1598 arg_on[i] = (LList *)CAR(list_on)->Eval(); 1596 1599 PtrRef::stack.push(&arg_on[i]); 1597 1600 … … 1654 1657 PtrRef ref1(prog_list), ref2(el_list); 1655 1658 void *ret=NULL; 1656 void *rtype =eval(CAR(prog_list));1659 void *rtype = CAR(prog_list)->Eval(); 1657 1660 1658 1661 long len=0; // determin the length of the resulting string … … 1669 1672 for (i=0; i<elements; i++, el_list=CDR(el_list)) 1670 1673 { 1671 str_eval[i] =eval(CAR(el_list));1674 str_eval[i] = CAR(el_list)->Eval(); 1672 1675 PtrRef::stack.push(&str_eval[i]); 1673 1676 … … 1748 1751 return NULL; 1749 1752 else if ((LSymbol *) (((LList *)args)->car)==comma_symbol) 1750 return eval(CAR(CDR(args)));1753 return CAR(CDR(args))->Eval(); 1751 1754 else 1752 1755 { … … 1759 1762 if (CAR(args)==comma_symbol) // dot list with a comma? 1760 1763 { 1761 tmp =eval(CAR(CDR(args)));1764 tmp = CAR(CDR(args))->Eval(); 1762 1765 ((LList *)last)->cdr = (LObject *)tmp; 1763 1766 args=NULL; … … 1800 1803 while (arg_list) 1801 1804 { 1802 ret=eval(CAR(arg_list)); arg_list=CDR(arg_list); 1805 ret = CAR(arg_list)->Eval(); 1806 arg_list=CDR(arg_list); 1803 1807 ((LObject *)ret)->Print(); 1804 1808 } … … 1806 1810 } break; 1807 1811 case SYS_FUNC_CAR: 1808 { ret=lcar( eval(CAR(arg_list))); } break;1812 { ret=lcar(CAR(arg_list)->Eval()); } break; 1809 1813 case SYS_FUNC_CDR: 1810 { ret=lcdr( eval(CAR(arg_list))); } break;1814 { ret=lcdr(CAR(arg_list)->Eval()); } break; 1811 1815 case SYS_FUNC_LENGTH: 1812 1816 { 1813 void *v =eval(CAR(arg_list));1817 void *v = CAR(arg_list)->Eval(); 1814 1818 switch (item_type(v)) 1815 1819 { … … 1830 1834 { 1831 1835 cur = LList::Create(); 1832 void *val =eval(CAR(arg_list));1836 void *val = CAR(arg_list)->Eval(); 1833 1837 ((LList *) cur)->car = (LObject *)val; 1834 1838 if (last) … … 1843 1847 { void *c = LList::Create(); 1844 1848 PtrRef r1(c); 1845 void *val =eval(CAR(arg_list));1849 void *val = CAR(arg_list)->Eval(); 1846 1850 ((LList *)c)->car = (LObject *)val; 1847 val =eval(CAR(CDR(arg_list)));1851 val = CAR(CDR(arg_list))->Eval(); 1848 1852 ((LList *)c)->cdr = (LObject *)val; 1849 1853 ret=c; … … 1854 1858 case SYS_FUNC_EQ: 1855 1859 { 1856 l_user_stack.push( eval(CAR(arg_list)));1857 l_user_stack.push( eval(CAR(CDR(arg_list))));1860 l_user_stack.push(CAR(arg_list)->Eval()); 1861 l_user_stack.push(CAR(CDR(arg_list))->Eval()); 1858 1862 ret=lisp_eq(l_user_stack.pop(1), l_user_stack.pop(1)); 1859 1863 } break; 1860 1864 case SYS_FUNC_EQUAL: 1861 1865 { 1862 l_user_stack.push( eval(CAR(arg_list)));1863 l_user_stack.push( eval(CAR(CDR(arg_list))));1866 l_user_stack.push(CAR(arg_list)->Eval()); 1867 l_user_stack.push(CAR(CDR(arg_list))->Eval()); 1864 1868 ret=lisp_equal(l_user_stack.pop(1), l_user_stack.pop(1)); 1865 1869 } break; … … 1869 1873 while (arg_list) 1870 1874 { 1871 sum+=lnumber_value( eval(CAR(arg_list)));1875 sum+=lnumber_value(CAR(arg_list)->Eval()); 1872 1876 arg_list=CDR(arg_list); 1873 1877 } … … 1878 1882 { 1879 1883 long sum; 1880 void *first =eval(CAR(arg_list));1884 void *first = CAR(arg_list)->Eval(); 1881 1885 PtrRef r1(first); 1882 1886 if (arg_list && item_type(first)==L_FIXED_POINT) … … 1887 1891 sum=(sum>>8)*(lfixed_point_value(first)>>8); 1888 1892 arg_list=CDR(arg_list); 1889 if (arg_list) first =eval(CAR(arg_list));1893 if (arg_list) first = CAR(arg_list)->Eval(); 1890 1894 } while (arg_list); 1891 1895 … … 1895 1899 do 1896 1900 { 1897 sum*=lnumber_value( eval(CAR(arg_list)));1901 sum*=lnumber_value(CAR(arg_list)->Eval()); 1898 1902 arg_list=CDR(arg_list); 1899 if (arg_list) first =eval(CAR(arg_list));1903 if (arg_list) first =CAR(arg_list)->Eval(); 1900 1904 } while (arg_list); 1901 1905 ret = LNumber::Create(sum); … … 1908 1912 while (arg_list) 1909 1913 { 1910 void *i =eval(CAR(arg_list));1914 void *i = CAR(arg_list)->Eval(); 1911 1915 PtrRef r1(i); 1912 1916 if (item_type(i)!=L_NUMBER) … … 1928 1932 case SYS_FUNC_MINUS: 1929 1933 { 1930 long x=lnumber_value(eval(CAR(arg_list))); arg_list=CDR(arg_list); 1934 long x=lnumber_value(CAR(arg_list)->Eval()); 1935 arg_list=CDR(arg_list); 1931 1936 while (arg_list) 1932 1937 { 1933 x-=lnumber_value( eval(CAR(arg_list)));1938 x-=lnumber_value(CAR(arg_list)->Eval()); 1934 1939 arg_list=CDR(arg_list); 1935 1940 } … … 1939 1944 case SYS_FUNC_IF: 1940 1945 { 1941 if ( eval(CAR(arg_list)))1942 ret= eval(CAR(CDR(arg_list)));1946 if (CAR(arg_list)->Eval()) 1947 ret=CAR(CDR(arg_list))->Eval(); 1943 1948 else 1944 1949 { arg_list=CDR(CDR(arg_list)); // check for a else part 1945 1950 if (arg_list) 1946 ret =eval(CAR(arg_list));1951 ret = CAR(arg_list)->Eval(); 1947 1952 else ret=NULL; 1948 1953 } … … 1951 1956 case SYS_FUNC_SETF: 1952 1957 { 1953 void *set_to =eval(CAR(CDR(arg_list))), *i=NULL;1958 void *set_to = CAR(CDR(arg_list))->Eval(), *i=NULL; 1954 1959 PtrRef r1(set_to), r2(i); 1955 1960 i=CAR(arg_list); … … 1984 1989 if (car==car_symbol) 1985 1990 { 1986 car =eval(CAR(CDR(i)));1991 car = CAR(CDR(i))->Eval(); 1987 1992 if (!car || item_type(car)!=L_CONS_CELL) 1988 1993 { ((LObject *)car)->Print(); lbreak("setq car : evaled object is not a cons cell\n"); exit(0); } … … 1990 1995 } else if (car==cdr_symbol) 1991 1996 { 1992 car =eval(CAR(CDR(i)));1997 car = CAR(CDR(i))->Eval(); 1993 1998 if (!car || item_type(car)!=L_CONS_CELL) 1994 1999 { ((LObject *)car)->Print(); lbreak("setq cdr : evaled object is not a cons cell\n"); exit(0); } … … 1997 2002 { 1998 2003 #endif 1999 LArray *a = (LArray *) eval(CAR(CDR(i)));2004 LArray *a = (LArray *)CAR(CDR(i))->Eval(); 2000 2005 PtrRef r1(a); 2001 2006 #ifdef TYPE_CHECKING … … 2007 2012 } 2008 2013 #endif 2009 int num = lnumber_value( eval(CAR(CDR(CDR(i)))));2014 int num = lnumber_value(CAR(CDR(CDR(i)))->Eval()); 2010 2015 #ifdef TYPE_CHECKING 2011 2016 if (num >= (int)a->len || num < 0) … … 2039 2044 case SYS_FUNC_ASSOC: 2040 2045 { 2041 void *item =eval(CAR(arg_list));2046 void *item = CAR(arg_list)->Eval(); 2042 2047 PtrRef r1(item); 2043 void *list=(LList *) eval(CAR(CDR(arg_list)));2048 void *list=(LList *)CAR(CDR(arg_list))->Eval(); 2044 2049 PtrRef r2(list); 2045 2050 ret=assoc(item, (LList *)list); … … 2047 2052 case SYS_FUNC_NOT: 2048 2053 case SYS_FUNC_NULL: 2049 if ( eval(CAR(arg_list))==NULL) ret=true_symbol; else ret=NULL;2054 if (CAR(arg_list)->Eval()==NULL) ret=true_symbol; else ret=NULL; 2050 2055 break; 2051 2056 case SYS_FUNC_ACONS: 2052 2057 { 2053 void *i1 =eval(CAR(arg_list)), *i2=eval(CAR(CDR(arg_list)));2058 void *i1 = CAR(arg_list)->Eval(), *i2 = CAR(CDR(arg_list))->Eval(); 2054 2059 PtrRef r1(i1); 2055 2060 LList *cs = LList::Create(); … … 2061 2066 case SYS_FUNC_PAIRLIS: 2062 2067 { 2063 l_user_stack.push(eval(CAR(arg_list))); arg_list=CDR(arg_list); 2064 l_user_stack.push(eval(CAR(arg_list))); arg_list=CDR(arg_list); 2065 void *n3=eval(CAR(arg_list)); 2068 l_user_stack.push(CAR(arg_list)->Eval()); 2069 arg_list=CDR(arg_list); 2070 l_user_stack.push(CAR(arg_list)->Eval()); 2071 arg_list=CDR(arg_list); 2072 void *n3 = CAR(arg_list)->Eval(); 2066 2073 void *n2=l_user_stack.pop(1); 2067 2074 void *n1=l_user_stack.pop(1); … … 2089 2096 2090 2097 l_user_stack.push(((LSymbol *)var_name)->value); 2091 tmp =eval(CAR(CDR(CAR(var_list))));2098 tmp = CAR(CDR(CAR(var_list)))->Eval(); 2092 2099 ((LSymbol *)var_name)->SetValue((LObject *)tmp); 2093 2100 var_list=CDR(var_list); … … 2098 2105 while (block_list) 2099 2106 { 2100 ret =eval(CAR(block_list));2107 ret = CAR(block_list)->Eval(); 2101 2108 block_list=CDR(block_list); 2102 2109 } … … 2144 2151 } break; 2145 2152 case SYS_FUNC_ATOM: 2146 { ret=lisp_atom( eval(CAR(arg_list))); }2153 { ret=lisp_atom(CAR(arg_list)->Eval()); } 2147 2154 case SYS_FUNC_AND: 2148 2155 { … … 2152 2159 while (l) 2153 2160 { 2154 if (! eval(CAR(l)))2161 if (!CAR(l)->Eval()) 2155 2162 { 2156 2163 ret=NULL; … … 2166 2173 while (l) 2167 2174 { 2168 if ( eval(CAR(l)))2175 if (CAR(l)->Eval()) 2169 2176 { 2170 2177 ret=true_symbol; … … 2180 2187 case SYS_FUNC_CHAR_CODE: 2181 2188 { 2182 void *i =eval(CAR(arg_list));2189 void *i = CAR(arg_list)->Eval(); 2183 2190 PtrRef r1(i); 2184 2191 ret=NULL; … … 2199 2206 case SYS_FUNC_CODE_CHAR: 2200 2207 { 2201 void *i =eval(CAR(arg_list));2208 void *i = CAR(arg_list)->Eval(); 2202 2209 PtrRef r1(i); 2203 2210 if (item_type(i)!=L_NUMBER) … … 2219 2226 while (block_list) 2220 2227 { 2221 if ( eval(lcar(CAR(block_list))))2222 ret =eval(CAR(CDR(CAR(block_list))));2228 if (lcar(CAR(block_list))->Eval()) 2229 ret = CAR(CDR(CAR(block_list)))->Eval(); 2223 2230 block_list=CDR(block_list); 2224 2231 } … … 2227 2234 case SYS_FUNC_SELECT: 2228 2235 { 2229 void *selector =eval(CAR(arg_list));2236 void *selector = CAR(arg_list)->Eval(); 2230 2237 void *sel=CDR(arg_list); 2231 2238 PtrRef r1(selector), r2(sel); 2232 2239 while (sel) 2233 2240 { 2234 if (lisp_equal(selector, eval(CAR(CAR(sel)))))2241 if (lisp_equal(selector, CAR(CAR(sel))->Eval())) 2235 2242 { 2236 2243 sel=CDR(CAR(sel)); 2237 2244 while (sel) 2238 2245 { 2239 ret =eval(CAR(sel));2246 ret = CAR(sel)->Eval(); 2240 2247 sel=CDR(sel); 2241 2248 } … … 2245 2252 } break; 2246 2253 case SYS_FUNC_FUNCTION: 2247 ret = ((LSymbol *) eval(CAR(arg_list)))->GetFunction();2254 ret = ((LSymbol *)CAR(arg_list)->Eval())->GetFunction(); 2248 2255 break; 2249 2256 case SYS_FUNC_MAPCAR: … … 2251 2258 case SYS_FUNC_FUNCALL: 2252 2259 { 2253 void *n1 =eval(CAR(arg_list));2260 void *n1 = CAR(arg_list)->Eval(); 2254 2261 ret=eval_function((LSymbol *)n1, CDR(arg_list)); 2255 2262 } break; 2256 2263 case SYS_FUNC_GT: 2257 2264 { 2258 long n1=lnumber_value( eval(CAR(arg_list)));2259 long n2=lnumber_value( eval(CAR(CDR(arg_list))));2265 long n1=lnumber_value(CAR(arg_list)->Eval()); 2266 long n2=lnumber_value(CAR(CDR(arg_list))->Eval()); 2260 2267 if (n1>n2) ret=true_symbol; else ret=NULL; 2261 2268 } … … 2263 2270 case SYS_FUNC_LT: 2264 2271 { 2265 long n1=lnumber_value( eval(CAR(arg_list)));2266 long n2=lnumber_value( eval(CAR(CDR(arg_list))));2272 long n1=lnumber_value(CAR(arg_list)->Eval()); 2273 long n2=lnumber_value(CAR(CDR(arg_list))->Eval()); 2267 2274 if (n1<n2) ret=true_symbol; else ret=NULL; 2268 2275 } … … 2270 2277 case SYS_FUNC_GE: 2271 2278 { 2272 long n1=lnumber_value( eval(CAR(arg_list)));2273 long n2=lnumber_value( eval(CAR(CDR(arg_list))));2279 long n1=lnumber_value(CAR(arg_list)->Eval()); 2280 long n2=lnumber_value(CAR(CDR(arg_list))->Eval()); 2274 2281 if (n1>=n2) ret=true_symbol; else ret=NULL; 2275 2282 } … … 2277 2284 case SYS_FUNC_LE: 2278 2285 { 2279 long n1=lnumber_value( eval(CAR(arg_list)));2280 long n2=lnumber_value( eval(CAR(CDR(arg_list))));2286 long n1=lnumber_value(CAR(arg_list)->Eval()); 2287 long n2=lnumber_value(CAR(CDR(arg_list))->Eval()); 2281 2288 if (n1<=n2) ret=true_symbol; else ret=NULL; 2282 2289 } … … 2293 2300 case SYS_FUNC_SYMBOL_NAME: 2294 2301 void *symb; 2295 symb =eval(CAR(arg_list));2302 symb = CAR(arg_list)->Eval(); 2296 2303 #ifdef TYPE_CHECKING 2297 2304 if (item_type(symb)!=L_SYMBOL) … … 2307 2314 trace_level++; 2308 2315 if (arg_list) 2309 trace_print_level=lnumber_value( eval(CAR(arg_list)));2316 trace_print_level=lnumber_value(CAR(arg_list)->Eval()); 2310 2317 ret=true_symbol; 2311 2318 break; … … 2320 2327 { 2321 2328 char tmp[50], *tp; 2322 long num=lnumber_value( eval(CAR(arg_list)));2323 long dig=lnumber_value( eval(CAR(CDR(arg_list))));2329 long num=lnumber_value(CAR(arg_list)->Eval()); 2330 long dig=lnumber_value(CAR(CDR(arg_list))->Eval()); 2324 2331 tp=tmp+49; 2325 2332 *(tp--)=0; … … 2340 2347 case SYS_FUNC_COMPILE_FILE: 2341 2348 { 2342 void *fn = eval( CAR( arg_list ));2349 void *fn = CAR(arg_list)->Eval(); 2343 2350 char *st = lstring_value( fn ); 2344 2351 PtrRef r1( fn ); … … 2393 2400 crc_manager.get_filenumber(st); // make sure this file gets crc'ed 2394 2401 #endif 2395 void *compiled_form=NULL;2402 LObject *compiled_form = NULL; 2396 2403 PtrRef r11(compiled_form); 2397 2404 while (!end_of_program(cs)) // see if there is anything left to compile and run … … 2401 2408 #endif 2402 2409 void *m=mark_heap(TMP_SPACE); 2403 compiled_form= compile(cs);2404 eval(compiled_form);2410 compiled_form=LObject::Compile(cs); 2411 compiled_form->Eval(); 2405 2412 compiled_form=NULL; 2406 2413 restore_heap(m, TMP_SPACE); … … 2415 2422 } break; 2416 2423 case SYS_FUNC_ABS: 2417 ret = LNumber::Create(abs(lnumber_value( eval(CAR(arg_list))))); break;2424 ret = LNumber::Create(abs(lnumber_value(CAR(arg_list)->Eval()))); break; 2418 2425 case SYS_FUNC_MIN: 2419 2426 { 2420 int x=lnumber_value(eval(CAR(arg_list))), y=lnumber_value(eval(CAR(CDR(arg_list)))); 2427 int x=lnumber_value(CAR(arg_list)->Eval()), 2428 y=lnumber_value(CAR(CDR(arg_list))->Eval()); 2421 2429 ret = LNumber::Create(x < y ? x : y); 2422 2430 } break; 2423 2431 case SYS_FUNC_MAX: 2424 2432 { 2425 int x=lnumber_value(eval(CAR(arg_list))), y=lnumber_value(eval(CAR(CDR(arg_list)))); 2433 int x=lnumber_value(CAR(arg_list)->Eval()), 2434 y=lnumber_value(CAR(CDR(arg_list))->Eval()); 2426 2435 ret = LNumber::Create(x > y ? x : y); 2427 2436 } break; … … 2439 2448 case SYS_FUNC_NTH: 2440 2449 { 2441 long x=lnumber_value( eval(CAR(arg_list)));2442 ret=nth(x, eval(CAR(CDR(arg_list))));2450 long x=lnumber_value(CAR(arg_list)->Eval()); 2451 ret=nth(x, CAR(CDR(arg_list))->Eval()); 2443 2452 } break; 2444 2453 case SYS_FUNC_RESIZE_TMP: 2445 resize_tmp(lnumber_value( eval(CAR(arg_list)))); break;2454 resize_tmp(lnumber_value(CAR(arg_list)->Eval())); break; 2446 2455 case SYS_FUNC_RESIZE_PERM: 2447 resize_perm(lnumber_value( eval(CAR(arg_list)))); break;2456 resize_perm(lnumber_value(CAR(arg_list)->Eval())); break; 2448 2457 case SYS_FUNC_COS: 2449 ret = LFixedPoint::Create(lisp_cos(lnumber_value( eval(CAR(arg_list))))); break;2458 ret = LFixedPoint::Create(lisp_cos(lnumber_value(CAR(arg_list)->Eval()))); break; 2450 2459 case SYS_FUNC_SIN: 2451 ret = LFixedPoint::Create(lisp_sin(lnumber_value( eval(CAR(arg_list))))); break;2460 ret = LFixedPoint::Create(lisp_sin(lnumber_value(CAR(arg_list)->Eval()))); break; 2452 2461 case SYS_FUNC_ATAN2: 2453 2462 { 2454 long y=(lnumber_value( eval(CAR(arg_list)))); arg_list=CDR(arg_list);2455 long x=(lnumber_value( eval(CAR(arg_list))));2463 long y=(lnumber_value(CAR(arg_list)->Eval())); arg_list=CDR(arg_list); 2464 long x=(lnumber_value(CAR(arg_list)->Eval())); 2456 2465 ret = LNumber::Create(lisp_atan2(y, x)); 2457 2466 } break; … … 2463 2472 while (arg_list) 2464 2473 { 2465 void *sym =eval(CAR(arg_list));2474 void *sym = CAR(arg_list)->Eval(); 2466 2475 PtrRef r1(sym); 2467 2476 switch (item_type(sym)) … … 2471 2480 case L_CONS_CELL : 2472 2481 { 2473 void *s =eval(CAR(sym));2482 void *s = CAR(sym)->Eval(); 2474 2483 PtrRef r1(s); 2475 2484 #ifdef TYPE_CHECKING … … 2481 2490 } 2482 2491 #endif 2483 x=lnumber_value( eval(CAR(CDR(sym))));2492 x=lnumber_value(CAR(CDR(sym))->Eval()); 2484 2493 ((LSymbol *)sym)->value = LNumber::Create(x); 2485 2494 } break; … … 2502 2511 case SYS_FUNC_EVAL: 2503 2512 { 2504 ret =eval(eval(CAR(arg_list)));2513 ret = CAR(arg_list)->Eval()->Eval(); 2505 2514 } break; 2506 2515 case SYS_FUNC_BREAK: lbreak("User break"); break; 2507 2516 case SYS_FUNC_MOD: 2508 2517 { 2509 long x=lnumber_value( eval(CAR(arg_list))); arg_list=CDR(arg_list);2510 long y=lnumber_value( eval(CAR(arg_list)));2518 long x=lnumber_value(CAR(arg_list)->Eval()); arg_list=CDR(arg_list); 2519 long y=lnumber_value(CAR(arg_list)->Eval()); 2511 2520 if (y==0) { lbreak("mod : division by zero\n"); y=1; } 2512 2521 ret = LNumber::Create(x%y); … … 2514 2523 /* case SYS_FUNC_WRITE_PROFILE: 2515 2524 { 2516 char *fn=lstring_value( eval(CAR(arg_list)));2525 char *fn=lstring_value(CAR(arg_list)->Eval()); 2517 2526 FILE *fp=fopen(fn, "wb"); 2518 2527 if (!fp) … … 2538 2547 arg_list=CDR(arg_list); 2539 2548 2540 void *ilist =eval(CAR(arg_list)); arg_list=CDR(arg_list);2549 void *ilist = CAR(arg_list)->Eval(); arg_list=CDR(arg_list); 2541 2550 PtrRef r2(ilist); 2542 2551 … … 2552 2561 bind_var->SetValue((LObject *)CAR(ilist)); 2553 2562 for (block=arg_list; block; block=CDR(block)) 2554 ret =eval(CAR(block));2563 ret = CAR(block)->Eval(); 2555 2564 ilist=CDR(ilist); 2556 2565 } … … 2561 2570 { 2562 2571 bFILE *old_file=current_print_file; 2563 void *str1 =eval(CAR(arg_list));2572 void *str1 = CAR(arg_list)->Eval(); 2564 2573 PtrRef r1(str1); 2565 void *str2 =eval(CAR(CDR(arg_list)));2574 void *str2 = CAR(CDR(arg_list))->Eval(); 2566 2575 2567 2576 … … 2573 2582 while (arg_list) 2574 2583 { 2575 ret =eval(CAR(arg_list));2584 ret = CAR(arg_list)->Eval(); 2576 2585 arg_list=CDR(arg_list); 2577 2586 } … … 2583 2592 case SYS_FUNC_BIT_AND: 2584 2593 { 2585 long first=lnumber_value( eval(CAR(arg_list))); arg_list=CDR(arg_list);2594 long first=lnumber_value(CAR(arg_list)->Eval()); arg_list=CDR(arg_list); 2586 2595 while (arg_list) 2587 2596 { 2588 first&=lnumber_value( eval(CAR(arg_list)));2597 first&=lnumber_value(CAR(arg_list)->Eval()); 2589 2598 arg_list=CDR(arg_list); 2590 2599 } … … 2593 2602 case SYS_FUNC_BIT_OR: 2594 2603 { 2595 long first=lnumber_value( eval(CAR(arg_list))); arg_list=CDR(arg_list);2604 long first=lnumber_value(CAR(arg_list)->Eval()); arg_list=CDR(arg_list); 2596 2605 while (arg_list) 2597 2606 { 2598 first|=lnumber_value( eval(CAR(arg_list)));2607 first|=lnumber_value(CAR(arg_list)->Eval()); 2599 2608 arg_list=CDR(arg_list); 2600 2609 } … … 2603 2612 case SYS_FUNC_BIT_XOR: 2604 2613 { 2605 long first=lnumber_value( eval(CAR(arg_list))); arg_list=CDR(arg_list);2614 long first=lnumber_value(CAR(arg_list)->Eval()); arg_list=CDR(arg_list); 2606 2615 while (arg_list) 2607 2616 { 2608 first^=lnumber_value( eval(CAR(arg_list)));2617 first^=lnumber_value(CAR(arg_list)->Eval()); 2609 2618 arg_list=CDR(arg_list); 2610 2619 } … … 2613 2622 case SYS_FUNC_MAKE_ARRAY: 2614 2623 { 2615 long l=lnumber_value( eval(CAR(arg_list)));2624 long l=lnumber_value(CAR(arg_list)->Eval()); 2616 2625 if (l>=2<<16 || l<=0) 2617 2626 { … … 2623 2632 case SYS_FUNC_AREF: 2624 2633 { 2625 long x=lnumber_value( eval(CAR(CDR(arg_list))));2626 ret = ((LArray *) eval(CAR(arg_list)))->Get(x);2634 long x=lnumber_value(CAR(CDR(arg_list))->Eval()); 2635 ret = ((LArray *)CAR(arg_list)->Eval())->Get(x); 2627 2636 } break; 2628 2637 case SYS_FUNC_IF_1PROGN: 2629 2638 { 2630 if ( eval(CAR(arg_list)))2639 if (CAR(arg_list)->Eval()) 2631 2640 ret=eval_block(CAR(CDR(arg_list))); 2632 else ret =eval(CAR(CDR(CDR(arg_list))));2641 else ret = CAR(CDR(CDR(arg_list)))->Eval(); 2633 2642 2634 2643 } break; 2635 2644 case SYS_FUNC_IF_2PROGN: 2636 2645 { 2637 if ( eval(CAR(arg_list)))2638 ret =eval(CAR(CDR(arg_list)));2646 if (CAR(arg_list)->Eval()) 2647 ret = CAR(CDR(arg_list))->Eval(); 2639 2648 else ret=eval_block(CAR(CDR(CDR(arg_list)))); 2640 2649 … … 2642 2651 case SYS_FUNC_IF_12PROGN: 2643 2652 { 2644 if ( eval(CAR(arg_list)))2653 if (CAR(arg_list)->Eval()) 2645 2654 ret=eval_block(CAR(CDR(arg_list))); 2646 2655 else ret=eval_block(CAR(CDR(CDR(arg_list)))); … … 2649 2658 case SYS_FUNC_EQ0: 2650 2659 { 2651 void *v =eval(CAR(arg_list));2660 void *v = CAR(arg_list)->Eval(); 2652 2661 if (item_type(v)!=L_NUMBER || (((LNumber *)v)->num!=0)) 2653 2662 ret=NULL; … … 2657 2666 { 2658 2667 #ifdef L_PROFILE 2659 char *s=lstring_value( eval(CAR(arg_list)));2668 char *s=lstring_value(CAR(arg_list)->Eval()); 2660 2669 preport(s); 2661 2670 #endif … … 2663 2672 case SYS_FUNC_SEARCH: 2664 2673 { 2665 void *arg1 =eval(CAR(arg_list)); arg_list=CDR(arg_list);2674 void *arg1 = CAR(arg_list)->Eval(); arg_list=CDR(arg_list); 2666 2675 PtrRef r1(arg1); // protect this refrence 2667 char *haystack=lstring_value( eval(CAR(arg_list)));2676 char *haystack=lstring_value(CAR(arg_list)->Eval()); 2668 2677 char *needle=lstring_value(arg1); 2669 2678 … … 2675 2684 case SYS_FUNC_ELT: 2676 2685 { 2677 void *arg1 =eval(CAR(arg_list)); arg_list=CDR(arg_list);2686 void *arg1 = CAR(arg_list)->Eval(); arg_list=CDR(arg_list); 2678 2687 PtrRef r1(arg1); // protect this refrence 2679 long x=lnumber_value( eval(CAR(arg_list)));2688 long x=lnumber_value(CAR(arg_list)->Eval()); 2680 2689 char *st=lstring_value(arg1); 2681 2690 if (x < 0 || (unsigned)x >= strlen(st)) … … 2686 2695 case SYS_FUNC_LISTP: 2687 2696 { 2688 return item_type( eval(CAR(arg_list)))==L_CONS_CELL ? true_symbol : NULL;2697 return item_type(CAR(arg_list)->Eval())==L_CONS_CELL ? true_symbol : NULL; 2689 2698 } break; 2690 2699 case SYS_FUNC_NUMBERP: 2691 2700 { 2692 int t=item_type( eval(CAR(arg_list)));2701 int t=item_type(CAR(arg_list)->Eval()); 2693 2702 if (t==L_NUMBER || t==L_FIXED_POINT) return true_symbol; else return NULL; 2694 2703 } break; … … 2713 2722 // push all of the init forms, so we can set the symbol 2714 2723 for (init_var=CAR(arg_list); init_var; init_var=CDR(init_var)) 2715 l_user_stack.push( eval(CAR(CDR(CAR((init_var))))));2724 l_user_stack.push(CAR(CDR(CAR((init_var))))->Eval()); 2716 2725 2717 2726 // now set all the symbols … … 2725 2734 do 2726 2735 { 2727 i =(eval(CAR(CAR(CDR(arg_list))))!=NULL);2736 i = CAR(CAR(CDR(arg_list)))->Eval() != NULL; 2728 2737 if (!i) 2729 2738 { 2730 2739 eval_block(CDR(CDR(arg_list))); 2731 2740 for (init_var=CAR(arg_list); init_var; init_var=CDR(init_var)) 2732 eval(CAR(CDR(CDR(CAR(init_var)))));2741 CAR(CDR(CDR(CAR(init_var))))->Eval(); 2733 2742 } 2734 2743 } while (!i); 2735 2744 2736 ret =eval(CAR(CDR(CAR(CDR(arg_list)))));2745 ret = CAR(CDR(CAR(CDR(arg_list))))->Eval(); 2737 2746 2738 2747 // restore old values for symbols … … 2753 2762 case SYS_FUNC_SCHAR: 2754 2763 { 2755 char *s=lstring_value(eval(CAR(arg_list))); arg_list=CDR(arg_list); 2756 long x=lnumber_value(eval(CAR(arg_list))); 2764 char *s=lstring_value(CAR(arg_list)->Eval()); 2765 arg_list=CDR(arg_list); 2766 long x=lnumber_value(CAR(arg_list)->Eval()); 2757 2767 2758 2768 if ((unsigned)x >= strlen(s)) … … 2763 2773 } break; 2764 2774 case SYS_FUNC_SYMBOLP: 2765 { if (item_type( eval(CAR(arg_list)))==L_SYMBOL) return true_symbol;2775 { if (item_type(CAR(arg_list)->Eval())==L_SYMBOL) return true_symbol; 2766 2776 else return NULL; } break; 2767 2777 case SYS_FUNC_NUM2STR: 2768 2778 { 2769 2779 char str[20]; 2770 sprintf(str, "%ld", (long int)lnumber_value( eval(CAR(arg_list))));2780 sprintf(str, "%ld", (long int)lnumber_value(CAR(arg_list)->Eval())); 2771 2781 ret=LString::Create(str); 2772 2782 } break; 2773 2783 case SYS_FUNC_NCONC: 2774 2784 { 2775 void *l1= eval(CAR(arg_list)); arg_list=CDR(arg_list);2785 void *l1=CAR(arg_list)->Eval(); arg_list=CDR(arg_list); 2776 2786 PtrRef r1(l1); 2777 2787 void *first=l1, *next; … … 2780 2790 if (!l1) 2781 2791 { 2782 l1=first= eval(CAR(arg_list));2792 l1=first=CAR(arg_list)->Eval(); 2783 2793 arg_list=CDR(arg_list); 2784 2794 } … … 2790 2800 next=l1; 2791 2801 while (next) { l1=next; next=lcdr(next); } 2792 ((LList *)l1)->cdr = (LObject *)eval(CAR(arg_list));2802 ((LList *)l1)->cdr = CAR(arg_list)->Eval(); 2793 2803 arg_list=CDR(arg_list); 2794 2804 } while (arg_list); … … 2796 2806 } break; 2797 2807 case SYS_FUNC_FIRST: 2798 { ret=CAR( eval(CAR(arg_list))); } break;2808 { ret=CAR(CAR(arg_list)->Eval()); } break; 2799 2809 case SYS_FUNC_SECOND: 2800 { ret=CAR(CDR( eval(CAR(arg_list)))); } break;2810 { ret=CAR(CDR(CAR(arg_list)->Eval())); } break; 2801 2811 case SYS_FUNC_THIRD: 2802 { ret=CAR(CDR(CDR( eval(CAR(arg_list))))); } break;2812 { ret=CAR(CDR(CDR(CAR(arg_list)->Eval()))); } break; 2803 2813 case SYS_FUNC_FOURTH: 2804 { ret=CAR(CDR(CDR(CDR( eval(CAR(arg_list)))))); } break;2814 { ret=CAR(CDR(CDR(CDR(CAR(arg_list)->Eval())))); } break; 2805 2815 case SYS_FUNC_FIFTH: 2806 { ret=CAR(CDR(CDR(CDR(CDR( eval(CAR(arg_list))))))); } break;2816 { ret=CAR(CDR(CDR(CDR(CDR(CAR(arg_list)->Eval()))))); } break; 2807 2817 case SYS_FUNC_SIXTH: 2808 { ret=CAR(CDR(CDR(CDR(CDR(CDR( eval(CAR(arg_list)))))))); } break;2818 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CAR(arg_list)->Eval())))))); } break; 2809 2819 case SYS_FUNC_SEVENTH: 2810 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR( eval(CAR(arg_list))))))))); } break;2820 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(arg_list)->Eval()))))))); } break; 2811 2821 case SYS_FUNC_EIGHTH: 2812 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR( eval(CAR(arg_list)))))))))); } break;2822 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(arg_list)->Eval())))))))); } break; 2813 2823 case SYS_FUNC_NINTH: 2814 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR( eval(CAR(arg_list))))))))))); } break;2824 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(arg_list)->Eval()))))))))); } break; 2815 2825 case SYS_FUNC_TENTH: 2816 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR( eval(CAR(arg_list)))))))))))); } break;2826 { ret=CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CAR(arg_list)->Eval())))))))))); } break; 2817 2827 case SYS_FUNC_SUBSTR: 2818 2828 { 2819 long x1=lnumber_value( eval(CAR(arg_list))); arg_list=CDR(arg_list);2820 long x2=lnumber_value( eval(CAR(arg_list))); arg_list=CDR(arg_list);2821 void *st= eval(CAR(arg_list));2829 long x1=lnumber_value(CAR(arg_list)->Eval()); arg_list=CDR(arg_list); 2830 long x2=lnumber_value(CAR(arg_list)->Eval()); arg_list=CDR(arg_list); 2831 void *st=CAR(arg_list)->Eval(); 2822 2832 PtrRef r1(st); 2823 2833 … … 2838 2848 while (arg_list) 2839 2849 { 2840 void *q =eval(CAR(arg_list));2850 void *q = CAR(arg_list)->Eval(); 2841 2851 if (!rstart) rstart=q; 2842 2852 while (r && CDR(r)) r=CDR(r); … … 2933 2943 if (!arg_list) 2934 2944 { ((LObject *)sym)->Print(); lbreak("too few parameter to function\n"); exit(0); } 2935 l_user_stack.push( eval(CAR(arg_list)));2945 l_user_stack.push(CAR(arg_list)->Eval()); 2936 2946 f_arg=CDR(f_arg); 2937 2947 arg_list=CDR(arg_list); … … 2955 2965 while (block_list) 2956 2966 { 2957 ret= eval(CAR(block_list));2967 ret=CAR(block_list)->Eval(); 2958 2968 block_list=CDR(block_list); 2959 2969 } … … 2974 2984 } 2975 2985 2976 2977 2978 2979 2980 void *eval(void *prog) 2981 { 2982 2983 2984 void *ret=NULL; 2985 PtrRef ref1(prog); 2986 2987 2988 int tstart=trace_level; 2989 2990 if (trace_level) 2991 { 2992 if (trace_level<=trace_print_level) 2993 { 2994 dprintf("%d (%d, %d, %d) TRACE : ", trace_level, 2995 space_size[PERM_SPACE]-((char *)free_space[PERM_SPACE]-(char *)space[PERM_SPACE]), 2996 space_size[TMP_SPACE]-((char *)free_space[TMP_SPACE]-(char *)space[TMP_SPACE]), 2997 PtrRef::stack.son); 2998 ((LObject *)prog)->Print(); 2999 3000 dprintf("\n"); 3001 } 3002 trace_level++; 3003 } 3004 if (prog) 3005 { 3006 switch (item_type(prog)) 3007 { 3008 case L_BAD_CELL : 3009 { lbreak("error : eval on a bad cell\n"); exit(0); } break; 3010 case L_CHARACTER : 3011 case L_STRING : 3012 case L_NUMBER : 3013 case L_POINTER : 3014 case L_FIXED_POINT : 3015 { ret=prog; } break; 3016 case L_SYMBOL : 3017 { if (prog==true_symbol) 3018 ret=prog; 3019 else 3020 { 3021 ret = ((LSymbol *)prog)->GetValue(); 3022 if (item_type(ret)==L_OBJECT_VAR) 3023 ret=l_obj_get(((LObjectVar *)ret)->index); 3024 } 3025 } break; 3026 case L_CONS_CELL : 3027 { 3028 ret=eval_function((LSymbol *)CAR(prog), CDR(prog)); 3029 } 3030 break; 3031 default : 3032 fprintf(stderr, "shouldn't happen\n"); 3033 } 3034 } 3035 if (tstart) 3036 { 3037 trace_level--; 3038 if (trace_level<=trace_print_level) 3039 dprintf("%d (%d, %d, %d) TRACE ==> ", trace_level, 3040 space_size[PERM_SPACE]-((char *)free_space[PERM_SPACE]-(char *)space[PERM_SPACE]), 3041 space_size[TMP_SPACE]-((char *)free_space[TMP_SPACE]-(char *)space[TMP_SPACE]), 3042 PtrRef::stack.son); 3043 ((LObject *)ret)->Print(); 3044 dprintf("\n"); 3045 } 2986 LObject *LObject::Eval() 2987 { 2988 LObject *ret = NULL; 2989 PtrRef ref1(this); 2990 2991 int tstart = trace_level; 2992 2993 if (trace_level) 2994 { 2995 if (trace_level <= trace_print_level) 2996 { 2997 dprintf("%d (%d, %d, %d) TRACE : ", trace_level, 2998 get_free_size(PERM_SPACE), get_free_size(TMP_SPACE), 2999 PtrRef::stack.son); 3000 Print(); 3001 dprintf("\n"); 3002 } 3003 trace_level++; 3004 } 3005 3006 if (this) 3007 { 3008 switch (item_type(this)) 3009 { 3010 case L_BAD_CELL: 3011 lbreak("error: eval on a bad cell\n"); 3012 exit(0); 3013 break; 3014 case L_CHARACTER: 3015 case L_STRING: 3016 case L_NUMBER: 3017 case L_POINTER: 3018 case L_FIXED_POINT: 3019 ret = this; 3020 break; 3021 case L_SYMBOL: 3022 if (this == true_symbol) 3023 ret = this; 3024 else 3025 { 3026 ret = ((LSymbol *)this)->GetValue(); 3027 if (item_type(ret) == L_OBJECT_VAR) 3028 ret = (LObject *)l_obj_get(((LObjectVar *)ret)->index); 3029 } 3030 break; 3031 case L_CONS_CELL: 3032 ret = (LObject *)eval_function((LSymbol *)CAR(this), CDR(this)); 3033 break; 3034 default : 3035 fprintf(stderr, "shouldn't happen\n"); 3036 break; 3037 } 3038 } 3039 3040 if (tstart) 3041 { 3042 trace_level--; 3043 if (trace_level <= trace_print_level) 3044 dprintf("%d (%d, %d, %d) TRACE ==> ", trace_level, 3045 get_free_size(PERM_SPACE), get_free_size(TMP_SPACE), 3046 PtrRef::stack.son); 3047 ret->Print(); 3048 dprintf("\n"); 3049 } 3046 3050 3047 3051 /* l_user_stack.push(ret); … … 3049 3053 ret=l_user_stack.pop(1); */ 3050 3054 3051 3052 return ret; 3055 return ret; 3053 3056 } 3054 3057 … … 3116 3119 free(space[0]); 3117 3120 free(space[1]); 3118 ldelete_syms(LSymbol::root);3121 DeleteAllSymbols(LSymbol::root); 3119 3122 LSymbol::root = NULL; 3120 3123 LSymbol::count = 0; … … 3123 3126 void clear_tmp() 3124 3127 { 3125 free_space[TMP_SPACE]=space[TMP_SPACE];3128 free_space[TMP_SPACE] = space[TMP_SPACE]; 3126 3129 } 3127 3130 -
abuse/trunk/src/lisp/lisp.h
r494 r496 48 48 struct LObject 49 49 { 50 /* Factories */ 51 static LObject *Compile(char const *&s); 52 53 /* Methods */ 54 LObject *Eval(); 50 55 void Print(); 51 56 57 /* Members */ 52 58 ltype type; 53 59 }; … … 55 61 struct LObjectVar : LObject 56 62 { 63 /* Factories */ 57 64 static LObjectVar *Create(int index); 58 65 66 /* Members */ 59 67 int index; 60 68 }; … … 62 70 struct LList : LObject 63 71 { 72 /* Factories */ 64 73 static LList *Create(); 65 74 75 /* Methods */ 66 76 size_t GetLength(); 67 77 78 /* Members */ 68 79 LObject *cdr, *car; 69 80 }; … … 71 82 struct LNumber : LObject 72 83 { 84 /* Factories */ 73 85 static LNumber *Create(long num); 74 86 87 /* Members */ 75 88 long num; 76 89 }; … … 78 91 struct LRedirect : LObject 79 92 { 93 /* Members */ 80 94 LObject *ref; 81 95 }; … … 83 97 struct LString : LObject 84 98 { 99 /* Factories */ 85 100 static LString *Create(char const *string); 86 101 static LString *Create(char const *string, int length); 87 102 static LString *Create(int length); 88 103 104 /* Methods */ 89 105 char *GetString(); 90 106 107 /* Members */ 91 108 private: 92 109 char str[1]; /* Can be allocated much larger than 1 */ … … 155 172 struct LChar : LObject 156 173 { 174 /* Factories */ 157 175 static LChar *Create(uint16_t ch); 158 176 177 /* Members */ 159 178 uint16_t ch; 160 179 }; … … 162 181 struct LPointer : LObject 163 182 { 183 /* Factories */ 164 184 static LPointer *Create(void *addr); 165 185 186 /* Members */ 166 187 void *addr; 167 188 }; … … 169 190 struct LFixedPoint : LObject 170 191 { 192 /* Factories */ 171 193 static LFixedPoint *Create(int32_t x); 172 194 195 /* Members */ 173 196 int32_t x; 174 197 }; … … 186 209 long lfixed_point_value(void *c); 187 210 void *lisp_atom(void *i); 188 void*lcdr(void *c);189 void*lcar(void *c);211 LObject *lcdr(void *c); 212 LObject *lcar(void *c); 190 213 void *lisp_eq(void *n1, void *n2); 191 214 void *lisp_equal(void *n1, void *n2); 192 void *eval(void *prog);193 215 void *eval_block(void *list); 194 216 void *eval_function(LSymbol *sym, void *arg_list); 195 217 void *eval_user_fun(LSymbol *sym, void *arg_list); 196 void *compile(char const *&s);197 218 void *assoc(void *item, void *list); 198 219 void resize_tmp(int new_size); -
abuse/trunk/src/lisp/lisp_gc.h
r494 r496 31 31 } 32 32 33 template<typename T> inline PtrRef(T * const &ref) 34 { 35 stack.push((void **)&ref); 36 } 37 33 38 inline ~PtrRef() 34 39 { -
abuse/trunk/src/loader2.cpp
r494 r496 344 344 345 345 cs=prog; 346 if (! eval(compile(cs)))346 if (!LObject::Compile(cs)->Eval()) 347 347 { 348 348 printf("unable to open file '%s'\n",lsf); -
abuse/trunk/src/menu.cpp
r494 r496 385 385 // char *prog="((\"art/help.spe\" . \"sell2\")(\"art/help.spe\" . \"sell4\")(\"art/help.spe\" . \"sell3\")(\"art/endgame.spe\" . \"credit\"))"; 386 386 // char *prog="((\"art/endgame.spe\" . \"credit\") (\"art/help.spe\" . \"sell6\"))"; 387 char const *prog ="((\"art/endgame.spe\" . \"credit\"))";388 ss->SetValue( (LObject *)compile(prog));387 char const *prog = "((\"art/endgame.spe\" . \"credit\"))"; 388 ss->SetValue(LObject::Compile(prog)); 389 389 current_space=sp; 390 390 }
Note: See TracChangeset
for help on using the changeset viewer.