/[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.95 by masse, Sun Mar 10 06:34:01 2002 UTC
# 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      env->gc_limit--;
86    gc_init(env);    gc_init(env);
87  }  }
88    
# Line 113  symbol **hash(hashtbl in_hashtbl, const Line 115  symbol **hash(hashtbl in_hashtbl, const
115    }    }
116  }  }
117    
118  value* new_val(environment *env) {  /* Create new value */
119    value* new_val(environment *env)
120    {
121    value *nval= malloc(sizeof(value));    value *nval= malloc(sizeof(value));
122    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
123    
# Line 132  value* new_val(environment *env) { Line 136  value* new_val(environment *env) {
136    return nval;    return nval;
137  }  }
138    
139  void gc_mark(value *val) {  /* Mark values recursively.
140       Marked values are not collected by the GC. */
141    void gc_mark(value *val)
142    {
143    stackitem *iterator;    stackitem *iterator;
144    
145    if(val==NULL || val->gc_garb==0)    if(val==NULL || val->gc_garb==0)
# Line 150  void gc_mark(value *val) { Line 157  void gc_mark(value *val) {
157    }    }
158  }  }
159    
160  extern void gc_init(environment *env) {  /* Start GC */
161    extern void gc_init(environment *env)
162    {
163    stackitem *new_head= NULL, *titem, *iterator;    stackitem *new_head= NULL, *titem, *iterator;
164    symbol *tsymb;    symbol *tsymb;
165    int i;    int i;
166    
167    if(env->gc_count < env->gc_limit)    if(env->gc_count < env->gc_limit)
168      return;      return;
169    
170    /* Garb by default */    /* Garb by default */
171    iterator= env->gc_ref;    iterator= env->gc_ref;
# 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 649  extern void eval(environment *env) Line 669  extern void eval(environment *env)
669  }  }
670    
671  /* Reverse (flip) a list */  /* Reverse (flip) a list */
672  extern void rev(environment *env){  extern void rev(environment *env)
673    {
674    stackitem *old_head, *new_head, *item;    stackitem *old_head, *new_head, *item;
675    
676    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 835  extern void def(environment *env) Line 856  extern void def(environment *env)
856  /* Quit stack. */  /* Quit stack. */
857  extern void quit(environment *env)  extern void quit(environment *env)
858  {  {
859    long i;    int i;
860    
861    clear(env);    clear(env);
862    
# Line 881  extern void words(environment *env) Line 902  extern void words(environment *env)
902  }  }
903    
904  /* Internal forget function */  /* Internal forget function */
905  void forget_sym(symbol **hash_entry) {  void forget_sym(symbol **hash_entry)
906    {
907    symbol *temp;    symbol *temp;
908    
909    temp= *hash_entry;    temp= *hash_entry;
# Line 916  extern void forget(environment *env) Line 938  extern void forget(environment *env)
938  }  }
939    
940  /* Returns the current error number to the stack */  /* Returns the current error number to the stack */
941  extern void errn(environment *env){  extern void errn(environment *env)
942    {
943    push_int(env, env->err);    push_int(env, env->err);
944  }  }
945    
# Line 992  under certain conditions; type `copying; Line 1015  under certain conditions; type `copying;
1015  }  }
1016    
1017  /* "+" */  /* "+" */
1018  extern void sx_2b(environment *env) {  extern void sx_2b(environment *env)
1019    {
1020    int a, b;    int a, b;
1021    float fa, fb;    float fa, fb;
1022    size_t len;    size_t len;
# Line 1072  extern void sx_2b(environment *env) { Line 1096  extern void sx_2b(environment *env) {
1096  }  }
1097    
1098  /* "-" */  /* "-" */
1099  extern void sx_2d(environment *env) {  extern void sx_2d(environment *env)
1100    {
1101    int a, b;    int a, b;
1102    float fa, fb;    float fa, fb;
1103    
# Line 1131  extern void sx_2d(environment *env) { Line 1156  extern void sx_2d(environment *env) {
1156  }  }
1157    
1158  /* ">" */  /* ">" */
1159  extern void sx_3e(environment *env) {  extern void sx_3e(environment *env)
1160    {
1161    int a, b;    int a, b;
1162    float fa, fb;    float fa, fb;
1163    
# Line 1190  extern void sx_3e(environment *env) { Line 1216  extern void sx_3e(environment *env) {
1216  }  }
1217    
1218  /* "<" */  /* "<" */
1219  extern void sx_3c(environment *env) {  extern void sx_3c(environment *env)
1220    {
1221    swap(env); if(env->err) return;    swap(env); if(env->err) return;
1222    sx_3e(env);    sx_3e(env);
1223  }  }
1224    
1225  /* "<=" */  /* "<=" */
1226  extern void sx_3c3d(environment *env) {  extern void sx_3c3d(environment *env)
1227    {
1228    sx_3e(env); if(env->err) return;    sx_3e(env); if(env->err) return;
1229    not(env);    not(env);
1230  }  }
1231    
1232  /* ">=" */  /* ">=" */
1233  extern void sx_3e3d(environment *env) {  extern void sx_3e3d(environment *env)
1234    {
1235    sx_3c(env); if(env->err) return;    sx_3c(env); if(env->err) return;
1236    not(env);    not(env);
1237  }  }
1238    
1239  /* Return copy of a value */  /* Return copy of a value */
1240  value *copy_val(environment *env, value *old_value){  value *copy_val(environment *env, value *old_value)
1241    {
1242    stackitem *old_item, *new_item, *prev_item;    stackitem *old_item, *new_item, *prev_item;
1243    value *new_value;    value *new_value;
1244    
# Line 1255  value *copy_val(environment *env, value Line 1285  value *copy_val(environment *env, value
1285  }  }
1286    
1287  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1288  extern void sx_647570(environment *env) {  extern void sx_647570(environment *env)
1289    {
1290    if((env->head)==NULL) {    if((env->head)==NULL) {
1291      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1292      env->err= 1;      env->err= 1;
# Line 1265  extern void sx_647570(environment *env) Line 1296  extern void sx_647570(environment *env)
1296  }  }
1297    
1298  /* "if", If-Then */  /* "if", If-Then */
1299  extern void sx_6966(environment *env) {  extern void sx_6966(environment *env)
1300    {
1301    int truth;    int truth;
1302    
1303    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 1327  extern void sx_6966(environment *env) {
1327  }  }
1328    
1329  /* If-Then-Else */  /* If-Then-Else */
1330  extern void ifelse(environment *env) {  extern void ifelse(environment *env)
1331    {
1332    int truth;    int truth;
1333    
1334    if((env->head)==NULL || env->head->next==NULL    if((env->head)==NULL || env->head->next==NULL
# Line 1332  extern void ifelse(environment *env) { Line 1363  extern void ifelse(environment *env) {
1363  }  }
1364    
1365  /* "while" */  /* "while" */
1366  extern void sx_7768696c65(environment *env) {  extern void sx_7768696c65(environment *env)
1367    {
1368    int truth;    int truth;
1369    value *loop, *test;    value *loop, *test;
1370    
# Line 1378  extern void sx_7768696c65(environment *e Line 1409  extern void sx_7768696c65(environment *e
1409    
1410    
1411  /* "for"; for-loop */  /* "for"; for-loop */
1412  extern void sx_666f72(environment *env) {  extern void sx_666f72(environment *env)
1413    {
1414    value *loop;    value *loop;
1415    int foo1, foo2;    int foo1, foo2;
1416    
# Line 1425  extern void sx_666f72(environment *env) Line 1457  extern void sx_666f72(environment *env)
1457  }  }
1458    
1459  /* Variant of for-loop */  /* Variant of for-loop */
1460  extern void foreach(environment *env) {  extern void foreach(environment *env)
1461      {  
1462    value *loop, *foo;    value *loop, *foo;
1463    stackitem *iterator;    stackitem *iterator;
1464        
# Line 1462  extern void foreach(environment *env) { Line 1494  extern void foreach(environment *env) {
1494  }  }
1495    
1496  /* "to" */  /* "to" */
1497  extern void to(environment *env) {  extern void to(environment *env)
1498    int i, start, ending;  {
1499    stackitem *temp_head;    int ending, start, i;
1500    value *temp_val;    stackitem *iterator, *temp;
1501        value *pack;
1502    
1503    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
1504      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1505      env->err=1;      env->err=1;
# Line 1485  extern void to(environment *env) { Line 1518  extern void to(environment *env) {
1518    start= env->head->item->content.i;    start= env->head->item->content.i;
1519    toss(env); if(env->err) return;    toss(env); if(env->err) return;
1520    
1521    temp_head= env->head;    push_sym(env, "[");
   env->head= NULL;  
1522    
1523    if(ending>=start) {    if(ending>=start) {
1524      for(i= ending; i>=start; i--)      for(i= ending; i>=start; i--)
# Line 1496  extern void to(environment *env) { Line 1528  extern void to(environment *env) {
1528        push_int(env, i);        push_int(env, i);
1529    }    }
1530    
1531    temp_val= new_val(env);    iterator= env->head;
1532    protect(env, temp_val);    pack= new_val(env);
1533      protect(env, pack);
1534    
1535    temp_val->content.ptr= env->head;    if(iterator==NULL
1536    temp_val->type= list;       || (iterator->item->type==symb
1537    env->head= temp_head;       && ((symbol*)(iterator->item->content.ptr))->id[0]=='[')) {
1538    push_val(env, temp_val);      temp= NULL;
1539        toss(env);
1540      } else {
1541        /* Search for first delimiter */
1542        while(iterator->next!=NULL
1543              && (iterator->next->item->type!=symb
1544              || ((symbol*)(iterator->next->item->content.ptr))->id[0]!='['))
1545          iterator= iterator->next;
1546        
1547        /* Extract list */
1548        temp= env->head;
1549        env->head= iterator->next;
1550        iterator->next= NULL;
1551    
1552        pack->type= list;
1553        pack->content.ptr= temp;
1554        
1555        if(env->head!=NULL)
1556          toss(env);
1557      }
1558    
1559      /* Push list */
1560    
1561      push_val(env, pack);
1562    
1563    unprotect(env);    unprotect(env);
1564  }  }
1565    
1566  /* Read a string */  /* Read a string */
1567  extern void readline(environment *env) {  extern void readline(environment *env)
1568    {
1569    char in_string[101];    char in_string[101];
1570    
1571    if(fgets(in_string, 100, env->inputstream)==NULL)    if(fgets(in_string, 100, env->inputstream)==NULL)
# Line 1518  extern void readline(environment *env) { Line 1575  extern void readline(environment *env) {
1575  }  }
1576    
1577  /* "read"; Read a value and place on stack */  /* "read"; Read a value and place on stack */
1578  extern void sx_72656164(environment *env) {  extern void sx_72656164(environment *env)
1579    {
1580    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";    const char symbform[]= "%[a-zA-Z0-9!$%*+./:<=>?@^_~-]%n";
1581    const char strform[]= "\"%[^\"]\"%n";    const char strform[]= "\"%[^\"]\"%n";
1582    const char intform[]= "%i%n";    const char intform[]= "%i%n";
# Line 1597  extern void sx_72656164(environment *env Line 1655  extern void sx_72656164(environment *env
1655      return sx_72656164(env);      return sx_72656164(env);
1656  }  }
1657    
1658  extern void beep(environment *env) {  extern void beep(environment *env)
1659    {
1660    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1661    
1662    if((env->head)==NULL || env->head->next==NULL) {    if((env->head)==NULL || env->head->next==NULL) {
# Line 1638  extern void beep(environment *env) { Line 1696  extern void beep(environment *env) {
1696    default:    default:
1697      abort();      abort();
1698    }    }
1699  };  }
1700    
1701  /* "wait" */  /* "wait" */
1702  extern void sx_77616974(environment *env) {  extern void sx_77616974(environment *env)
1703    {
1704    int dur;    int dur;
1705    
1706    if((env->head)==NULL) {    if((env->head)==NULL) {
# Line 1661  extern void sx_77616974(environment *env Line 1719  extern void sx_77616974(environment *env
1719    toss(env);    toss(env);
1720    
1721    usleep(dur);    usleep(dur);
1722  };  }
1723    
1724  extern void copying(environment *env){  extern void copying(environment *env)
1725    {
1726    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("GNU GENERAL PUBLIC LICENSE\n\
1727                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1728  \n\  \n\
# Line 1922  of preserving the free status of all der Line 1981  of preserving the free status of all der
1981  of promoting the sharing and reuse of software generally.\n");  of promoting the sharing and reuse of software generally.\n");
1982  }  }
1983    
1984  extern void warranty(environment *env){  extern void warranty(environment *env)
1985    {
1986    printf("                          NO WARRANTY\n\    printf("                          NO WARRANTY\n\
1987  \n\  \n\
1988    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.95
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26