| … | |
… | |
| 30 | #endif |
30 | #endif |
| 31 | #if USE_MATH |
31 | #if USE_MATH |
| 32 | # include <math.h> |
32 | # include <math.h> |
| 33 | #endif |
33 | #endif |
| 34 | |
34 | |
|
|
35 | #define ECB_NO_THREADS 1 |
| 35 | #include "ecb.h" |
36 | #include "ecb.h" |
| 36 | |
37 | |
| 37 | #include <sys/types.h> |
38 | #include <sys/types.h> |
| 38 | #include <sys/stat.h> |
39 | #include <sys/stat.h> |
| 39 | #include <fcntl.h> |
40 | #include <fcntl.h> |
| … | |
… | |
| 194 | # define stricmp(a,b) strcmp (a, b) |
195 | # define stricmp(a,b) strcmp (a, b) |
| 195 | # define strlwr(s) (s) |
196 | # define strlwr(s) (s) |
| 196 | #endif |
197 | #endif |
| 197 | |
198 | |
| 198 | #ifndef prompt |
199 | #ifndef prompt |
| 199 | # define prompt "ts> " |
200 | # define prompt "ms> " |
| 200 | #endif |
201 | #endif |
| 201 | |
202 | |
| 202 | #ifndef InitFile |
203 | #ifndef InitFile |
| 203 | # define InitFile "init.scm" |
204 | # define InitFile "init.scm" |
| 204 | #endif |
205 | #endif |
| … | |
… | |
| 1097 | |
1098 | |
| 1098 | static int |
1099 | static int |
| 1099 | hash_fn (const char *key, int table_size) |
1100 | hash_fn (const char *key, int table_size) |
| 1100 | { |
1101 | { |
| 1101 | const unsigned char *p = (unsigned char *)key; |
1102 | const unsigned char *p = (unsigned char *)key; |
| 1102 | uint32_t hash = 2166136261; |
1103 | uint32_t hash = 2166136261U; |
| 1103 | |
1104 | |
| 1104 | while (*p) |
1105 | while (*p) |
| 1105 | hash = (hash ^ *p++) * 16777619; |
1106 | hash = (hash ^ *p++) * 16777619; |
| 1106 | |
1107 | |
| 1107 | return hash % table_size; |
1108 | return hash % table_size; |
| … | |
… | |
| 3466 | if (file_interactive (SCHEME_A)) |
3467 | if (file_interactive (SCHEME_A)) |
| 3467 | { |
3468 | { |
| 3468 | SCHEME_V->envir = SCHEME_V->global_env; |
3469 | SCHEME_V->envir = SCHEME_V->global_env; |
| 3469 | dump_stack_reset (SCHEME_A); |
3470 | dump_stack_reset (SCHEME_A); |
| 3470 | putcharacter (SCHEME_A_ '\n'); |
3471 | putcharacter (SCHEME_A_ '\n'); |
|
|
3472 | #if EXPERIMENT |
|
|
3473 | system ("ps v $PPID"); |
|
|
3474 | #endif |
| 3471 | putstr (SCHEME_A_ prompt); |
3475 | putstr (SCHEME_A_ prompt); |
| 3472 | } |
3476 | } |
| 3473 | |
3477 | |
| 3474 | /* Set up another iteration of REPL */ |
3478 | /* Set up another iteration of REPL */ |
| 3475 | SCHEME_V->nesting = 0; |
3479 | SCHEME_V->nesting = 0; |
| … | |
… | |
| 5384 | break; |
5388 | break; |
| 5385 | } |
5389 | } |
| 5386 | |
5390 | |
| 5387 | if (is_pair (y)) |
5391 | if (is_pair (y)) |
| 5388 | s_return (car (y)); |
5392 | s_return (car (y)); |
| 5389 | else |
5393 | |
| 5390 | s_return (S_F); |
5394 | s_return (S_F); |
| 5391 | |
|
|
| 5392 | |
5395 | |
| 5393 | case OP_GET_CLOSURE: /* get-closure-code *//* a.k */ |
5396 | case OP_GET_CLOSURE: /* get-closure-code *//* a.k */ |
| 5394 | SCHEME_V->args = a; |
5397 | SCHEME_V->args = a; |
| 5395 | |
5398 | |
| 5396 | if (SCHEME_V->args == NIL) |
5399 | if (SCHEME_V->args == NIL) |
| 5397 | s_return (S_F); |
5400 | s_return (S_F); |
| 5398 | else if (is_closure (SCHEME_V->args)) |
5401 | else if (is_closure (SCHEME_V->args) || is_macro (SCHEME_V->args)) |
| 5399 | s_return (cons (SCHEME_V->LAMBDA, closure_code (SCHEME_V->value))); |
5402 | s_return (cons (SCHEME_V->LAMBDA, closure_code (SCHEME_V->value))); |
| 5400 | else if (is_macro (SCHEME_V->args)) |
5403 | |
| 5401 | s_return (cons (SCHEME_V->LAMBDA, closure_code (SCHEME_V->value))); |
|
|
| 5402 | else |
|
|
| 5403 | s_return (S_F); |
5404 | s_return (S_F); |
| 5404 | |
5405 | |
| 5405 | case OP_CLOSUREP: /* closure? */ |
5406 | case OP_CLOSUREP: /* closure? */ |
| 5406 | /* |
5407 | /* |
| 5407 | * Note, macro object is also a closure. |
5408 | * Note, macro object is also a closure. |
| 5408 | * Therefore, (closure? <#MACRO>) ==> #t |
5409 | * Therefore, (closure? <#MACRO>) ==> #t |
| … | |
… | |
| 5920 | for (i = 0; i <= SCHEME_V->last_cell_seg; i++) |
5921 | for (i = 0; i <= SCHEME_V->last_cell_seg; i++) |
| 5921 | free (SCHEME_V->cell_seg[i]); |
5922 | free (SCHEME_V->cell_seg[i]); |
| 5922 | |
5923 | |
| 5923 | #if SHOW_ERROR_LINE |
5924 | #if SHOW_ERROR_LINE |
| 5924 | for (i = 0; i <= SCHEME_V->file_i; i++) |
5925 | for (i = 0; i <= SCHEME_V->file_i; i++) |
| 5925 | { |
|
|
| 5926 | if (SCHEME_V->load_stack[i].kind & port_file) |
5926 | if (SCHEME_V->load_stack[i].kind & port_file) |
| 5927 | { |
5927 | { |
| 5928 | fname = SCHEME_V->load_stack[i].rep.stdio.filename; |
5928 | fname = SCHEME_V->load_stack[i].rep.stdio.filename; |
| 5929 | |
5929 | |
| 5930 | if (fname) |
5930 | if (fname) |
| 5931 | free (fname); |
5931 | free (fname); |
| 5932 | } |
5932 | } |
| 5933 | } |
|
|
| 5934 | #endif |
5933 | #endif |
| 5935 | } |
5934 | } |
| 5936 | |
5935 | |
| 5937 | ecb_cold void |
5936 | ecb_cold void |
| 5938 | scheme_load_file (SCHEME_P_ int fin) |
5937 | scheme_load_file (SCHEME_P_ int fin) |
| … | |
… | |
| 6110 | # endif |
6109 | # endif |
| 6111 | int fin; |
6110 | int fin; |
| 6112 | char *file_name = InitFile; |
6111 | char *file_name = InitFile; |
| 6113 | int retcode; |
6112 | int retcode; |
| 6114 | int isfile = 1; |
6113 | int isfile = 1; |
|
|
6114 | #if EXPERIMENT |
| 6115 | system ("ps v $PPID");//D |
6115 | system ("ps v $PPID"); |
|
|
6116 | #endif |
| 6116 | |
6117 | |
| 6117 | if (argc == 2 && strcmp (argv[1], "-?") == 0) |
6118 | if (argc == 2 && strcmp (argv[1], "-?") == 0) |
| 6118 | { |
6119 | { |
| 6119 | putstr (SCHEME_A_ "Usage: tinyscheme -?\n"); |
6120 | putstr (SCHEME_A_ "Usage: tinyscheme -?\n"); |
| 6120 | putstr (SCHEME_A_ "or: tinyscheme [<file1> <file2> ...]\n"); |
6121 | putstr (SCHEME_A_ "or: tinyscheme [<file1> <file2> ...]\n"); |
