home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / multival.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-05-07  |  2.6 KB  |  135 lines
  1. /*
  2.  Copyright (C) 1994 M. Hagiya, W. Schelter, T. Yuasa
  3.  
  4. This file is part of GNU Common Lisp, herein referred to as GCL
  5.  
  6. GCL is free software; you can redistribute it and/or modify it under
  7. the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
  8. the Free Software Foundation; either version 2, or (at your option)
  9. any later version.
  10.  
  11. GCL is distributed in the hope that it will be useful, but WITHOUT
  12. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Library General Public 
  14. License for more details.
  15.  
  16. You should have received a copy of the GNU Library General Public License 
  17. along with GCL; see the file COPYING.  If not, write to the Free Software
  18. Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. */
  21.  
  22. /*
  23.  
  24.     multival.c
  25.  
  26.     Multiple Values
  27. */
  28.  
  29. #include "include.h"
  30.  
  31. Lvalues()
  32. {
  33.     if (vs_base == vs_top) vs_base[0] = Cnil;
  34. }
  35.  
  36. Lvalues_list()
  37. {
  38.     object list;
  39.  
  40.     check_arg(1);
  41.     list = vs_base[0];
  42.     vs_top = vs_base;
  43.     while (!endp(list)) {    
  44.         vs_push(MMcar(list));
  45.         list = MMcdr(list);
  46.     }
  47.     if (vs_top == vs_base) vs_base[0] = Cnil;
  48. }
  49.  
  50. Fmultiple_value_list(form)
  51. object form;
  52. {
  53.     object *top = vs_top;
  54.  
  55.     if (endp(form))
  56.         FEtoo_few_argumentsF(form);
  57.     if (!endp(MMcdr(form)))
  58.         FEtoo_many_argumentsF(form);
  59.     vs_push(Cnil);
  60.     eval(MMcar(form));
  61.     while (vs_base < vs_top) {    
  62.         top[0] = MMcons(vs_top[-1],top[0]);
  63.         vs_top--;
  64.     }
  65.     vs_base = top;
  66.     vs_top = top+1;
  67. }
  68.  
  69. Fmultiple_value_call(form)
  70. object form;
  71. {
  72.     object *top = vs_top;
  73.     object *top1;
  74.     object *top2;
  75.  
  76.     if (endp(form))
  77.         FEtoo_few_argumentsF(form);
  78.     eval(MMcar(form));
  79.     vs_top = top;
  80.     vs_push(vs_base[0]);
  81.     form = MMcdr(form);
  82.     while (!endp(form)) {
  83.         top1 = vs_top;
  84.         eval(MMcar(form));
  85.         top2 = vs_top;
  86.         vs_top = top1;
  87.         while (vs_base < top2) {
  88.             vs_push(vs_base[0]);
  89.             vs_base++;
  90.         }
  91.         form = MMcdr(form);
  92.     }
  93.     vs_base = top+1;
  94.     super_funcall(top[0]);
  95. }
  96.  
  97. Fmultiple_value_prog1(forms)
  98. object forms;
  99. {
  100.     object *top;
  101.     object *base = vs_top;
  102.  
  103.     if (endp(forms))
  104.         FEtoo_few_argumentsF(forms);
  105.     eval(MMcar(forms));
  106.     top = vs_top;
  107.     vs_top=base;
  108.     while (vs_base < top) {    
  109.         vs_push(vs_base[0]);
  110.         vs_base++;
  111.     }
  112.     top = vs_top;
  113.     forms = MMcdr(forms);
  114.     while (!endp(forms)) {    
  115.         eval(MMcar(forms));
  116.         vs_top = top;
  117.         forms = MMcdr(forms);
  118.     }
  119.     vs_base = base;
  120.     vs_top = top;
  121.     if (vs_base == vs_top) vs_base[0] = Cnil;
  122. }
  123.  
  124.     
  125. init_multival()
  126. {
  127.     make_constant("MULTIPLE-VALUES-LIMIT",make_fixnum(32));
  128.     make_function("VALUES",Lvalues);
  129.     make_function("VALUES-LIST",Lvalues_list);
  130.     make_special_form("MULTIPLE-VALUE-CALL",Fmultiple_value_call);
  131.     make_special_form("MULTIPLE-VALUE-PROG1",
  132.               Fmultiple_value_prog1);
  133.     make_special_form("MULTIPLE-VALUE-LIST",Fmultiple_value_list);
  134. }
  135.