home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / c / multival.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  2.1 KB  |  120 lines
  1. /*
  2. (c) Copyright Taiichi Yuasa and Masami Hagiya, 1984.  All rights reserved.
  3. Copying of this file is authorized to users who have executed the true and
  4. proper "License Agreement for Kyoto Common LISP" with SIGLISP.
  5. */
  6.  
  7. /*
  8.  
  9.     multival.c
  10.  
  11.     Multiple Values
  12. */
  13.  
  14. #include "include.h"
  15.  
  16. Lvalues()
  17. {
  18.     if (vs_base == vs_top) vs_base[0] = Cnil;
  19. }
  20.  
  21. Lvalues_list()
  22. {
  23.     object list;
  24.  
  25.     check_arg(1);
  26.     list = vs_base[0];
  27.     vs_top = vs_base;
  28.     while (!endp(list)) {    
  29.         vs_push(MMcar(list));
  30.         list = MMcdr(list);
  31.     }
  32.     if (vs_top == vs_base) vs_base[0] = Cnil;
  33. }
  34.  
  35. Fmultiple_value_list(form)
  36. object form;
  37. {
  38.     object *top = vs_top;
  39.  
  40.     if (endp(form))
  41.         FEtoo_few_argumentsF(form);
  42.     if (!endp(MMcdr(form)))
  43.         FEtoo_many_argumentsF(form);
  44.     vs_push(Cnil);
  45.     eval(MMcar(form));
  46.     while (vs_base < vs_top) {    
  47.         top[0] = MMcons(vs_top[-1],top[0]);
  48.         vs_top--;
  49.     }
  50.     vs_base = top;
  51.     vs_top = top+1;
  52. }
  53.  
  54. Fmultiple_value_call(form)
  55. object form;
  56. {
  57.     object *top = vs_top;
  58.     object *top1;
  59.     object *top2;
  60.  
  61.     if (endp(form))
  62.         FEtoo_few_argumentsF(form);
  63.     eval(MMcar(form));
  64.     vs_top = top;
  65.     vs_push(vs_base[0]);
  66.     form = MMcdr(form);
  67.     while (!endp(form)) {
  68.         top1 = vs_top;
  69.         eval(MMcar(form));
  70.         top2 = vs_top;
  71.         vs_top = top1;
  72.         while (vs_base < top2) {
  73.             vs_push(vs_base[0]);
  74.             vs_base++;
  75.         }
  76.         form = MMcdr(form);
  77.     }
  78.     vs_base = top+1;
  79.     super_funcall(top[0]);
  80. }
  81.  
  82. Fmultiple_value_prog1(forms)
  83. object forms;
  84. {
  85.     object *top;
  86.     object *base = vs_top;
  87.  
  88.     if (endp(forms))
  89.         FEtoo_few_argumentsF(forms);
  90.     eval(MMcar(forms));
  91.     top = vs_top;
  92.     vs_top=base;
  93.     while (vs_base < top) {    
  94.         vs_push(vs_base[0]);
  95.         vs_base++;
  96.     }
  97.     top = vs_top;
  98.     forms = MMcdr(forms);
  99.     while (!endp(forms)) {    
  100.         eval(MMcar(forms));
  101.         vs_top = top;
  102.         forms = MMcdr(forms);
  103.     }
  104.     vs_base = base;
  105.     vs_top = top;
  106.     if (vs_base == vs_top) vs_base[0] = Cnil;
  107. }
  108.  
  109.     
  110. init_multival()
  111. {
  112.     make_constant("MULTIPLE-VALUES-LIMIT",make_fixnum(32));
  113.     make_function("VALUES",Lvalues);
  114.     make_function("VALUES-LIST",Lvalues_list);
  115.     make_special_form("MULTIPLE-VALUE-CALL",Fmultiple_value_call);
  116.     make_special_form("MULTIPLE-VALUE-PROG1",
  117.               Fmultiple_value_prog1);
  118.     make_special_form("MULTIPLE-VALUE-LIST",Fmultiple_value_list);
  119. }
  120.