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

Diff of /stack/stack.c

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

revision 1.109 by masse, Thu Mar 14 10:39:11 2002 UTC revision 1.112 by teddy, Sat Mar 16 20:09:51 2002 UTC
# Line 60  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 78  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 188  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 203  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 223  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 328  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 425  extern void nl() Line 450  extern void nl()
450  /* Gets the type of a value */  /* Gets the type of a value */
451  extern void type(environment *env)  extern void type(environment *env)
452  {  {
453    int typenum;    if(env->head->type==empty) {
   
   if(env->head==NULL) {  
454      printerr("Too Few Arguments");      printerr("Too Few Arguments");
455      env->err= 1;      env->err= 1;
456      return;      return;
457    }    }
458    
459    typenum= CAR(env->head)->type;    switch(CAR(env->head)->type){
460    toss(env);    case empty:
461    switch(typenum){      push_sym(env, "empty");
462        break;
463    case integer:    case integer:
464      push_sym(env, "integer");      push_sym(env, "integer");
465      break;      break;
# Line 455  extern void type(environment *env) Line 479  extern void type(environment *env)
479      push_sym(env, "list");      push_sym(env, "list");
480      break;      break;
481    }    }
482      swap(env);
483      if (env->err) return;
484      toss(env);
485  }      }    
486    
487  /* Prints the top element of the stack. */  /* Prints the top element of the stack. */
488  void print_h(value *stack_head, int noquote)  void print_h(value *stack_head, int noquote)
489  {  {
490    switch(CAR(stack_head)->type) {    switch(CAR(stack_head)->type) {
491      case empty:
492        printf("[]");
493        break;
494    case integer:    case integer:
495      printf("%d", CAR(stack_head)->content.i);      printf("%d", CAR(stack_head)->content.i);
496      break;      break;
# Line 469  void print_h(value *stack_head, int noqu Line 499  void print_h(value *stack_head, int noqu
499      break;      break;
500    case string:    case string:
501      if(noquote)      if(noquote)
502        printf("%s", (char*)CAR(stack_head)->content.ptr);        printf("%s", (char*)(CAR(stack_head)->content.ptr));
503      else      else
504        printf("\"%s\"", (char*)CAR(stack_head)->content.ptr);        printf("\"%s\"", (char*)(CAR(stack_head)->content.ptr));
505      break;      break;
506    case symb:    case symb:
507      printf("%s", CAR(stack_head)->content.sym->id);      printf("%s", CAR(stack_head)->content.sym->id);
# Line 483  void print_h(value *stack_head, int noqu Line 513  void print_h(value *stack_head, int noqu
513      /* 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 */
514      stack_head= CAR(stack_head);      stack_head= CAR(stack_head);
515      printf("[ ");      printf("[ ");
516      while(stack_head != NULL) {      while(stack_head->type != empty) {
517        print_h(stack_head, noquote);        print_h(stack_head, noquote);
518        printf(" ");        switch(CDR(stack_head)->type){
519          case empty:
520            break;
521          case tcons:
522            printf(" ");
523            break;
524          default:
525            printf(" . ");          /* Improper list */
526          }
527        stack_head= CDR(stack_head);        stack_head= CDR(stack_head);
528      }      }
529      printf("]");      printf(" ]");
530      break;      break;
531    }    }
532  }  }
533    
534  extern void print_(environment *env)  extern void print_(environment *env)
535  {  {
536    if(env->head==NULL) {    if(env->head->type==empty) {
537      printerr("Too Few Arguments");      printerr("Too Few Arguments");
538      env->err= 1;      env->err= 1;
539      return;      return;
# Line 514  extern void print(environment *env) Line 552  extern void print(environment *env)
552    
553  extern void princ_(environment *env)  extern void princ_(environment *env)
554  {  {
555    if(env->head==NULL) {    if(env->head->type==empty) {
556      printerr("Too Few Arguments");      printerr("Too Few Arguments");
557      env->err= 1;      env->err= 1;
558      return;      return;
# Line 533  extern void princ(environment *env) Line 571  extern void princ(environment *env)
571  /* Only to be called by function printstack. */  /* Only to be called by function printstack. */
572  void print_st(value *stack_head, long counter)  void print_st(value *stack_head, long counter)
573  {  {
574    if(CDR(stack_head) != NULL)    if(CDR(stack_head)->type != empty)
575      print_st(CDR(stack_head), counter+1);      print_st(CDR(stack_head), counter+1);
576    printf("%ld: ", counter);    printf("%ld: ", counter);
577    print_h(stack_head, 0);    print_h(stack_head, 0);
# Line 543  void print_st(value *stack_head, long co Line 581  void print_st(value *stack_head, long co
581  /* Prints the stack. */  /* Prints the stack. */
582  extern void printstack(environment *env)  extern void printstack(environment *env)
583  {  {
584    if(env->head == NULL) {    if(env->head->type == empty) {
585      printf("Stack Empty\n");      printf("Stack Empty\n");
586      return;      return;
587    }    }
# Line 556  extern void swap(environment *env) Line 594  extern void swap(environment *env)
594  {  {
595    value *temp= env->head;    value *temp= env->head;
596        
597    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type == empty || CDR(env->head)->type == empty) {
598      printerr("Too Few Arguments");      printerr("Too Few Arguments");
599      env->err=1;      env->err=1;
600      return;      return;
# Line 572  extern void rot(environment *env) Line 610  extern void rot(environment *env)
610  {  {
611    value *temp= env->head;    value *temp= env->head;
612        
613    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type == empty || CDR(env->head)->type == empty
614       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type == empty) {
615      printerr("Too Few Arguments");      printerr("Too Few Arguments");
616      env->err= 1;      env->err= 1;
617      return;      return;
# Line 589  extern void rcl(environment *env) Line 627  extern void rcl(environment *env)
627  {  {
628    value *val;    value *val;
629    
630    if(env->head==NULL) {    if(env->head->type==empty) {
631      printerr("Too Few Arguments");      printerr("Too Few Arguments");
632      env->err= 1;      env->err= 1;
633      return;      return;
# Line 607  extern void rcl(environment *env) Line 645  extern void rcl(environment *env)
645      env->err= 3;      env->err= 3;
646      return;      return;
647    }    }
648    protect(val);    push_val(env, val);           /* Return the symbol's bound value */
649    toss(env);            /* toss the symbol */    swap(env);
650      if(env->err) return;
651      toss(env);                    /* toss the symbol */
652    if(env->err) return;    if(env->err) return;
   push_val(env, val); /* Return its bound value */  
   unprotect(val);  
653  }  }
654    
655  /* 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 627  extern void eval(environment *env) Line 665  extern void eval(environment *env)
665    
666    gc_maybe(env);    gc_maybe(env);
667    
668    if(env->head==NULL) {    if(env->head->type==empty) {
669      printerr("Too Few Arguments");      printerr("Too Few Arguments");
670      env->err= 1;      env->err= 1;
671      return;      return;
# Line 658  extern void eval(environment *env) Line 696  extern void eval(environment *env)
696      toss(env); if(env->err) return;      toss(env); if(env->err) return;
697      iterator= temp_val;      iterator= temp_val;
698            
699      while(iterator!=NULL) {      while(iterator->type != empty) {
700        push_val(env, CAR(iterator));        push_val(env, CAR(iterator));
701                
702        if(CAR(env->head)->type==symb        if(CAR(env->head)->type==symb
# Line 666  extern void eval(environment *env) Line 704  extern void eval(environment *env)
704          toss(env);          toss(env);
705          if(env->err) return;          if(env->err) return;
706                    
707          if(CDR(iterator)==NULL){          if(CDR(iterator)->type == empty){
708            goto eval_start;            goto eval_start;
709          }          }
710          eval(env);          eval(env);
711          if(env->err) return;          if(env->err) return;
712        }        }
713        if (CDR(iterator)->type == tcons)        if (CDR(iterator)->type == empty || CDR(iterator)->type == tcons)
714          iterator= CDR(iterator);          iterator= CDR(iterator);
715        else {        else {
716          printerr("Bad Argument Type"); /* Improper list */          printerr("Bad Argument Type"); /* Improper list */
# Line 693  extern void rev(environment *env) Line 731  extern void rev(environment *env)
731  {  {
732    value *old_head, *new_head, *item;    value *old_head, *new_head, *item;
733    
734    if(env->head==NULL) {    if(env->head->type==empty) {
735      printerr("Too Few Arguments");      printerr("Too Few Arguments");
736      env->err= 1;      env->err= 1;
737      return;      return;
738    }    }
739    
740      if(CAR(env->head)->type==empty)
741        return;                     /* Don't reverse an empty list */
742    
743    if(CAR(env->head)->type!=tcons) {    if(CAR(env->head)->type!=tcons) {
744      printerr("Bad Argument Type");      printerr("Bad Argument Type");
745      env->err= 2;      env->err= 2;
# Line 706  extern void rev(environment *env) Line 747  extern void rev(environment *env)
747    }    }
748    
749    old_head= CAR(env->head);    old_head= CAR(env->head);
750    new_head= NULL;    new_head= new_val(env);
751    while(old_head!=NULL) {    new_head->type= empty;
752      while(old_head->type != empty) {
753      item= old_head;      item= old_head;
754      old_head= CDR(old_head);      old_head= CDR(old_head);
755      CDR(item)= new_head;      CDR(item)= new_head;
# Line 719  extern void rev(environment *env) Line 761  extern void rev(environment *env)
761  /* Make a list. */  /* Make a list. */
762  extern void pack(environment *env)  extern void pack(environment *env)
763  {  {
764    value *iterator, *temp;    value *iterator, *temp, *ending;
765    
766      ending=new_val(env);
767      ending->type=empty;
768    
769    iterator= env->head;    iterator= env->head;
770    if(iterator==NULL    if(iterator->type == empty
771       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
772       && CAR(iterator)->content.sym->id[0]=='[')) {       && CAR(iterator)->content.sym->id[0]=='[')) {
773      temp= NULL;      temp= ending;
774      toss(env);      toss(env);
775    } else {    } else {
776      /* Search for first delimiter */      /* Search for first delimiter */
777      while(CDR(iterator)!=NULL      while(CDR(iterator)->type != empty
778            && (CAR(CDR(iterator))->type!=symb            && (CAR(CDR(iterator))->type!=symb
779             || CAR(CDR(iterator))->content.sym->id[0]!='['))             || CAR(CDR(iterator))->content.sym->id[0]!='['))
780        iterator= CDR(iterator);        iterator= CDR(iterator);
# Line 737  extern void pack(environment *env) Line 782  extern void pack(environment *env)
782      /* Extract list */      /* Extract list */
783      temp= env->head;      temp= env->head;
784      env->head= CDR(iterator);      env->head= CDR(iterator);
785      CDR(iterator)= NULL;      CDR(iterator)= ending;
786    
787      if(env->head!=NULL)      if(env->head->type != empty)
788        toss(env);        toss(env);
789    }    }
790    
# Line 755  extern void expand(environment *env) Line 800  extern void expand(environment *env)
800    value *temp, *new_head;    value *temp, *new_head;
801    
802    /* Is top element a list? */    /* Is top element a list? */
803    if(env->head==NULL) {    if(env->head->type==empty) {
804      printerr("Too Few Arguments");      printerr("Too Few Arguments");
805      env->err= 1;      env->err= 1;
806      return;      return;
# Line 778  extern void expand(environment *env) Line 823  extern void expand(environment *env)
823    toss(env);    toss(env);
824    
825    /* Find the end of the list */    /* Find the end of the list */
826    while(CDR(temp)->content.ptr != NULL) {    while(CDR(temp)->type != empty) {
827      if (CDR(temp)->type == tcons)      if (CDR(temp)->type == tcons)
828        temp= CDR(temp);        temp= CDR(temp);
829      else {      else {
# Line 799  extern void eq(environment *env) Line 844  extern void eq(environment *env)
844  {  {
845    void *left, *right;    void *left, *right;
846    
847    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
848      printerr("Too Few Arguments");      printerr("Too Few Arguments");
849      env->err= 1;      env->err= 1;
850      return;      return;
# Line 817  extern void not(environment *env) Line 862  extern void not(environment *env)
862  {  {
863    int val;    int val;
864    
865    if(env->head==NULL) {    if(env->head->type==empty) {
866      printerr("Too Few Arguments");      printerr("Too Few Arguments");
867      env->err= 1;      env->err= 1;
868      return;      return;
# Line 848  extern void def(environment *env) Line 893  extern void def(environment *env)
893    symbol *sym;    symbol *sym;
894    
895    /* 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 */
896    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
897      printerr("Too Few Arguments");      printerr("Too Few Arguments");
898      env->err= 1;      env->err= 1;
899      return;      return;
# Line 887  extern void quit(environment *env) Line 932  extern void quit(environment *env)
932    env->gc_limit= 0;    env->gc_limit= 0;
933    gc_maybe(env);    gc_maybe(env);
934    
935      words(env);
936    
937    if(env->free_string!=NULL)    if(env->free_string!=NULL)
938      free(env->free_string);      free(env->free_string);
939        
# Line 900  extern void quit(environment *env) Line 947  extern void quit(environment *env)
947  /* Clear stack */  /* Clear stack */
948  extern void clear(environment *env)  extern void clear(environment *env)
949  {  {
950    while(env->head!=NULL)    while(env->head->type != empty)
951      toss(env);      toss(env);
952  }  }
953    
# Line 913  extern void words(environment *env) Line 960  extern void words(environment *env)
960    for(i= 0; i<HASHTBLSIZE; i++) {    for(i= 0; i<HASHTBLSIZE; i++) {
961      temp= env->symbols[i];      temp= env->symbols[i];
962      while(temp!=NULL) {      while(temp!=NULL) {
963    #ifdef DEBUG
964          if (temp->val != NULL && temp->val->gc.flag.protect)
965            printf("(protected) ");
966    #endif /* DEBUG */
967        printf("%s\n", temp->id);        printf("%s\n", temp->id);
968        temp= temp->next;        temp= temp->next;
969      }      }
# Line 935  void forget_sym(symbol **hash_entry) Line 986  void forget_sym(symbol **hash_entry)
986  extern void forget(environment *env)  extern void forget(environment *env)
987  {  {
988    char* sym_id;    char* sym_id;
   value *stack_head= env->head;  
989    
990    if(stack_head==NULL) {    if(env->head->type==empty) {
991      printerr("Too Few Arguments");      printerr("Too Few Arguments");
992      env->err= 1;      env->err= 1;
993      return;      return;
994    }    }
995        
996    if(CAR(stack_head)->type!=symb) {    if(CAR(env->head)->type!=symb) {
997      printerr("Bad Argument Type");      printerr("Bad Argument Type");
998      env->err= 2;      env->err= 2;
999      return;      return;
1000    }    }
1001    
1002    sym_id= CAR(stack_head)->content.sym->id;    sym_id= CAR(env->head)->content.sym->id;
1003    toss(env);    toss(env);
1004    
1005    return forget_sym(hash(env->symbols, sym_id));    return forget_sym(hash(env->symbols, sym_id));
# Line 983  int main(int argc, char **argv) Line 1033  int main(int argc, char **argv)
1033          break;          break;
1034        case '?':        case '?':
1035          fprintf (stderr,          fprintf (stderr,
1036                   "Unknown option character `\\x%x'.\n",                   "Unknown option character '\\x%x'.\n",
1037                   optopt);                   optopt);
1038          return EX_USAGE;          return EX_USAGE;
1039        default:        default:
# Line 1002  int main(int argc, char **argv) Line 1052  int main(int argc, char **argv)
1052    if(myenv.interactive) {    if(myenv.interactive) {
1053      printf("Stack version $Revision$\n\      printf("Stack version $Revision$\n\
1054  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\  Copyright (C) 2002  Mats Alritzson and Teddy Hogeborn\n\
1055  Stack comes with ABSOLUTELY NO WARRANTY; for details type `warranty;'.\n\  Stack comes with ABSOLUTELY NO WARRANTY; for details type 'warranty;'.\n\
1056  This is free software, and you are welcome to redistribute it\n\  This is free software, and you are welcome to redistribute it\n\
1057  under certain conditions; type `copying;' for details.\n");  under certain conditions; type 'copying;' for details.\n");
1058    }    }
1059    
1060    while(1) {    while(1) {
# Line 1019  under certain conditions; type `copying; Line 1069  under certain conditions; type `copying;
1069        }        }
1070        myenv.err=0;        myenv.err=0;
1071      }      }
1072      sx_72656164(&myenv);      sx_72656164(&myenv);        /* "read" */
1073      if (myenv.err==4) {      if (myenv.err==4) {         /* EOF */
1074        return EXIT_SUCCESS;      /* EOF */        myenv.err=0;
1075      } else if(myenv.head!=NULL        quit(&myenv);
1076        } else if(myenv.head->type!=empty
1077                && CAR(myenv.head)->type==symb                && CAR(myenv.head)->type==symb
1078                && CAR(myenv.head)->content.sym->id[0]                && CAR(myenv.head)->content.sym->id[0]
1079                ==';') {                ==';') {
# Line 1044  extern void sx_2b(environment *env) Line 1095  extern void sx_2b(environment *env)
1095    char* new_string;    char* new_string;
1096    value *a_val, *b_val;    value *a_val, *b_val;
1097    
1098    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1099      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1100      env->err= 1;      env->err= 1;
1101      return;      return;
# Line 1122  extern void sx_2d(environment *env) Line 1173  extern void sx_2d(environment *env)
1173    int a, b;    int a, b;
1174    float fa, fb;    float fa, fb;
1175    
1176    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1177      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1178      env->err=1;      env->err=1;
1179      return;      return;
# Line 1182  extern void sx_3e(environment *env) Line 1233  extern void sx_3e(environment *env)
1233    int a, b;    int a, b;
1234    float fa, fb;    float fa, fb;
1235    
1236    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1237      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1238      env->err= 1;      env->err= 1;
1239      return;      return;
# Line 1298  value *copy_val(environment *env, value Line 1349  value *copy_val(environment *env, value
1349  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
1350  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
1351  {  {
1352    if(env->head==NULL) {    if(env->head->type==empty) {
1353      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1354      env->err= 1;      env->err= 1;
1355      return;      return;
# Line 1311  extern void sx_6966(environment *env) Line 1362  extern void sx_6966(environment *env)
1362  {  {
1363    int truth;    int truth;
1364    
1365    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1366      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1367      env->err= 1;      env->err= 1;
1368      return;      return;
# Line 1342  extern void ifelse(environment *env) Line 1393  extern void ifelse(environment *env)
1393  {  {
1394    int truth;    int truth;
1395    
1396    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1397       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type==empty) {
1398      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1399      env->err= 1;      env->err= 1;
1400      return;      return;
# Line 1375  extern void ifelse(environment *env) Line 1426  extern void ifelse(environment *env)
1426    
1427  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
1428  {  {
1429    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1430       || CDR(CDR(env->head))==NULL || CDR(CDR(CDR(env->head)))==NULL       || CDR(CDR(env->head))->type==empty || CDR(CDR(CDR(env->head)))->type==empty
1431       || CDR(CDR(CDR(CDR(env->head))))==NULL) {       || CDR(CDR(CDR(CDR(env->head))))->type==empty) {
1432      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1433      env->err= 1;      env->err= 1;
1434      return;      return;
# Line 1398  extern void sx_656c7365(environment *env Line 1449  extern void sx_656c7365(environment *env
1449    
1450  extern void then(environment *env)  extern void then(environment *env)
1451  {  {
1452    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1453       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type==empty) {
1454      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1455      env->err= 1;      env->err= 1;
1456      return;      return;
# Line 1422  extern void sx_7768696c65(environment *e Line 1473  extern void sx_7768696c65(environment *e
1473    int truth;    int truth;
1474    value *loop, *test;    value *loop, *test;
1475    
1476    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1477      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1478      env->err= 1;      env->err= 1;
1479      return;      return;
# Line 1468  extern void sx_666f72(environment *env) Line 1519  extern void sx_666f72(environment *env)
1519    value *loop;    value *loop;
1520    int foo1, foo2;    int foo1, foo2;
1521    
1522    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1523       || CDR(CDR(env->head))==NULL) {       || CDR(CDR(env->head))->type==empty) {
1524      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1525      env->err= 1;      env->err= 1;
1526      return;      return;
# Line 1516  extern void foreach(environment *env) Line 1567  extern void foreach(environment *env)
1567    value *loop, *foo;    value *loop, *foo;
1568    value *iterator;    value *iterator;
1569        
1570    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1571      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1572      env->err= 1;      env->err= 1;
1573      return;      return;
# Line 1559  extern void to(environment *env) Line 1610  extern void to(environment *env)
1610    int ending, start, i;    int ending, start, i;
1611    value *iterator, *temp;    value *iterator, *temp;
1612    
1613    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1614      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1615      env->err= 1;      env->err= 1;
1616      return;      return;
# Line 1589  extern void to(environment *env) Line 1640  extern void to(environment *env)
1640    
1641    iterator= env->head;    iterator= env->head;
1642    
1643    if(iterator==NULL    if(iterator->type==empty
1644       || (CAR(iterator)->type==symb       || (CAR(iterator)->type==symb
1645           && CAR(iterator)->content.sym->id[0]=='[')) {           && CAR(iterator)->content.sym->id[0]=='[')) {
1646      temp= NULL;      temp= NULL;
# Line 1711  extern void beep(environment *env) Line 1762  extern void beep(environment *env)
1762  {  {
1763    int freq, dur, period, ticks;    int freq, dur, period, ticks;
1764    
1765    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
1766      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1767      env->err= 1;      env->err= 1;
1768      return;      return;
# Line 1756  extern void sx_77616974(environment *env Line 1807  extern void sx_77616974(environment *env
1807  {  {
1808    int dur;    int dur;
1809    
1810    if(env->head==NULL) {    if(env->head->type==empty) {
1811      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1812      env->err= 1;      env->err= 1;
1813      return;      return;
# Line 1776  extern void sx_77616974(environment *env Line 1827  extern void sx_77616974(environment *env
1827    
1828  extern void copying(environment *env)  extern void copying(environment *env)
1829  {  {
1830    printf("GNU GENERAL PUBLIC LICENSE\n\    printf("                  GNU GENERAL PUBLIC LICENSE\n\
1831                         Version 2, June 1991\n\                         Version 2, June 1991\n\
1832  \n\  \n\
1833   Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\   Copyright (C) 1989, 1991 Free Software Foundation, Inc.\n\
# Line 2065  extern void sx_2a(environment *env) Line 2116  extern void sx_2a(environment *env)
2116    int a, b;    int a, b;
2117    float fa, fb;    float fa, fb;
2118    
2119    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2120      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2121      env->err= 1;      env->err= 1;
2122      return;      return;
# Line 2125  extern void sx_2f(environment *env) Line 2176  extern void sx_2f(environment *env)
2176    int a, b;    int a, b;
2177    float fa, fb;    float fa, fb;
2178    
2179    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2180      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2181      env->err= 1;      env->err= 1;
2182      return;      return;
# Line 2184  extern void mod(environment *env) Line 2235  extern void mod(environment *env)
2235  {  {
2236    int a, b;    int a, b;
2237    
2238    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2239      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2240      env->err= 1;      env->err= 1;
2241      return;      return;
# Line 2210  extern void sx_646976(environment *env) Line 2261  extern void sx_646976(environment *env)
2261  {  {
2262    int a, b;    int a, b;
2263        
2264    if(env->head==NULL || CDR(env->head)==NULL) {    if(env->head->type==empty || CDR(env->head)->type==empty) {
2265      printerr("Too Few Arguments");      printerr("Too Few Arguments");
2266      env->err= 1;      env->err= 1;
2267      return;      return;
Legend:
Removed from v.1.109  
changed lines
  Added in v.1.112
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26