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

Diff of /stack/stack.c

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

revision 1.106 by masse, Tue Mar 12 15:13:48 2002 UTC revision 1.111 by teddy, Sat Mar 16 19:09:54 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    /* assert */
41    #include <assert.h>
42    
43    #ifdef __linux__
44  /* mtrace, muntrace */  /* mtrace, muntrace */
45  #include <mcheck.h>  #include <mcheck.h>
46  /* ioctl */  /* ioctl */
47  #include <sys/ioctl.h>  #include <sys/ioctl.h>
48  /* KDMKTONE */  /* KDMKTONE */
49  #include <linux/kd.h>  #include <linux/kd.h>
50    #endif /* __linux__ */
51    
52  #include "stack.h"  #include "stack.h"
53    
# Line 55  void init_env(environment *env) Line 60  void init_env(environment *env)
60    env->gc_count= 0;    env->gc_count= 0;
61    env->gc_ref= NULL;    env->gc_ref= NULL;
62    
63    env->head= NULL;    env->head= new_val(env);
64      env->head->type= empty;
65    for(i= 0; i<HASHTBLSIZE; i++)    for(i= 0; i<HASHTBLSIZE; i++)
66      env->symbols[i]= NULL;      env->symbols[i]= NULL;
67    env->err= 0;    env->err= 0;
# Line 73  void printerr(const char* in_string) Line 79  void printerr(const char* in_string)
79  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
80  extern void toss(environment *env)  extern void toss(environment *env)
81  {  {
82    if(env->head==NULL) {    if(env->head->type==empty) {
83      printerr("Too Few Arguments");      printerr("Too Few Arguments");
84      env->err= 1;      env->err= 1;
85      return;      return;
# Line 118  value* new_val(environment *env) Line 124  value* new_val(environment *env)
124    stackitem *nitem= malloc(sizeof(stackitem));    stackitem *nitem= malloc(sizeof(stackitem));
125    
126    nval->content.ptr= NULL;    nval->content.ptr= NULL;
127      nval->type= integer;
128    
129    nitem->item= nval;    nitem->item= nval;
130    nitem->next= env->gc_ref;    nitem->next= env->gc_ref;
# Line 182  extern void gc_init(environment *env) Line 189  extern void gc_init(environment *env)
189    if(env->interactive)    if(env->interactive)
190      printf(".");      printf(".");
191    
   
192    env->gc_count= 0;    env->gc_count= 0;
193    
194    while(env->gc_ref!=NULL) {    /* Sweep unused values */    while(env->gc_ref!=NULL) {    /* Sweep unused values */
# Line 197  extern void gc_init(environment *env) Line 203  extern void gc_init(environment *env)
203        free(env->gc_ref);        /* Remove value */        free(env->gc_ref);        /* Remove value */
204        env->gc_ref= titem;        env->gc_ref= titem;
205        continue;        continue;
206      }      }
207    #ifdef DEBUG
208        printf("Kept value (%p)", env->gc_ref->item);
209        if(env->gc_ref->item->gc.flag.mark)
210          printf(" (marked)");
211        if(env->gc_ref->item->gc.flag.protect)
212          printf(" (protected)");
213        switch(env->gc_ref->item->type){
214        case integer:
215          printf(" integer: %d", env->gc_ref->item->content.i);
216          break;
217        case func:
218          printf(" func: %p", env->gc_ref->item->content.ptr);
219          break;
220        case symb:
221          printf(" symb: %s", env->gc_ref->item->content.sym->id);
222          break;
223        case tcons:
224          printf(" tcons: %p\t%p", env->gc_ref->item->content.c->car,
225                 env->gc_ref->item->content.c->cdr);
226          break;
227        default:
228          printf(" <unknown %d>", (env->gc_ref->item->type));
229        }
230        printf("\n");
231    #endif /* DEBUG */
232    
233      /* Keep values */          /* Keep values */    
234      env->gc_count += sizeof(value);      env->gc_count += sizeof(value);
# Line 217  extern void gc_init(environment *env) Line 248  extern void gc_init(environment *env)
248    env->gc_ref= new_head;    env->gc_ref= new_head;
249    
250    if(env->interactive)    if(env->interactive)
251      printf("done\n");      printf("done (%d bytes still allocated)\n", env->gc_count);
252    
253  }  }
254    
# Line 255  void push_val(environment *env, value *v Line 286  void push_val(environment *env, value *v
286    value *new_value= new_val(env);    value *new_value= new_val(env);
287    
288    new_value->content.c= malloc(sizeof(cons));    new_value->content.c= malloc(sizeof(cons));
289      assert(new_value->content.c!=NULL);
290    new_value->type= tcons;    new_value->type= tcons;
291    CAR(new_value)= val;    CAR(new_value)= val;
292    CDR(new_value)= env->head;    CDR(new_value)= env->head;
# Line 321  extern void mangle(environment *env) Line 353  extern void mangle(environment *env)
353  {  {
354    char *new_string;    char *new_string;
355    
356    if(env->head==NULL) {    if(env->head->type==empty) {
357      printerr("Too Few Arguments");      printerr("Too Few Arguments");
358      env->err= 1;      env->err= 1;
359      return;      return;
# Line 420  extern void type(environment *env) Line 452  extern void type(environment *env)
452  {  {
453    int typenum;    int typenum;
454    
455    if(env->head==NULL) {    if(env->head->type==empty) {
456      printerr("Too Few Arguments");      printerr("Too Few Arguments");
457      env->err= 1;      env->err= 1;
458      return;      return;
# Line 476  void print_h(value *stack_head, int noqu Line 508  void print_h(value *stack_head, int noqu
508      /* A list is just a stack, so make stack_head point to it */      /* A list is just a stack, so make stack_head point to it */
509      stack_head= CAR(stack_head);      stack_head= CAR(stack_head);
510      printf("[ ");      printf("[ ");
511      while(stack_head != NULL) {      while(CAR(stack_head)->type != empty) {
512        print_h(stack_head, noquote);        print_h(stack_head, noquote);
513        printf(" ");        if(CDR(stack_head)->type==tcons)
514            printf(" ");
515          else
516            printf(" . ");          /* Improper list */
517        stack_head= CDR(stack_head);        stack_head= CDR(stack_head);
518      }      }
519      printf("]");      printf(" ]");
520      break;      break;
521    }    }
522  }  }
523    
524  extern void print_(environment *env)  extern void print_(environment *env)
525  {  {
526    if(env->head==NULL) {    if(env->head->type==empty) {
527      printerr("Too Few Arguments");      printerr("Too Few Arguments");
528      env->err= 1;      env->err= 1;
529      return;      return;
# Line 507  extern void print(environment *env) Line 542  extern void print(environment *env)
542    
543  extern void princ_(environment *env)  extern void princ_(environment *env)
544  {  {
545    if(env->head==NULL) {    if(env->head->type==empty) {
546      printerr("Too Few Arguments");      printerr("Too Few Arguments");
547      env->err= 1;      env->err= 1;
548      return;      return;
# Line 526  extern void princ(environment *env) Line 561  extern void princ(environment *env)
561  /* Only to be called by function printstack. */  /* Only to be called by function printstack. */
562  void print_st(value *stack_head, long counter)  void print_st(value *stack_head, long counter)
563  {  {
564    if(CDR(stack_head) != NULL)    if(CDR(stack_head)->type != empty)
565      print_st(CDR(stack_head), counter+1);      print_st(CDR(stack_head), counter+1);
566    printf("%ld: ", counter);    printf("%ld: ", counter);
567    print_h(stack_head, 0);    print_h(stack_head, 0);
# Line 536  void print_st(value *stack_head, long co Line 571  void print_st(value *stack_head, long co
571  /* Prints the stack. */  /* Prints the stack. */
572  extern void printstack(environment *env)  extern void printstack(environment *env)
573  {  {
574    if(env->head == NULL) {    if(env->head->type == empty) {
575      printf("Stack Empty\n");      printf("Stack Empty\n");
576      return;      return;
577    }    }
# Line 549  extern void swap(environment *env) Line 584  extern void swap(environment *env)
584  {  {
585    value *temp= env->head;    value *temp= env->head;
586        
587    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type == empty || CDR(env->head)->type == empty) {
588      printerr("Too Few Arguments");      printerr("Too Few Arguments");
589      env->err=1;      env->err=1;
590      return;      return;
# Line 565  extern void rot(environment *env) Line 600  extern void rot(environment *env)
600  {  {
601    value *temp= env->head;    value *temp= env->head;
602        
603    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type == empty || CDR(env->head)->type == empty
604       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type == empty) {
605      printerr("Too Few Arguments");      printerr("Too Few Arguments");
606      env->err= 1;      env->err= 1;
607      return;      return;
# Line 582  extern void rcl(environment *env) Line 617  extern void rcl(environment *env)
617  {  {
618    value *val;    value *val;
619    
620    if(env->head==NULL) {    if(env->head->type==empty) {
621      printerr("Too Few Arguments");      printerr("Too Few Arguments");
622      env->err= 1;      env->err= 1;
623      return;      return;
# Line 600  extern void rcl(environment *env) Line 635  extern void rcl(environment *env)
635      env->err= 3;      env->err= 3;
636      return;      return;
637    }    }
638    protect(val);    push_val(env, val);           /* Return the symbol's bound value */
639    toss(env);            /* toss the symbol */    swap(env);
640      if(env->err) return;
641      toss(env);                    /* toss the symbol */
642    if(env->err) return;    if(env->err) return;
   push_val(env, val); /* Return its bound value */  
   unprotect(val);  
643  }  }
644    
645  /* If the top element is a symbol, determine if it's bound to a  /* If the top element is a symbol, determine if it's bound to a
# Line 620  extern void eval(environment *env) Line 655  extern void eval(environment *env)
655    
656    gc_maybe(env);    gc_maybe(env);
657    
658    if(env->head==NULL) {    if(env->head->type==empty) {
659      printerr("Too Few Arguments");      printerr("Too Few Arguments");
660      env->err= 1;      env->err= 1;
661      return;      return;
# Line 651  extern void eval(environment *env) Line 686  extern void eval(environment *env)
686      toss(env); if(env->err) return;      toss(env); if(env->err) return;
687      iterator= temp_val;      iterator= temp_val;
688            
689      while(iterator!=NULL) {      while(iterator->type != empty) {
690        push_val(env, CAR(iterator));        push_val(env, CAR(iterator));
691                
692        if(CAR(env->head)->type==symb        if(CAR(env->head)->type==symb
# Line 659  extern void eval(environment *env) Line 694  extern void eval(environment *env)
694          toss(env);          toss(env);
695          if(env->err) return;          if(env->err) return;
696                    
697          if(CDR(iterator)==NULL){          if(CDR(iterator)->type == empty){
698            goto eval_start;            goto eval_start;
699          }          }
700          eval(env);          eval(env);
701          if(env->err) return;          if(env->err) return;
702        }        }
703        if (CDR(iterator)->type == tcons)        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)
704          iterator= CDR(iterator);          iterator= CDR(iterator);
705        else {        else {
706          printerr("Bad Argument Type"); /* Improper list */          printerr("Bad Argument Type"); /* Improper list */
# Line 686  extern void rev(environment *env) Line 721  extern void rev(environment *env)
721  {  {
722    value *old_head, *new_head, *item;    value *old_head, *new_head, *item;
723    
724    if(env->head==NULL) {    if(env->head->type==empty) {
725      printerr("Too Few Arguments");      printerr("Too Few Arguments");
726      env->err= 1;      env->err= 1;
727      return;      return;
728    }    }
729    
730      if(CAR(env->head)->type==empty)
731        return;                     /* Don't reverse an empty list */
732    
733    if(CAR(env->head)->type!=tcons) {    if(CAR(env->head)->type!=tcons) {
734      printerr("Bad Argument Type");      printerr("Bad Argument Type");
735      env->err= 2;      env->err= 2;
# Line 699  extern void rev(environment *env) Line 737  extern void rev(environment *env)
737    }    }
738    
739    old_head= CAR(env->head);    old_head= CAR(env->head);
740    new_head= NULL;    new_head= new_val(env);
741    while(old_head!=NULL) {    new_head->type= empty;
742      while(old_head->type != empty) {
743      item= old_head;      item= old_head;
744      old_head= CDR(old_head);      old_head= CDR(old_head);
745      CDR(item)= new_head;      CDR(item)= new_head;
# Line 712  extern void rev(environment *env) Line 751  extern void rev(environment *env)
751  /* Make a list. */  /* Make a list. */
752  extern void pack(environment *env)  extern void pack(environment *env)
753  {  {
754    value *iterator, *temp;    value *iterator, *temp, *ending;
755    
756      ending=new_val(env);
757      ending->type=empty;
758    
759    iterator= env->head;    iterator= env->head;
760    if(iterator==NULL    if(iterator->type == empty
761       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
762       && CAR(iterator)->content.sym->id[0]=='[')) {       && CAR(iterator)->content.sym->id[0]=='[')) {
763      temp= NULL;      temp= ending;
764      toss(env);      toss(env);
765    } else {    } else {
766      /* Search for first delimiter */      /* Search for first delimiter */
767      while(CDR(iterator)!=NULL      while(CDR(iterator)->type != empty
768            && (CAR(CDR(iterator))->type!=symb            && (CAR(CDR(iterator))->type!=symb
769             || CAR(CDR(iterator))->content.sym->id[0]!='['))             || CAR(CDR(iterator))->content.sym->id[0]!='['))
770        iterator= CDR(iterator);        iterator= CDR(iterator);
# Line 730  extern void pack(environment *env) Line 772  extern void pack(environment *env)
772      /* Extract list */      /* Extract list */
773      temp= env->head;      temp= env->head;
774      env->head= CDR(iterator);      env->head= CDR(iterator);
775      CDR(iterator)= NULL;      CDR(iterator)= ending;
776    
777      if(env->head!=NULL)      if(env->head->type != empty)
778        toss(env);        toss(env);
779    }    }
780    
# Line 748  extern void expand(environment *env) Line 790  extern void expand(environment *env)
790    value *temp, *new_head;    value *temp, *new_head;
791    
792    /* Is top element a list? */    /* Is top element a list? */
793    if(env->head==NULL) {    if(env->head->type==empty) {
794      printerr("Too Few Arguments");      printerr("Too Few Arguments");
795      env->err= 1;      env->err= 1;
796      return;      return;
# Line 771  extern void expand(environment *env) Line 813  extern void expand(environment *env)
813    toss(env);    toss(env);
814    
815    /* Find the end of the list */    /* Find the end of the list */
816    while(CDR(temp)->content.ptr != NULL) {    while(CDR(temp)->type != empty) {
817      if (CDR(temp)->type == tcons)      if (CDR(temp)->type == tcons)
818        temp= CDR(temp);        temp= CDR(temp);
819      else {      else {
# Line 792  extern void eq(environment *env) Line 834  extern void eq(environment *env)
834  {  {
835    void *left, *right;    void *left, *right;
836    
837    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
838      printerr("Too Few Arguments");      printerr("Too Few Arguments");
839      env->err= 1;      env->err= 1;
840      return;      return;
# Line 810  extern void not(environment *env) Line 852  extern void not(environment *env)
852  {  {
853    int val;    int val;
854    
855    if(env->head==NULL) {    if(env->head->type==empty) {
856      printerr("Too Few Arguments");      printerr("Too Few Arguments");
857      env->err= 1;      env->err= 1;
858      return;      return;
# Line 841  extern void def(environment *env) Line 883  extern void def(environment *env)
883    symbol *sym;    symbol *sym;
884    
885    /* Needs two values on the stack, the top one must be a symbol */    /* Needs two values on the stack, the top one must be a symbol */
886    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
887      printerr("Too Few Arguments");      printerr("Too Few Arguments");
888      env->err= 1;      env->err= 1;
889      return;      return;
# Line 880  extern void quit(environment *env) Line 922  extern void quit(environment *env)
922    env->gc_limit= 0;    env->gc_limit= 0;
923    gc_maybe(env);    gc_maybe(env);
924    
925      words(env);
926    
927    if(env->free_string!=NULL)    if(env->free_string!=NULL)
928      free(env->free_string);      free(env->free_string);
929        
930    #ifdef __linux__
931    muntrace();    muntrace();
932    #endif
933    
934    exit(EXIT_SUCCESS);    exit(EXIT_SUCCESS);
935  }  }
# Line 891  extern void quit(environment *env) Line 937  extern void quit(environment *env)
937  /* Clear stack */  /* Clear stack */
938  extern void clear(environment *env)  extern void clear(environment *env)
939  {  {
940    while(env->head!=NULL)    while(env->head->type != empty)
941      toss(env);      toss(env);
942  }  }
943    
# Line 904  extern void words(environment *env) Line 950  extern void words(environment *env)
950    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
951      temp= env->symbols[i];      temp= env->symbols[i];
952      while(temp!=NULL) {      while(temp!=NULL) {
953    #ifdef DEBUG
954          if (temp->val != NULL && temp->val->gc.flag.protect)
955            printf("(protected) ");
956    #endif /* DEBUG */
957        printf("%s\n", temp->id);        printf("%s\n", temp->id);
958        temp= temp->next;        temp= temp->next;
959      }      }
# Line 926  void forget_sym(symbol **hash_entry) Line 976  void forget_sym(symbol **hash_entry)
976  extern void forget(environment *env)  extern void forget(environment *env)
977  {  {
978    char* sym_id;    char* sym_id;
   value *stack_head= env->head;  
979    
980    if(stack_head==NULL) {    if(env->head->type==empty) {
981      printerr("Too Few Arguments");      printerr("Too Few Arguments");
982      env->err= 1;      env->err= 1;
983      return;      return;
984    }    }
985        
986    if(CAR(stack_head)->type!=symb) {    if(CAR(env->head)->type!=symb) {
987      printerr("Bad Argument Type");      printerr("Bad Argument Type");
988      env->err= 2;      env->err= 2;
989      return;      return;
990    }    }
991    
992    sym_id= CAR(stack_head)->content.sym->id;    sym_id= CAR(env->head)->content.sym->id;
993    toss(env);    toss(env);
994    
995    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 1007  int main(int argc, char **argv)
1007    
1008    int c;                        /* getopt option character */    int c;                        /* getopt option character */
1009    
1010    #ifdef __linux__
1011    mtrace();    mtrace();
1012    #endif
1013    
1014    init_env(&myenv);    init_env(&myenv);
1015    
# Line 972  int main(int argc, char **argv) Line 1023  int main(int argc, char **argv)
1023          break;          break;
1024        case '?':        case '?':
1025          fprintf (stderr,          fprintf (stderr,
1026                   "Unknown option character `\\x%x'.\n",                   "Unknown option character '\\x%x'.\n",
1027                   optopt);                   optopt);
1028          return EX_USAGE;          return EX_USAGE;
1029        default:        default:
# Line 991  int main(int argc, char **argv) Line 1042  int main(int argc, char **argv)
1042    if(myenv.interactive) {    if(myenv.interactive) {
1043      printf("Stack version $Revision$\n\      printf("Stack version $Revision$\n\
1044  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
1045  Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\n\  Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
1046  This is free software, and you are welcome to redistribute it\n\  This is free software, and you are welcome to redistribute it\n\
1047  under certain conditions; type `copying;' for details.\n");  under certain conditions; type 'copying;' for details.\n");
1048    }    }
1049    
1050    while(1) {    while(1) {
# Line 1008  under certain conditions; type `copying; Line 1059  under certain conditions; type `copying;
1059        }        }
1060        myenv.err=0;        myenv.err=0;
1061      }      }
1062      sx_72656164(&myenv);      sx_72656164(&myenv);        /* "read" */
1063      if (myenv.err==4) {      if (myenv.err==4) {         /* EOF */
1064        return EXIT_SUCCESS;      /* EOF */        myenv.err=0;
1065      } else if(myenv.head!=NULL        quit(&myenv);
1066        } else if(myenv.head->type!=empty
1067                && CAR(myenv.head)->type==symb                && CAR(myenv.head)->type==symb
1068                && CAR(myenv.head)->content.sym->id[0]                && CAR(myenv.head)->content.sym->id[0]
1069                ==';') {                ==';') {
# Line 1033  extern void sx_2b(environment *env) Line 1085  extern void sx_2b(environment *env)
1085    char* new_string;    char* new_string;
1086    value *a_val, *b_val;    value *a_val, *b_val;
1087    
1088    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1089      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1090      env->err= 1;      env->err= 1;
1091      return;      return;
# Line 1111  extern void sx_2d(environment *env) Line 1163  extern void sx_2d(environment *env)
1163    int a, b;    int a, b;
1164    float fa, fb;    float fa, fb;
1165    
1166    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1167      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1168      env->err=1;      env->err=1;
1169      return;      return;
# Line 1171  extern void sx_3e(environment *env) Line 1223  extern void sx_3e(environment *env)
1223    int a, b;    int a, b;
1224    float fa, fb;    float fa, fb;
1225    
1226    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1227      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1228      env->err= 1;      env->err= 1;
1229      return;      return;
# Line 1256  value *copy_val(environment *env, value Line 1308  value *copy_val(environment *env, value
1308    
1309    protect(old_value);    protect(old_value);
1310    new_value= new_val(env);    new_value= new_val(env);
   protect(new_value);  
1311    new_value->type= old_value->type;    new_value->type= old_value->type;
1312    
1313    switch(old_value->type){    switch(old_value->type){
# Line 1271  value *copy_val(environment *env, value Line 1322  value *copy_val(environment *env, value
1322        strdup((char *)(old_value->content.ptr));        strdup((char *)(old_value->content.ptr));
1323      break;      break;
1324    case tcons:    case tcons:
     new_value= NULL;  
1325    
1326      new_value->content.c= malloc(sizeof(cons));      new_value->content.c= malloc(sizeof(cons));
1327        assert(new_value->content.c!=NULL);
1328    
1329      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */      CAR(new_value)= copy_val(env, CAR(old_value)); /* recurse */
1330      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */      CDR(new_value)= copy_val(env, CDR(old_value)); /* recurse */
1331      break;      break;
1332    }    }
1333    
1334    unprotect(old_value); unprotect(new_value);    unprotect(old_value);
1335    
1336    return new_value;    return new_value;
1337  }  }
# Line 1287  value *copy_val(environment *env, value Line 1339  value *copy_val(environment *env, value
1339  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1340  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
1341  {  {
1342    if(env->head==NULL) {    if(env->head->type==empty) {
1343      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1344      env->err= 1;      env->err= 1;
1345      return;      return;
# Line 1300  extern void sx_6966(environment *env) Line 1352  extern void sx_6966(environment *env)
1352  {  {
1353    int truth;    int truth;
1354    
1355    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1356      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1357      env->err= 1;      env->err= 1;
1358      return;      return;
# Line 1331  extern void ifelse(environment *env) Line 1383  extern void ifelse(environment *env)
1383  {  {
1384    int truth;    int truth;
1385    
1386    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1387       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type==empty) {
1388      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1389      env->err= 1;      env->err= 1;
1390      return;      return;
# Line 1364  extern void ifelse(environment *env) Line 1416  extern void ifelse(environment *env)
1416    
1417  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
1418  {  {
1419    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1420       || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL) {       || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty
1421         || CDR(CDR(CDR(CDR(env->head))))->type==empty) {
1422        printerr("Too Few Arguments");
1423        env->err= 1;
1424        return;
1425      }
1426    
1427      if(CAR(CDR(env->head))->type!=symb
1428         || strcmp(CAR(CDR(env->head))->content.sym->id, "then")!=0
1429         || CAR(CDR(CDR(CDR(env->head))))->type!=symb
1430         || strcmp(CAR(CDR(CDR(CDR(env->head))))->content.sym->id, "if")!=0) {
1431        printerr("Bad Argument Type");
1432        env->err= 2;
1433        return;
1434      }
1435    
1436      swap(env); toss(env); rot(env); toss(env);
1437      ifelse(env);
1438    }
1439    
1440    extern void then(environment *env)
1441    {
1442      if(env->head->type==empty || CDR(env->head)->type==empty
1443         || CDR(CDR(env->head))->type==empty) {
1444      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1445      env->err= 1;      env->err= 1;
1446      return;      return;
# Line 1379  extern void sx_656c7365(environment *env Line 1454  extern void sx_656c7365(environment *env
1454    }    }
1455    
1456    swap(env); toss(env);    swap(env); toss(env);
1457    ifelse(env);    sx_6966(env);
1458  }  }
1459    
1460  /* "while" */  /* "while" */
# Line 1388  extern void sx_7768696c65(environment *e Line 1463  extern void sx_7768696c65(environment *e
1463    int truth;    int truth;
1464    value *loop, *test;    value *loop, *test;
1465    
1466    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1467      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1468      env->err= 1;      env->err= 1;
1469      return;      return;
# Line 1434  extern void sx_666f72(environment *env) Line 1509  extern void sx_666f72(environment *env)
1509    value *loop;    value *loop;
1510    int foo1, foo2;    int foo1, foo2;
1511    
1512    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1513       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type==empty) {
1514      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1515      env->err= 1;      env->err= 1;
1516      return;      return;
# Line 1482  extern void foreach(environment *env) Line 1557  extern void foreach(environment *env)
1557    value *loop, *foo;    value *loop, *foo;
1558    value *iterator;    value *iterator;
1559        
1560    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1561      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1562      env->err= 1;      env->err= 1;
1563      return;      return;
# Line 1525  extern void to(environment *env) Line 1600  extern void to(environment *env)
1600    int ending, start, i;    int ending, start, i;
1601    value *iterator, *temp;    value *iterator, *temp;
1602    
1603    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1604      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1605      env->err= 1;      env->err= 1;
1606      return;      return;
# Line 1555  extern void to(environment *env) Line 1630  extern void to(environment *env)
1630    
1631    iterator= env->head;    iterator= env->head;
1632    
1633    if(iterator==NULL    if(iterator->type==empty
1634       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
1635           && CAR(iterator)->content.sym->id[0]=='[')) {           && CAR(iterator)->content.sym->id[0]=='[')) {
1636      temp= NULL;      temp= NULL;
# Line 1672  extern void sx_72656164(environment *env Line 1747  extern void sx_72656164(environment *env
1747      return sx_72656164(env);      return sx_72656164(env);
1748  }  }
1749    
1750    #ifdef __linux__
1751  extern void beep(environment *env)  extern void beep(environment *env)
1752  {  {
1753    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1754    
1755    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1756      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1757      env->err= 1;      env->err= 1;
1758      return;      return;
# Line 1714  extern void beep(environment *env) Line 1790  extern void beep(environment *env)
1790      abort();      abort();
1791    }    }
1792  }  }
1793    #endif /* __linux__ */
1794    
1795  /* "wait" */  /* "wait" */
1796  extern void sx_77616974(environment *env)  extern void sx_77616974(environment *env)
1797  {  {
1798    int dur;    int dur;
1799    
1800    if(env->head==NULL) {    if(env->head->type==empty) {
1801      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1802      env->err= 1;      env->err= 1;
1803      return;      return;
# Line 1740  extern void sx_77616974(environment *env Line 1817  extern void sx_77616974(environment *env
1817    
1818  extern void copying(environment *env)  extern void copying(environment *env)
1819  {  {
1820    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("                  GNU GENERAL PUBLIC LICENSE\n\
1821                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1822  \n\  \n\
1823   Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\   Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\
# Line 2029  extern void sx_2a(environment *env) Line 2106  extern void sx_2a(environment *env)
2106    int a, b;    int a, b;
2107    float fa, fb;    float fa, fb;
2108    
2109    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2110      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2111      env->err= 1;      env->err= 1;
2112      return;      return;
# Line 2089  extern void sx_2f(environment *env) Line 2166  extern void sx_2f(environment *env)
2166    int a, b;    int a, b;
2167    float fa, fb;    float fa, fb;
2168    
2169    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2170      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2171      env->err= 1;      env->err= 1;
2172      return;      return;
# Line 2148  extern void mod(environment *env) Line 2225  extern void mod(environment *env)
2225  {  {
2226    int a, b;    int a, b;
2227    
2228    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2229      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2230      env->err= 1;      env->err= 1;
2231      return;      return;
# Line 2174  extern void sx_646976(environment *env) Line 2251  extern void sx_646976(environment *env)
2251  {  {
2252    int a, b;    int a, b;
2253        
2254    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2255      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2256      env->err= 1;      env->err= 1;
2257      return;      return;
Legend:
Removed from v.1.106  
changed lines
  Added in v.1.111
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26