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

Diff of /stack/stack.c

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

revision 1.55 by teddy, Fri Feb 8 00:59:34 2002 UTC revision 1.64 by teddy, Fri Feb 8 16:33:14 2002 UTC
# Line 48  typedef symbol *hashtbl[HASHTBLSIZE]; /* Line 48  typedef symbol *hashtbl[HASHTBLSIZE]; /*
48  typedef struct stackitem_struct  typedef struct stackitem_struct
49  {  {
50    value *item;                  /* The value on the stack */    value *item;                  /* The value on the stack */
51                                    /* (This is never NULL) */
52    struct stackitem_struct *next; /* Next item */    struct stackitem_struct *next; /* Next item */
53  } stackitem;  } stackitem;
54    
# Line 346  extern void type(environment *env){ Line 347  extern void type(environment *env){
347    case list:    case list:
348      push_sym(env, "list");      push_sym(env, "list");
349      break;      break;
   default:  
     push_sym(env, "unknown");  
     break;  
350    }    }
351  }      }    
352    
# Line 360  void print_h(stackitem *stack_head) Line 358  void print_h(stackitem *stack_head)
358      printf("%d", stack_head->item->content.val);      printf("%d", stack_head->item->content.val);
359      break;      break;
360    case string:    case string:
361      printf("\"%s\"", (char*)stack_head->item->content.ptr);      printf("%s", (char*)stack_head->item->content.ptr);
362      break;      break;
363    case symb:    case symb:
364      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);      printf("%s", ((symbol *)(stack_head->item->content.ptr))->id);
# Line 379  void print_h(stackitem *stack_head) Line 377  void print_h(stackitem *stack_head)
377      }      }
378      printf("]");      printf("]");
379      break;      break;
   default:  
     printf("#<unknown %p>", (stack_head->item->content.ptr));  
     break;  
380    }    }
381  }  }
382    
# Line 438  extern void swap(environment *env) Line 433  extern void swap(environment *env)
433    env->head->next= temp;    env->head->next= temp;
434  }  }
435    
436    /* Rotate the first three elements on the stack. */
437    extern void rot(environment *env)
438    {
439      stackitem *temp= env->head;
440      
441      if(env->head==NULL || env->head->next==NULL
442          || env->head->next->next==NULL) {
443        printerr("Too Few Arguments");
444        env->err=1;
445        return;
446      }
447    
448      env->head= env->head->next->next;
449      temp->next->next= env->head->next;
450      env->head->next= temp;
451    }
452    
453  /* Recall a value from a symbol, if bound */  /* Recall a value from a symbol, if bound */
454  extern void rcl(environment *env)  extern void rcl(environment *env)
455  {  {
# Line 484  extern void eval(environment *env) Line 496  extern void eval(environment *env)
496      return;      return;
497    }    }
498    
499     eval_start:
500    
501    switch(env->head->item->type) {    switch(env->head->item->type) {
502      /* if it's a symbol */      /* if it's a symbol */
503    case symb:    case symb:
504      rcl(env);                   /* get its contents */      rcl(env);                   /* get its contents */
505      if(env->err) return;      if(env->err) return;
506      if(env->head->item->type!=symb){ /* don't recurse symbols */      if(env->head->item->type!=symb){ /* don't recurse symbols */
507        eval(env);                        /* evaluate the value */        goto eval_start;
       return;  
508      }      }
509      break;      return;
510    
511      /* If it's a lone function value, run it */      /* If it's a lone function value, run it */
512    case func:    case func:
513      in_func= (funcp)(env->head->item->content.ptr);      in_func= (funcp)(env->head->item->content.ptr);
514      toss(env);      toss(env);
515      if(env->err) return;      if(env->err) return;
516      (*in_func)(env);      return (*in_func)(env);
     break;  
517    
518      /* If it's a list */      /* If it's a list */
519    case list:    case list:
# Line 510  extern void eval(environment *env) Line 522  extern void eval(environment *env)
522      toss(env);      toss(env);
523      if(env->err) return;      if(env->err) return;
524      iterator= (stackitem*)temp_val->content.ptr;      iterator= (stackitem*)temp_val->content.ptr;
525      while(iterator!=NULL && iterator->item!=NULL) {      while(iterator!=NULL) {
526        push_val(&(env->head), iterator->item);        push_val(&(env->head), iterator->item);
527        if(env->head->item->type==symb        if(env->head->item->type==symb
528          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {          && strcmp(";", ((symbol*)(env->head->item->content.ptr))->id)==0) {
529          toss(env);          toss(env);
530          if(env->err) return;          if(env->err) return;
531            if(iterator->next == NULL){
532              free_val(temp_val);
533              goto eval_start;
534            }
535          eval(env);          eval(env);
536          if(env->err) return;          if(env->err) return;
537        }        }
538        iterator= iterator->next;        iterator= iterator->next;
539      }      }
540      free_val(temp_val);      free_val(temp_val);
541      break;      return;
542    
543      /* If it's a string */      /* If it's a string */
544    case string:    case string:
# Line 532  extern void eval(environment *env) Line 548  extern void eval(environment *env)
548      if(env->err) return;      if(env->err) return;
549      temp_string= malloc(strlen((char*)temp_val->content.ptr)+5);      temp_string= malloc(strlen((char*)temp_val->content.ptr)+5);
550      strcpy(temp_string, "[ ");      strcpy(temp_string, "[ ");
551      strcat(temp_string, (char*)temp_val->content.ptr);      strcpy(temp_string+2, (char*)temp_val->content.ptr);
552        free_val(temp_val);
553      strcat(temp_string, " ]");      strcat(temp_string, " ]");
554      stack_read(env, temp_string);      stack_read(env, temp_string);
     eval(env);  
     if(env->err) return;  
     free_val(temp_val);  
555      free(temp_string);      free(temp_string);
556      break;      goto eval_start;
557    
558    case integer:    case integer:
559      break;      return;
560    }    }
561  }  }
562    
# Line 943  extern void sx_2b(environment *env) { Line 957  extern void sx_2b(environment *env) {
957    a=env->head->item->content.val;    a=env->head->item->content.val;
958    toss(env);    toss(env);
959    if(env->err) return;    if(env->err) return;
960    b=env->head->item->content.val;    if(env->head->item->refcount == 1)
961        env->head->item->content.val += a;
962      else {
963        b=env->head->item->content.val;
964        toss(env);
965        if(env->err) return;
966        push_int(&(env->head), a+b);
967      }
968    }
969    
970    /* - */
971    extern void sx_2d(environment *env) {
972      int a, b;
973    
974      if((env->head)==NULL || env->head->next==NULL) {
975        printerr("Too Few Arguments");
976        env->err=1;
977        return;
978      }
979      
980      if(env->head->item->type!=integer
981         || env->head->next->item->type!=integer) {
982        printerr("Bad Argument Type");
983        env->err=2;
984        return;
985      }
986      a=env->head->item->content.val;
987      toss(env);
988      if(env->err) return;
989      if(env->head->item->refcount == 1)
990        env->head->item->content.val -= a;
991      else {
992        b=env->head->item->content.val;
993        toss(env);
994        if(env->err) return;
995        push_int(&(env->head), b-a);
996      }
997    }
998    
999    /* > */
1000    extern void sx_3e(environment *env) {
1001      int a, b;
1002    
1003      if((env->head)==NULL || env->head->next==NULL) {
1004        printerr("Too Few Arguments");
1005        env->err=1;
1006        return;
1007      }
1008      
1009      if(env->head->item->type!=integer
1010         || env->head->next->item->type!=integer) {
1011        printerr("Bad Argument Type");
1012        env->err=2;
1013        return;
1014      }
1015      a=env->head->item->content.val;
1016    toss(env);    toss(env);
1017    if(env->err) return;    if(env->err) return;
1018    push_int(&(env->head), a+b);    if(env->head->item->refcount == 1)
1019        env->head->item->content.val = (env->head->item->content.val > a);
1020      else {
1021        b=env->head->item->content.val;
1022        toss(env);
1023        if(env->err) return;
1024        push_int(&(env->head), b>a);
1025      }
1026  }  }
1027    
1028  /* Return copy of a value */  /* Return copy of a value */
# Line 1003  extern void dup(environment *env) { Line 1079  extern void dup(environment *env) {
1079    }    }
1080    push_val(&(env->head), copy_val(env->head->item));    push_val(&(env->head), copy_val(env->head->item));
1081  }  }
1082    
1083    /* "if", If-Then */
1084    extern void sx_6966(environment *env) {
1085    
1086      int truth;
1087    
1088      if((env->head)==NULL || env->head->next==NULL) {
1089        printerr("Too Few Arguments");
1090        env->err=1;
1091        return;
1092      }
1093    
1094      if(env->head->next->item->type != integer) {
1095        printerr("Bad Argument Type");
1096        env->err=2;
1097        return;
1098      }
1099      
1100      swap(env);
1101      if(env->err) return;
1102      
1103      truth=env->head->item->content.val;
1104    
1105      toss(env);
1106      if(env->err) return;
1107    
1108      if(truth)
1109        eval(env);
1110      else
1111        toss(env);
1112    }
1113    
1114    /* If-Then-Else */
1115    extern void ifelse(environment *env) {
1116    
1117      int truth;
1118    
1119      if((env->head)==NULL || env->head->next==NULL
1120         || env->head->next->next==NULL) {
1121        printerr("Too Few Arguments");
1122        env->err=1;
1123        return;
1124      }
1125    
1126      if(env->head->next->next->item->type != integer) {
1127        printerr("Bad Argument Type");
1128        env->err=2;
1129        return;
1130      }
1131      
1132      rot(env);
1133      if(env->err) return;
1134      
1135      truth=env->head->item->content.val;
1136    
1137      toss(env);
1138      if(env->err) return;
1139    
1140      if(!truth)
1141        swap(env);
1142      if(env->err) return;
1143    
1144      toss(env);
1145      if(env->err) return;
1146    
1147      eval(env);
1148    }
1149    
1150    /* while */
1151    extern void sx_7768696c65(environment *env) {
1152    
1153      int truth;
1154      value *loop, *test;
1155    
1156      if((env->head)==NULL || env->head->next==NULL) {
1157        printerr("Too Few Arguments");
1158        env->err=1;
1159        return;
1160      }
1161    
1162      loop= env->head->item;
1163      loop->refcount++;
1164      toss(env); if(env->err) return;
1165    
1166      test= env->head->item;
1167      test->refcount++;
1168      toss(env); if(env->err) return;
1169    
1170      do {
1171        push_val(&(env->head), test);
1172        eval(env);
1173        
1174        if(env->head->item->type != integer) {
1175          printerr("Bad Argument Type");
1176          env->err=2;
1177          return;
1178        }
1179        
1180        truth= env->head->item->content.val;
1181        toss(env); if(env->err) return;
1182        
1183        if(truth) {
1184          push_val(&(env->head), loop);
1185          eval(env);
1186        } else {
1187          toss(env);
1188        }
1189      
1190      } while(truth);
1191    
1192      free_val(test);
1193      free_val(loop);
1194    }
Legend:
Removed from v.1.55  
changed lines
  Added in v.1.64
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26