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

Diff of /stack/stack.c

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

revision 1.104 by masse, Tue Mar 12 14:06:05 2002 UTC revision 1.107 by masse, Tue Mar 12 21:05:11 2002 UTC
# Line 37  Line 37 
37  #include <unistd.h>  #include <unistd.h>
38  /* EX_NOINPUT, EX_USAGE */  /* EX_NOINPUT, EX_USAGE */
39  #include <sysexits.h>  #include <sysexits.h>
40    
41    #ifdef __linux__
42  /* mtrace, muntrace */  /* mtrace, muntrace */
43  #include <mcheck.h>  #include <mcheck.h>
44  /* ioctl */  /* ioctl */
45  #include <sys/ioctl.h>  #include <sys/ioctl.h>
46  /* KDMKTONE */  /* KDMKTONE */
47  #include <linux/kd.h>  #include <linux/kd.h>
48    #endif /* __linux__ */
49    
50  #include "stack.h"  #include "stack.h"
51    
# Line 467  void print_h(value *stack_head, int noqu Line 470  void print_h(value *stack_head, int noqu
470        printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);        printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);
471      break;      break;
472    case symb:    case symb:
473      printf("%s", ((symbol *)(CAR(stack_head)->content.ptr))->id);      printf("%s", CAR(stack_head)->content.sym->id);
474      break;      break;
475    case func:    case func:
476      printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));      printf("#<function %p>", (funcp)(CAR(stack_head)->content.ptr));
# Line 594  extern void rcl(environment *env) Line 597  extern void rcl(environment *env)
597      return;      return;
598    }    }
599    
600    val= ((symbol *)(CAR(env->head)->content.ptr))->val;    val= CAR(env->head)->content.sym->val;
601    if(val == NULL){    if(val == NULL){
602      printerr("Unbound Variable");      printerr("Unbound Variable");
603      env->err= 3;      env->err= 3;
# Line 655  extern void eval(environment *env) Line 658  extern void eval(environment *env)
658        push_val(env, CAR(iterator));        push_val(env, CAR(iterator));
659                
660        if(CAR(env->head)->type==symb        if(CAR(env->head)->type==symb
661           && (((symbol*)(CAR(env->head)->content.ptr))->id[0]==';')) {           && CAR(env->head)->content.sym->id[0]==';') {
662          toss(env);          toss(env);
663          if(env->err) return;          if(env->err) return;
664                    
# Line 717  extern void pack(environment *env) Line 720  extern void pack(environment *env)
720    iterator= env->head;    iterator= env->head;
721    if(iterator==NULL    if(iterator==NULL
722       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
723       && ((symbol*)(CAR(iterator)->content.ptr))->id[0]=='[')) {       && CAR(iterator)->content.sym->id[0]=='[')) {
724      temp= NULL;      temp= NULL;
725      toss(env);      toss(env);
726    } else {    } else {
727      /* Search for first delimiter */      /* Search for first delimiter */
728      while(CDR(iterator)!=NULL      while(CDR(iterator)!=NULL
729            && (CAR(CDR(iterator))->type!=symb            && (CAR(CDR(iterator))->type!=symb
730             || ((symbol*)(CAR(CDR(iterator))->content.ptr))->id[0]!='['))             || CAR(CDR(iterator))->content.sym->id[0]!='['))
731        iterator= CDR(iterator);        iterator= CDR(iterator);
732            
733      /* Extract list */      /* Extract list */
# Line 883  extern void quit(environment *env) Line 886  extern void quit(environment *env)
886    if(env->free_string!=NULL)    if(env->free_string!=NULL)
887      free(env->free_string);      free(env->free_string);
888        
889    #ifdef __linux__
890    muntrace();    muntrace();
891    #endif
892    
893    exit(EXIT_SUCCESS);    exit(EXIT_SUCCESS);
894  }  }
# Line 940  extern void forget(environment *env) Line 945  extern void forget(environment *env)
945      return;      return;
946    }    }
947    
948    sym_id= ((symbol*)(CAR(stack_head)->content.ptr))->id;    sym_id= CAR(stack_head)->content.sym->id;
949    toss(env);    toss(env);
950    
951    return forget_sym(hash(env->symbols, sym_id));    return forget_sym(hash(env->symbols, sym_id));
# Line 958  int main(int argc, char **argv) Line 963  int main(int argc, char **argv)
963    
964    int c;                        /* getopt option character */    int c;                        /* getopt option character */
965    
966    #ifdef __linux__
967    mtrace();    mtrace();
968    #endif
969    
970    init_env(&myenv);    init_env(&myenv);
971    
# Line 1013  under certain conditions; type `copying; Line 1020  under certain conditions; type `copying;
1020        return EXIT_SUCCESS;      /* EOF */        return EXIT_SUCCESS;      /* EOF */
1021      } else if(myenv.head!=NULL      } else if(myenv.head!=NULL
1022                && CAR(myenv.head)->type==symb                && CAR(myenv.head)->type==symb
1023                && ((symbol*)(CAR(myenv.head)->content.ptr))->id[0]                && CAR(myenv.head)->content.sym->id[0]
1024                ==';') {                ==';') {
1025        toss(&myenv);             /* No error check in main */        toss(&myenv);             /* No error check in main */
1026        eval(&myenv);        eval(&myenv);
# Line 1362  extern void ifelse(environment *env) Line 1369  extern void ifelse(environment *env)
1369    eval(env);    eval(env);
1370  }  }
1371    
1372    extern void sx_656c7365(environment *env)
1373    {
1374      if(env->head==NULL || CDR(env->head)==NULL
1375         || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL) {
1376        printerr("Too Few Arguments");
1377        env->err= 1;
1378        return;
1379      }
1380    
1381      if(CAR(CDR(env->head))->type!=symb
1382         || strcmp(CAR(CDR(env->head))->content.sym->id, "if")!=0) {
1383        printerr("Bad Argument Type");
1384        env->err= 2;
1385        return;
1386      }
1387    
1388      swap(env); toss(env);
1389      ifelse(env);
1390    }
1391    
1392  /* "while" */  /* "while" */
1393  extern void sx_7768696c65(environment *env)  extern void sx_7768696c65(environment *env)
1394  {  {
# Line 1488  extern void foreach(environment *env) Line 1515  extern void foreach(environment *env)
1515      push_val(env, CAR(iterator));      push_val(env, CAR(iterator));
1516      push_val(env, loop);      push_val(env, loop);
1517      eval(env); if(env->err) return;      eval(env); if(env->err) return;
1518      if (CDR(iterator)->type == tcons){      if (iterator->type == tcons){
1519        iterator= CDR(iterator);        iterator= CDR(iterator);
1520      } else {      } else {
1521        printerr("Bad Argument Type"); /* Improper list */        printerr("Bad Argument Type"); /* Improper list */
# Line 1537  extern void to(environment *env) Line 1564  extern void to(environment *env)
1564    
1565    if(iterator==NULL    if(iterator==NULL
1566       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
1567           && ((symbol*)(CAR(iterator)->content.ptr))->id[0]=='[')) {           && CAR(iterator)->content.sym->id[0]=='[')) {
1568      temp= NULL;      temp= NULL;
1569      toss(env);      toss(env);
1570    } else {    } else {
1571      /* Search for first delimiter */      /* Search for first delimiter */
1572      while(CDR(iterator)!=NULL      while(CDR(iterator)!=NULL
1573            && (CAR(CDR(iterator))->type!=symb            && (CAR(CDR(iterator))->type!=symb
1574                || ((symbol*)(CAR(CDR(iterator))->content.ptr))->id[0]                || CAR(CDR(iterator))->content.sym->id[0]!='['))
               !='['))  
1575        iterator= CDR(iterator);        iterator= CDR(iterator);
1576            
1577      /* Extract list */      /* Extract list */
# Line 1653  extern void sx_72656164(environment *env Line 1679  extern void sx_72656164(environment *env
1679      return sx_72656164(env);      return sx_72656164(env);
1680  }  }
1681    
1682    #ifdef __linux__
1683  extern void beep(environment *env)  extern void beep(environment *env)
1684  {  {
1685    int freq, dur, period, ticks;    int freq, dur, period, ticks;
# Line 1695  extern void beep(environment *env) Line 1722  extern void beep(environment *env)
1722      abort();      abort();
1723    }    }
1724  }  }
1725    #endif /* __linux__ */
1726    
1727  /* "wait" */  /* "wait" */
1728  extern void sx_77616974(environment *env)  extern void sx_77616974(environment *env)
Legend:
Removed from v.1.104  
changed lines
  Added in v.1.107
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26