/[gcl]/gcl/o/bind.c
ViewVC logotype

Diff of /gcl/o/bind.c

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

revision 1.1.1.1 by wfs, Mon Dec 6 22:44:10 1999 UTC revision 1.2 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 23  Foundation, 675 Mass Ave, Cambridge, MA Line 23  Foundation, 675 Mass Ave, Cambridge, MA
23          bind.c          bind.c
24  */  */
25    
26    #define _GNU_SOURCE
27  #include "include.h"  #include "include.h"
28  #include "varargs.h"  /*  #include "varargs.h" */
29    
30  struct nil3 { object nil3_self[3]; } three_nils;  struct nil3 { object nil3_self[3]; } three_nils;
31  struct nil6 { object nil6_self[6]; } six_nils;  struct nil6 { object nil6_self[6]; } six_nils;
# Line 70  struct aux { Line 71  struct aux {
71    
72  #define isdeclare(x)    ((x) == sLdeclare)  #define isdeclare(x)    ((x) == sLdeclare)
73    
74  lambda_bind(arg_top)  void
75  object *arg_top;  lambda_bind(object *arg_top)
76  {  {
77        
78          object endp_temp,temporary;          object endp_temp,temporary;
79          object lambda, lambda_list, body, form, x, ds, vs, v;          object lambda, lambda_list, body, form=Cnil, x, ds, vs, v;
80          int narg, i, j;          int narg, i, j;
81          object *base = vs_base;          object *base = vs_base;
82          struct required *required;          struct required *required;
83          int nreq;          int nreq;
84          struct optional *optional;          struct optional *optional=NULL;
85          int nopt;          int nopt;
86          struct rest *rest;          struct rest *rest=NULL;
87          bool rest_flag;          bool rest_flag;
88          struct keyword *keyword;          struct keyword *keyword=NULL;
89          bool key_flag;          bool key_flag;
90          bool allow_other_keys_flag, other_keys_appeared;          bool allow_other_keys_flag, other_keys_appeared;
91          int nkey;          int nkey;
92          struct aux *aux;          struct aux *aux=NULL;
93          int naux;          int naux;
94          bool special_processed;          bool special_processed;
95          vs_mark;          vs_mark;
# Line 560  REQUIRED_ONLY: Line 561  REQUIRED_ONLY:
561          }          }
562  }  }
563    
564  bind_var(var, val, spp)  void
565  object var, val, spp;  bind_var(object var, object val, object spp)
566  {  {
567          object temporary;          object temporary;
568          vs_mark;          vs_mark;
# Line 591  object var, val, spp; Line 592  object var, val, spp;
592          vs_reset;          vs_reset;
593  }  }
594    
595  illegal_lambda()  void
596    illegal_lambda(void)
597  {  {
598          FEerror("Illegal lambda expression.", 0);          FEerror("Illegal lambda expression.", 0);
599  }  }
# Line 606  struct bind_temp { Line 608  struct bind_temp {
608  */  */
609    
610  object  object
611  find_special(body, start, end)  find_special(object body, struct bind_temp *start, struct bind_temp *end)
 object body;  
 struct bind_temp *start, *end;  
612  {  {
613          object temporary;          object temporary;
614          object endp_temp;          object endp_temp;
615          object form;          object form=Cnil;
616          object ds, vs, v;          object ds, vs, v;
617          struct bind_temp *bt;          struct bind_temp *bt;
618          bool special_processed;          bool special_processed;
# Line 666  struct bind_temp *start, *end; Line 666  struct bind_temp *start, *end;
666  }  }
667    
668  object  object
669  let_bind(body, start, end)  let_bind(object body, struct bind_temp *start, struct bind_temp *end)
 object body;  
 struct bind_temp *start, *end;  
670  {  {
671          struct bind_temp *bt;          struct bind_temp *bt;
672    
# Line 684  struct bind_temp *start, *end; Line 682  struct bind_temp *start, *end;
682  }  }
683    
684  object  object
685  letA_bind(body, start, end)  letA_bind(object body, struct bind_temp *start, struct bind_temp *end)
 object body;  
 struct bind_temp *start, *end;  
686  {  {
687          struct bind_temp *bt;          struct bind_temp *bt;
688                    
# Line 708  struct bind_temp *start, *end; Line 704  struct bind_temp *start, *end;
704  #define FOUND           11  #define FOUND           11
705  #define NOT_KEYWORD     1  #define NOT_KEYWORD     1
706    
707  parse_key(base, rest, allow_other_keys, n, va_alist)  void
708  object *base;  parse_key(object *base, bool rest, bool allow_other_keys, register int n, .../*  __builtin_va_alist_t __builtin_va_alist */)
 bool rest, allow_other_keys;  
 register int n;  
 va_dcl  
709  {  {
710          object temporary;          object temporary;
711          va_list ap;          va_list ap;
# Line 747  va_dcl Line 740  va_dcl
740                          base++;                          base++;
741                  top = base + n;                  top = base + n;
742                  other_key = k;                  other_key = k;
743                  va_start(ap);                  va_start(ap,n);
744                  for (i = 0;  i < n;  i++) {                  for (i = 0;  i < n;  i++) {
745                                            
746                          if (va_arg(ap,object) == k) {                          if (va_arg(ap,object) == k) {
# Line 768  va_dcl Line 761  va_dcl
761                          FEerror("The keyword ~S is not allowed.",1,other_key);                          FEerror("The keyword ~S is not allowed.",1,other_key);
762                  return;                  return;
763          }          }
764          va_start(ap);          va_start(ap,n);
765          for (i = 0;  i < n;  i++) {          for (i = 0;  i < n;  i++) {
766                  k = va_arg(ap,object);                  k = va_arg(ap,object);
767                  k->s.s_stype = NOT_YET;                  k->s.s_stype = NOT_YET;
# Line 801  va_dcl Line 794  va_dcl
794                  vs_top = top;                  vs_top = top;
795          }          }
796          top = base + n;          top = base + n;
797          va_start(ap);          va_start(ap,n);
798          for (i = 0;  i < n;  i++) {          for (i = 0;  i < n;  i++) {
799                  k = va_arg(ap,object);                  k = va_arg(ap,object);
800                  base[i] = k->s.s_dbind;                  base[i] = k->s.s_dbind;
# Line 816  va_dcl Line 809  va_dcl
809                  FEerror("The keyword ~S is not allowed.", 1, other_key);                  FEerror("The keyword ~S is not allowed.", 1, other_key);
810  }  }
811    
812  check_other_key(l, n, va_alist)  void
813  object l;  check_other_key(object l, int n, .../*  __builtin_va_alist_t __builtin_va_alist */)
 int n;  
 va_dcl  
814  {  {
815          object endp_temp;          object endp_temp;
816          va_list ap;          va_list ap;
# Line 836  va_dcl Line 827  va_dcl
827                          FEerror("Odd number of arguments for keywords.", 0);                          FEerror("Odd number of arguments for keywords.", 0);
828                  if (k == sKallow_other_keys && l->c.c_cdr->c.c_car != Cnil) {                  if (k == sKallow_other_keys && l->c.c_cdr->c.c_car != Cnil) {
829                          allow_other_keys = TRUE;                          allow_other_keys = TRUE;
830                  } else {register object *loc;                  } else {
831                          char buf [100];                    char buf [100];
832                          bzero(buf,n);                    bzero(buf,n);
833                          va_start(ap);                    va_start(ap,n);
834                          for (i = 0;  i < n;  i++)                    for (i = 0;  i < n;  i++)
835                            { if (va_arg(ap,object) == k &&                      { if (va_arg(ap,object) == k &&
836                                  buf[i] ==0) {buf[i]=1; break;}}                            buf[i] ==0) {buf[i]=1; break;}}
837                          va_end(ap);                    va_end(ap);
838                          if (i >= n) other_key = k;                    if (i >= n) other_key = k;
839                  }                  }
840          }          }
841          if (other_key != OBJNULL && !allow_other_keys)          if (other_key != OBJNULL && !allow_other_keys)
# Line 853  va_dcl Line 844  va_dcl
844  }  }
845    
846    
847  struct key {short n,allow_other_keys;  /*  struct key {short n,allow_other_keys; */
848              iobject *defaults;  /*          iobject *defaults; */
849              iobject keys[1];  /*          iobject keys[1]; */
850             };  /*         }; */
851    
852    
853  object Cstd_key_defaults[15]={Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,  object Cstd_key_defaults[15]={Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,
854                                  Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil};                                  Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil,Cnil};
855    
856  parse_key_new(n,base,keys,ap)  int
857       int n;  parse_key_new(int n, object *base, struct key *keys, va_list ap)
      object *base;  
      struct key *keys;  
      va_list ap;  
858  {object *new;  {object *new;
859   COERCE_VA_LIST(new,ap,n);   COERCE_VA_LIST(new,ap,n);
860    
# Line 876  parse_key_new(n,base,keys,ap) Line 864  parse_key_new(n,base,keys,ap)
864     object *p= (object *)(keys->defaults);     object *p= (object *)(keys->defaults);
865     while (--j >=0) base[j]=p[j];     while (--j >=0) base[j]=p[j];
866   }   }
867   {if (n==0){ return;}   {if (n==0){ return 0;}
868   {int allow = keys->allow_other_keys;   {int allow = keys->allow_other_keys;
869    object k;    object k;
870   top:   top:
# Line 910  parse_key_new(n,base,keys,ap) Line 898  parse_key_new(n,base,keys,ap)
898    return 0;    return 0;
899   error:   error:
900    FEerror("Unrecognized key ~a",1,k);    FEerror("Unrecognized key ~a",1,k);
901      return -1;
902  }}}  }}}
903    
904  parse_key_rest(rest,n,base,keys,ap)  int
905       int n;  parse_key_rest(object rest, int n, object *base, struct key *keys, va_list ap)
      object *base;  
      struct key *keys;  
      va_list ap;  
      object rest;  
906  {object *new;  {object *new;
907   COERCE_VA_LIST(new,ap,n);   COERCE_VA_LIST(new,ap,n);
908    
# Line 933  parse_key_rest(rest,n,base,keys,ap) Line 918  parse_key_rest(rest,n,base,keys,ap)
918     object *p= (object *)(keys->defaults);     object *p= (object *)(keys->defaults);
919     while (--j >=0) base[j]=p[j];     while (--j >=0) base[j]=p[j];
920   }   }
921   {if (n==0){ return;}   {if (n==0){ return 0;}
922   {int allow = keys->allow_other_keys;   {int allow = keys->allow_other_keys;
923    object k;    object k;
924   top:   top:
# Line 968  parse_key_rest(rest,n,base,keys,ap) Line 953  parse_key_rest(rest,n,base,keys,ap)
953    return 0;    return 0;
954   error:   error:
955    FEerror("Unrecognized key ~a",1,k);    FEerror("Unrecognized key ~a",1,k);
956      return -1;
957  }}}  }}}
958    
959        
960  set_key_struct(ks,data)  void
961       object data;  set_key_struct(struct key *ks, object data)
      struct key *ks;  
962  {int i=ks->n;  {int i=ks->n;
963   while (--i >=0)   while (--i >=0)
964     {ks->keys[i].o =   data->cfd.cfd_self[ ks->keys[i].i ];     {ks->keys[i].o =   data->cfd.cfd_self[ ks->keys[i].i ];
# Line 990  set_key_struct(ks,data) Line 975  set_key_struct(ks,data)
975  DEF_ORDINARY("ALLOW-OTHER-KEYS",sKallow_other_keys,KEYWORD,"");  DEF_ORDINARY("ALLOW-OTHER-KEYS",sKallow_other_keys,KEYWORD,"");
976    
977    
978    void
979  init_bind()  init_bind(void)
980  {  {
981          ANDoptional = make_ordinary("&OPTIONAL");          ANDoptional = make_ordinary("&OPTIONAL");
982          enter_mark_origin(&ANDoptional);          enter_mark_origin(&ANDoptional);

Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26