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

Diff of /stack/stack.c

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

revision 1.110 by teddy, Sat Mar 16 09:12:39 2002 UTC revision 1.111 by teddy, Sat Mar 16 19:09:54 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 352  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 451  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 507  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 538  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 557  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 567  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 580  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 596  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 613  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 651  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 682  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 690  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)==NULL || 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 717  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 730  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 743  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 761  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 779  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 802  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 823  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 841  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 872  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 926  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 965  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 1053  under certain conditions; type 'copying; Line 1063  under certain conditions; type 'copying;
1063      if (myenv.err==4) {         /* EOF */      if (myenv.err==4) {         /* EOF */
1064        myenv.err=0;        myenv.err=0;
1065        quit(&myenv);        quit(&myenv);
1066      } else if(myenv.head!=NULL      } 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 1075  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 1153  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 1213  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 1329  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 1342  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 1373  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 1406  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))))==NULL) {       || CDR(CDR(CDR(CDR(env->head))))->type==empty) {
1422      printerr("Too Few Arguments");      printerr("Too Few Arguments");
1423      env->err= 1;      env->err= 1;
1424      return;      return;
# Line 1429  extern void sx_656c7365(environment *env Line 1439  extern void sx_656c7365(environment *env
1439    
1440  extern void then(environment *env)  extern void then(environment *env)
1441  {  {
1442    if(env->head==NULL || CDR(env->head)==NULL    if(env->head->type==empty || CDR(env->head)->type==empty
1443       || CDR(CDR(env->head))==NULL) {       || 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 1453  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 1499  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 1547  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 1590  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 1620  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 1742  extern void beep(environment *env) Line 1752  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 1787  extern void sx_77616974(environment *env Line 1797  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 1807  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 2096  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 2156  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 2215  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 2241  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.110  
changed lines
  Added in v.1.111
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26