/[cvs]/stack/stack.c
ViewVC logotype

Diff of /stack/stack.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.94 by masse, Sat Mar 9 09:58:31 2002 UTC revision 1.96 by teddy, Sun Mar 10 07:55:13 2002 UTC
# Line 48  void init_env(environment *env) Line 48  void init_env(environment *env)
48  {  {
49    int i;    int i;
50    
51    env->gc_limit= 20;    env->gc_limit= 200;
52    env->gc_count= 0;    env->gc_count= 0;
53    env->gc_ref= NULL;    env->gc_ref= NULL;
54    env->gc_protect= NULL;    env->gc_protect= NULL;
# Line 63  void init_env(environment *env) Line 63  void init_env(environment *env)
63    env->interactive= 1;    env->interactive= 1;
64  }  }
65    
66  void printerr(const char* in_string) {  void printerr(const char* in_string)
67    {
68    fprintf(stderr, "Err: %s\n", in_string);    fprintf(stderr, "Err: %s\n", in_string);
69  }  }
70    
# Line 81  extern void toss(environment *env) Line 82  extern void toss(environment *env)
82    env->head= env->head->next;   /* Remove the top stack item */    env->head= env->head->next;   /* Remove the top stack item */
83    free(temp);                   /* Free the old top stack item */    free(temp);                   /* Free the old top stack item */
84    
85    gc_init(env);    env->gc_limit--;
86  }  }
87    
88  /* Returns a pointer to a pointer to an element in the hash table. */  /* Returns a pointer to a pointer to an element in the hash table. */
# Line 113  symbol **hash(hashtbl in_hashtbl, const Line 114  symbol **hash(hashtbl in_hashtbl, const
114    }    }
115  }  }
116    
117  value* new_val(environment *env) {  /* Create new value */
118    value* new_val(environment *env)
119    {
120    value *nval= malloc(sizeof(value));    value *nval= malloc(sizeof(value));
121    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
122    
# Line 125  value* new_val(environment *env) { Line 128  value* new_val(environment *env) {
128    
129    env->gc_count++;    env->gc_count++;
130    
   protect(env, nval);  
   gc_init(env);  
   unprotect(env);  
   
131    return nval;    return nval;
132  }  }
133    
134  void gc_mark(value *val) {  /* Mark values recursively.
135       Marked values are not collected by the GC. */
136    inline void gc_mark(value *val)
137    {
138    stackitem *iterator;    stackitem *iterator;
139    
140    if(val==NULL || val->gc_garb==0)    if(val==NULL || val->gc_garb==0)
# Line 150  void gc_mark(value *val) { Line 152  void gc_mark(value *val) {
152    }    }
153  }  }
154    
155  extern void gc_init(environment *env) {  inline void gc_maybe(environment *env)
156    {
157      if(env->gc_count < env->gc_limit)
158        return;
159      else
160        return gc_init(env);
161    }
162    
163    /* Start GC */
164    extern void gc_init(environment *env)
165    {
166    stackitem *new_head= NULL, *titem, *iterator;    stackitem *new_head= NULL, *titem, *iterator;
167    symbol *tsymb;    symbol *tsymb;
168    int i;    int i;
169    
   if(env->gc_count < env->gc_limit)  
     return;  
   
170    /* Garb by default */    /* Garb by default */
171    iterator= env->gc_ref;    iterator= env->gc_ref;
172    while(iterator!=NULL) {    while(iterator!=NULL) {
# Line 172  extern void gc_init(environment *env) { Line 181  extern void gc_init(environment *env) {
181      iterator= iterator->next;      iterator= iterator->next;
182    }    }
183    
184    /* Mark values in stack */    /* Mark values on stack */
185    iterator= env->head;    iterator= env->head;
186    while(iterator!=NULL) {    while(iterator!=NULL) {
187      gc_mark(iterator->item);      gc_mark(iterator->item);
# Line 190  extern void gc_init(environment *env) { Line 199  extern void gc_init(environment *env) {
199    
200    env->gc_count= 0;    env->gc_count= 0;
201    
202    /* Sweep */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
   while(env->gc_ref!=NULL) {  
203    
204      if(env->gc_ref->item->gc_garb) {      if(env->gc_ref->item->gc_garb) {
205    
206        /* Remove content */        switch(env->gc_ref->item->type) { /* Remove content */
       switch(env->gc_ref->item->type) {  
207        case string:        case string:
208          free(env->gc_ref->item->content.ptr);          free(env->gc_ref->item->content.ptr);
209          break;          break;
# Line 214  extern void gc_init(environment *env) { Line 221  extern void gc_init(environment *env) {
221        titem= env->gc_ref->next;        titem= env->gc_ref->next;
222        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
223        env->gc_ref= titem;        env->gc_ref= titem;
224      } else {                    /* Save */      } else {                    /* Keep values */
225        titem= env->gc_ref->next;        titem= env->gc_ref->next;
226        env->gc_ref->next= new_head;        env->gc_ref->next= new_head;
227        new_head= env->gc_ref;        new_head= env->gc_ref;
# Line 227  extern void gc_init(environment *env) { Line 234  extern void gc_init(environment *env) {
234    env->gc_ref= new_head;    env->gc_ref= new_head;
235  }  }
236    
237    /* Protect values from GC */
238  void protect(environment *env, value *val)  void protect(environment *env, value *val)
239  {  {
240    stackitem *new_item= malloc(sizeof(stackitem));    stackitem *new_item= malloc(sizeof(stackitem));
# Line 235  void protect(environment *env, value *va Line 243  void protect(environment *env, value *va
243    env->gc_protect= new_item;    env->gc_protect= new_item;
244  }  }
245    
246    /* Unprotect values from GC */
247  void unprotect(environment *env)  void unprotect(environment *env)
248  {  {
249    stackitem *temp= env->gc_protect;    stackitem *temp= env->gc_protect;
# Line 251  void push_val(environment *env, value *v Line 260  void push_val(environment *env, value *v
260    env->head= new_item;    env->head= new_item;
261  }  }
262    
263  /* Push an integer onto the stack. */  /* Push an integer onto the stack */
264  void push_int(environment *env, int in_val)  void push_int(environment *env, int in_val)
265  {  {
266    value *new_value= new_val(env);    value *new_value= new_val(env);
# Line 262  void push_int(environment *env, int in_v Line 271  void push_int(environment *env, int in_v
271    push_val(env, new_value);    push_val(env, new_value);
272  }  }
273    
274    /* Push a floating point number onto the stack */
275  void push_float(environment *env, float in_val)  void push_float(environment *env, float in_val)
276  {  {
277    value *new_value= new_val(env);    value *new_value= new_val(env);
# Line 285  void push_cstring(environment *env, cons Line 295  void push_cstring(environment *env, cons
295  }  }
296    
297  /* Mangle a symbol name to a valid C identifier name */  /* Mangle a symbol name to a valid C identifier name */
298  char *mangle_str(const char *old_string){  char *mangle_str(const char *old_string)
299    {
300    char validchars[]= "0123456789abcdef";    char validchars[]= "0123456789abcdef";
301    char *new_string, *current;    char *new_string, *current;
302    
# Line 303  char *mangle_str(const char *old_string) Line 314  char *mangle_str(const char *old_string)
314    return new_string;            /* The caller must free() it */    return new_string;            /* The caller must free() it */
315  }  }
316    
317  extern void mangle(environment *env){  extern void mangle(environment *env)
318    {
319    char *new_string;    char *new_string;
320    
321    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 372  void push_sym(environment *env, const ch Line 384  void push_sym(environment *env, const ch
384    
385      mangled= mangle_str(in_string); /* mangle the name */      mangled= mangle_str(in_string); /* mangle the name */
386      funcptr= dlsym(handle, mangled); /* and try to find it */      funcptr= dlsym(handle, mangled); /* and try to find it */
387      free(mangled);  
388      dlerr= dlerror();      dlerr= dlerror();
389      if(dlerr != NULL) {         /* If no function was found */      if(dlerr != NULL) {         /* If no function was found */
390        funcptr= dlsym(handle, in_string); /* Get function pointer */        funcptr= dlsym(handle, in_string); /* Get function pointer */
391        dlerr= dlerror();        dlerr= dlerror();
392      }      }
393    
394      if(dlerr==NULL) {           /* If a function was found */      if(dlerr==NULL) {           /* If a function was found */
395        new_fvalue->type= func;   /* The new value is a function pointer */        new_fvalue->type= func;   /* The new value is a function pointer */
396        new_fvalue->content.ptr= funcptr; /* Store function pointer */        new_fvalue->content.ptr= funcptr; /* Store function pointer */
397        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new        (*new_symbol)->val= new_fvalue; /* Bind the symbol to the new
398                                           function value */                                           function value */
399      }      }
400    
401        free(mangled);
402    }    }
403    
404    push_val(env, new_value);    push_val(env, new_value);
405    unprotect(env); unprotect(env);    unprotect(env); unprotect(env);
406  }  }
# Line 396  extern void nl() Line 412  extern void nl()
412  }  }
413    
414  /* Gets the type of a value */  /* Gets the type of a value */
415  extern void type(environment *env){  extern void type(environment *env)
416    {
417    int typenum;    int typenum;
418    
419    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 464  void print_h(stackitem *stack_head, int Line 481  void print_h(stackitem *stack_head, int
481    }    }
482  }  }
483    
484  extern void print_(environment *env) {  extern void print_(environment *env)
485    {
486    if(env->head==NULL) {    if(env->head==NULL) {
487      printerr("Too Few Arguments");      printerr("Too Few Arguments");
488      env->err=1;      env->err=1;
# Line 482  extern void print(environment *env) Line 500  extern void print(environment *env)
500    toss(env);    toss(env);
501  }  }
502    
503  extern void princ_(environment *env) {  extern void princ_(environment *env)
504    {
505    if(env->head==NULL) {    if(env->head==NULL) {
506      printerr("Too Few Arguments");      printerr("Too Few Arguments");
507      env->err=1;      env->err=1;
# Line 516  extern void printstack(environment *env) Line 535  extern void printstack(environment *env)
535      printf("Stack Empty\n");      printf("Stack Empty\n");
536      return;      return;
537    }    }
538    
539    print_st(env->head, 1);    print_st(env->head, 1);
540  }  }
541    
# Line 593  extern void eval(environment *env) Line 613  extern void eval(environment *env)
613    
614   eval_start:   eval_start:
615    
616      gc_maybe(env);
617    
618    if(env->head==NULL) {    if(env->head==NULL) {
619      printerr("Too Few Arguments");      printerr("Too Few Arguments");
620      env->err=1;      env->err=1;
# Line 649  extern void eval(environment *env) Line 671  extern void eval(environment *env)
671  }  }
672    
673  /* Reverse (flip) a list */  /* Reverse (flip) a list */
674  extern void rev(environment *env){  extern void rev(environment *env)
675    {
676    stackitem *old_head, *new_head, *item;    stackitem *old_head, *new_head, *item;
677    
678    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 835  extern void def(environment *env) Line 858  extern void def(environment *env)
858  /* Quit stack. */  /* Quit stack. */
859  extern void quit(environment *env)  extern void quit(environment *env)
860  {  {
861    long i;    int i;
862    
863    clear(env);    clear(env);
864    
# Line 848  extern void quit(environment *env) Line 871  extern void quit(environment *env)
871    }    }
872    
873    env->gc_limit= 0;    env->gc_limit= 0;
874    gc_init(env);    gc_maybe(env);
875    
876    if(env->free_string!=NULL)    if(env->free_string!=NULL)
877      free(env->free_string);      free(env->free_string);
# Line 881  extern void words(environment *env) Line 904  extern void words(environment *env)
904  }  }
905    
906  /* Internal forget function */  /* Internal forget function */
907  void forget_sym(symbol **hash_entry) {  void forget_sym(symbol **hash_entry)
908    {
909    symbol *temp;    symbol *temp;
910    
911    temp= *hash_entry;    temp= *hash_entry;
# Line 916  extern void forget(environment *env) Line 940  extern void forget(environment *env)
940  }  }
941    
942  /* Returns the current error number to the stack */  /* Returns the current error number to the stack */
943  extern void errn(environment *env){  extern void errn(environment *env)
944    {
945    push_int(env, env->err);    push_int(env, env->err);
946  }  }
947    
# Line 985  under certain conditions; type `copying; Line 1010  under certain conditions; type `copying;
1010        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1011        eval(&myenv);        eval(&myenv);
1012      }      }
1013      gc_init(&myenv);      gc_maybe(&myenv);
1014    }    }
1015    quit(&myenv);    quit(&myenv);
1016    return EXIT_FAILURE;    return EXIT_FAILURE;
1017  }  }
1018    
1019  /* "+" */  /* "+" */
1020  extern void sx_2b(environment *env) {  extern void sx_2b(environment *env)
1021    {
1022    int a, b;    int a, b;
1023    float fa, fb;    float fa, fb;
1024    size_t len;    size_t len;
# Line 1072  extern void sx_2b(environment *env) { Line 1098  extern void sx_2b(environment *env) {
1098  }  }
1099    
1100  /* "-" */  /* "-" */
1101  extern void sx_2d(environment *env) {  extern void sx_2d(environment *env)
1102    {
1103    int a, b;    int a, b;
1104    float fa, fb;    float fa, fb;
1105    
# Line 1131  extern void sx_2d(environment *env) { Line 1158  extern void sx_2d(environment *env) {
1158  }  }
1159    
1160  /* ">" */  /* ">" */
1161  extern void sx_3e(environment *env) {  extern void sx_3e(environment *env)
1162    {
1163    int a, b;    int a, b;
1164    float fa, fb;    float fa, fb;
1165    
# Line 1190  extern void sx_3e(environment *env) { Line 1218  extern void sx_3e(environment *env) {
1218  }  }
1219    
1220  /* "<" */  /* "<" */
1221  extern void sx_3c(environment *env) {  extern void sx_3c(environment *env)
1222    {
1223    swap(env); if(env->err) return;    swap(env); if(env->err) return;
1224    sx_3e(env);    sx_3e(env);
1225  }  }
1226    
1227  /* "<=" */  /* "<=" */
1228  extern void sx_3c3d(environment *env) {  extern void sx_3c3d(environment *env)
1229    {
1230    sx_3e(env); if(env->err) return;    sx_3e(env); if(env->err) return;
1231    not(env);    not(env);
1232  }  }
1233    
1234  /* ">=" */  /* ">=" */
1235  extern void sx_3e3d(environment *env) {  extern void sx_3e3d(environment *env)
1236    {
1237    sx_3c(env); if(env->err) return;    sx_3c(env); if(env->err) return;
1238    not(env);    not(env);
1239  }  }
1240    
1241  /* Return copy of a value */  /* Return copy of a value */
1242  value *copy_val(environment *env, value *old_value){  value *copy_val(environment *env, value *old_value)
1243    {
1244    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1245    value *new_value;    value *new_value;
1246    
# Line 1255  value *copy_val(environment *env, value Line 1287  value *copy_val(environment *env, value
1287  }  }
1288    
1289  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1290  extern void sx_647570(environment *env) {  extern void sx_647570(environment *env)
1291    {
1292    if((env->head)==NULL) {    if((env->head)==NULL) {
1293      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1294      env->err= 1;      env->err= 1;
# Line 1265  extern void sx_647570(environment *env) Line 1298  extern void sx_647570(environment *env)
1298  }  }
1299    
1300  /* "if", If-Then */  /* "if", If-Then */
1301  extern void sx_6966(environment *env) {  extern void sx_6966(environment *env)
1302    {
1303    int truth;    int truth;
1304    
1305    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1296  extern void sx_6966(environment *env) { Line 1329  extern void sx_6966(environment *env) {
1329  }  }
1330    
1331  /* If-Then-Else */  /* If-Then-Else */
1332  extern void ifelse(environment *env) {  extern void ifelse(environment *env)
1333    {
1334    int truth;    int truth;
1335    
1336    if((env->head)==NULL || env->head->next==NULL    if((env->head)==NULL || env->head->next==NULL
# Line 1332  extern void ifelse(environment *env) { Line 1365  extern void ifelse(environment *env) {
1365  }  }
1366    
1367  /* "while" */  /* "while" */
1368  extern void sx_7768696c65(environment *env) {  extern void sx_7768696c65(environment *env)
1369    {
1370    int truth;    int truth;
1371    value *loop, *test;    value *loop, *test;
1372    
# Line 1378  extern void sx_7768696c65(environment *e Line 1411  extern void sx_7768696c65(environment *e
1411    
1412    
1413  /* "for"; for-loop */  /* "for"; for-loop */
1414  extern void sx_666f72(environment *env) {  extern void sx_666f72(environment *env)
1415    {
1416    value *loop;    value *loop;
1417    int foo1, foo2;    int foo1, foo2;
1418    
# Line 1425  extern void sx_666f72(environment *env) Line 1459  extern void sx_666f72(environment *env)
1459  }  }
1460    
1461  /* Variant of for-loop */  /* Variant of for-loop */
1462  extern void foreach(environment *env) {  extern void foreach(environment *env)
1463      {  
1464    value *loop, *foo;    value *loop, *foo;
1465    stackitem *iterator;    stackitem *iterator;
1466        
# Line 1462  extern void foreach(environment *env) { Line 1496  extern void foreach(environment *env) {
1496  }  }
1497    
1498  /* "to" */  /* "to" */
1499  extern void to(environment *env) {  extern void to(environment *env)
1500    int i, start, ending;  {
1501    stackitem *temp_head;    int ending, start, i;
1502    value *temp_val;    stackitem *iterator, *temp;
1503        value *pack;
1504    
1505    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1506      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1507      env->err=1;      env->err=1;
# Line 1485  extern void to(environment *env) { Line 1520  extern void to(environment *env) {
1520    start= env->head->item->content.i;    start= env->head->item->content.i;
1521    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1522    
1523    temp_head= env->head;    push_sym(env, "[");
   env->head= NULL;  
1524    
1525    if(ending>=start) {    if(ending>=start) {
1526      for(i= ending; i>=start; i--)      for(i= ending; i>=start; i--)
# Line 1496  extern void to(environment *env) { Line 1530  extern void to(environment *env) {
1530        push_int(env, i);        push_int(env, i);
1531    }    }
1532    
1533    temp_val= new_val(env);    iterator= env->head;
1534    protect(env, temp_val);    pack= new_val(env);
1535      protect(env, pack);
1536    
1537    temp_val->content.ptr= env->head;    if(iterator==NULL
1538    temp_val->type= list;       || (iterator->item->type==symb
1539    env->head= temp_head;       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {
1540    push_val(env, temp_val);      temp= NULL;
1541        toss(env);
1542      } else {
1543        /* Search for first delimiter */
1544        while(iterator->next!=NULL
1545              && (iterator->next->item->type!=symb
1546              || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))
1547          iterator= iterator->next;
1548        
1549        /* Extract list */
1550        temp= env->head;
1551        env->head= iterator->next;
1552        iterator->next= NULL;
1553    
1554        pack->type= list;
1555        pack->content.ptr= temp;
1556        
1557        if(env->head!=NULL)
1558          toss(env);
1559      }
1560    
1561      /* Push list */
1562    
1563      push_val(env, pack);
1564    
1565    unprotect(env);    unprotect(env);
1566  }  }
1567    
1568  /* Read a string */  /* Read a string */
1569  extern void readline(environment *env) {  extern void readline(environment *env)
1570    {
1571    char in_string[101];    char in_string[101];
1572    
1573    if(fgets(in_string, 100, env->inputstream)==NULL)    if(fgets(in_string, 100, env->inputstream)==NULL)
# Line 1518  extern void readline(environment *env) { Line 1577  extern void readline(environment *env) {
1577  }  }
1578    
1579  /* "read"; Read a value and place on stack */  /* "read"; Read a value and place on stack */
1580  extern void sx_72656164(environment *env) {  extern void sx_72656164(environment *env)
1581    {
1582    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
1583    const char strform[]= "\"%[^\"]\"%n";    const char strform[]= "\"%[^\"]\"%n";
1584    const char intform[]= "%i%n";    const char intform[]= "%i%n";
# Line 1597  extern void sx_72656164(environment *env Line 1657  extern void sx_72656164(environment *env
1657      return sx_72656164(env);      return sx_72656164(env);
1658  }  }
1659    
1660  extern void beep(environment *env) {  extern void beep(environment *env)
1661    {
1662    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1663    
1664    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1638  extern void beep(environment *env) { Line 1698  extern void beep(environment *env) {
1698    default:    default:
1699      abort();      abort();
1700    }    }
1701  };  }
1702    
1703  /* "wait" */  /* "wait" */
1704  extern void sx_77616974(environment *env) {  extern void sx_77616974(environment *env)
1705    {
1706    int dur;    int dur;
1707    
1708    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 1661  extern void sx_77616974(environment *env Line 1721  extern void sx_77616974(environment *env
1721    toss(env);    toss(env);
1722    
1723    usleep(dur);    usleep(dur);
1724  };  }
1725    
1726  extern void copying(environment *env){  extern void copying(environment *env)
1727    {
1728    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("GNU GENERAL PUBLIC LICENSE\n\
1729                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1730  \n\  \n\
# Line 1922  of preserving the free status of all der Line 1983  of preserving the free status of all der
1983  of promoting the sharing and reuse of software generally.\n");  of promoting the sharing and reuse of software generally.\n");
1984  }  }
1985    
1986  extern void warranty(environment *env){  extern void warranty(environment *env)
1987    {
1988    printf("                          NO WARRANTY\n\    printf("                          NO WARRANTY\n\
1989  \n\  \n\
1990    11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\n\    11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY\n\
Legend:
Removed from v.1.94  
changed lines
  Added in v.1.96
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26