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

Diff of /stack/symbols.c

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

revision 1.2 by masse, Mon Aug 4 14:13:16 2003 UTC revision 1.5 by masse, Fri Aug 8 14:20:49 2003 UTC
# Line 1  Line 1 
 #include <stdio.h>  
1  #include "stack.h"  #include "stack.h"
2    #include "messages.h"
3    
4  /* Print newline. */  /* Print newline. */
5  extern void nl(environment *env)  extern void nl(environment *env)
# Line 294  extern void def(environment *env) Line 294  extern void def(environment *env)
294    }    }
295    
296    /* long names are a pain */    /* long names are a pain */
297    sym= CAR(env->head)->content.ptr;    sym= CAR(env->head)->content.sym;
298    
299    /* Bind the symbol to the value */    /* Bind the symbol to the value */
300    sym->val= CAR(CDR(env->head));    sym->val= CAR(CDR(env->head));
# Line 305  extern void def(environment *env) Line 305  extern void def(environment *env)
305  /* Clear stack */  /* Clear stack */
306  extern void clear(environment *env)  extern void clear(environment *env)
307  {  {
308    while(env->head->type != empty)    env->head= new_val(env);
     toss(env);  
309  }  }
310    
311  /* Forgets a symbol (remove it from the hash table) */  /* Forgets a symbol (remove it from the hash table) */
# Line 360  extern void sx_2b(environment *env) Line 359  extern void sx_2b(environment *env)
359      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
360      toss(env); if(env->err) return;      toss(env); if(env->err) return;
361      toss(env); if(env->err) return;      toss(env); if(env->err) return;
362      len= strlen(a_val->content.ptr)+strlen(b_val->content.ptr)+1;      len= strlen(a_val->content.string)+strlen(b_val->content.string)+1;
363      new_string= malloc(len);      new_string= malloc(len);
364      assert(new_string != NULL);      assert(new_string != NULL);
365      strcpy(new_string, b_val->content.ptr);      strcpy(new_string, b_val->content.string);
366      strcat(new_string, a_val->content.ptr);      strcat(new_string, a_val->content.string);
367      push_cstring(env, new_string);      push_cstring(env, new_string);
368      unprotect(a_val); unprotect(b_val);      unprotect(a_val); unprotect(b_val);
369      free(new_string);      free(new_string);
# Line 1439  extern void sx_636c6f7365(environment *e Line 1438  extern void sx_636c6f7365(environment *e
1438    
1439    toss(env);    toss(env);
1440  }  }
1441    
1442    extern void mangle(environment *env)
1443    {
1444      char *new_string;
1445    
1446      if(env->head->type==empty) {
1447        printerr("Too Few Arguments");
1448        env->err= 1;
1449        return;
1450      }
1451    
1452      if(CAR(env->head)->type!=string) {
1453        printerr("Bad Argument Type");
1454        env->err= 2;
1455        return;
1456      }
1457    
1458      new_string= mangle_str(CAR(env->head)->content.string);
1459    
1460      toss(env);
1461      if(env->err) return;
1462    
1463      push_cstring(env, new_string);
1464    }
1465    
1466    /* "fork" */
1467    extern void sx_666f726b(environment *env)
1468    {
1469      push_int(env, fork());
1470    }
1471    
1472    /* "waitpid" */
1473    extern void sx_77616974706964(environment *env)
1474    {
1475    
1476      if(env->head->type==empty) {
1477        printerr("Too Few Arguments");
1478        env->err= 1;
1479        return;
1480      }
1481    
1482      if(CAR(env->head)->type!=integer) {
1483        printerr("Bad Argument Type");
1484        env->err= 2;
1485        return;
1486      }
1487    
1488      push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
1489      swap(env); toss(env);
1490    }
1491    
1492    
1493    /* Discard the top element of the stack. */
1494    extern void toss(environment *env)
1495    {
1496      if(env->head->type==empty) {
1497        printerr("Too Few Arguments");
1498        env->err= 1;
1499        return;
1500      }
1501      
1502      env->head= CDR(env->head); /* Remove the top stack item */
1503    }
1504    
1505    
1506    /* Quit stack. */
1507    extern void quit(environment *env)
1508    {
1509      int i;
1510    
1511      env->head= new_val(env);
1512    
1513      if (env->err) return;
1514      for(i= 0; i<HASHTBLSIZE; i++) {
1515        while(env->symbols[i]!= NULL) {
1516          forget_sym(&(env->symbols[i]));
1517        }
1518        env->symbols[i]= NULL;
1519      }
1520    
1521      env->gc_limit= 0;
1522      gc_maybe(env);
1523    
1524      words(env);
1525    
1526      if(env->free_string!=NULL)
1527        free(env->free_string);
1528      
1529    #ifdef __linux__
1530      muntrace();
1531    #endif
1532    
1533      exit(EXIT_SUCCESS);
1534    }
1535    
1536    
1537    /* List all defined words */
1538    extern void words(environment *env)
1539    {
1540      symbol *temp;
1541      int i;
1542      
1543      for(i= 0; i<HASHTBLSIZE; i++) {
1544        temp= env->symbols[i];
1545        while(temp!=NULL) {
1546    #ifdef DEBUG
1547          if (temp->val != NULL && temp->val->gc.flag.protect)
1548            printf("(protected) ");
1549    #endif /* DEBUG */
1550          printf("%s ", temp->id);
1551          temp= temp->next;
1552        }
1553      }
1554    }
1555    
1556    
1557    /* Only to be called by itself function printstack. */
1558    void print_st(environment *env, value *stack_head, long counter)
1559    {
1560      if(CDR(stack_head)->type != empty)
1561        print_st(env, CDR(stack_head), counter+1);
1562      printf("%ld: ", counter);
1563      print_val(env, CAR(stack_head), 0, NULL, stdout);
1564      printf("\n");
1565    }
1566    
1567    
1568    /* Prints the stack. */
1569    extern void printstack(environment *env)
1570    {
1571      if(env->head->type == empty) {
1572        printf("Stack Empty\n");
1573        return;
1574      }
1575    
1576      print_st(env, env->head, 1);
1577    }
1578    
1579    
1580    extern void copying(environment *env)
1581    {
1582      printf(license_message);
1583    }
1584    
1585    
1586    extern void warranty(environment *env)
1587    {
1588      printf(warranty_message);
1589    }
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26