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

Diff of /stack/symbols.c

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

revision 1.6 by masse, Mon Aug 11 14:31:48 2003 UTC revision 1.7 by masse, Tue Aug 12 07:15:29 2003 UTC
# Line 1038  extern void sx_77616974(environment *env Line 1038  extern void sx_77616974(environment *env
1038    usleep(dur);    usleep(dur);
1039  }  }
1040    
 /// XXXXXX  
   
1041    
1042  /* "*" */  /* "*" */
1043  extern void sx_2a(environment *env)  extern void sx_2a(environment *env)
# Line 1047  extern void sx_2a(environment *env) Line 1045  extern void sx_2a(environment *env)
1045    int a, b;    int a, b;
1046    float fa, fb;    float fa, fb;
1047    
1048    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
1049      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1050      return;      return;
1051    }    }
1052      
1053    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
1054      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
1055      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1056      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1064  extern void sx_2a(environment *env) Line 1060  extern void sx_2a(environment *env)
1060      return;      return;
1061    }    }
1062    
1063    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
1064      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
1065      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1066      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1075  extern void sx_2a(environment *env) Line 1070  extern void sx_2a(environment *env)
1070      return;      return;
1071    }    }
1072    
1073    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
1074      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
1075      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1076      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1086  extern void sx_2a(environment *env) Line 1080  extern void sx_2a(environment *env)
1080      return;      return;
1081    }    }
1082    
1083    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
1084      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
1085      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1086      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1107  extern void sx_2f(environment *env) Line 1100  extern void sx_2f(environment *env)
1100    int a, b;    int a, b;
1101    float fa, fb;    float fa, fb;
1102    
1103    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
1104      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1105      return;      return;
1106    }    }
1107      
1108    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
1109      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
1110      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1111      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1124  extern void sx_2f(environment *env) Line 1115  extern void sx_2f(environment *env)
1115      return;      return;
1116    }    }
1117    
1118    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
1119      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
1120      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1121      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1135  extern void sx_2f(environment *env) Line 1125  extern void sx_2f(environment *env)
1125      return;      return;
1126    }    }
1127    
1128    if(CAR(env->head)->type==tfloat    if(check_args(env, tfloat, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
1129      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
1130      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1131      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1146  extern void sx_2f(environment *env) Line 1135  extern void sx_2f(environment *env)
1135      return;      return;
1136    }    }
1137    
1138    if(CAR(env->head)->type==integer    if(check_args(env, integer, tfloat, empty)==0) {
      && CAR(CDR(env->head))->type==tfloat) {  
1139      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
1140      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1141      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 1166  extern void mod(environment *env) Line 1154  extern void mod(environment *env)
1154  {  {
1155    int a, b;    int a, b;
1156    
1157    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
1158      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1159      return;      return;
1160    }    }
1161      
1162    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
1163      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
1164      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1165      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1191  extern void mod(environment *env) Line 1177  extern void mod(environment *env)
1177  extern void sx_646976(environment *env)  extern void sx_646976(environment *env)
1178  {  {
1179    int a, b;    int a, b;
1180      
1181    if(env->head->type==empty || CDR(env->head)->type==empty) {    if(check_args(env, unknown, unknown, empty)==1) {
1182      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1183      return;      return;
1184    }    }
1185      
1186    if(CAR(env->head)->type==integer    if(check_args(env, integer, integer, empty)==0) {
      && CAR(CDR(env->head))->type==integer) {  
1187      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
1188      toss(env); if(env->err) return;      toss(env); if(env->err) return;
1189      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 1213  extern void sx_646976(environment *env) Line 1197  extern void sx_646976(environment *env)
1197    env->err= 2;    env->err= 2;
1198  }  }
1199    
1200    
1201  extern void setcar(environment *env)  extern void setcar(environment *env)
1202  {  {
1203    if(env->head->type==empty || CDR(env->head)->type==empty) {  
1204      switch(check_args(env, tcons, unknown, empty)) {
1205      case 1:
1206      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1207      return;      return;
1208    }    case 2:
   
   if(CDR(env->head)->type!=tcons) {  
1209      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1210      return;      return;
1211      default:
1212        break;
1213    }    }
1214    
1215    CAR(CAR(CDR(env->head)))=CAR(env->head);    CAR(CAR(CDR(env->head)))=CAR(env->head);
# Line 1233  extern void setcar(environment *env) Line 1218  extern void setcar(environment *env)
1218    
1219  extern void setcdr(environment *env)  extern void setcdr(environment *env)
1220  {  {
1221    if(env->head->type==empty || CDR(env->head)->type==empty) {  
1222      switch(check_args(env, tcons, unknown, empty)) {
1223      case 1:
1224      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1225      return;      return;
1226    }    case 2:
   
   if(CDR(env->head)->type!=tcons) {  
1227      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1228      return;      return;
1229      default:
1230        break;
1231    }    }
1232    
1233    CDR(CAR(CDR(env->head)))=CAR(env->head);    CDR(CAR(CDR(env->head)))=CAR(env->head);
# Line 1251  extern void setcdr(environment *env) Line 1236  extern void setcdr(environment *env)
1236    
1237  extern void car(environment *env)  extern void car(environment *env)
1238  {  {
1239    if(env->head->type==empty) {  
1240      switch(check_args(env, tcons, empty)) {
1241      case 1:
1242      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1243      return;      return;
1244    }    case 2:
   
   if(CAR(env->head)->type!=tcons) {  
1245      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1246      return;      return;
1247      default:
1248        break;
1249    }    }
1250    
1251    CAR(env->head)=CAR(CAR(env->head));    CAR(env->head)=CAR(CAR(env->head));
# Line 1268  extern void car(environment *env) Line 1253  extern void car(environment *env)
1253    
1254  extern void cdr(environment *env)  extern void cdr(environment *env)
1255  {  {
1256    if(env->head->type==empty) {  
1257      switch(check_args(env, tcons, empty)) {
1258      case 1:
1259      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1260      return;      return;
1261    }    case 2:
   
   if(CAR(env->head)->type!=tcons) {  
1262      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1263      return;      return;
1264      default:
1265        break;
1266    }    }
1267    
1268    CAR(env->head)=CDR(CAR(env->head));    CAR(env->head)=CDR(CAR(env->head));
# Line 1287  extern void cons(environment *env) Line 1272  extern void cons(environment *env)
1272  {  {
1273    value *val;    value *val;
1274    
1275    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, unknown, unknown, empty)) {
1276      case 1:
1277      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1278      return;      return;
1279      case 2:
1280        printerr(env, "Bad Argument Type");
1281        return;
1282      default:
1283        break;
1284    }    }
1285    
1286    val=new_val(env);    val=new_val(env);
# Line 1319  void assocgen(environment *env, funcp eq Line 1309  void assocgen(environment *env, funcp eq
1309    
1310    /* Needs two values on the stack, the top one must be an association    /* Needs two values on the stack, the top one must be an association
1311       list */       list */
1312    if(env->head->type==empty || CDR(env->head)->type==empty) {    switch(check_args(env, tcons, unknown, empty)) {
1313      case 1:
1314      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1315      return;      return;
1316    }    case 2:
   
   if(CAR(env->head)->type!=tcons) {  
1317      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1318      return;      return;
1319      default:
1320        break;
1321    }    }
1322    
1323    key=CAR(CDR(env->head));    key=CAR(CDR(env->head));
# Line 1406  extern void sx_6f70656e(environment *env Line 1395  extern void sx_6f70656e(environment *env
1395    value *new_port;    value *new_port;
1396    FILE *stream;    FILE *stream;
1397    
1398    if(env->head->type == empty || CDR(env->head)->type == empty) {    switch(check_args(env, string, string, empty)) {
1399      case 1:
1400      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err=1;  
1401      return;      return;
1402    }    case 2:
   
   if(CAR(env->head)->type != string  
      || CAR(CDR(env->head))->type != string) {  
1403      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1404      return;      return;
1405      default:
1406        break;
1407    }    }
1408    
1409    stream=fopen(CAR(CDR(env->head))->content.ptr,    stream=fopen(CAR(CDR(env->head))->content.ptr,
# Line 1446  extern void sx_636c6f7365(environment *e Line 1433  extern void sx_636c6f7365(environment *e
1433  {  {
1434    int ret;    int ret;
1435    
1436    if(env->head->type == empty) {    switch(check_args(env, port, empty)) {
1437      case 1:
1438      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err=1;  
1439      return;      return;
1440    }    case 2:
   
   if(CAR(env->head)->type != port) {  
1441      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1442      return;      return;
1443      default:
1444        break;
1445    }    }
1446    
1447    ret= fclose(CAR(env->head)->content.p);    ret= fclose(CAR(env->head)->content.p);
# Line 1469  extern void sx_636c6f7365(environment *e Line 1455  extern void sx_636c6f7365(environment *e
1455    toss(env);    toss(env);
1456  }  }
1457    
1458    
1459  extern void mangle(environment *env)  extern void mangle(environment *env)
1460  {  {
1461    char *new_string;    char *new_string;
1462    
1463    if(env->head->type==empty) {    switch(check_args(env, string, empty)) {
1464      case 1:
1465      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1466      return;      return;
1467    }    case 2:
   
   if(CAR(env->head)->type!=string) {  
1468      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1469      return;      return;
1470      default:
1471        break;
1472    }    }
1473    
1474    new_string= mangle_str(CAR(env->head)->content.string);    new_string= mangle_str(CAR(env->head)->content.string);
# Line 1503  extern void sx_666f726b(environment *env Line 1489  extern void sx_666f726b(environment *env
1489  extern void sx_77616974706964(environment *env)  extern void sx_77616974706964(environment *env)
1490  {  {
1491    
1492    if(env->head->type==empty) {    switch(check_args(env, integer, empty)) {
1493      case 1:
1494      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1495      return;      return;
1496    }    case 2:
   
   if(CAR(env->head)->type!=integer) {  
1497      printerr(env, "Bad Argument Type");      printerr(env, "Bad Argument Type");
     env->err= 2;  
1498      return;      return;
1499      default:
1500        break;
1501    }    }
1502    
1503    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
# Line 1523  extern void sx_77616974706964(environmen Line 1508  extern void sx_77616974706964(environmen
1508  /* Discard the top element of the stack. */  /* Discard the top element of the stack. */
1509  extern void toss(environment *env)  extern void toss(environment *env)
1510  {  {
1511    if(env->head->type==empty) {  
1512      switch(check_args(env, unknown, empty)) {
1513      case 1:
1514      printerr(env, "Too Few Arguments");      printerr(env, "Too Few Arguments");
     env->err= 1;  
1515      return;      return;
1516      case 2:
1517        printerr(env, "Bad Argument Type");
1518        return;
1519      default:
1520        break;
1521    }    }
1522      
1523    env->head= CDR(env->head); /* Remove the top stack item */    env->head= CDR(env->head); /* Remove the top stack item */
1524  }  }
1525    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26