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

Diff of /gcl/o/toplevel.c

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

revision 1.6 by camm, Sun Sep 14 02:43:08 2003 UTC revision 1.7 by camm, Tue Oct 7 21:06:33 2003 UTC
# Line 50  Fdefun(object args) Line 50  Fdefun(object args)
50          if (MMcadr(args) != Cnil && type_of(MMcadr(args)) != t_cons)          if (MMcadr(args) != Cnil && type_of(MMcadr(args)) != t_cons)
51                  FEerror("~S is an illegal lambda-list.", 1, MMcadr(args));                  FEerror("~S is an illegal lambda-list.", 1, MMcadr(args));
52          name = MMcar(args);          name = MMcar(args);
53          if (type_of(name) != t_symbol)          if (type_of(name) != t_symbol) {
54                  not_a_symbol(name);            if (setf_fn_form(name)) {
55                vs_base = vs_top;
56                vs_push(MMcons(sLlambda, MMcdr(args)));
57                putprop(MMcadr(name),vs_base[0],sSsetf_function);
58                vs_base[0]=name;
59                return;
60              } else
61                not_a_symbol(name);
62            }
63          if (name->s.s_sfdef != NOT_SPECIAL) {          if (name->s.s_sfdef != NOT_SPECIAL) {
64                  if (name->s.s_mflag) {            if (name->s.s_mflag) {
65                          if (symbol_value(sSAinhibit_macro_specialA) != Cnil)              if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
66                                  name->s.s_sfdef = NOT_SPECIAL;                name->s.s_sfdef = NOT_SPECIAL;
67                  } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil)            } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
68                   FEerror("~S, a special form, cannot be redefined.", 1, name);              FEerror("~S, a special form, cannot be redefined.", 1, name);
69          }          }
70          if (name->s.s_hpack == lisp_package &&          if (name->s.s_hpack == lisp_package &&
71              name->s.s_gfdef != OBJNULL && initflag) {              name->s.s_gfdef != OBJNULL && initflag) {
72                  vs_push(make_simple_string(            vs_push(make_simple_string(
73                          "~S is being redefined."));                                       "~S is being redefined."));
74                  ifuncall2(sLwarn, vs_head, name);            ifuncall2(sLwarn, vs_head, name);
75                  vs_popp;            vs_popp;
76          }          }
77          vs_base = vs_top;          vs_base = vs_top;
78          if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) {          if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) {
79                  vs_push(MMcons(sLlambda_block, args));            vs_push(MMcons(sLlambda_block, args));
80          } else {          } else {
81                  vs_push(MMcons(lex_env[2], args));            vs_push(MMcons(lex_env[2], args));
82                  vs_base[0] = MMcons(lex_env[1], vs_base[0]);            vs_base[0] = MMcons(lex_env[1], vs_base[0]);
83                  vs_base[0] = MMcons(lex_env[0], vs_base[0]);            vs_base[0] = MMcons(lex_env[0], vs_base[0]);
84                  vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]);            vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]);
85          }          }
86          {object fname =  clear_compiler_properties(name,vs_base[0]);          {object fname =  clear_compiler_properties(name,vs_base[0]);
87           fname->s.s_gfdef = vs_base[0];          fname->s.s_gfdef = vs_base[0];
88           fname->s.s_mflag = FALSE;}          fname->s.s_mflag = FALSE;}
89          vs_base[0] = name;          vs_base[0] = name;
90          for (body = MMcddr(args);  !endp(body);  body = body->c.c_cdr) {          for (body = MMcddr(args);  !endp(body);  body = body->c.c_cdr) {
91                  form = macro_expand(body->c.c_car);            form = macro_expand(body->c.c_car);
92                  if (type_of(form) == t_string) {            if (type_of(form) == t_string) {
93                          if (endp(body->c.c_cdr))              if (endp(body->c.c_cdr))
94                                  break;                break;
95                          vs_push(form);              vs_push(form);
96                          name->s.s_plist =              name->s.s_plist =
97                          putf(name->s.s_plist,                putf(name->s.s_plist,
98                               form,                     form,
99                               sSfunction_documentation);                     sSfunction_documentation);
100                          vs_popp;              vs_popp;
101                          break;              break;
102                  }            }
103                  if (type_of(form) != t_cons || form->c.c_car != sLdeclare)            if (type_of(form) != t_cons || form->c.c_car != sLdeclare)
104                          break;              break;
105          }          }
106  }  }
107                    
# Line 206  DEF_ORDINARY("PROGN",sLprogn,LISP,""); Line 214  DEF_ORDINARY("PROGN",sLprogn,LISP,"");
214  DEF_ORDINARY("TYPEP",sLtypep,LISP,"");  DEF_ORDINARY("TYPEP",sLtypep,LISP,"");
215  DEF_ORDINARY("VALUES",sLvalues,LISP,"");  DEF_ORDINARY("VALUES",sLvalues,LISP,"");
216  DEF_ORDINARY("VARIABLE-DOCUMENTATION",sSvariable_documentation,SI,"");  DEF_ORDINARY("VARIABLE-DOCUMENTATION",sSvariable_documentation,SI,"");
217    DEF_ORDINARY("SETF-FUNCTION",sSsetf_function,SI,"");
218  DEF_ORDINARY("WARN",sLwarn,LISP,"");  DEF_ORDINARY("WARN",sLwarn,LISP,"");
219    
220  void  void

Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7

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