├── .gitignore ├── README.md ├── forth.c ├── forth.h ├── lib.fs ├── makefile └── test.fs /.gitignore: -------------------------------------------------------------------------------- 1 | ### C ### 2 | # Object files 3 | *.o 4 | *.ko 5 | *.obj 6 | *.elf 7 | 8 | # Precompiled Headers 9 | *.gch 10 | *.pch 11 | 12 | # Libraries 13 | *.lib 14 | *.a 15 | *.la 16 | *.lo 17 | 18 | # Shared objects (inc. Windows DLLs) 19 | *.dll 20 | *.so 21 | *.so.* 22 | *.dylib 23 | 24 | # Executables 25 | *.exe 26 | *.exe.stackdump 27 | *.out 28 | *.app 29 | *.i*86 30 | *.x86_64 31 | *.hex 32 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | cnforth -- C语言实现的Forth语言解释器 2 | ==================== 3 | 4 | ###### Author:Chai Fei 5 | ###### E-mail:cforth@cfxyz.com 6 | -------------------- 7 | 8 | ## 简介 9 | 10 | [cnforth](https://github.com/cforth/cnforth)项目是一个用C语言实现的简单的Forth语言解释器，不是一个传统的Forth系统。受到[耳朵](https://github.com/earforth)的[ear_cforth](https://github.com/earforth/ear-cforth)的启发，以及他的指点。再次感谢[耳朵](https://github.com/earforth)和[CNFIG社区](https://github.com/CNFIG)！！！ 11 | 12 | ## 特性支持 13 | 14 | 1. 核心词; 15 | 16 | 2. 定义和使用扩展词; 17 | 18 | 3. `if else then` 控制语句（支持嵌套）; 19 | 20 | 4. `do loop` 循环语句（支持嵌套）; 21 | 22 | 5. 变量和常量（`variable` `constant`）; 23 | 24 | 6. 状态变量`state`，状态切换词`[`和`]` ; 25 | 26 | 7. 反编译扩展词`see` ; 27 | 28 | 8. 递归定义扩展词（`myself`）; 29 | 30 | 9. 从外部读取forth代码（`load lib.fs`或者命令行`./forth lib.fs`）; 31 | 32 | 10. 其他特性参见[Wiki](https://github.com/cforth/cnforth/wiki/cnforth%E6%94%AF%E6%8C%81%E7%9A%84%E7%89%B9%E6%80%A7)。 33 | 34 | ## 环境 35 | 36 | 1. Windows(32位/64位) + Cygwin + gcc 4.9.3 37 | 38 | 2. Linux(32位) + gcc 4.9.2 39 | 40 | ## 安装 41 | 42 | ```bash 43 | make forth 44 | ``` 45 | 46 | ## 使用 47 | 48 | 求8的阶乘，使用递归实现： 49 | 50 | ```bash 51 | ./forth lib.fs 52 | 53 | >>> : factorial ( Num -- FactorialResult ) dup 1 = if drop 1 else dup 1- myself * then ; 54 | >>> 8 factorial . 55 | 40320 56 | ``` 57 | -------------------------------------------------------------------------------- /forth.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include "forth.h" 6 | 7 | int check_blank(char c) 8 | { 9 | return (c==' ' || c=='\t' || c=='\n'); 10 | } 11 | 12 | 13 | char *parse_word() 14 | { 15 | char *now; 16 | while (check_blank(*text_p)) //跳过字符串头部的空白字符后返回指针 17 | text_p++; 18 | 19 | now = text_p; 20 | 21 | while ( !check_blank(*text_p) && (*text_p)!='\0') //跳过字符串中第一个词 22 | text_p++; 23 | 24 | if(*text_p == '\0') 25 | return now; 26 | *text_p = '\0'; //将字符串中第一个词后的空格变为'\0' 27 | text_p++; 28 | 29 | return now; 30 | } 31 | 32 | 33 | Word *create(char *name, fn_p fp) 34 | { 35 | Word *w=(Word*)malloc(sizeof(Word)); 36 | w->code_p=fp; 37 | 38 | w->name=(char*)malloc(strlen(name) + 1); 39 | strcpy(w->name,name); 40 | 41 | w->wplist=NULL; 42 | 43 | w->flag = HIDE_WORD; 44 | 45 | return w; 46 | } 47 | 48 | 49 | void does(Word *w, Word **list, int n) 50 | { 51 | if(n != 0) { 52 | w->wplist = (Word**)malloc(n); 53 | memcpy(w->wplist,list, n); 54 | } else { 55 | w->wplist = list; 56 | } 57 | w->flag = REVEAL_WORD; 58 | } 59 | 60 | 61 | Word *def_core(char *name, fn_p fp) 62 | { 63 | Word *w=create(name, fp); 64 | w->flag = REVEAL_WORD; 65 | 66 | return w; 67 | } 68 | 69 | 70 | void colon_code() 71 | { 72 | RP++; 73 | *RP=(CELL)IP; 74 | IP=(*IP)->wplist-1; 75 | PRINT("[DEBUG]进入子例程\n") 76 | } 77 | 78 | 79 | void cons_code() 80 | { 81 | ds_push((CELL)((*IP)->wplist)); 82 | } 83 | 84 | 85 | void var_code() 86 | { 87 | ds_push((CELL)*IP); 88 | } 89 | 90 | 91 | Dict *dict_init() 92 | { 93 | Dict *dict=(Dict*)malloc(sizeof(Dict)); 94 | dict->size = 0; 95 | dict->head = NULL; 96 | return dict; 97 | } 98 | 99 | 100 | int dict_ins_next(Dict *dict, Word *word) 101 | { 102 | word->link = dict->head; 103 | dict->head = word; 104 | dict->size++; 105 | return 0; 106 | } 107 | 108 | 109 | Word *dict_search_name(Dict *dict, char *name) 110 | { 111 | Word *w = dict->head; 112 | //为了支持递归忽略隐藏词 113 | while ((w != NULL && strcmp(w->name,name)) 114 | || (w != NULL && !strcmp(w->name,name) && w->flag == HIDE_WORD)) 115 | { 116 | w=w->link; 117 | } 118 | 119 | return w; 120 | } 121 | 122 | 123 | void dict_destroy_word(Word *word) 124 | { 125 | free(word->name); 126 | if(word->code_p == colon_code) free(word->wplist); 127 | free(word); 128 | } 129 | 130 | 131 | int dict_rem_after(Dict *dict, char *name) 132 | { 133 | Word *w = dict_search_name(dict, name); 134 | Word *del_w; 135 | 136 | if(w == NULL) 137 | { 138 | printf("%s :\n\tCan't find!\n", name); 139 | } 140 | else 141 | { 142 | if(w->wplist == NULL) 143 | { 144 | printf("\tCore Word can't be deleted\n"); 145 | return 0; 146 | } 147 | do 148 | { 149 | del_w = dict->head; 150 | dict->head = dict->head->link; 151 | dict_destroy_word(del_w); 152 | dict->size--; 153 | } while(del_w != w); 154 | 155 | return 1; 156 | } 157 | 158 | return 0; 159 | } 160 | 161 | 162 | void explain() 163 | { 164 | Word **IP_end = IP; 165 | IP=IP_head; 166 | 167 | while(IP != IP_end) 168 | { 169 | PRINT("[DEBUG]解释执行> %s\n", (*IP)->name) 170 | 171 | (*IP)->code_p(); 172 | ++IP; 173 | } 174 | IP_head = IP; 175 | } 176 | 177 | 178 | int is_num(char *s) 179 | { 180 | if(*s == '-') 181 | s++; 182 | 183 | while (*s != 0) 184 | { 185 | if (!isdigit((CELL)*s)) 186 | return 0; 187 | s++; 188 | } 189 | return 1; 190 | } 191 | 192 | 193 | int find(Dict *dict, char *name) 194 | { 195 | Word *word_p; 196 | word_p = dict_search_name(dict, name); 197 | 198 | if(!strcmp(":", name) || !strcmp("]", name)) state = COMPILE; 199 | 200 | if(state == COMPILE) 201 | { 202 | if(word_p==NULL) //词典链表搜索不到名字后，去判断是不是数字 203 | { 204 | if (!is_num(name)) 205 | { 206 | return 0; //如果不是数字，返回0 207 | } 208 | else 209 | { //如果是数字 210 | PRINT("[DEBUG]成功找到数字%s\n",name) 211 | ip_push(dict_search_name(dict, "(lit)"), IP_head); //将push核心词指针存入IP数组 212 | ip_push((Word*)(CELL)(atoi(name)), IP_head); //将CELL型数强制转换为Word指针类型 213 | 214 | return 1; 215 | } 216 | } 217 | else if(word_p->flag == IMMD_WORD) //立即词 218 | { 219 | PRINT("[DEBUG]执行立即词 %s\n", name) 220 | if(word_p->wplist != NULL) 221 | { 222 | in_interpret(); 223 | ip_push(word_p, IP_head); 224 | explain(); 225 | out_interpret(); 226 | } 227 | else 228 | { 229 | word_p->code_p(); 230 | } 231 | } 232 | else 233 | { 234 | PRINT("[DEBUG]成功编译%s词\n",name) 235 | ip_push(word_p, IP_head); 236 | } 237 | } 238 | else if(state == EXPLAIN) 239 | { 240 | if(word_p==NULL) //词典链表搜索不到名字后，去判断是不是数字 241 | { 242 | if (!is_num(name)) 243 | { 244 | return 0; //如果不是数字，返回0 245 | } 246 | else 247 | { //如果是数字 248 | PRINT("[DEBUG]数据栈压入 %s\n",name) 249 | ds_push((CELL)(atoi(name))); 250 | 251 | return 1; 252 | } 253 | } 254 | else 255 | { 256 | PRINT("[DEBUG]成功找到%s词\n",name) 257 | ip_push(word_p, IP_head); 258 | explain(); 259 | } 260 | } 261 | 262 | return 1; 263 | } 264 | 265 | 266 | void empty_stack() 267 | { 268 | DP=DS-1; 269 | RP=RS-1; 270 | } 271 | 272 | 273 | void stack_error(int n) 274 | { 275 | switch(n) 276 | { 277 | case 1: printf("Stack underflow\n"); break; 278 | case 2: printf("Stack overflow\n"); break; 279 | } 280 | exit(0); 281 | } 282 | 283 | 284 | void ip_push(Word *w, Word** list) 285 | { 286 | if(IP >= list+BUFF_LEN){stack_error(2);} 287 | *IP=w; 288 | IP++; 289 | } 290 | 291 | 292 | void ds_push(CELL n) 293 | { 294 | if(DP >= DS+STACK_LEN-1){stack_error(2);} 295 | DP++; 296 | *DP=n; 297 | } 298 | 299 | 300 | void rs_push(CELL n) 301 | { 302 | if(RP >= RS+STACK_LEN-1){stack_error(2);} 303 | RP++; 304 | *RP=n; 305 | } 306 | 307 | 308 | CELL ds_pop() 309 | { 310 | if(DP <= DS-1){stack_error(1);} 311 | DP--; 312 | return *(DP+1); 313 | } 314 | 315 | 316 | CELL rs_pop() 317 | { 318 | if(RP <= RS-1){stack_error(1);} 319 | RP--; 320 | return *(RP+1); 321 | } 322 | 323 | 324 | CELL ds_top() 325 | { 326 | if(DP <= DS-1){stack_error(1);} 327 | return *DP; 328 | } 329 | 330 | 331 | CELL rs_top() 332 | { 333 | if(RP <= RS-1){stack_error(1);} 334 | return *RP; 335 | } 336 | 337 | 338 | void lit() 339 | { 340 | IP++; 341 | ds_push((CELL)*IP); 342 | PRINT("[DEBUG]数%ld压入数据栈\n", (CELL)*IP) 343 | } 344 | 345 | 346 | void popds() 347 | { 348 | printf("%ld\n", ds_pop()); 349 | } 350 | 351 | 352 | void bye() 353 | { 354 | exit(1); 355 | } 356 | 357 | 358 | void ret() 359 | { 360 | IP=(Word**)(rs_pop()); 361 | PRINT("[DEBUG]从子例程返回\n") 362 | } 363 | 364 | 365 | void depth() 366 | { 367 | ds_push((CELL)(DP-DS+1)); 368 | } 369 | 370 | 371 | void add() 372 | { 373 | ds_push(ds_pop() + ds_pop()); 374 | } 375 | 376 | 377 | void sub() 378 | { 379 | CELL d = ds_pop(); 380 | ds_push(ds_pop() - d); 381 | } 382 | 383 | 384 | void mul() 385 | { 386 | ds_push(ds_pop() * ds_pop()); 387 | } 388 | 389 | 390 | void divv() 391 | { 392 | CELL d = ds_pop(); 393 | ds_push(ds_pop() / d); 394 | } 395 | 396 | 397 | void drop() 398 | { 399 | ds_pop(); 400 | } 401 | 402 | 403 | void showds() 404 | { 405 | printf("<%ld> ", (CELL)(DP-DS+1)); 406 | CELL *i=DS; 407 | for (;i<=DP ;i++ ) 408 | { 409 | printf("%ld ",*i); 410 | } 411 | printf("\n"); 412 | } 413 | 414 | 415 | void pick() 416 | { 417 | CELL k = ds_pop(); 418 | if(DP-k+1 <= DS-1){stack_error(1);} 419 | ds_push(*(DP-k+1)); 420 | } 421 | 422 | 423 | void roll() 424 | { 425 | CELL k = ds_pop(); 426 | if(DP-k+1 <= DS-1){stack_error(1);} 427 | CELL dk = *(DP-k+1); 428 | for(; k>1; k--) { 429 | *(DP-k+1) = *(DP-k+2); 430 | } 431 | ds_pop(); 432 | ds_push(dk); 433 | } 434 | 435 | 436 | void invar() 437 | { 438 | Word *p = (Word *)(ds_pop()); 439 | p->wplist = (Word **)ds_pop(); 440 | } 441 | 442 | 443 | void outvar() 444 | { 445 | Word *p = (Word *)(ds_pop()); 446 | ds_push((CELL)(p->wplist)); 447 | } 448 | 449 | 450 | void equal() 451 | { 452 | if(ds_pop() == ds_pop()) 453 | { 454 | ds_push(-1); 455 | } 456 | else 457 | { 458 | ds_push(0); 459 | } 460 | } 461 | 462 | 463 | void noequal() 464 | { 465 | if(ds_pop() != ds_pop()) 466 | { 467 | ds_push(-1); 468 | } 469 | else 470 | { 471 | ds_push(0); 472 | } 473 | } 474 | 475 | 476 | void morethan() 477 | { 478 | CELL d = ds_pop(); 479 | if(ds_pop() > d) 480 | { 481 | ds_push(-1); 482 | } 483 | else 484 | { 485 | ds_push(0); 486 | } 487 | } 488 | 489 | 490 | void lessthan() 491 | { 492 | CELL d = ds_pop(); 493 | if(ds_pop() < d) 494 | { 495 | ds_push(-1); 496 | } 497 | else 498 | { 499 | ds_push(0); 500 | } 501 | } 502 | 503 | 504 | void if_branch() 505 | { 506 | if(ds_pop() == 0) 507 | { 508 | IP = IP + (CELL)(*(IP+1)); 509 | } 510 | else 511 | { 512 | IP++; 513 | } 514 | } 515 | 516 | 517 | void branch() 518 | { 519 | IP = IP + (CELL)(*(IP+1)); 520 | } 521 | 522 | 523 | void doo() 524 | { 525 | CELL index = ds_pop(); 526 | CELL limit = ds_pop(); 527 | if(limit <= index) 528 | { 529 | IP = IP + (CELL)(*(IP+1)); 530 | } 531 | else 532 | { 533 | IP++; 534 | index++; 535 | rs_push(index); 536 | rs_push(limit); 537 | } 538 | } 539 | 540 | 541 | void loopp() 542 | { 543 | IP = IP - (CELL)(*(IP+1)); 544 | ds_push(rs_pop()); 545 | ds_push(rs_pop()); 546 | } 547 | 548 | 549 | void tor() 550 | { 551 | rs_push(ds_pop()); 552 | } 553 | 554 | 555 | void rto() 556 | { 557 | ds_push(rs_pop()); 558 | } 559 | 560 | 561 | void rat() 562 | { 563 | ds_push(rs_top()); 564 | } 565 | 566 | 567 | void emit() 568 | { 569 | putchar((char)(ds_pop())); 570 | } 571 | 572 | 573 | void words() 574 | { 575 | Word *w = forth_dict->head; 576 | while (w != NULL) 577 | { 578 | printf("%s ", w->name); 579 | w=w->link; 580 | } 581 | printf("\n"); 582 | } 583 | 584 | 585 | void immediate() 586 | { 587 | forth_dict->head->flag = IMMD_WORD; 588 | } 589 | 590 | 591 | void pushds_cfa() 592 | { 593 | current_text = parse_word(); 594 | ds_push((CELL)dict_search_name(forth_dict, current_text)); 595 | } 596 | 597 | 598 | void compile_wplist() 599 | { 600 | IP++; 601 | Word **tmp = IP; 602 | Word *word_p = *IP; 603 | Word **IP_over = (Word **)rs_pop(); 604 | IP = (Word **)rs_pop(); 605 | if(word_p->wplist != NULL) 606 | { 607 | Word **p = word_p->wplist; 608 | Word *end = dict_search_name(forth_dict, "ret"); 609 | for (; *p != end; p++) 610 | { 611 | ip_push(*p, forth_dict->wplist_tmp); 612 | } 613 | } 614 | else 615 | { 616 | PRINT("[DEBUG]编译核心词 %s\n", word_p->name) 617 | ip_push((Word *)word_p, forth_dict->wplist_tmp); 618 | } 619 | rs_push((CELL)IP); 620 | rs_push((CELL)IP_over); 621 | IP = tmp; 622 | } 623 | 624 | 625 | void compile_s() 626 | { 627 | Word **tmp = IP; 628 | Word **IP_over = (Word **)rs_pop(); 629 | IP = (Word **)rs_pop(); 630 | CELL num = ds_pop(); 631 | PRINT("[DEBUG]编译栈顶数 %ld\n", num) 632 | ip_push((Word *)num, forth_dict->wplist_tmp); 633 | rs_push((CELL)IP); 634 | rs_push((CELL)IP_over); 635 | IP = tmp; 636 | } 637 | 638 | 639 | void in_interpret() 640 | { 641 | state = EXPLAIN; 642 | IP_head = IP_list; 643 | rs_push((CELL)IP); 644 | IP=IP_head; 645 | } 646 | 647 | 648 | void out_interpret() 649 | { 650 | IP_head = forth_dict->wplist_tmp; 651 | IP = (Word **)rs_pop(); 652 | state = COMPILE; 653 | } 654 | 655 | 656 | void myself() 657 | { 658 | ip_push(forth_dict->head, IP_head); 659 | } 660 | 661 | 662 | void defcolon() 663 | { 664 | IP_head = forth_dict->wplist_tmp; 665 | IP=IP_head; 666 | current_text = parse_word(); 667 | dict_ins_next(forth_dict, create(current_text, colon_code)); 668 | } 669 | 670 | 671 | void endcolon() 672 | { 673 | ip_push(dict_search_name(forth_dict, "ret"), IP_head); 674 | int n = (CELL)IP - (CELL)IP_head; 675 | does(forth_dict->head, IP_head, n); 676 | 677 | //DEBUG模式下打印出IP指针列表 678 | if(DEBUG) { 679 | printf("[DEBUG]IP指针列表> "); 680 | Word **p=IP_head; 681 | for (;pcode_p == colon_code) 752 | { 753 | Word **p = word_p->wplist; 754 | Word *end = dict_search_name(forth_dict, "ret"); 755 | Word *dict_p = forth_dict->head; 756 | for(; *p != end; p++) 757 | { 758 | while (dict_p != NULL && dict_p != *p) 759 | { 760 | dict_p=dict_p->link; 761 | } 762 | 763 | if(dict_p != NULL) 764 | printf("%s ", (*p)->name); 765 | else 766 | printf("%ld ", (CELL)(*p)); 767 | dict_p = forth_dict->head; 768 | } 769 | printf(";"); 770 | if(word_p->flag == IMMD_WORD) 771 | printf(" immediate\n"); 772 | else 773 | printf("\n"); 774 | } 775 | else 776 | { 777 | printf("%s\n", word_p->name); 778 | } 779 | } 780 | } 781 | 782 | 783 | void forget() 784 | { 785 | current_text = parse_word(); 786 | dict_rem_after(forth_dict, current_text); //删除当前扩展词以及词典中该词之后定义的所有扩展词 787 | } 788 | 789 | 790 | void var() 791 | { 792 | current_text = parse_word(); 793 | dict_ins_next(forth_dict, create(current_text, var_code)); 794 | does(forth_dict->head, (Word **)0, 0); 795 | } 796 | 797 | 798 | void cons() 799 | { 800 | current_text = parse_word(); 801 | dict_ins_next(forth_dict, create(current_text, cons_code)); 802 | does(forth_dict->head, (Word **)ds_pop(), 0); 803 | 804 | } 805 | 806 | 807 | void load() 808 | { 809 | current_text = parse_word(); 810 | load_file(current_text); 811 | } 812 | 813 | 814 | void interpret() 815 | { 816 | state = EXPLAIN; 817 | text_p = forth_text; 818 | IP_head = IP_list; 819 | IP=IP_head; 820 | 821 | while (*(current_text = parse_word()) != '\0') 822 | { 823 | if(!strcmp(".\"",current_text)) //如果是." str " 则立即编译其中的字符串str 824 | { 825 | PRINT("[DEBUG]编译字符串\n") 826 | 827 | char tempstr[BUFF_LEN]; 828 | while(*text_p != '\"') 829 | { 830 | sprintf(tempstr, "%ld", (CELL)(*text_p)); 831 | find(forth_dict, tempstr); 832 | find(forth_dict, "emit"); 833 | text_p++; 834 | } 835 | text_p++; 836 | } 837 | else if(!strcmp("(",current_text)) //注释模式 838 | { 839 | 840 | while(*text_p != ')') 841 | { 842 | text_p++; 843 | } 844 | text_p++; 845 | } 846 | else if(!find(forth_dict, current_text)) 847 | { 848 | printf("[%s]?\n",current_text); 849 | empty_stack(); 850 | IP=IP_head; 851 | return; 852 | } 853 | } 854 | } 855 | 856 | 857 | //从外部文件读取Forth代码 858 | int load_file(char *file_path) 859 | { 860 | FILE *fp; //文件指针 861 | char c; 862 | int i = 0; 863 | int colon_flag = FALSE; 864 | 865 | if((fp = fopen(file_path, "r")) == NULL) 866 | { 867 | printf("Can't open %s\n", file_path); 868 | return 0; 869 | } 870 | 871 | do 872 | { 873 | c = getc(fp); 874 | if((c != '\n' && c != EOF) 875 | || (c == '\n' && colon_flag == TRUE)) 876 | { 877 | if(c == ':') colon_flag = TRUE; 878 | else if(c == ';') colon_flag = FALSE; 879 | forth_text[i] = c; 880 | i++; 881 | } 882 | else if((c == '\n' && colon_flag == FALSE) 883 | || c == EOF) 884 | { 885 | forth_text[i] = '\0'; 886 | interpret(); 887 | i = 0; 888 | } 889 | } while(c != EOF); 890 | fclose(fp); 891 | 892 | return 1; 893 | } 894 | 895 | 896 | //主程序入口 897 | int main(int argc, char *argv[]) 898 | { 899 | empty_stack(); 900 | IP_head = IP_list; 901 | IP = IP_head; 902 | forth_dict= dict_init(); 903 | 904 | //初始化词典 905 | dict_ins_next(forth_dict, def_core("(lit)",lit)); 906 | dict_ins_next(forth_dict, def_core(".",popds)); 907 | dict_ins_next(forth_dict, def_core("bye",bye)); 908 | dict_ins_next(forth_dict, def_core("ret",ret)); 909 | dict_ins_next(forth_dict, def_core("depth",depth)); 910 | dict_ins_next(forth_dict, def_core("+",add)); 911 | dict_ins_next(forth_dict, def_core("-",sub)); 912 | dict_ins_next(forth_dict, def_core("*",mul)); 913 | dict_ins_next(forth_dict, def_core("/",divv)); 914 | dict_ins_next(forth_dict, def_core("drop",drop)); 915 | dict_ins_next(forth_dict, def_core(".s",showds)); 916 | dict_ins_next(forth_dict, def_core("pick",pick)); 917 | dict_ins_next(forth_dict, def_core("roll",roll)); 918 | dict_ins_next(forth_dict, def_core("!", invar)); 919 | dict_ins_next(forth_dict, def_core("@", outvar)); 920 | dict_ins_next(forth_dict, def_core("=",equal)); 921 | dict_ins_next(forth_dict, def_core("<>",noequal)); 922 | dict_ins_next(forth_dict, def_core(">",morethan)); 923 | dict_ins_next(forth_dict, def_core("<",lessthan)); 924 | dict_ins_next(forth_dict, def_core("?branch",if_branch)); 925 | dict_ins_next(forth_dict, def_core("branch",branch)); 926 | dict_ins_next(forth_dict, def_core("(do)",doo)); 927 | dict_ins_next(forth_dict, def_core("(loop)",loopp)); 928 | dict_ins_next(forth_dict, def_core(">r",tor)); 929 | dict_ins_next(forth_dict, def_core("r>",rto)); 930 | dict_ins_next(forth_dict, def_core("r@",rat)); 931 | dict_ins_next(forth_dict, def_core("emit", emit)); 932 | dict_ins_next(forth_dict, def_core("words",words)); 933 | dict_ins_next(forth_dict, def_core("immediate",immediate)); 934 | dict_ins_next(forth_dict, def_core("compile", compile_wplist)); 935 | dict_ins_next(forth_dict, def_core(",", compile_s)); 936 | dict_ins_next(forth_dict, def_core("'", pushds_cfa)); 937 | 938 | dict_ins_next(forth_dict, def_core("[",in_interpret)); immediate(); 939 | dict_ins_next(forth_dict, def_core("]",out_interpret)); immediate(); 940 | dict_ins_next(forth_dict, def_core("myself", myself)); immediate(); 941 | dict_ins_next(forth_dict, def_core(":",defcolon)); immediate(); 942 | dict_ins_next(forth_dict, def_core(";",endcolon)); immediate(); 943 | dict_ins_next(forth_dict, def_core("if",_if)); immediate(); 944 | dict_ins_next(forth_dict, def_core("else",_else)); immediate(); 945 | dict_ins_next(forth_dict, def_core("then",_then)); immediate(); 946 | dict_ins_next(forth_dict, def_core("do",_do)); immediate(); 947 | dict_ins_next(forth_dict, def_core("loop",_loop)); immediate(); 948 | dict_ins_next(forth_dict, def_core("see",see)); immediate(); 949 | dict_ins_next(forth_dict, def_core("forget",forget)); immediate(); 950 | dict_ins_next(forth_dict, def_core("variable",var)); immediate(); 951 | dict_ins_next(forth_dict, def_core("constant",cons)); immediate(); 952 | dict_ins_next(forth_dict, def_core("load",load)); immediate(); 953 | 954 | 955 | for(; argc > 1; argc--) 956 | load_file(*++argv); 957 | 958 | while (1) 959 | { 960 | printf(">>> "); 961 | gets(forth_text); 962 | interpret(); 963 | } 964 | 965 | 966 | return 0; 967 | } -------------------------------------------------------------------------------- /forth.h: -------------------------------------------------------------------------------- 1 | #define CELL long //定义数据类型，在32位与64位系统中与指针类型的宽度相同 2 | #define STACK_LEN 1024 //定义栈的深度 3 | #define BUFF_LEN 1024 //缓冲区长度 4 | #define TRUE 1 5 | #define FALSE 0 6 | #define EXPLAIN 0 //解释模式 7 | #define COMPILE 1 //编译模式 8 | #define REVEAL_WORD 0 //标记为显示词 9 | #define IMMD_WORD 1 //标记为立即词 10 | #define HIDE_WORD 2 //标记为隐藏词 11 | 12 | #define DEBUG 0 13 | #if DEBUG 14 | #define PRINT(fmt, args...) printf(fmt,##args); 15 | #else 16 | #define PRINT(fmt, args...) 17 | #endif 18 | 19 | 20 | //代码域函数指针 21 | typedef void(*fn_p)(); 22 | 23 | 24 | //用结构体定义Forth的词结构，利用链表实现词典 25 | typedef struct Word 26 | { 27 | struct Word *link; //Forth词的链接域 28 | CELL flag; //Forth标记数，用来识别立即词、隐藏词 29 | char *name; //Forth词的名字域 30 | fn_p code_p; //Forth词的代码域 31 | struct Word **wplist; //Forth词的参数域 32 | } Word; 33 | 34 | 35 | //定义字典结构 36 | typedef struct Dict 37 | { 38 | CELL size; //Forth词典中词的数量 39 | Word *head; //Forth词典链表最后一个词的地址 40 | Word *wplist_tmp[BUFF_LEN];//保存编译模式正在定义的扩展词参数域，临时用 41 | } Dict; 42 | 43 | 44 | //Forth系统运行时的核心指针 45 | CELL state; //Forth状态变量 46 | char forth_text[BUFF_LEN]; //Forth代码文本缓冲区 47 | char *current_text; //当前Forth词的词首指针 48 | char *text_p; //Forth代码文本指针 49 | Dict *forth_dict; //Forth词典指针 50 | CELL DS[STACK_LEN]; //参数栈 51 | CELL RS[STACK_LEN]; //返回栈 52 | CELL *DP, *RP; //栈指针 53 | Word *IP_list[BUFF_LEN]; //解释模式指令列表，长度为BUFF_LEN 54 | Word **IP; //指令列表指针(指针的指针) 55 | Word **IP_head; //IPlist选择指针，根据状态变量指向不同的指令列表 56 | 57 | //文本解析 58 | int check_blank(char c); //判断是否为空白字符 59 | char *parse_word(); //返回输入流中当前的forth词，并更新text_p指针 60 | 61 | //Forth词的构建函数 62 | Word *create(char *name, fn_p fp); //创建Forth词的名字域 63 | void does(Word *c, Word **list, int n); //创建Forth词中的参数域 64 | Word *def_core(char *name, fn_p fp); //创建一个Forth核心词 65 | void colon_code(); //扩展词的代码域 66 | void cons_code(); //常数词的代码域 67 | void var_code(); //变量词的代码域 68 | 69 | //Forth词典的操作函数 70 | Dict *dict_init(); 71 | int dict_ins_next(Dict *dict, Word *word); 72 | Word *dict_search_name(Dict *dict, char *name); 73 | void dict_destroy_word(Word *word); 74 | int dict_rem_after(Dict *dict, char *name); 75 | 76 | //Forth指令列表操作函数 77 | void explain(); //IP列表执行 78 | int is_num(char *s); //判断字符串是否为数字 79 | int find(Dict *dict, char *name); //根据词名，去执行相应的IP列表操作 80 | 81 | //Forth栈操作函数 82 | void empty_stack(); 83 | void stack_error(int n); 84 | void ip_push(Word *w, Word** list); //IP栈PUSH 85 | void ds_push(CELL n); 86 | void rs_push(CELL n); 87 | CELL ds_pop(); 88 | CELL rs_pop(); 89 | CELL ds_top(); 90 | CELL rs_top(); 91 | 92 | //Forth核心词 93 | void lit(); // (lit) 94 | void popds(); // . 95 | void bye(); // bye 96 | 97 | void ret(); // ret 98 | 99 | void depth(); // depth 100 | void add(); // + 101 | void sub(); // - 102 | void mul(); // * 103 | void divv(); // / 104 | 105 | void drop(); // drop 106 | void showds(); // .s 107 | void pick(); // pick 108 | void roll(); // roll 109 | 110 | void invar(); // ! 111 | void outvar(); // @ 112 | 113 | void equal(); // = 114 | void noequal(); // <> 115 | void morethan(); // > 116 | void lessthan(); // < 117 | 118 | void if_branch(); // ?branch 119 | void branch(); // branch 120 | 121 | void doo(); // (do) 122 | void loopp(); // (loop) 123 | 124 | void tor(); // >r 125 | void rto(); // r> 126 | void rat(); // r@ 127 | 128 | void emit(); // emit 129 | void words(); // words 130 | 131 | void immediate(); // immediate 132 | void compile(); // compile 编译后面一个词的运行时代码 133 | void compile_s(); // , 编译栈顶数到扩展词定义中 134 | void pushds_cfa(); // ' 将后面一个词的执行地址压入数据栈 135 | 136 | //Forth核心词中的立即词 137 | void in_interpret(); // [ 138 | void out_interpret();// ] 139 | void myself(); // myself 140 | void defcolon(); // : 141 | void endcolon(); // ; 142 | void _if(); // if 143 | void _else(); // else 144 | void _then(); // then 145 | void _do(); // do 146 | void _loop(); // loop 147 | void see(); // see 148 | void forget(); // forget 149 | void var(); // variable 150 | void cons(); // constant 151 | void load(); // load 152 | 153 | 154 | //Forth解释器部分 155 | void interpret(); 156 | int load_file(char *file_path); -------------------------------------------------------------------------------- /lib.fs: -------------------------------------------------------------------------------- 1 | ( Forth System Words Begin ) 2 | : cr 10 emit ; 3 | : dup 1 pick ; 4 | : swap 2 roll ; 5 | : over 2 pick ; 6 | : rot 3 roll ; 7 | : -rot 3 roll 3 roll ; 8 | : 2dup over over ; 9 | : 2drop drop drop ; 10 | : 2swap 4 roll 4 roll ; 11 | : 2over 4 pick 4 pick ; 12 | : 2rot 6 roll 6 roll ; 13 | : nip swap drop ; 14 | : tuck swap over ; 15 | : 3dup 3 pick 3 pick 3 pick ; 16 | 17 | : mod ( n1 n2 -- mod ) 2dup / * - ; 18 | : /mod ( n1 n2 -- mod div ) 2dup / >r mod r> ; 19 | : negate ( n -- -n ) -1 * ; 20 | : abs dup 0 < if negate then ; 21 | : 1+ 1 + ; 22 | : 1- 1 - ; 23 | : 2+ 2 + ; 24 | : 2- 2 - ; 25 | : 2* 2 * ; 26 | : 2/ 2 / ; 27 | : max 2dup < if swap then drop ; 28 | : min 2dup > if swap then drop ; 29 | : max2 ( n1 n2 n3 -- max1 max2 ) 2dup max >r min max r> ; 30 | 31 | : 0= 0 = ; 32 | : 0<> 0 <> ; 33 | : 0> 0 > ; 34 | : 0< 0 < ; 35 | : true -1 ; 36 | : false 0 ; 37 | : ?dup dup 0<> if dup then ; 38 | 39 | : space 32 emit ; 40 | 41 | : [compile] ' , ; immediate 42 | : literal ( n -- ) compile (lit) , ; immediate 43 | ( Forth System Words End ) words cr -------------------------------------------------------------------------------- /makefile: -------------------------------------------------------------------------------- 1 | CC := gcc 2 | CFLAGS := -Wall 3 | forth: forth.o 4 | $(CC) $(CFLAGS) $^ -o $@ 5 | forth.o: forth.c forth.h 6 | $(CC) $(CFLAGS) -c forth.c 7 | clean: 8 | @echo "cleanning project" 9 | -rm -f *.o 10 | @echo "clean completed" 11 | -------------------------------------------------------------------------------- /test.fs: -------------------------------------------------------------------------------- 1 | : test_ok ( -- ) 2 | ." test OK!" cr ; 3 | 4 | : test_fail ( -- ) 5 | ." test Fail!" cr ; 6 | 7 | : test ( n1 n2 -- n1==n2? ) 8 | = 9 | if 10 | test_ok 11 | else 12 | test_fail 13 | then ; 14 | 15 | variable foo 16 | 3 foo ! foo @ 3 test cr 17 | 555 constant foo2 foo2 555 test cr 18 | 19 | ." Fib Test: Print the twelfth fib numbers " cr 20 | : fib ( fib_index -- fib_number ) 21 | dup 3 < 22 | if 23 | drop 1 24 | else 25 | 1- dup 1- myself swap myself + 26 | then ; 27 | 28 | : test_fib 29 | 11 fib dup . 89 test ; 30 | 31 | see fib 32 | test_fib cr 33 | 34 | ." Factorial Test: Us recursive to Print Eight's Factorial " cr 35 | 36 | : factorial ( Num -- FactorialResult ) 37 | dup 1 = 38 | if 39 | drop 1 40 | else 41 | dup 1- myself * 42 | then ; 43 | 44 | : test_fact 45 | 8 factorial dup . 40320 test ; 46 | 47 | see factorial 48 | test_fact cr 49 | 50 | ." Matrix: Test nested statements " cr 51 | : star 42 emit ; 52 | 53 | : matrix 54 | swap 0 55 | do 56 | dup >r 0 57 | do 58 | star space 59 | loop 60 | cr r> 61 | loop drop cr ; 62 | 63 | 5 4 matrix cr 64 | 65 | ." Hanoi Tower: level 3" cr 66 | : 4dup 4 pick 4 pick 4 pick 4 pick ; 67 | 68 | : 4drop drop drop drop drop ; 69 | 70 | : arrow 45 emit 62 emit ; 71 | 72 | : move ( A B C n -- ) 73 | dup 1 = 74 | if 75 | 4 pick emit arrow 2 pick emit cr 76 | else 77 | 4dup 1- >r swap r> myself 4 pick emit arrow 2 pick emit cr 4dup 1- >r >r swap r> r> myself 78 | then 79 | 4drop ; 80 | 81 | : hanoi ( level -- ) 65 66 67 4 roll move cr ; 82 | 83 | 3 hanoi cr 84 | 85 | ." : test[ if 1 [ 4 5 + ] else 2 then ;" cr 86 | : test[ if 1 [ 4 5 + ] else 2 then ; 87 | see test[ 88 | 9 test cr 89 | 90 | : aaa 1 2 ; 91 | : bbb 3 4 ; 92 | see aaa 93 | see bbb 94 | : ccc compile aaa compile bbb ; immediate 95 | see ccc 96 | : testccc ccc ; 97 | see testccc 98 | testccc + + + 10 test cr 99 | 100 | see literal 101 | ." : new-five+ [ 5 ] literal + ; " cr 102 | : new-five+ [ 5 ] literal + ; 103 | see new-five+ 104 | 2 new-five+ 7 test cr --------------------------------------------------------------------------------