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; |
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; |
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; |
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 |
} |
} |
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; |
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 |
|
|
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 |
|
|
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; |
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) { |
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; |
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; |
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; |
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) |
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 |
|
|
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: |
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 |
|
|
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: |
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 ]; |
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); |