← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to o/assignment.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
o/assignment.c
 
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
        assignment.c
 
25
 
 
26
        Assignment
 
27
*/
 
28
 
 
29
#include "include.h"
 
30
 
 
31
static object
 
32
setf(object,object);
 
33
 
 
34
object sLsetf;
 
35
 
 
36
object sLget;
 
37
object sLgetf;
 
38
object sLaref;
 
39
object sLsvref;
 
40
object sLelt;
 
41
object sLchar;
 
42
object sLschar;
 
43
object sLfill_pointer;
 
44
object sLgethash;
 
45
object sLcar;
 
46
object sLcdr;
 
47
 
 
48
object sLpush;
 
49
object sLpop;
 
50
object sLincf;
 
51
object sLdecf;
 
52
 
 
53
object sSstructure_access;
 
54
object sSsetf_lambda;
 
55
 
 
56
 
 
57
 
 
58
object sSclear_compiler_properties;
 
59
 
 
60
object sLwarn;
 
61
 
 
62
object sSAinhibit_macro_specialA;
 
63
 
 
64
void
 
65
setq(object sym, object val)
 
66
{
 
67
        object vd;
 
68
        enum stype type;
 
69
 
 
70
        if(type_of(sym) != t_symbol)
 
71
                not_a_symbol(sym);
 
72
        type = (enum stype)sym->s.s_stype;
 
73
        if(type == stp_special)
 
74
                sym->s.s_dbind = val;
 
75
        else
 
76
        if (type == stp_constant)
 
77
                FEinvalid_variable("Cannot assign to the constant ~S.", sym);
 
78
        else {
 
79
                vd = lex_var_sch(sym);
 
80
                if(MMnull(vd) || endp(MMcdr(vd)))
 
81
                        sym->s.s_dbind = val;
 
82
                else
 
83
                        MMcadr(vd) = val;
 
84
        }
 
85
}
 
86
 
 
87
static void
 
88
FFN(Fsetq)(object form)
 
89
{
 
90
        object ans;
 
91
        if (endp(form)) {
 
92
                vs_base = vs_top;
 
93
                vs_push(Cnil);
 
94
        } else {
 
95
                object *top = vs_top;
 
96
                do {
 
97
                        vs_top = top;
 
98
                        if (endp(MMcdr(form)))
 
99
                        FEinvalid_form("No value for ~S.", form->c.c_car);
 
100
                        setq(MMcar(form),ans=Ieval(MMcadr(form)));
 
101
                        form = MMcddr(form);
 
102
                } while (!endp(form));
 
103
                top[0]=ans;
 
104
                vs_base=top;
 
105
                vs_top= top+1;
 
106
        }
 
107
}
 
108
 
 
109
static void
 
110
FFN(Fpsetq)(object arg)
 
111
{
 
112
        object *old_top = vs_top;
 
113
        object *top;
 
114
        object argsv = arg;
 
115
        for (top = old_top;  !endp(arg);  arg = MMcddr(arg), top++) {
 
116
                if(endp(MMcdr(arg)))
 
117
                        FEinvalid_form("No value for ~S.", arg->c.c_car);
 
118
                
 
119
                top[0] = Ieval(MMcadr(arg));
 
120
                vs_top = top + 1;
 
121
        }
 
122
        for (arg = argsv, top = old_top; !endp(arg); arg = MMcddr(arg), top++)
 
123
                setq(MMcar(arg),top[0]);
 
124
        vs_base = vs_top = old_top;
 
125
        vs_push(Cnil);
 
126
}
 
127
 
 
128
DEFUNO_NEW("SET",object,fLset,LISP
 
129
   ,2,2,NONE,OO,OO,OO,OO,void,Lset,(object symbol,object value),"")
 
130
 
 
131
{
 
132
        /* 2 args */
 
133
        if (type_of(symbol) != t_symbol)
 
134
                not_a_symbol(symbol);
 
135
        if ((enum stype)symbol->s.s_stype == stp_constant)
 
136
                FEinvalid_variable("Cannot assign to the constant ~S.",
 
137
                                   symbol);
 
138
        symbol->s.s_dbind = value;
 
139
        RETURN1(value);
 
140
}
 
141
 
 
142
DEFUNO_NEW("FSET",object,fSfset,SI
 
143
   ,2,2,NONE,OO,OO,OO,OO,void,siLfset,(object sym,object function),"")
 
144
 
 
145
{
 
146
        /* 2 args */
 
147
        if (type_of(sym) != t_symbol) {
 
148
          if (setf_fn_form(sym)) {
 
149
            putprop(MMcadr(sym),function,sSsetf_function);
 
150
            return(function);
 
151
          } else
 
152
            not_a_symbol(sym);
 
153
        }
 
154
        if (sym->s.s_sfdef != NOT_SPECIAL) {
 
155
                if (sym->s.s_mflag) {
 
156
                        if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
 
157
                                sym->s.s_sfdef = NOT_SPECIAL;
 
158
                } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
 
159
                        FEerror("~S, a special form, cannot be redefined.",
 
160
                                1, sym);
 
161
        }
 
162
        sym = clear_compiler_properties(sym,function);
 
163
        if (sym->s.s_hpack == lisp_package &&
 
164
            sym->s.s_gfdef != OBJNULL && initflag) {
 
165
                ifuncall2(sLwarn,make_simple_string("~S is being redefined."),
 
166
                         sym);
 
167
        }
 
168
        if (type_of(function) == t_cfun ||
 
169
            type_of(function) == t_sfun ||
 
170
            type_of(function) == t_vfun ||
 
171
            type_of(function) == t_gfun ||
 
172
            type_of(function) == t_cclosure||
 
173
            type_of(function) == t_closure ||
 
174
            type_of(function) == t_afun 
 
175
            ) {
 
176
                sym->s.s_gfdef = function;
 
177
                sym->s.s_mflag = FALSE;
 
178
        } else if (car(function) == sLspecial)
 
179
                FEerror("Cannot define a special form.", 0);
 
180
        else if (function->c.c_car == sLmacro) {
 
181
                sym->s.s_gfdef = function->c.c_cdr;
 
182
                sym->s.s_mflag = TRUE;
 
183
        } else {
 
184
                sym->s.s_gfdef = function;
 
185
                sym->s.s_mflag = FALSE;
 
186
        }
 
187
 
 
188
        RETURN1(function);
 
189
}
 
190
#ifdef STATIC_FUNCTION_POINTERS
 
191
object
 
192
fSfset(object sym,object function) {
 
193
  return FFN(fSfset)(sym,function);
 
194
}
 
195
#endif
 
196
 
 
197
static void
 
198
FFN(Fmultiple_value_setq)(object form)
 
199
{
 
200
        object vars;
 
201
        int n, i;
 
202
 
 
203
        if (endp(form) || endp(form->c.c_cdr) ||
 
204
            !endp(form->c.c_cdr->c.c_cdr))
 
205
            FEinvalid_form("~S is an illegal argument to MULTIPLE-VALUE-SETQ",
 
206
                           form);
 
207
        vars = form->c.c_car;
 
208
 
 
209
        fcall.values[0]=Ieval(form->c.c_cdr->c.c_car);
 
210
        n = fcall.nvalues;
 
211
        
 
212
        for (i = 0;  !endp(vars);  i++, vars = vars->c.c_cdr)
 
213
                if (i < n)
 
214
                        setq(vars->c.c_car, fcall.values[i]);
 
215
                else
 
216
                        setq(vars->c.c_car, Cnil);
 
217
        vs_base[0]=fcall.values[0];
 
218
        vs_top = vs_base+1;
 
219
}
 
220
 
 
221
DEFUNO_NEW("MAKUNBOUND",object,fLmakunbound,LISP
 
222
   ,1,1,NONE,OO,OO,OO,OO,void,Lmakunbound,(object sym),"")
 
223
 
 
224
{
 
225
        /* 1 args */
 
226
        if (type_of(sym) != t_symbol)
 
227
                not_a_symbol(sym);
 
228
        if ((enum stype)sym->s.s_stype == stp_constant)
 
229
                FEinvalid_variable("Cannot unbind the constant ~S.",
 
230
                                   sym);
 
231
        sym->s.s_dbind = OBJNULL;
 
232
        RETURN1(sym);
 
233
}
 
234
 
 
235
object sStraced;
 
236
 
 
237
DEFUNO_NEW("FMAKUNBOUND",object,fLfmakunbound,LISP
 
238
   ,1,1,NONE,OO,OO,OO,OO,void,Lfmakunbound,(object sym),"")
 
239
 
 
240
{
 
241
        /* 1 args */
 
242
        if(type_of(sym) != t_symbol)
 
243
                not_a_symbol(sym);
 
244
        if (sym->s.s_sfdef != NOT_SPECIAL) {
 
245
                if (sym->s.s_mflag) {
 
246
                        if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
 
247
                                sym->s.s_sfdef = NOT_SPECIAL;
 
248
                } else if (symbol_value(sSAinhibit_macro_specialA) != Cnil)
 
249
                        FEerror("~S, a special form, cannot be redefined.",
 
250
                                1, sym);
 
251
        }
 
252
        remf(&(sym->s.s_plist),sStraced);
 
253
        clear_compiler_properties(sym,Cnil);
 
254
        if (sym->s.s_hpack == lisp_package &&
 
255
            sym->s.s_gfdef != OBJNULL && initflag) {
 
256
                ifuncall2(sLwarn, make_simple_string(
 
257
                        "~S is being redefined."), sym);
 
258
        }
 
259
        sym->s.s_gfdef = OBJNULL;
 
260
        sym->s.s_mflag = FALSE;
 
261
        RETURN1(sym);
 
262
}
 
263
 
 
264
static void
 
265
FFN(Fsetf)(object form)
 
266
{
 
267
        object result,*t,*t1;
 
268
        if (endp(form)) {
 
269
                vs_base = vs_top;
 
270
                vs_push(Cnil);
 
271
        } else {
 
272
                object *top = vs_top;
 
273
                do {
 
274
                        vs_top = top;
 
275
                        if (endp(MMcdr(form)))
 
276
                        FEinvalid_form("No value for ~S.", form->c.c_car);
 
277
                        result = setf(MMcar(form), MMcadr(form));
 
278
                        form = MMcddr(form);
 
279
                } while (!endp(form));
 
280
                t=vs_base;
 
281
                t1=vs_top;
 
282
                vs_top = vs_base = top;
 
283
                for (;t<t1;t++)
 
284
                  vs_push(*t);
 
285
 
 
286
        }
 
287
}
 
288
 
 
289
#define eval_push(form)  \
 
290
{  \
 
291
        object *old_top = vs_top;  \
 
292
  \
 
293
        *old_top = Ieval(form);  \
 
294
        vs_top = old_top + 1;  \
 
295
}
 
296
 
 
297
static object
 
298
setf(object place, object form)
 
299
{
 
300
        object fun;
 
301
        object *vs = vs_top;
 
302
        void (*f)();
 
303
        object args;
 
304
        object x,result,y;
 
305
        int i;
 
306
/*      extern void siLaset(void); */
 
307
/*      extern void siLsvset(void); */
 
308
        extern void siLelt_set();
 
309
        extern void siLchar_set();
 
310
/*      extern void siLfill_pointer_set(void); */
 
311
        extern void siLhash_set();
 
312
 
 
313
        if (type_of(place) != t_cons) {
 
314
          setq(place, result=Ieval(form));
 
315
          vs_top=vs_base+1;
 
316
          return result;
 
317
        }
 
318
        fun = place->c.c_car;
 
319
        if (type_of(fun) != t_symbol)
 
320
                goto OTHERWISE;
 
321
        args = place->c.c_cdr;
 
322
        if (fun == sLget) {
 
323
          object sym,val;
 
324
          sym = Ieval(car(args));
 
325
          val = Ieval(form);
 
326
          return (putprop(sym,val,Ieval(car(Mcdr(args))))); 
 
327
        }
 
328
        if (fun == sLgetf) 
 
329
          Ieval(Mcaddr(args));
 
330
        if (fun == sLaref) { f = siLaset; goto EVAL; }
 
331
        if (fun == sLsvref) { f = siLsvset; goto EVAL; }
 
332
        if (fun == sLelt) { f = siLelt_set; goto EVAL; }
 
333
        if (fun == sLchar) { f = siLchar_set; goto EVAL; }
 
334
        if (fun == sLschar) { f = siLchar_set; goto EVAL; }
 
335
        if (fun == sLfill_pointer) { f = siLfill_pointer_set; goto EVAL; }
 
336
        if (fun == sLgethash) { f = siLhash_set; goto EVAL; }
 
337
        if (fun == sLcar) {
 
338
                x = Ieval(Mcar(args));
 
339
                result = Ieval(form);
 
340
                if (type_of(x) != t_cons)
 
341
                        FEerror("~S is not a cons.", 1, x);
 
342
                Mcar(x) = result;
 
343
                return result;
 
344
        }
 
345
        if (fun == sLcdr) {
 
346
                x = Ieval(Mcar(args));
 
347
                result = Ieval(form);
 
348
                if (type_of(x) != t_cons)
 
349
                        FEerror("~S is not a cons.", 1, x);
 
350
                Mcdr(x) = result;
 
351
                return result;
 
352
        }
 
353
 
 
354
        /* FIXME should this be removed as it appears to usurp setf-expanders? */
 
355
        if ((x=getf(fun->s.s_plist,sSsetf_function,Cnil))!=Cnil) {
 
356
          object y=args;
 
357
          /* FIXME do a direct funcall here */
 
358
          y=append(list(1,form),y);
 
359
          y=MMcons(x,y);
 
360
          y=MMcons(sLfuncall,y);
 
361
          result=Ieval(y);
 
362
          return result;
 
363
        }
 
364
 
 
365
        x = getf(fun->s.s_plist, sSstructure_access, Cnil);
 
366
        if (x == Cnil || type_of(x) != t_cons)
 
367
                goto OTHERWISE;
 
368
        if (getf(fun->s.s_plist, sSsetf_lambda, Cnil) == Cnil)
 
369
                goto OTHERWISE;
 
370
        if (type_of(x->c.c_cdr) != t_fixnum)
 
371
                goto OTHERWISE;
 
372
        i = fix(x->c.c_cdr);
 
373
/*
 
374
        if (i < 0)
 
375
                goto OTHERWISE;
 
376
*/
 
377
        x = x->c.c_car;
 
378
        y = Ieval(Mcar(args));
 
379
        result = Ieval(form);
 
380
        if (x == sLvector) {
 
381
                if (type_of(y) != t_vector || i >= y->v.v_fillp)
 
382
                        goto OTHERWISE;
 
383
                y->v.v_self[i] = result;
 
384
        } else if (x == sLlist) {
 
385
                for (x = y;  i > 0;  --i)
 
386
                        x = cdr(x);
 
387
                if (type_of(x) != t_cons)
 
388
                        goto OTHERWISE;
 
389
                x->c.c_car = result;
 
390
        } else {
 
391
                structure_set(y, x, i, result);
 
392
        }
 
393
        return result;
 
394
 
 
395
EVAL:
 
396
        for (;  !endp(args);  args = args->c.c_cdr) {
 
397
                eval_push(args->c.c_car);
 
398
        }
 
399
        eval_push(form);
 
400
        vs_base = vs;
 
401
        (*f)();
 
402
        return vs_base[0];
 
403
 
 
404
OTHERWISE:
 
405
        vs_base = vs_top;
 
406
        vs_push(sLsetf);
 
407
        vs_push(place);
 
408
        vs_push(form);
 
409
        result=vs_top[-1];
 
410
        vs_push(Cnil);
 
411
        stack_cons();
 
412
        stack_cons();
 
413
        stack_cons();
 
414
/***/
 
415
#define VS_PUSH_ENV \
 
416
        if(lex_env[1]){ \
 
417
          vs_push(list(3,lex_env[0],lex_env[1],lex_env[2]));} \
 
418
        else {vs_push(Cnil);}
 
419
        VS_PUSH_ENV ;
 
420
/***/
 
421
        if (!sLsetf->s.s_mflag || sLsetf->s.s_gfdef == OBJNULL)
 
422
                FEerror("Where is SETF?", 0);
 
423
        funcall(sLsetf->s.s_gfdef);
 
424
        return Ieval(vs_base[0]);
 
425
}
 
426
 
 
427
static void
 
428
FFN(Fpush)(object form)
 
429
{
 
430
        object var;
 
431
        
 
432
        if (endp(form) || endp(MMcdr(form)))
 
433
                FEtoo_few_argumentsF(form);
 
434
        if (!endp(MMcddr(form)))
 
435
                FEtoo_many_argumentsF(form);
 
436
        var = MMcadr(form);
 
437
        if (type_of(var) != t_cons) {
 
438
                eval(MMcar(form));
 
439
                form = vs_base[0];
 
440
                eval(var);
 
441
                vs_base[0] = MMcons(form, vs_base[0]);
 
442
                setq(var, vs_base[0]);
 
443
                return;
 
444
        }
 
445
        vs_base = vs_top;
 
446
        vs_push(sLpush);
 
447
        vs_push(form);
 
448
        stack_cons();
 
449
/***/
 
450
         VS_PUSH_ENV ;
 
451
/***/
 
452
        if (!sLpush->s.s_mflag || sLpush->s.s_gfdef == OBJNULL)
 
453
                FEerror("Where is PUSH?", 0);
 
454
        funcall(sLpush->s.s_gfdef);
 
455
        eval(vs_base[0]);
 
456
}
 
457
 
 
458
static void
 
459
FFN(Fpop)(object form)
 
460
{
 
461
        object var;
 
462
 
 
463
        if (endp(form))
 
464
                FEtoo_few_argumentsF(form);
 
465
        if (!endp(MMcdr(form)))
 
466
                FEtoo_many_argumentsF(form);
 
467
        var = MMcar(form);
 
468
        if (type_of(var) != t_cons) {
 
469
                eval(var);
 
470
                setq(var, cdr(vs_base[0]));
 
471
                vs_base[0] = car(vs_base[0]);
 
472
                return;
 
473
        }
 
474
        vs_base = vs_top;
 
475
        vs_push(sLpop);
 
476
        vs_push(form);
 
477
        stack_cons();
 
478
/***/
 
479
        VS_PUSH_ENV ;
 
480
/***/
 
481
        if (!sLpop->s.s_mflag || sLpop->s.s_gfdef == OBJNULL)
 
482
                FEerror("Where is POP?", 0);
 
483
        funcall(sLpop->s.s_gfdef);
 
484
        eval(vs_base[0]);
 
485
}
 
486
 
 
487
static void
 
488
FFN(Fincf)(object form)
 
489
{
 
490
        object var;
 
491
        object one_plus(object x), number_plus(object x, object y);
 
492
 
 
493
        if (endp(form))
 
494
                FEtoo_few_argumentsF(form);
 
495
        if (!endp(MMcdr(form)) && !endp(MMcddr(form)))
 
496
                FEtoo_many_argumentsF(form);
 
497
        var = MMcar(form);
 
498
        if (type_of(var) != t_cons) {
 
499
                if (endp(MMcdr(form))) {
 
500
                        eval(var);
 
501
                        vs_base[0] = one_plus(vs_base[0]);
 
502
                        setq(var, vs_base[0]);
 
503
                        return;
 
504
                }
 
505
                eval(MMcadr(form));
 
506
                form = vs_base[0];
 
507
                eval(var);
 
508
                vs_base[0] = number_plus(vs_base[0], form);
 
509
                setq(var, vs_base[0]);
 
510
                return;
 
511
        }
 
512
        vs_base = vs_top;
 
513
        vs_push(sLincf);
 
514
        vs_push(form);
 
515
        stack_cons();
 
516
/***/
 
517
        VS_PUSH_ENV ;
 
518
/***/
 
519
        if (!sLincf->s.s_mflag || sLincf->s.s_gfdef == OBJNULL)
 
520
                FEerror("Where is INCF?", 0);
 
521
        funcall(sLincf->s.s_gfdef);
 
522
        eval(vs_base[0]);
 
523
}
 
524
 
 
525
static void
 
526
FFN(Fdecf)(object form)
 
527
{
 
528
        object var;
 
529
        object one_minus(object x), number_minus(object x, object y);
 
530
 
 
531
        if (endp(form))
 
532
                FEtoo_few_argumentsF(form);
 
533
        if (!endp(MMcdr(form)) && !endp(MMcddr(form)))
 
534
                FEtoo_many_argumentsF(form);
 
535
        var = MMcar(form);
 
536
        if (type_of(var) != t_cons) {
 
537
                if (endp(MMcdr(form))) {
 
538
                        eval(var);
 
539
                        vs_base[0] = one_minus(vs_base[0]);
 
540
                        setq(var, vs_base[0]);
 
541
                        return;
 
542
                }
 
543
                eval(MMcadr(form));
 
544
                form = vs_base[0];
 
545
                eval(var);
 
546
                vs_base[0] = number_minus(vs_base[0], form);
 
547
                setq(var, vs_base[0]);
 
548
                return;
 
549
        }
 
550
        vs_base = vs_top;
 
551
        vs_push(sLdecf);
 
552
        vs_push(form);
 
553
        stack_cons();
 
554
/***/
 
555
        VS_PUSH_ENV ;
 
556
/***/
 
557
        if (!sLdecf->s.s_mflag || sLdecf->s.s_gfdef == OBJNULL)
 
558
                FEerror("Where is DECF?", 0);
 
559
        funcall(sLdecf->s.s_gfdef);
 
560
        eval(vs_base[0]);
 
561
}
 
562
 
 
563
 
 
564
/* object */
 
565
/* clear_compiler_properties(object sym, object code) */
 
566
/* { object tem; */
 
567
/*   VFUN_NARGS=2; fSuse_fast_links(Cnil,sym); */
 
568
/*   tem = getf(sym->s.s_plist,sStraced,Cnil); */
 
569
/*   if (sSAinhibit_macro_specialA && sSAinhibit_macro_specialA->s.s_dbind != Cnil) */
 
570
/*     (void)ifuncall2(sSclear_compiler_properties, sym,code); */
 
571
/*   if (tem != Cnil) return tem; */
 
572
/*   return sym; */
 
573
  
 
574
/* } */
 
575
 
 
576
DEF_ORDINARY("CLEAR-COMPILER-PROPERTIES",sSclear_compiler_properties,SI,"");
 
577
 
 
578
DEFUN_NEW("CLEAR-COMPILER-PROPERTIES",object,fSclear_compiler_properties,SI
 
579
   ,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"")
 
580
 
 
581
{
 
582
        /* 2 args */
 
583
  RETURN1(Cnil);
 
584
}
 
585
 
 
586
DEF_ORDINARY("AREF",sLaref,LISP,"");
 
587
DEF_ORDINARY("CAR",sLcar,LISP,"");
 
588
DEF_ORDINARY("CDR",sLcdr,LISP,"");
 
589
DEF_ORDINARY("CHAR",sLchar,LISP,"");
 
590
DEF_ORDINARY("DECF",sLdecf,LISP,"");
 
591
DEF_ORDINARY("ELT",sLelt,LISP,"");
 
592
DEF_ORDINARY("FILL-POINTER",sLfill_pointer,LISP,"");
 
593
DEF_ORDINARY("GET",sLget,LISP,"");
 
594
DEF_ORDINARY("GETF",sLgetf,LISP,"");
 
595
DEF_ORDINARY("GETHASH",sLgethash,LISP,"");
 
596
DEF_ORDINARY("INCF",sLincf,LISP,"");
 
597
DEF_ORDINARY("POP",sLpop,LISP,"");
 
598
DEF_ORDINARY("PUSH",sLpush,LISP,"");
 
599
DEF_ORDINARY("SCHAR",sLschar,LISP,"");
 
600
DEF_ORDINARY("SETF",sLsetf,LISP,"");
 
601
DEF_ORDINARY("SETF-LAMBDA",sSsetf_lambda,SI,"");
 
602
DEF_ORDINARY("STRUCTURE-ACCESS",sSstructure_access,SI,"");
 
603
DEF_ORDINARY("SVREF",sLsvref,LISP,"");
 
604
DEF_ORDINARY("TRACED",sStraced,SI,"");
 
605
DEF_ORDINARY("VECTOR",sLvector,LISP,"");
 
606
 
 
607
void
 
608
gcl_init_assignment(void)
 
609
{
 
610
        make_special_form("SETQ", Fsetq);
 
611
        make_special_form("PSETQ", Fpsetq);
 
612
        make_special_form("MULTIPLE-VALUE-SETQ", Fmultiple_value_setq);
 
613
        sLsetf=make_special_form("SETF", Fsetf);
 
614
        sLpush=make_special_form("PUSH", Fpush);
 
615
        sLpop=make_special_form("POP", Fpop);
 
616
        sLincf=make_special_form("INCF", Fincf);
 
617
        sLdecf=make_special_form("DECF", Fdecf);
 
618
 
 
619
}