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

Diff of /stack/symbols.c

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

revision 1.9 by masse, Wed Aug 13 11:58:00 2003 UTC revision 1.10 by masse, Mon Aug 18 14:39:16 2003 UTC
# Line 10  extern void nl(environment *env) Line 10  extern void nl(environment *env)
10  /* Print a newline to a port */  /* Print a newline to a port */
11  extern void nlport(environment *env)  extern void nlport(environment *env)
12  {  {
13    if(check_args(env, port, empty))    if(check_args(env, 1, port))
14      return printerr(env);      return printerr(env);
15    
16    if(fprintf(CAR(env->head)->content.p, "\n") < 0){    if(fprintf(CAR(env->head)->content.p, "\n") < 0) {
     perror("nl");  
17      env->err= 5;      env->err= 5;
18      return;      return printerr(env);
19    }    }
20    
21    toss(env);    toss(env);
22  }  }
23    
# Line 25  extern void nlport(environment *env) Line 25  extern void nlport(environment *env)
25  extern void type(environment *env)  extern void type(environment *env)
26  {  {
27    
28    if(check_args(env, unknown, empty))    if(check_args(env, 1, unknown))
29      return printerr(env);      return printerr(env);
30    
31    switch(CAR(env->head)->type){    switch(CAR(env->head)->type){
# Line 66  extern void type(environment *env) Line 66  extern void type(environment *env)
66  extern void print_(environment *env)  extern void print_(environment *env)
67  {  {
68    
69    if(check_args(env, unknown, empty))    if(check_args(env, 1, unknown))
70      return printerr(env);      return printerr(env);
71    
72    print_val(env, CAR(env->head), 0, NULL, stdout);    print_val(env, CAR(env->head), 0, NULL, stdout);
# Line 87  extern void print(environment *env) Line 87  extern void print(environment *env)
87  extern void princ_(environment *env)  extern void princ_(environment *env)
88  {  {
89    
90    if(check_args(env, unknown, empty))    if(check_args(env, 1, unknown))
91      return printerr(env);      return printerr(env);
92    
93    print_val(env, CAR(env->head), 1, NULL, stdout);    print_val(env, CAR(env->head), 1, NULL, stdout);
# Line 105  extern void princ(environment *env) Line 105  extern void princ(environment *env)
105  extern void printport_(environment *env)  extern void printport_(environment *env)
106  {  {
107    
108    if(check_args(env, port, unknown, empty))    if(check_args(env, 2, port, unknown))
109      return printerr(env);      return printerr(env);
110    
111    print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p);    print_val(env, CAR(CDR(env->head)), 0, NULL, CAR(env->head)->content.p);
# Line 125  extern void printport(environment *env) Line 125  extern void printport(environment *env)
125  extern void princport_(environment *env)  extern void princport_(environment *env)
126  {  {
127    
128    if(check_args(env, port, unknown, empty))    if(check_args(env, 2, port, unknown))
129      return printerr(env);      return printerr(env);
130    
131    print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p);    print_val(env, CAR(CDR(env->head)), 1, NULL, CAR(env->head)->content.p);
# Line 145  extern void rot(environment *env) Line 145  extern void rot(environment *env)
145  {  {
146    value *temp= env->head;    value *temp= env->head;
147    
148    if(check_args(env, unknown, unknown, unknown, empty))    if(check_args(env, 3, unknown, unknown, unknown))
149      return printerr(env);      return printerr(env);
150        
151    env->head= CDR(CDR(env->head));    env->head= CDR(CDR(env->head));
# Line 158  extern void expand(environment *env) Line 158  extern void expand(environment *env)
158  {  {
159    value *temp, *new_head;    value *temp, *new_head;
160    
161    if(check_args(env, tcons, empty))    if(check_args(env, 1, tcons))
162      return printerr(env);      return printerr(env);
163    
164    rev(env);    rev(env);
# Line 193  extern void eq(environment *env) Line 193  extern void eq(environment *env)
193  {  {
194    void *left, *right;    void *left, *right;
195    
196    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, unknown, unknown))
197      return printerr(env);      return printerr(env);
198    
199    left= CAR(env->head)->content.ptr;    left= CAR(env->head)->content.ptr;
# Line 208  extern void not(environment *env) Line 208  extern void not(environment *env)
208  {  {
209    int val;    int val;
210    
211    if(check_args(env, integer, empty))    if(check_args(env, 1, integer))
212      return printerr(env);      return printerr(env);
213    
214    val= CAR(env->head)->content.i;    val= CAR(env->head)->content.i;
# Line 229  extern void def(environment *env) Line 229  extern void def(environment *env)
229    symbol *sym;    symbol *sym;
230    
231    /* 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 */
232    if(check_args(env, symb, unknown, empty))    if(check_args(env, 2, symb, unknown))
233      return printerr(env);      return printerr(env);
234    
235    /* long names are a pain */    /* long names are a pain */
# Line 252  extern void forget(environment *env) Line 252  extern void forget(environment *env)
252  {  {
253    char* sym_id;    char* sym_id;
254    
255    if(check_args(env, symb, empty))    if(check_args(env, 1, symb))
256      return printerr(env);      return printerr(env);
257    
258    sym_id= CAR(env->head)->content.sym->id;    sym_id= CAR(env->head)->content.sym->id;
# Line 276  extern void sx_2b(environment *env) Line 276  extern void sx_2b(environment *env)
276    char* new_string;    char* new_string;
277    value *a_val, *b_val;    value *a_val, *b_val;
278    
279    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, string, string)==0) {
     return printerr(env);  
   
   if(check_args(env, string, string, empty)==0) {  
280      a_val= CAR(env->head);      a_val= CAR(env->head);
281      b_val= CAR(CDR(env->head));      b_val= CAR(CDR(env->head));
282      protect(a_val); protect(b_val);      protect(a_val); protect(b_val);
# Line 297  extern void sx_2b(environment *env) Line 294  extern void sx_2b(environment *env)
294      return;      return;
295    }    }
296        
297    if(check_args(env, integer, integer, empty)==0) {    if(check_args(env, 2, integer, integer)==0) {
298      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
299      toss(env); if(env->err) return;      toss(env); if(env->err) return;
300      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 307  extern void sx_2b(environment *env) Line 304  extern void sx_2b(environment *env)
304      return;      return;
305    }    }
306    
307    if(check_args(env, tfloat, tfloat, empty)==0) {    if(check_args(env, 2, tfloat, tfloat)==0) {
308      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
309      toss(env); if(env->err) return;      toss(env); if(env->err) return;
310      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 317  extern void sx_2b(environment *env) Line 314  extern void sx_2b(environment *env)
314      return;      return;
315    }    }
316    
317    if(check_args(env, tfloat, integer, empty)==0) {    if(check_args(env, 2, tfloat, integer)==0) {
318      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
319      toss(env); if(env->err) return;      toss(env); if(env->err) return;
320      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 327  extern void sx_2b(environment *env) Line 324  extern void sx_2b(environment *env)
324      return;      return;
325    }    }
326    
327    if(check_args(env, integer, tfloat, empty)==0) {    if(check_args(env, 2, integer, tfloat)==0) {
328      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
329      toss(env); if(env->err) return;      toss(env); if(env->err) return;
330      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 346  extern void sx_2d(environment *env) Line 343  extern void sx_2d(environment *env)
343    int a, b;    int a, b;
344    float fa, fb;    float fa, fb;
345    
346    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, integer, integer)==0) {
     return printerr(env);  
   
   if(check_args(env, integer, integer, empty)==0) {  
347      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
348      toss(env); if(env->err) return;      toss(env); if(env->err) return;
349      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 359  extern void sx_2d(environment *env) Line 353  extern void sx_2d(environment *env)
353      return;      return;
354    }    }
355    
356    if(check_args(env, tfloat, tfloat, empty)==0) {    if(check_args(env, 2, tfloat, tfloat)==0) {
357      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
358      toss(env); if(env->err) return;      toss(env); if(env->err) return;
359      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 369  extern void sx_2d(environment *env) Line 363  extern void sx_2d(environment *env)
363      return;      return;
364    }    }
365    
366    if(check_args(env, tfloat, integer, empty)==0) {    if(check_args(env, 2, tfloat, integer)==0) {
367      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
368      toss(env); if(env->err) return;      toss(env); if(env->err) return;
369      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 379  extern void sx_2d(environment *env) Line 373  extern void sx_2d(environment *env)
373      return;      return;
374    }    }
375    
376    if(check_args(env, integer, tfloat, empty)==0) {    if(check_args(env, 2, integer, tfloat)==0) {
377      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
378      toss(env); if(env->err) return;      toss(env); if(env->err) return;
379      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 398  extern void sx_3e(environment *env) Line 392  extern void sx_3e(environment *env)
392    int a, b;    int a, b;
393    float fa, fb;    float fa, fb;
394    
395    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, integer, integer)==0) {
     return printerr(env);  
   
   if(check_args(env, integer, integer, empty)==0) {  
396      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
397      toss(env); if(env->err) return;      toss(env); if(env->err) return;
398      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 411  extern void sx_3e(environment *env) Line 402  extern void sx_3e(environment *env)
402      return;      return;
403    }    }
404    
405    if(check_args(env, tfloat, tfloat, empty)==0) {    if(check_args(env, 2, tfloat, tfloat)==0) {
406      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
407      toss(env); if(env->err) return;      toss(env); if(env->err) return;
408      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 421  extern void sx_3e(environment *env) Line 412  extern void sx_3e(environment *env)
412      return;      return;
413    }    }
414    
415    if(check_args(env, tfloat, integer, empty)==0) {    if(check_args(env, 2, tfloat, integer)==0) {
416      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
417      toss(env); if(env->err) return;      toss(env); if(env->err) return;
418      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 431  extern void sx_3e(environment *env) Line 422  extern void sx_3e(environment *env)
422      return;      return;
423    }    }
424    
425    if(check_args(env, integer, tfloat, empty)==0) {    if(check_args(env, 2, integer, tfloat)==0) {
426      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
427      toss(env); if(env->err) return;      toss(env); if(env->err) return;
428      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 468  extern void sx_3e3d(environment *env) Line 459  extern void sx_3e3d(environment *env)
459  /* "dup"; duplicates an item on the stack */  /* "dup"; duplicates an item on the stack */
460  extern void sx_647570(environment *env)  extern void sx_647570(environment *env)
461  {  {
462    if(check_args(env, unknown, empty))    if(check_args(env, 1, unknown))
463      return printerr(env);      return printerr(env);
464    
465    push_val(env, copy_val(env, CAR(env->head)));    push_val(env, copy_val(env, CAR(env->head)));
# Line 479  extern void sx_6966(environment *env) Line 470  extern void sx_6966(environment *env)
470  {  {
471    int truth;    int truth;
472    
473    if(check_args(env, unknown, integer, empty))    if(check_args(env, 2, unknown, integer))
474      return printerr(env);      return printerr(env);
475    
476    swap(env);    swap(env);
# Line 501  extern void ifelse(environment *env) Line 492  extern void ifelse(environment *env)
492  {  {
493    int truth;    int truth;
494    
495    if(check_args(env, unknown, unknown, integer, empty))    if(check_args(env, 3, unknown, unknown, integer))
496      return printerr(env);      return printerr(env);
497    
498    rot(env);    rot(env);
# Line 526  extern void ifelse(environment *env) Line 517  extern void ifelse(environment *env)
517  extern void sx_656c7365(environment *env)  extern void sx_656c7365(environment *env)
518  {  {
519    
520    if(check_args(env, unknown, symb, unknown, symb, integer, empty))    if(check_args(env, 5, unknown, symb, unknown, symb, integer))
521      return printerr(env);      return printerr(env);
522    
523    /// XXX    /// XXX
# Line 546  extern void sx_656c7365(environment *env Line 537  extern void sx_656c7365(environment *env
537  extern void then(environment *env)  extern void then(environment *env)
538  {  {
539        
540    if(check_args(env, unknown, symb, integer, empty))    if(check_args(env, 3, unknown, symb, integer))
541      return printerr(env);      return printerr(env);
542    
543    /// XXX    /// XXX
# Line 567  extern void sx_7768696c65(environment *e Line 558  extern void sx_7768696c65(environment *e
558    int truth;    int truth;
559    value *loop, *test;    value *loop, *test;
560    
561    if(check_args(env, unknown, integer, empty))    if(check_args(env, 2, unknown, integer))
562      return printerr(env);      return printerr(env);
563    
564    loop= CAR(env->head);    loop= CAR(env->head);
# Line 611  extern void sx_666f72(environment *env) Line 602  extern void sx_666f72(environment *env)
602    value *loop;    value *loop;
603    int foo1, foo2;    int foo1, foo2;
604    
605    if(check_args(env, unknown, integer, integer, empty))    if(check_args(env, 3, unknown, integer, integer))
606      return printerr(env);      return printerr(env);
607    
608    loop= CAR(env->head);    loop= CAR(env->head);
# Line 649  extern void foreach(environment *env) Line 640  extern void foreach(environment *env)
640    value *loop, *foo;    value *loop, *foo;
641    value *iterator;    value *iterator;
642    
643    if(check_args(env, unknown, tcons, empty))    if(check_args(env, 2, unknown, tcons))
644      return printerr(env);      return printerr(env);
645        
646    loop= CAR(env->head);    loop= CAR(env->head);
# Line 686  extern void to(environment *env) Line 677  extern void to(environment *env)
677    int ending, start, i;    int ending, start, i;
678    value *iterator, *temp, *end;    value *iterator, *temp, *end;
679    
680    if(check_args(env, integer, integer, empty))    if(check_args(env, 2, integer, integer))
681      return printerr(env);      return printerr(env);
682    
683    end= new_val(env);    end= new_val(env);
# Line 744  extern void readlineport(environment *en Line 735  extern void readlineport(environment *en
735  {  {
736    FILE *stream;    FILE *stream;
737    
738    if(check_args(env, port, empty))    if(check_args(env, 1, port))
739      return printerr(env);      return printerr(env);
740    
741    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
# Line 765  extern void readport(environment *env) Line 756  extern void readport(environment *env)
756  {  {
757    FILE *stream;    FILE *stream;
758    
759    if(check_args(env, port, empty))    if(check_args(env, 1, port))
760      return printerr(env);      return printerr(env);
761    
762    stream=CAR(env->head)->content.p;    stream=CAR(env->head)->content.p;
# Line 780  extern void beep(environment *env) Line 771  extern void beep(environment *env)
771  {  {
772    int freq, dur, period, ticks;    int freq, dur, period, ticks;
773    
774    if(check_args(env, integer, integer, empty))    if(check_args(env, 2, integer, integer))
775      return printerr(env);      return printerr(env);
776    
777    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
# Line 801  extern void beep(environment *env) Line 792  extern void beep(environment *env)
792      usleep(dur);      usleep(dur);
793      return;      return;
794    case -1:    case -1:
     perror("beep");  
795      env->err= 5;      env->err= 5;
796      return;      return printerr(env);
797    default:    default:
798      abort();      abort();
799    }    }
# Line 815  extern void sx_77616974(environment *env Line 805  extern void sx_77616974(environment *env
805  {  {
806    int dur;    int dur;
807    
808    if(check_args(env, integer, empty))    if(check_args(env, 1, integer))
809      return printerr(env);      return printerr(env);
810    
811    dur= CAR(env->head)->content.i;    dur= CAR(env->head)->content.i;
# Line 831  extern void sx_2a(environment *env) Line 821  extern void sx_2a(environment *env)
821    int a, b;    int a, b;
822    float fa, fb;    float fa, fb;
823    
824    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, integer, integer)==0) {
     return printerr(env);  
   
   if(check_args(env, integer, integer, empty)==0) {  
825      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
826      toss(env); if(env->err) return;      toss(env); if(env->err) return;
827      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 844  extern void sx_2a(environment *env) Line 831  extern void sx_2a(environment *env)
831      return;      return;
832    }    }
833    
834    if(check_args(env, tfloat, tfloat, empty)==0) {    if(check_args(env, 2, tfloat, tfloat)==0) {
835      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
836      toss(env); if(env->err) return;      toss(env); if(env->err) return;
837      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 854  extern void sx_2a(environment *env) Line 841  extern void sx_2a(environment *env)
841      return;      return;
842    }    }
843    
844    if(check_args(env, tfloat, integer, empty)==0) {    if(check_args(env, 2, tfloat, integer)==0) {
845      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
846      toss(env); if(env->err) return;      toss(env); if(env->err) return;
847      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 864  extern void sx_2a(environment *env) Line 851  extern void sx_2a(environment *env)
851      return;      return;
852    }    }
853    
854    if(check_args(env, integer, tfloat, empty)==0) {    if(check_args(env, 2, integer, tfloat)==0) {
855      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
856      toss(env); if(env->err) return;      toss(env); if(env->err) return;
857      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 883  extern void sx_2f(environment *env) Line 870  extern void sx_2f(environment *env)
870    int a, b;    int a, b;
871    float fa, fb;    float fa, fb;
872    
873    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, integer, integer)==0) {
     return printerr(env);  
   
   if(check_args(env, integer, integer, empty)==0) {  
874      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
875      toss(env); if(env->err) return;      toss(env); if(env->err) return;
876      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 896  extern void sx_2f(environment *env) Line 880  extern void sx_2f(environment *env)
880      return;      return;
881    }    }
882    
883    if(check_args(env, tfloat, tfloat, empty)==0) {    if(check_args(env, 2, tfloat, tfloat)==0) {
884      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
885      toss(env); if(env->err) return;      toss(env); if(env->err) return;
886      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 906  extern void sx_2f(environment *env) Line 890  extern void sx_2f(environment *env)
890      return;      return;
891    }    }
892    
893    if(check_args(env, tfloat, integer, empty)==0) {    if(check_args(env, 2, tfloat, integer)==0) {
894      fa= CAR(env->head)->content.f;      fa= CAR(env->head)->content.f;
895      toss(env); if(env->err) return;      toss(env); if(env->err) return;
896      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 916  extern void sx_2f(environment *env) Line 900  extern void sx_2f(environment *env)
900      return;      return;
901    }    }
902    
903    if(check_args(env, integer, tfloat, empty)==0) {    if(check_args(env, 2, integer, tfloat)==0) {
904      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
905      toss(env); if(env->err) return;      toss(env); if(env->err) return;
906      fb= CAR(env->head)->content.f;      fb= CAR(env->head)->content.f;
# Line 934  extern void mod(environment *env) Line 918  extern void mod(environment *env)
918  {  {
919    int a, b;    int a, b;
920    
921    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, integer, integer)==0) {
     return printerr(env);  
   
   if(check_args(env, integer, integer, empty)==0) {  
922      a= CAR(env->head)->content.i;      a= CAR(env->head)->content.i;
923      toss(env); if(env->err) return;      toss(env); if(env->err) return;
924      b= CAR(env->head)->content.i;      b= CAR(env->head)->content.i;
# Line 956  extern void sx_646976(environment *env) Line 937  extern void sx_646976(environment *env)
937  {  {
938    int a, b;    int a, b;
939    
940    if(check_args(env, integer, integer, empty))    if(check_args(env, 2, integer, integer))
941      return printerr(env);      return printerr(env);
942        
943    a= CAR(env->head)->content.i;    a= CAR(env->head)->content.i;
# Line 970  extern void sx_646976(environment *env) Line 951  extern void sx_646976(environment *env)
951  extern void setcar(environment *env)  extern void setcar(environment *env)
952  {  {
953    
954    if(check_args(env, tcons, unknown, empty))    if(check_args(env, 2, tcons, unknown))
955      return printerr(env);      return printerr(env);
956    
957    CAR(CAR(CDR(env->head)))=CAR(env->head);    CAR(CAR(CDR(env->head)))=CAR(env->head);
# Line 980  extern void setcar(environment *env) Line 961  extern void setcar(environment *env)
961  extern void setcdr(environment *env)  extern void setcdr(environment *env)
962  {  {
963    
964    if(check_args(env, tcons, unknown, empty))    if(check_args(env, 2, tcons, unknown))
965      return printerr(env);      return printerr(env);
966    
967    CDR(CAR(CDR(env->head)))=CAR(env->head);    CDR(CAR(CDR(env->head)))=CAR(env->head);
# Line 990  extern void setcdr(environment *env) Line 971  extern void setcdr(environment *env)
971  extern void car(environment *env)  extern void car(environment *env)
972  {  {
973    
974    if(check_args(env, tcons, empty))    if(check_args(env, 1, tcons))
975      return printerr(env);      return printerr(env);
976    
977    CAR(env->head)=CAR(CAR(env->head));    CAR(env->head)=CAR(CAR(env->head));
# Line 999  extern void car(environment *env) Line 980  extern void car(environment *env)
980  extern void cdr(environment *env)  extern void cdr(environment *env)
981  {  {
982    
983    if(check_args(env, tcons, empty))    if(check_args(env, 1, tcons))
984      return printerr(env);      return printerr(env);
985    
986    CAR(env->head)=CDR(CAR(env->head));    CAR(env->head)=CDR(CAR(env->head));
# Line 1009  extern void cons(environment *env) Line 990  extern void cons(environment *env)
990  {  {
991    value *val;    value *val;
992    
993    if(check_args(env, unknown, unknown, empty))    if(check_args(env, 2, unknown, unknown))
994      return printerr(env);      return printerr(env);
995    
996    val=new_val(env);    val=new_val(env);
# Line 1038  void assocgen(environment *env, funcp eq Line 1019  void assocgen(environment *env, funcp eq
1019    
1020    /* 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
1021       list */       list */
1022    if(check_args(env, tcons, unknown, empty))    if(check_args(env, 2, tcons, unknown))
1023      return printerr(env);      return printerr(env);
1024    
1025    key=CAR(CDR(env->head));    key=CAR(CDR(env->head));
# Line 1055  void assocgen(environment *env, funcp eq Line 1036  void assocgen(environment *env, funcp eq
1036      eqfunc((void*)env); if(env->err) return;      eqfunc((void*)env); if(env->err) return;
1037    
1038      /* Check the result of 'eqfunc' */      /* Check the result of 'eqfunc' */
1039      if(check_args(env, integer, empty))      if(check_args(env, 1, integer))
1040        return printerr(env);        return printerr(env);
1041    
1042      if(CAR(env->head)->content.i){      if(CAR(env->head)->content.i){
# Line 1107  extern void sx_6f70656e(environment *env Line 1088  extern void sx_6f70656e(environment *env
1088    value *new_port;    value *new_port;
1089    FILE *stream;    FILE *stream;
1090    
1091    if(check_args(env, string, string, empty))    if(check_args(env, 2, string, string))
1092      return printerr(env);      return printerr(env);
1093    
1094    stream=fopen(CAR(CDR(env->head))->content.ptr,    stream=fopen(CAR(CDR(env->head))->content.ptr,
1095                 CAR(env->head)->content.ptr);                 CAR(env->head)->content.ptr);
1096    
1097    if(stream == NULL) {    if(stream == NULL) {
     perror("open");  
1098      env->err= 5;      env->err= 5;
1099      return;      return printerr(env);
1100    }    }
1101    
1102    new_port=new_val(env);    new_port=new_val(env);
# Line 1137  extern void sx_636c6f7365(environment *e Line 1117  extern void sx_636c6f7365(environment *e
1117  {  {
1118    int ret;    int ret;
1119    
1120    if(check_args(env, port, empty))    if(check_args(env, 1, port))
1121      return printerr(env);      return printerr(env);
1122    
1123    ret= fclose(CAR(env->head)->content.p);    ret= fclose(CAR(env->head)->content.p);
1124    
1125    if(ret != 0){    if(ret != 0){
     perror("close");  
1126      env->err= 5;      env->err= 5;
1127      return;      return printerr(env);
1128    }    }
1129    
1130    toss(env);    toss(env);
# Line 1156  extern void mangle(environment *env) Line 1135  extern void mangle(environment *env)
1135  {  {
1136    char *new_string;    char *new_string;
1137    
1138    if(check_args(env, string, empty))    if(check_args(env, 1, string))
1139      return printerr(env);      return printerr(env);
1140    
1141    new_string= mangle_str(CAR(env->head)->content.string);    new_string= mangle_str(CAR(env->head)->content.string);
# Line 1177  extern void sx_666f726b(environment *env Line 1156  extern void sx_666f726b(environment *env
1156  extern void sx_77616974706964(environment *env)  extern void sx_77616974706964(environment *env)
1157  {  {
1158    
1159    if(check_args(env, integer, empty))    if(check_args(env, 1, integer))
1160      return printerr(env);      return printerr(env);
1161    
1162    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));    push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0));
# Line 1189  extern void sx_77616974706964(environmen Line 1168  extern void sx_77616974706964(environmen
1168  extern void toss(environment *env)  extern void toss(environment *env)
1169  {  {
1170    
1171    if(check_args(env, unknown, empty))    if(check_args(env, 1, unknown))
1172      return printerr(env);      return printerr(env);
1173    
1174    env->head= CDR(env->head); /* Remove the top stack item */    env->head= CDR(env->head); /* Remove the top stack item */
# Line 1280  extern void warranty(environment *env) Line 1259  extern void warranty(environment *env)
1259  {  {
1260    puts(warranty_message);    puts(warranty_message);
1261  }  }
1262    
1263    
1264    /* random */
1265    extern void sx_72616e646f6d(environment *env)
1266    {
1267      push_int(env, (int)rand());
1268    }
1269    
1270    
1271    extern void seed(environment *env)
1272    {
1273      if(check_args(env, 1, integer))
1274        return printerr(env);
1275    
1276      srand(CAR(env->head)->content.i);
1277      toss(env);
1278    }
1279    
1280    
1281    extern void ticks(environment *env)
1282    {
1283      int val;
1284    
1285      val= (int)time(NULL);
1286      if(val<0) {
1287        env->err= 5;
1288        return printerr(env);
1289      }
1290      
1291      return push_int(env, val);
1292    }
1293    
1294    
1295    extern void push(environment *env)
1296    {
1297      symbol *sym;
1298      value *oldval;
1299      value *newval;
1300    
1301      if(check_args(env, 2, symb, unknown)==0) {
1302        sym= CAR(env->head)->content.sym;
1303        oldval= sym->val;
1304      
1305        if(oldval==NULL)
1306          oldval= new_val(env);
1307    
1308        sym->val= new_val(env);
1309        sym->val->content.c= malloc(sizeof(pair));
1310        assert(sym->val->content.c!=NULL);
1311        env->gc_count += sizeof(pair);
1312        sym->val->type= tcons;
1313        CDR(sym->val)= oldval;
1314        CAR(sym->val)= CAR(CDR(env->head));
1315        env->head= CDR(CDR(env->head));
1316    
1317        return;
1318      }
1319    
1320      if(check_args(env, 2, tcons, unknown)==0
1321         || check_args(env, 2, empty, unknown)==0) {
1322        oldval= CAR(env->head);
1323        env->head= CDR(env->head);
1324        newval= new_val(env);
1325        newval->content.c= malloc(sizeof(pair));
1326        assert(newval->content.c!=NULL);
1327        env->gc_count += sizeof(pair);
1328        newval->type= tcons;
1329        CDR(newval)= oldval;
1330        CAR(newval)= CAR(env->head);
1331        env->head= CDR(env->head);
1332        push_val(env, newval);
1333        
1334        return;
1335      }
1336    
1337      return printerr(env);
1338    }
1339    
1340    
1341    extern void pop(environment *env)
1342    {
1343      symbol *sym;
1344      value *val;
1345    
1346      if(check_args(env, 1, symb)==0) {
1347        sym= CAR(env->head)->content.sym;
1348    
1349        if(sym->val==NULL) {
1350          env->err= 3;
1351          return printerr(env);
1352        }
1353    
1354        env->head= CDR(env->head);
1355        if(sym->val->type==tcons) {
1356          push_val(env, CAR(sym->val));
1357          sym->val= CDR(sym->val);
1358        } else {
1359          env->err= 2;
1360          return printerr(env);
1361        }
1362    
1363        return;
1364      }
1365    
1366      if(check_args(env, 1, tcons)==0) {
1367        val= CAR(env->head);
1368        env->head= CDR(env->head);
1369        push_val(env, CAR(val));
1370        return;
1371      }
1372    
1373      return printerr(env);
1374    }
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
root@recompile.se
 ViewVC Help
Powered by ViewVC 1.1.26