~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/c/compiler.d

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-06-21 09:21:21 UTC
  • mfrom: (1.1.1 upstream)
  • Revision ID: james.westby@ubuntu.com-20060621092121-txz1f21lj0wh0f67
Tags: 0.9h-20060617-1
* New upstream version
* Updated standards version without real changes. 

Show diffs side-by-side

added added

removed removed

Lines of Context:
307
307
        asm_op2(code, c_register_constant(o));
308
308
}
309
309
 
 
310
/*
 
311
 * Note: the following should match the definitions in cmp/cmpenv.lsp, as
 
312
 * well as CMP-ENV-REGISTER-MACROLET (lsp/defmacro.lsp)
 
313
 *
 
314
 * The compiler environment consists of two lists, one stored in
 
315
 * env->variables, the other one stored in env->macros.
 
316
 *
 
317
 * variable-record =    (:block block-name) |
 
318
 *                      (:tag ({tag-name}*)) |
 
319
 *                      (:function function-name) |
 
320
 *                      (var-name {:special | nil} bound-p) |
 
321
 *                      (symbol si::symbol-macro macro-function) |
 
322
 *                      CB | LB | UNWIND-PROTECT
 
323
 * macro-record =       (function-name function) |
 
324
 *                      (macro-name si::macro macro-function)
 
325
 *                      CB | LB | UNWIND-PROTECT
 
326
 *
 
327
 * A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A
 
328
 * MACRO-FUNCTION is a function that provides us with the expansion
 
329
 * for that local macro or symbol macro. BOUND-P is true when the
 
330
 * variable has been bound by an enclosing form, while it is NIL if
 
331
 * the variable-record corresponds just to a special declaration.
 
332
 * CB, LB and UNWIND-PROTECT are only used by the C compiler and they
 
333
 * denote closure, lexical environment and unwind-protect boundaries.
 
334
 */
 
335
 
310
336
static void
311
337
c_register_block(cl_object name)
312
338
{
329
355
static cl_object
330
356
c_macro_expand1(cl_object stmt)
331
357
{
332
 
        return macro_expand1(stmt, CONS(ENV->variables, ENV->macros));
 
358
        return cl_macroexpand_1(2, stmt, CONS(ENV->variables, ENV->macros));
333
359
}
334
360
 
335
361
static void
358
384
        }
359
385
}
360
386
 
361
 
static void
362
 
c_new_env(struct cl_compiler_env *new_c_env, cl_object env)
 
387
static cl_object
 
388
guess_environment(cl_object interpreter_env)
363
389
{
364
 
        ENV = new_c_env;
365
 
        ENV->stepping = 0;
366
 
        ENV->coalesce = TRUE;
367
 
        ENV->constants = Cnil;
368
 
        ENV->variables = Cnil;
369
 
        ENV->macros = Cnil;
370
 
        if (Null(env)) {
371
 
                ENV->lexical_level = 0;
372
 
                return;
373
 
        }
374
 
        ENV->lexical_level = 1;
375
 
        for (env = @revappend(env, Cnil); !Null(env); env = CDR(env))
 
390
        /*
 
391
         * Given the environment of an interpreted function, we guess a
 
392
         * suitable compiler enviroment to compile forms that access the
 
393
         * variables and local functions of this interpreted code.
 
394
         */
 
395
        for (interpreter_env = @revappend(interpreter_env, Cnil);
 
396
             !Null(interpreter_env);
 
397
             interpreter_env = CDR(interpreter_env))
376
398
        {
377
 
                cl_object record = CAR(env);
 
399
                cl_object record = CAR(interpreter_env);
378
400
                cl_object record0 = CAR(record);
379
401
                cl_object record1 = CDR(record);
380
402
                if (SYMBOLP(record0)) {
389
411
        }
390
412
}
391
413
 
 
414
static void
 
415
c_new_env(struct cl_compiler_env *new_c_env, cl_object env)
 
416
{
 
417
        ENV = new_c_env;
 
418
        ENV->stepping = 0;
 
419
        ENV->coalesce = TRUE;
 
420
        ENV->macros = Cnil;
 
421
        ENV->lexical_level = 0;
 
422
        ENV->constants = Cnil;
 
423
        if (Null(env)) {
 
424
                ENV->macros = Cnil;
 
425
                ENV->variables = Cnil;
 
426
        } else {
 
427
                ENV->variables = CAR(env);
 
428
                ENV->macros = CDR(env);
 
429
                for (env = ENV->variables; !Null(env); env = CDR(env)) {
 
430
                        cl_object record = CAR(env);
 
431
                        if (ATOM(record))
 
432
                                continue;
 
433
                        if (SYMBOLP(CAR(record)) && CADR(record) != @'si::symbol-macro') {
 
434
                                continue;
 
435
                        } else {
 
436
                                ENV->lexical_level = 1;
 
437
                                break;
 
438
                        }
 
439
                }
 
440
        }
 
441
}
 
442
 
392
443
static cl_object
393
444
c_tag_ref(cl_object the_tag, cl_object the_type)
394
445
{
395
446
        cl_fixnum n = 0;
396
 
        cl_object l;
 
447
        cl_object l, record, type, name;
397
448
        for (l = ENV->variables; CONSP(l); l = CDR(l)) {
398
 
                cl_object record = CAR(l);
399
 
                cl_object type = CAR(record);
400
 
                cl_object name = CADR(record);
 
449
                record = CAR(l);
 
450
                if (ATOM(record))
 
451
                        continue;
 
452
                type = CAR(record);
 
453
                name = CADR(record);
401
454
                if (type == @':tag') {
402
455
                        if (type == the_type && !Null(assql(the_tag, name)))
403
456
                                return CONS(MAKE_FIXNUM(n),
421
474
c_var_ref(cl_object var, int allow_symbol_macro, bool ensure_defined)
422
475
{
423
476
        cl_fixnum n = 0;
424
 
        cl_object l;
 
477
        cl_object l, record, special, name;
425
478
        for (l = ENV->variables; CONSP(l); l = CDR(l)) {
426
 
                cl_object record = CAR(l);
427
 
                cl_object name = CAR(record);
428
 
                cl_object special = CADR(record);
 
479
                record = CAR(l);
 
480
                if (ATOM(record))
 
481
                        continue;
 
482
                name = CAR(record);
 
483
                special = CADR(record);
429
484
                if (name == @':block' || name == @':tag' || name == @':function')
430
485
                        n++;
431
486
                else if (name != var) {
445
500
        if (ensure_defined) {
446
501
                l = SYM_VAL(@'si::*action-on-undefined-variable*');
447
502
                if (l != Cnil) {
448
 
                        funcall(3, l, make_simple_string("Undefined variable referenced in interpreted code.~%Name: ~A"),
 
503
                        funcall(3, l, make_simple_base_string("Undefined variable referenced in interpreted code.~%Name: ~A"),
449
504
                                var);
450
505
                }
451
506
        }
1280
1335
static int
1281
1336
c_macrolet(cl_object args, int flags)
1282
1337
{
1283
 
        cl_object def_list;
1284
 
        cl_object old_macros = ENV->macros;
1285
 
 
1286
 
        /* Pop the list of definitions */
1287
 
        for (def_list = pop(&args); !endp(def_list); ) {
1288
 
                cl_object definition = pop(&def_list);
1289
 
                cl_object name = pop(&definition);
1290
 
                cl_object arglist = pop(&definition);
1291
 
                cl_object macro, function;
1292
 
                macro = funcall(4, @'si::expand-defmacro', name, arglist,
1293
 
                                definition);
1294
 
                function = make_lambda(name, CDR(macro));
1295
 
                c_register_macro(name, function);
1296
 
        }
1297
 
        /* Remove declarations */
 
1338
        cl_object old_env = ENV->macros;
 
1339
        cl_object env = funcall(3, @'si::cmp-env-register-macrolet', pop(&args),
 
1340
                                CONS(ENV->variables, ENV->macros));
 
1341
        ENV->macros = CDR(env);
1298
1342
        args = c_process_declarations(args);
1299
1343
        flags = compile_body(args, flags);
1300
 
        ENV->macros = old_macros;
1301
 
 
 
1344
        ENV->macros = old_env;
1302
1345
        return flags;
1303
1346
}
1304
1347
 
1305
 
 
1306
1348
static int
1307
1349
c_multiple_value_bind(cl_object args, int flags)
1308
1350
{
1993
2035
        for (; !endp(body); body = CDR(body)) {
1994
2036
          form = CAR(body);
1995
2037
 
1996
 
          if (!Null(doc) && type_of(form) == t_string && !endp(CDR(body))) {
 
2038
          if (!Null(doc) && type_of(form) == t_base_string && !endp(CDR(body))) {
1997
2039
            if (documentation == Cnil)
1998
2040
              documentation = form;
1999
2041
            else
2432
2474
        @(return lambda)
2433
2475
}
2434
2476
 
2435
 
@(defun si::eval-with-env (form &optional (env Cnil) (stepping Cnil))
 
2477
@(defun si::eval-with-env (form &optional (env Cnil) (stepping Cnil) (compiler_env_p Cnil))
2436
2478
        struct cl_compiler_env *old_c_env = ENV;
2437
2479
        struct cl_compiler_env new_c_env;
2438
2480
        volatile cl_index handle;
2439
2481
        struct ihs_frame ihs;
2440
 
        cl_object bytecodes;
 
2482
        cl_object bytecodes, interpreter_env, compiler_env;
2441
2483
@
2442
2484
        /*
2443
2485
         * Compile to bytecodes.
2444
2486
         */
2445
2487
        ENV = &new_c_env;
2446
 
        c_new_env(&new_c_env, env);
 
2488
        if (compiler_env_p == Cnil) {
 
2489
                interpreter_env = env;
 
2490
                compiler_env = Cnil;
 
2491
        } else {
 
2492
                interpreter_env = Cnil;
 
2493
                compiler_env = env;
 
2494
        }
 
2495
        c_new_env(&new_c_env, compiler_env);
 
2496
        guess_environment(interpreter_env);
2447
2497
        cl_env.lex_env = env;
2448
2498
        ENV->stepping = stepping != Cnil;
2449
2499
        handle = asm_begin();
2461
2511
         * Interpret using the given lexical environment.
2462
2512
         */
2463
2513
        ihs_push(&ihs, @'eval');
2464
 
        cl_env.lex_env = env;
 
2514
        cl_env.lex_env = interpreter_env;
2465
2515
        VALUES(0) = Cnil;
2466
2516
        NVALUES = 0;
2467
2517
        interpret(bytecodes, bytecodes->bytecodes.code);