diff options
| author | Richard M. Stallman | 1992-08-04 21:22:43 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1992-08-04 21:22:43 +0000 |
| commit | 044512ed541a3dead8fcc29f4d5e56a00926895e (patch) | |
| tree | 6bddfd1e1b367735818054fe4c31dc4e9d9ae2b4 /src | |
| parent | cefabdab1ccc77ed0ee43474f947d3e5177404b6 (diff) | |
| download | emacs-044512ed541a3dead8fcc29f4d5e56a00926895e.tar.gz emacs-044512ed541a3dead8fcc29f4d5e56a00926895e.zip | |
entered into RCS
Diffstat (limited to 'src')
| -rw-r--r-- | src/bytecode.c | 267 | ||||
| -rw-r--r-- | src/callproc.c | 277 |
2 files changed, 181 insertions, 363 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index 5ab689f1925..f888a68b7f6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c | |||
| @@ -1,11 +1,11 @@ | |||
| 1 | /* Execution of byte code produced by bytecomp.el. | 1 | /* Execution of byte code produced by bytecomp.el. |
| 2 | Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc. | 2 | Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. |
| 3 | 3 | ||
| 4 | This file is part of GNU Emacs. | 4 | This file is part of GNU Emacs. |
| 5 | 5 | ||
| 6 | GNU Emacs is free software; you can redistribute it and/or modify | 6 | GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | it under the terms of the GNU General Public License as published by | 7 | it under the terms of the GNU General Public License as published by |
| 8 | the Free Software Foundation; either version 2, or (at your option) | 8 | the Free Software Foundation; either version 1, or (at your option) |
| 9 | any later version. | 9 | any later version. |
| 10 | 10 | ||
| 11 | GNU Emacs is distributed in the hope that it will be useful, | 11 | GNU Emacs is distributed in the hope that it will be useful, |
| @@ -17,12 +17,14 @@ You should have received a copy of the GNU General Public License | |||
| 17 | along with GNU Emacs; see the file COPYING. If not, write to | 17 | along with GNU Emacs; see the file COPYING. If not, write to |
| 18 | the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | 18 | the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. |
| 19 | 19 | ||
| 20 | hacked on by jwz@lucid.com 17-jun-91 | 20 | hacked on by jwz 17-jun-91 |
| 21 | o added a compile-time switch to turn on simple sanity checking; | 21 | o added a compile-time switch to turn on simple sanity checking; |
| 22 | o put back the obsolete byte-codes for error-detection; | 22 | o put back the obsolete byte-codes for error-detection; |
| 23 | o put back fset, symbol-function, and read-char because I don't | ||
| 24 | see any reason for them to have been removed; | ||
| 23 | o added a new instruction, unbind_all, which I will use for | 25 | o added a new instruction, unbind_all, which I will use for |
| 24 | tail-recursion elimination; | 26 | tail-recursion elimination; |
| 25 | o made temp_output_buffer_show be called with the right number | 27 | o made temp_output_buffer_show() be called with the right number |
| 26 | of args; | 28 | of args; |
| 27 | o made the new bytecodes be called with args in the right order; | 29 | o made the new bytecodes be called with args in the right order; |
| 28 | o added metering support. | 30 | o added metering support. |
| @@ -32,49 +34,48 @@ by Hallvard: | |||
| 32 | o all conditionals now only do QUIT if they jump. | 34 | o all conditionals now only do QUIT if they jump. |
| 33 | */ | 35 | */ |
| 34 | 36 | ||
| 37 | |||
| 35 | #include "config.h" | 38 | #include "config.h" |
| 36 | #include "lisp.h" | 39 | #include "lisp.h" |
| 37 | #include "buffer.h" | 40 | #include "buffer.h" |
| 38 | #include "syntax.h" | 41 | #include "syntax.h" |
| 39 | 42 | ||
| 40 | /* | 43 | /* Define this to enable some minor sanity checking |
| 41 | * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for | 44 | (useful for debugging the byte compiler...) |
| 42 | * debugging the byte compiler...) | 45 | */ |
| 43 | * | 46 | #define BYTE_CODE_SAFE |
| 44 | * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. | 47 | |
| 48 | /* Define this to enable generation of a histogram of byte-op usage. | ||
| 45 | */ | 49 | */ |
| 46 | /* #define BYTE_CODE_SAFE */ | 50 | #define BYTE_CODE_METER |
| 47 | /* #define BYTE_CODE_METER */ | ||
| 48 | 51 | ||
| 49 | 52 | ||
| 50 | #ifdef BYTE_CODE_METER | 53 | #ifdef BYTE_CODE_METER |
| 51 | 54 | ||
| 52 | Lisp_Object Vbyte_code_meter, Qbyte_code_meter; | 55 | Lisp_Object Vbyte_code_meter; |
| 53 | int byte_metering_on; | 56 | int byte_metering_on; |
| 54 | 57 | ||
| 55 | #define METER_2(code1, code2) \ | 58 | # define METER_2(code1,code2) \ |
| 56 | XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ | 59 | XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ |
| 57 | ->contents[(code2)]) | 60 | ->contents[(code2)]) |
| 58 | 61 | ||
| 59 | #define METER_1(code) METER_2 (0, (code)) | 62 | # define METER_1(code) METER_2 (0,(code)) |
| 60 | |||
| 61 | #define METER_CODE(last_code, this_code) \ | ||
| 62 | { \ | ||
| 63 | if (byte_metering_on) \ | ||
| 64 | { \ | ||
| 65 | if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ | ||
| 66 | METER_1 (this_code)++; \ | ||
| 67 | if (last_code \ | ||
| 68 | && METER_2 (last_code, this_code) != ((1<<VALBITS)-1)) \ | ||
| 69 | METER_2 (last_code, this_code)++; \ | ||
| 70 | } \ | ||
| 71 | } | ||
| 72 | 63 | ||
| 73 | #else /* no BYTE_CODE_METER */ | 64 | # define METER_CODE(last_code, this_code) { \ |
| 65 | if (byte_metering_on) { \ | ||
| 66 | if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ | ||
| 67 | METER_1 (this_code) ++; \ | ||
| 68 | if (last_code && \ | ||
| 69 | METER_2 (last_code,this_code) != ((1<<VALBITS)-1)) \ | ||
| 70 | METER_2 (last_code,this_code) ++; \ | ||
| 71 | } \ | ||
| 72 | } | ||
| 74 | 73 | ||
| 75 | #define METER_CODE(last_code, this_code) | 74 | #else /* ! BYTE_CODE_METER */ |
| 76 | 75 | ||
| 77 | #endif /* no BYTE_CODE_METER */ | 76 | # define meter_code(last_code, this_code) |
| 77 | |||
| 78 | #endif | ||
| 78 | 79 | ||
| 79 | 80 | ||
| 80 | Lisp_Object Qbytecode; | 81 | Lisp_Object Qbytecode; |
| @@ -146,7 +147,7 @@ Lisp_Object Qbytecode; | |||
| 146 | #define Bbobp 0157 | 147 | #define Bbobp 0157 |
| 147 | #define Bcurrent_buffer 0160 | 148 | #define Bcurrent_buffer 0160 |
| 148 | #define Bset_buffer 0161 | 149 | #define Bset_buffer 0161 |
| 149 | #define Bread_char 0162 /* No longer generated as of v19 */ | 150 | #define Bread_char 0162 |
| 150 | #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ | 151 | #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ |
| 151 | #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ | 152 | #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ |
| 152 | 153 | ||
| @@ -160,7 +161,6 @@ Lisp_Object Qbytecode; | |||
| 160 | #define Bdelete_region 0174 | 161 | #define Bdelete_region 0174 |
| 161 | #define Bnarrow_to_region 0175 | 162 | #define Bnarrow_to_region 0175 |
| 162 | #define Bwiden 0176 | 163 | #define Bwiden 0176 |
| 163 | #define Bend_of_line 0177 | ||
| 164 | 164 | ||
| 165 | #define Bconstant2 0201 | 165 | #define Bconstant2 0201 |
| 166 | #define Bgoto 0202 | 166 | #define Bgoto 0202 |
| @@ -184,12 +184,6 @@ Lisp_Object Qbytecode; | |||
| 184 | 184 | ||
| 185 | #define Bunbind_all 0222 | 185 | #define Bunbind_all 0222 |
| 186 | 186 | ||
| 187 | #define Bset_marker 0223 | ||
| 188 | #define Bmatch_beginning 0224 | ||
| 189 | #define Bmatch_end 0225 | ||
| 190 | #define Bupcase 0226 | ||
| 191 | #define Bdowncase 0227 | ||
| 192 | |||
| 193 | #define Bstringeqlsign 0230 | 187 | #define Bstringeqlsign 0230 |
| 194 | #define Bstringlss 0231 | 188 | #define Bstringlss 0231 |
| 195 | #define Bequal 0232 | 189 | #define Bequal 0232 |
| @@ -208,16 +202,6 @@ Lisp_Object Qbytecode; | |||
| 208 | #define Bnumberp 0247 | 202 | #define Bnumberp 0247 |
| 209 | #define Bintegerp 0250 | 203 | #define Bintegerp 0250 |
| 210 | 204 | ||
| 211 | #define BRgoto 0252 | ||
| 212 | #define BRgotoifnil 0253 | ||
| 213 | #define BRgotoifnonnil 0254 | ||
| 214 | #define BRgotoifnilelsepop 0255 | ||
| 215 | #define BRgotoifnonnilelsepop 0256 | ||
| 216 | |||
| 217 | #define BlistN 0257 | ||
| 218 | #define BconcatN 0260 | ||
| 219 | #define BinsertN 0261 | ||
| 220 | |||
| 221 | #define Bconstant 0300 | 205 | #define Bconstant 0300 |
| 222 | #define CONSTANTLIM 0100 | 206 | #define CONSTANTLIM 0100 |
| 223 | 207 | ||
| @@ -301,10 +285,11 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 301 | { | 285 | { |
| 302 | #ifdef BYTE_CODE_SAFE | 286 | #ifdef BYTE_CODE_SAFE |
| 303 | if (stackp > stacke) | 287 | if (stackp > stacke) |
| 304 | error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", | 288 | error ( |
| 289 | "Stack overflow in byte code (byte compiler bug), pc = %d, depth = %d", | ||
| 305 | pc - XSTRING (string_saved)->data, stacke - stackp); | 290 | pc - XSTRING (string_saved)->data, stacke - stackp); |
| 306 | if (stackp < stack) | 291 | if (stackp < stack) |
| 307 | error ("Byte code stack underflow (byte compiler bug), pc %d", | 292 | error ("Stack underflow in byte code (byte compiler bug), pc = %d", |
| 308 | pc - XSTRING (string_saved)->data); | 293 | pc - XSTRING (string_saved)->data); |
| 309 | #endif | 294 | #endif |
| 310 | 295 | ||
| @@ -405,19 +390,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 405 | case Bcall+4: case Bcall+5: | 390 | case Bcall+4: case Bcall+5: |
| 406 | op -= Bcall; | 391 | op -= Bcall; |
| 407 | docall: | 392 | docall: |
| 408 | DISCARD (op); | 393 | DISCARD(op); |
| 409 | #ifdef BYTE_CODE_METER | ||
| 410 | if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol) | ||
| 411 | { | ||
| 412 | v1 = TOP; | ||
| 413 | v2 = Fget (v1, Qbyte_code_meter); | ||
| 414 | if (XTYPE (v2) == Lisp_Int) | ||
| 415 | { | ||
| 416 | XSETINT (v2, XINT (v2) + 1); | ||
| 417 | Fput (v1, Qbyte_code_meter, v2); | ||
| 418 | } | ||
| 419 | } | ||
| 420 | #endif | ||
| 421 | TOP = Ffuncall (op + 1, &TOP); | 394 | TOP = Ffuncall (op + 1, &TOP); |
| 422 | break; | 395 | break; |
| 423 | 396 | ||
| @@ -438,7 +411,8 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 438 | 411 | ||
| 439 | case Bunbind_all: | 412 | case Bunbind_all: |
| 440 | /* To unbind back to the beginning of this frame. Not used yet, | 413 | /* To unbind back to the beginning of this frame. Not used yet, |
| 441 | but will be needed for tail-recursion elimination. */ | 414 | but wil be needed for tail-recursion elimination. |
| 415 | */ | ||
| 442 | unbind_to (count, Qnil); | 416 | unbind_to (count, Qnil); |
| 443 | break; | 417 | break; |
| 444 | 418 | ||
| @@ -450,7 +424,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 450 | 424 | ||
| 451 | case Bgotoifnil: | 425 | case Bgotoifnil: |
| 452 | op = FETCH2; | 426 | op = FETCH2; |
| 453 | if (NILP (POP)) | 427 | if (NULL (POP)) |
| 454 | { | 428 | { |
| 455 | QUIT; | 429 | QUIT; |
| 456 | pc = XSTRING (string_saved)->data + op; | 430 | pc = XSTRING (string_saved)->data + op; |
| @@ -459,7 +433,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 459 | 433 | ||
| 460 | case Bgotoifnonnil: | 434 | case Bgotoifnonnil: |
| 461 | op = FETCH2; | 435 | op = FETCH2; |
| 462 | if (!NILP (POP)) | 436 | if (!NULL (POP)) |
| 463 | { | 437 | { |
| 464 | QUIT; | 438 | QUIT; |
| 465 | pc = XSTRING (string_saved)->data + op; | 439 | pc = XSTRING (string_saved)->data + op; |
| @@ -468,65 +442,22 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 468 | 442 | ||
| 469 | case Bgotoifnilelsepop: | 443 | case Bgotoifnilelsepop: |
| 470 | op = FETCH2; | 444 | op = FETCH2; |
| 471 | if (NILP (TOP)) | 445 | if (NULL (TOP)) |
| 472 | { | 446 | { |
| 473 | QUIT; | 447 | QUIT; |
| 474 | pc = XSTRING (string_saved)->data + op; | 448 | pc = XSTRING (string_saved)->data + op; |
| 475 | } | 449 | } |
| 476 | else DISCARD (1); | 450 | else DISCARD(1); |
| 477 | break; | 451 | break; |
| 478 | 452 | ||
| 479 | case Bgotoifnonnilelsepop: | 453 | case Bgotoifnonnilelsepop: |
| 480 | op = FETCH2; | 454 | op = FETCH2; |
| 481 | if (!NILP (TOP)) | 455 | if (!NULL (TOP)) |
| 482 | { | 456 | { |
| 483 | QUIT; | 457 | QUIT; |
| 484 | pc = XSTRING (string_saved)->data + op; | 458 | pc = XSTRING (string_saved)->data + op; |
| 485 | } | 459 | } |
| 486 | else DISCARD (1); | 460 | else DISCARD(1); |
| 487 | break; | ||
| 488 | |||
| 489 | case BRgoto: | ||
| 490 | QUIT; | ||
| 491 | pc += *pc - 127; | ||
| 492 | break; | ||
| 493 | |||
| 494 | case BRgotoifnil: | ||
| 495 | if (NILP (POP)) | ||
| 496 | { | ||
| 497 | QUIT; | ||
| 498 | pc += *pc - 128; | ||
| 499 | } | ||
| 500 | pc++; | ||
| 501 | break; | ||
| 502 | |||
| 503 | case BRgotoifnonnil: | ||
| 504 | if (!NILP (POP)) | ||
| 505 | { | ||
| 506 | QUIT; | ||
| 507 | pc += *pc - 128; | ||
| 508 | } | ||
| 509 | pc++; | ||
| 510 | break; | ||
| 511 | |||
| 512 | case BRgotoifnilelsepop: | ||
| 513 | op = *pc++; | ||
| 514 | if (NILP (TOP)) | ||
| 515 | { | ||
| 516 | QUIT; | ||
| 517 | pc += op - 128; | ||
| 518 | } | ||
| 519 | else DISCARD (1); | ||
| 520 | break; | ||
| 521 | |||
| 522 | case BRgotoifnonnilelsepop: | ||
| 523 | op = *pc++; | ||
| 524 | if (!NILP (TOP)) | ||
| 525 | { | ||
| 526 | QUIT; | ||
| 527 | pc += op - 128; | ||
| 528 | } | ||
| 529 | else DISCARD (1); | ||
| 530 | break; | 461 | break; |
| 531 | 462 | ||
| 532 | case Breturn: | 463 | case Breturn: |
| @@ -534,7 +465,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 534 | goto exit; | 465 | goto exit; |
| 535 | 466 | ||
| 536 | case Bdiscard: | 467 | case Bdiscard: |
| 537 | DISCARD (1); | 468 | DISCARD(1); |
| 538 | break; | 469 | break; |
| 539 | 470 | ||
| 540 | case Bdup: | 471 | case Bdup: |
| @@ -598,7 +529,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 598 | { | 529 | { |
| 599 | if (CONSP (v1)) | 530 | if (CONSP (v1)) |
| 600 | v1 = XCONS (v1)->cdr; | 531 | v1 = XCONS (v1)->cdr; |
| 601 | else if (!NILP (v1)) | 532 | else if (!NULL (v1)) |
| 602 | { | 533 | { |
| 603 | immediate_quit = 0; | 534 | immediate_quit = 0; |
| 604 | v1 = wrong_type_argument (Qlistp, v1); | 535 | v1 = wrong_type_argument (Qlistp, v1); |
| @@ -622,7 +553,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 622 | break; | 553 | break; |
| 623 | 554 | ||
| 624 | case Blistp: | 555 | case Blistp: |
| 625 | TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; | 556 | TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil; |
| 626 | break; | 557 | break; |
| 627 | 558 | ||
| 628 | case Beq: | 559 | case Beq: |
| @@ -636,21 +567,21 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 636 | break; | 567 | break; |
| 637 | 568 | ||
| 638 | case Bnot: | 569 | case Bnot: |
| 639 | TOP = NILP (TOP) ? Qt : Qnil; | 570 | TOP = NULL (TOP) ? Qt : Qnil; |
| 640 | break; | 571 | break; |
| 641 | 572 | ||
| 642 | case Bcar: | 573 | case Bcar: |
| 643 | v1 = TOP; | 574 | v1 = TOP; |
| 644 | docar: | 575 | docar: |
| 645 | if (CONSP (v1)) TOP = XCONS (v1)->car; | 576 | if (CONSP (v1)) TOP = XCONS (v1)->car; |
| 646 | else if (NILP (v1)) TOP = Qnil; | 577 | else if (NULL (v1)) TOP = Qnil; |
| 647 | else Fcar (wrong_type_argument (Qlistp, v1)); | 578 | else Fcar (wrong_type_argument (Qlistp, v1)); |
| 648 | break; | 579 | break; |
| 649 | 580 | ||
| 650 | case Bcdr: | 581 | case Bcdr: |
| 651 | v1 = TOP; | 582 | v1 = TOP; |
| 652 | if (CONSP (v1)) TOP = XCONS (v1)->cdr; | 583 | if (CONSP (v1)) TOP = XCONS (v1)->cdr; |
| 653 | else if (NILP (v1)) TOP = Qnil; | 584 | else if (NULL (v1)) TOP = Qnil; |
| 654 | else Fcdr (wrong_type_argument (Qlistp, v1)); | 585 | else Fcdr (wrong_type_argument (Qlistp, v1)); |
| 655 | break; | 586 | break; |
| 656 | 587 | ||
| @@ -669,21 +600,15 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 669 | break; | 600 | break; |
| 670 | 601 | ||
| 671 | case Blist3: | 602 | case Blist3: |
| 672 | DISCARD (2); | 603 | DISCARD(2); |
| 673 | TOP = Flist (3, &TOP); | 604 | TOP = Flist (3, &TOP); |
| 674 | break; | 605 | break; |
| 675 | 606 | ||
| 676 | case Blist4: | 607 | case Blist4: |
| 677 | DISCARD (3); | 608 | DISCARD(3); |
| 678 | TOP = Flist (4, &TOP); | 609 | TOP = Flist (4, &TOP); |
| 679 | break; | 610 | break; |
| 680 | 611 | ||
| 681 | case BlistN: | ||
| 682 | op = FETCH; | ||
| 683 | DISCARD (op - 1); | ||
| 684 | TOP = Flist (op, &TOP); | ||
| 685 | break; | ||
| 686 | |||
| 687 | case Blength: | 612 | case Blength: |
| 688 | TOP = Flength (TOP); | 613 | TOP = Flength (TOP); |
| 689 | break; | 614 | break; |
| @@ -727,26 +652,20 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 727 | break; | 652 | break; |
| 728 | 653 | ||
| 729 | case Bconcat2: | 654 | case Bconcat2: |
| 730 | DISCARD (1); | 655 | DISCARD(1); |
| 731 | TOP = Fconcat (2, &TOP); | 656 | TOP = Fconcat (2, &TOP); |
| 732 | break; | 657 | break; |
| 733 | 658 | ||
| 734 | case Bconcat3: | 659 | case Bconcat3: |
| 735 | DISCARD (2); | 660 | DISCARD(2); |
| 736 | TOP = Fconcat (3, &TOP); | 661 | TOP = Fconcat (3, &TOP); |
| 737 | break; | 662 | break; |
| 738 | 663 | ||
| 739 | case Bconcat4: | 664 | case Bconcat4: |
| 740 | DISCARD (3); | 665 | DISCARD(3); |
| 741 | TOP = Fconcat (4, &TOP); | 666 | TOP = Fconcat (4, &TOP); |
| 742 | break; | 667 | break; |
| 743 | 668 | ||
| 744 | case BconcatN: | ||
| 745 | op = FETCH; | ||
| 746 | DISCARD (op - 1); | ||
| 747 | TOP = Fconcat (op, &TOP); | ||
| 748 | break; | ||
| 749 | |||
| 750 | case Bsub1: | 669 | case Bsub1: |
| 751 | v1 = TOP; | 670 | v1 = TOP; |
| 752 | if (XTYPE (v1) == Lisp_Int) | 671 | if (XTYPE (v1) == Lisp_Int) |
| @@ -797,7 +716,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 797 | break; | 716 | break; |
| 798 | 717 | ||
| 799 | case Bdiff: | 718 | case Bdiff: |
| 800 | DISCARD (1); | 719 | DISCARD(1); |
| 801 | TOP = Fminus (2, &TOP); | 720 | TOP = Fminus (2, &TOP); |
| 802 | break; | 721 | break; |
| 803 | 722 | ||
| @@ -813,32 +732,33 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 813 | break; | 732 | break; |
| 814 | 733 | ||
| 815 | case Bplus: | 734 | case Bplus: |
| 816 | DISCARD (1); | 735 | DISCARD(1); |
| 817 | TOP = Fplus (2, &TOP); | 736 | TOP = Fplus (2, &TOP); |
| 818 | break; | 737 | break; |
| 819 | 738 | ||
| 820 | case Bmax: | 739 | case Bmax: |
| 821 | DISCARD (1); | 740 | DISCARD(1); |
| 822 | TOP = Fmax (2, &TOP); | 741 | TOP = Fmax (2, &TOP); |
| 823 | break; | 742 | break; |
| 824 | 743 | ||
| 825 | case Bmin: | 744 | case Bmin: |
| 826 | DISCARD (1); | 745 | DISCARD(1); |
| 827 | TOP = Fmin (2, &TOP); | 746 | TOP = Fmin (2, &TOP); |
| 828 | break; | 747 | break; |
| 829 | 748 | ||
| 830 | case Bmult: | 749 | case Bmult: |
| 831 | DISCARD (1); | 750 | DISCARD(1); |
| 832 | TOP = Ftimes (2, &TOP); | 751 | TOP = Ftimes (2, &TOP); |
| 833 | break; | 752 | break; |
| 834 | 753 | ||
| 835 | case Bquo: | 754 | case Bquo: |
| 836 | DISCARD (1); | 755 | DISCARD(1); |
| 837 | TOP = Fquo (2, &TOP); | 756 | TOP = Fquo (2, &TOP); |
| 838 | break; | 757 | break; |
| 839 | 758 | ||
| 840 | case Brem: | 759 | case Brem: |
| 841 | v1 = POP; | 760 | v1 = POP; |
| 761 | /* This had args in the wrong order. -- jwz */ | ||
| 842 | TOP = Frem (TOP, v1); | 762 | TOP = Frem (TOP, v1); |
| 843 | break; | 763 | break; |
| 844 | 764 | ||
| @@ -855,12 +775,6 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 855 | TOP = Finsert (1, &TOP); | 775 | TOP = Finsert (1, &TOP); |
| 856 | break; | 776 | break; |
| 857 | 777 | ||
| 858 | case BinsertN: | ||
| 859 | op = FETCH; | ||
| 860 | DISCARD (op - 1); | ||
| 861 | TOP = Finsert (op, &TOP); | ||
| 862 | break; | ||
| 863 | |||
| 864 | case Bpoint_max: | 778 | case Bpoint_max: |
| 865 | XFASTINT (v1) = ZV; | 779 | XFASTINT (v1) = ZV; |
| 866 | PUSH (v1); | 780 | PUSH (v1); |
| @@ -928,24 +842,29 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 928 | break; | 842 | break; |
| 929 | 843 | ||
| 930 | case Bforward_char: | 844 | case Bforward_char: |
| 845 | /* This was wrong! --jwz */ | ||
| 931 | TOP = Fforward_char (TOP); | 846 | TOP = Fforward_char (TOP); |
| 932 | break; | 847 | break; |
| 933 | 848 | ||
| 934 | case Bforward_word: | 849 | case Bforward_word: |
| 850 | /* This was wrong! --jwz */ | ||
| 935 | TOP = Fforward_word (TOP); | 851 | TOP = Fforward_word (TOP); |
| 936 | break; | 852 | break; |
| 937 | 853 | ||
| 938 | case Bskip_chars_forward: | 854 | case Bskip_chars_forward: |
| 855 | /* This was wrong! --jwz */ | ||
| 939 | v1 = POP; | 856 | v1 = POP; |
| 940 | TOP = Fskip_chars_forward (TOP, v1); | 857 | TOP = Fskip_chars_forward (TOP, v1); |
| 941 | break; | 858 | break; |
| 942 | 859 | ||
| 943 | case Bskip_chars_backward: | 860 | case Bskip_chars_backward: |
| 861 | /* This was wrong! --jwz */ | ||
| 944 | v1 = POP; | 862 | v1 = POP; |
| 945 | TOP = Fskip_chars_backward (TOP, v1); | 863 | TOP = Fskip_chars_backward (TOP, v1); |
| 946 | break; | 864 | break; |
| 947 | 865 | ||
| 948 | case Bforward_line: | 866 | case Bforward_line: |
| 867 | /* This was wrong! --jwz */ | ||
| 949 | TOP = Fforward_line (TOP); | 868 | TOP = Fforward_line (TOP); |
| 950 | break; | 869 | break; |
| 951 | 870 | ||
| @@ -961,11 +880,13 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 961 | 880 | ||
| 962 | case Bdelete_region: | 881 | case Bdelete_region: |
| 963 | v1 = POP; | 882 | v1 = POP; |
| 883 | /* This had args in the wrong order. -- jwz */ | ||
| 964 | TOP = Fdelete_region (TOP, v1); | 884 | TOP = Fdelete_region (TOP, v1); |
| 965 | break; | 885 | break; |
| 966 | 886 | ||
| 967 | case Bnarrow_to_region: | 887 | case Bnarrow_to_region: |
| 968 | v1 = POP; | 888 | v1 = POP; |
| 889 | /* This had args in the wrong order. -- jwz */ | ||
| 969 | TOP = Fnarrow_to_region (TOP, v1); | 890 | TOP = Fnarrow_to_region (TOP, v1); |
| 970 | break; | 891 | break; |
| 971 | 892 | ||
| @@ -973,49 +894,27 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 973 | PUSH (Fwiden ()); | 894 | PUSH (Fwiden ()); |
| 974 | break; | 895 | break; |
| 975 | 896 | ||
| 976 | case Bend_of_line: | ||
| 977 | TOP = Fend_of_line (TOP); | ||
| 978 | break; | ||
| 979 | |||
| 980 | case Bset_marker: | ||
| 981 | v1 = POP; | ||
| 982 | v2 = POP; | ||
| 983 | TOP = Fset_marker (TOP, v2, v1); | ||
| 984 | break; | ||
| 985 | |||
| 986 | case Bmatch_beginning: | ||
| 987 | TOP = Fmatch_beginning (TOP); | ||
| 988 | break; | ||
| 989 | |||
| 990 | case Bmatch_end: | ||
| 991 | TOP = Fmatch_end (TOP); | ||
| 992 | break; | ||
| 993 | |||
| 994 | case Bupcase: | ||
| 995 | TOP = Fupcase (TOP); | ||
| 996 | break; | ||
| 997 | |||
| 998 | case Bdowncase: | ||
| 999 | TOP = Fdowncase (TOP); | ||
| 1000 | break; | ||
| 1001 | |||
| 1002 | case Bstringeqlsign: | 897 | case Bstringeqlsign: |
| 1003 | v1 = POP; | 898 | v1 = POP; |
| 899 | /* This had args in the wrong order. -- jwz */ | ||
| 1004 | TOP = Fstring_equal (TOP, v1); | 900 | TOP = Fstring_equal (TOP, v1); |
| 1005 | break; | 901 | break; |
| 1006 | 902 | ||
| 1007 | case Bstringlss: | 903 | case Bstringlss: |
| 1008 | v1 = POP; | 904 | v1 = POP; |
| 905 | /* This had args in the wrong order. -- jwz */ | ||
| 1009 | TOP = Fstring_lessp (TOP, v1); | 906 | TOP = Fstring_lessp (TOP, v1); |
| 1010 | break; | 907 | break; |
| 1011 | 908 | ||
| 1012 | case Bequal: | 909 | case Bequal: |
| 1013 | v1 = POP; | 910 | v1 = POP; |
| 911 | /* This had args in the wrong order. -- jwz */ | ||
| 1014 | TOP = Fequal (TOP, v1); | 912 | TOP = Fequal (TOP, v1); |
| 1015 | break; | 913 | break; |
| 1016 | 914 | ||
| 1017 | case Bnthcdr: | 915 | case Bnthcdr: |
| 1018 | v1 = POP; | 916 | v1 = POP; |
| 917 | /* This had args in the wrong order. -- jwz */ | ||
| 1019 | TOP = Fnthcdr (TOP, v1); | 918 | TOP = Fnthcdr (TOP, v1); |
| 1020 | break; | 919 | break; |
| 1021 | 920 | ||
| @@ -1033,11 +932,13 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 1033 | 932 | ||
| 1034 | case Bmember: | 933 | case Bmember: |
| 1035 | v1 = POP; | 934 | v1 = POP; |
| 935 | /* This had args in the wrong order. -- jwz */ | ||
| 1036 | TOP = Fmember (TOP, v1); | 936 | TOP = Fmember (TOP, v1); |
| 1037 | break; | 937 | break; |
| 1038 | 938 | ||
| 1039 | case Bassq: | 939 | case Bassq: |
| 1040 | v1 = POP; | 940 | v1 = POP; |
| 941 | /* This had args in the wrong order. -- jwz */ | ||
| 1041 | TOP = Fassq (TOP, v1); | 942 | TOP = Fassq (TOP, v1); |
| 1042 | break; | 943 | break; |
| 1043 | 944 | ||
| @@ -1047,11 +948,13 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 1047 | 948 | ||
| 1048 | case Bsetcar: | 949 | case Bsetcar: |
| 1049 | v1 = POP; | 950 | v1 = POP; |
| 951 | /* This had args in the wrong order. -- jwz */ | ||
| 1050 | TOP = Fsetcar (TOP, v1); | 952 | TOP = Fsetcar (TOP, v1); |
| 1051 | break; | 953 | break; |
| 1052 | 954 | ||
| 1053 | case Bsetcdr: | 955 | case Bsetcdr: |
| 1054 | v1 = POP; | 956 | v1 = POP; |
| 957 | /* This had args in the wrong order. -- jwz */ | ||
| 1055 | TOP = Fsetcdr (TOP, v1); | 958 | TOP = Fsetcdr (TOP, v1); |
| 1056 | break; | 959 | break; |
| 1057 | 960 | ||
| @@ -1072,12 +975,13 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 1072 | break; | 975 | break; |
| 1073 | 976 | ||
| 1074 | case Bnconc: | 977 | case Bnconc: |
| 1075 | DISCARD (1); | 978 | DISCARD(1); |
| 1076 | TOP = Fnconc (2, &TOP); | 979 | TOP = Fnconc (2, &TOP); |
| 1077 | break; | 980 | break; |
| 1078 | 981 | ||
| 1079 | case Bnumberp: | 982 | case Bnumberp: |
| 1080 | TOP = (NUMBERP (TOP) ? Qt : Qnil); | 983 | TOP = (XTYPE (TOP) == Lisp_Int || XTYPE (TOP) == Lisp_Float |
| 984 | ? Qt : Qnil); | ||
| 1081 | break; | 985 | break; |
| 1082 | 986 | ||
| 1083 | case Bintegerp: | 987 | case Bintegerp: |
| @@ -1092,7 +996,7 @@ If the third argument is incorrect, Emacs may crash.") | |||
| 1092 | error ("scan-buffer is an obsolete bytecode"); | 996 | error ("scan-buffer is an obsolete bytecode"); |
| 1093 | break; | 997 | break; |
| 1094 | case Bmark: | 998 | case Bmark: |
| 1095 | error ("mark is an obsolete bytecode"); | 999 | error("mark is an obsolete bytecode"); |
| 1096 | break; | 1000 | break; |
| 1097 | #endif | 1001 | #endif |
| 1098 | 1002 | ||
| @@ -1131,18 +1035,17 @@ syms_of_bytecode () | |||
| 1131 | #ifdef BYTE_CODE_METER | 1035 | #ifdef BYTE_CODE_METER |
| 1132 | 1036 | ||
| 1133 | DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, | 1037 | DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, |
| 1134 | "A vector of vectors which holds a histogram of byte-code usage."); | 1038 | "a vector of vectors which holds a histogram of byte-code usage."); |
| 1135 | DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, ""); | 1039 | DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, ""); |
| 1136 | 1040 | ||
| 1137 | byte_metering_on = 0; | 1041 | byte_metering_on = 0; |
| 1138 | Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); | 1042 | Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0)); |
| 1139 | Qbyte_code_meter = intern ("byte-code-meter"); | 1043 | |
| 1140 | staticpro (&Qbyte_code_meter); | ||
| 1141 | { | 1044 | { |
| 1142 | int i = 256; | 1045 | int i = 256; |
| 1143 | while (i--) | 1046 | while (i--) |
| 1144 | XVECTOR (Vbyte_code_meter)->contents[i] = | 1047 | XVECTOR(Vbyte_code_meter)->contents[i] = |
| 1145 | Fmake_vector (make_number (256), make_number (0)); | 1048 | Fmake_vector(make_number(256), make_number(0)); |
| 1146 | } | 1049 | } |
| 1147 | #endif | 1050 | #endif |
| 1148 | } | 1051 | } |
diff --git a/src/callproc.c b/src/callproc.c index 253d6877851..7d8185c5a4b 100644 --- a/src/callproc.c +++ b/src/callproc.c | |||
| @@ -1,5 +1,5 @@ | |||
| 1 | /* Synchronous subprocess invocation for GNU Emacs. | 1 | /* Synchronous subprocess invocation for GNU Emacs. |
| 2 | Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc. | 2 | Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc. |
| 3 | 3 | ||
| 4 | This file is part of GNU Emacs. | 4 | This file is part of GNU Emacs. |
| 5 | 5 | ||
| @@ -19,7 +19,6 @@ the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |||
| 19 | 19 | ||
| 20 | 20 | ||
| 21 | #include <signal.h> | 21 | #include <signal.h> |
| 22 | #include <errno.h> | ||
| 23 | 22 | ||
| 24 | #include "config.h" | 23 | #include "config.h" |
| 25 | 24 | ||
| @@ -58,11 +57,16 @@ extern char **environ; | |||
| 58 | 57 | ||
| 59 | #define max(a, b) ((a) > (b) ? (a) : (b)) | 58 | #define max(a, b) ((a) > (b) ? (a) : (b)) |
| 60 | 59 | ||
| 61 | Lisp_Object Vexec_path, Vexec_directory, Vdata_directory; | 60 | Lisp_Object Vexec_path, Vexec_directory; |
| 62 | 61 | ||
| 63 | Lisp_Object Vshell_file_name; | 62 | Lisp_Object Vshell_file_name; |
| 64 | 63 | ||
| 64 | #ifndef MAINTAIN_ENVIRONMENT | ||
| 65 | /* List of strings to append to front of environment of | ||
| 66 | all subprocesses when they are started. */ | ||
| 67 | |||
| 65 | Lisp_Object Vprocess_environment; | 68 | Lisp_Object Vprocess_environment; |
| 69 | #endif | ||
| 66 | 70 | ||
| 67 | /* True iff we are about to fork off a synchronous process or if we | 71 | /* True iff we are about to fork off a synchronous process or if we |
| 68 | are waiting for it. */ | 72 | are waiting for it. */ |
| @@ -99,13 +103,13 @@ Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ | |||
| 99 | Remaining arguments are strings passed as command arguments to PROGRAM.\n\ | 103 | Remaining arguments are strings passed as command arguments to PROGRAM.\n\ |
| 100 | If BUFFER is nil or 0, returns immediately with value nil.\n\ | 104 | If BUFFER is nil or 0, returns immediately with value nil.\n\ |
| 101 | Otherwise waits for PROGRAM to terminate\n\ | 105 | Otherwise waits for PROGRAM to terminate\n\ |
| 102 | and returns a numeric exit status or a signal description string.\n\ | 106 | and returns a numeric exit status or a signal name as a string.\n\ |
| 103 | If you quit, the process is killed with SIGKILL.") | 107 | If you quit, the process is killed with SIGKILL.") |
| 104 | (nargs, args) | 108 | (nargs, args) |
| 105 | int nargs; | 109 | int nargs; |
| 106 | register Lisp_Object *args; | 110 | register Lisp_Object *args; |
| 107 | { | 111 | { |
| 108 | Lisp_Object display, infile, buffer, path, current_dir; | 112 | Lisp_Object display, buffer, path; |
| 109 | int fd[2]; | 113 | int fd[2]; |
| 110 | int filefd; | 114 | int filefd; |
| 111 | register int pid; | 115 | register int pid; |
| @@ -117,37 +121,34 @@ If you quit, the process is killed with SIGKILL.") | |||
| 117 | #if 0 | 121 | #if 0 |
| 118 | int mask; | 122 | int mask; |
| 119 | #endif | 123 | #endif |
| 124 | struct gcpro gcpro1; | ||
| 125 | |||
| 126 | GCPRO1 (*args); | ||
| 127 | gcpro1.nvars = nargs; | ||
| 128 | |||
| 120 | CHECK_STRING (args[0], 0); | 129 | CHECK_STRING (args[0], 0); |
| 121 | 130 | ||
| 122 | if (nargs >= 2 && ! NILP (args[1])) | 131 | if (nargs <= 1 || NULL (args[1])) |
| 123 | { | 132 | args[1] = build_string ("/dev/null"); |
| 124 | infile = Fexpand_file_name (args[1], current_buffer->directory); | ||
| 125 | CHECK_STRING (infile, 1); | ||
| 126 | } | ||
| 127 | else | 133 | else |
| 128 | #ifdef VMS | 134 | args[1] = Fexpand_file_name (args[1], current_buffer->directory); |
| 129 | infile = build_string ("NLA0:"); | ||
| 130 | #else | ||
| 131 | infile = build_string ("/dev/null"); | ||
| 132 | #endif /* not VMS */ | ||
| 133 | 135 | ||
| 134 | if (nargs >= 3) | 136 | CHECK_STRING (args[1], 1); |
| 135 | { | 137 | |
| 136 | register Lisp_Object tem; | 138 | { |
| 137 | 139 | register Lisp_Object tem; | |
| 138 | buffer = tem = args[2]; | 140 | buffer = tem = args[2]; |
| 139 | if (!(EQ (tem, Qnil) | 141 | if (nargs <= 2) |
| 140 | || EQ (tem, Qt) | 142 | buffer = Qnil; |
| 141 | || XFASTINT (tem) == 0)) | 143 | else if (!(EQ (tem, Qnil) || EQ (tem, Qt) |
| 142 | { | 144 | || XFASTINT (tem) == 0)) |
| 143 | buffer = Fget_buffer (tem); | 145 | { |
| 144 | CHECK_BUFFER (buffer, 2); | 146 | buffer = Fget_buffer (tem); |
| 145 | } | 147 | CHECK_BUFFER (buffer, 2); |
| 146 | } | 148 | } |
| 147 | else | 149 | } |
| 148 | buffer = Qnil; | ||
| 149 | 150 | ||
| 150 | display = nargs >= 4 ? args[3] : Qnil; | 151 | display = nargs >= 3 ? args[3] : Qnil; |
| 151 | 152 | ||
| 152 | { | 153 | { |
| 153 | register int i; | 154 | register int i; |
| @@ -161,14 +162,14 @@ If you quit, the process is killed with SIGKILL.") | |||
| 161 | new_argv[i - 3] = 0; | 162 | new_argv[i - 3] = 0; |
| 162 | } | 163 | } |
| 163 | 164 | ||
| 164 | filefd = open (XSTRING (infile)->data, O_RDONLY, 0); | 165 | filefd = open (XSTRING (args[1])->data, O_RDONLY, 0); |
| 165 | if (filefd < 0) | 166 | if (filefd < 0) |
| 166 | { | 167 | { |
| 167 | report_file_error ("Opening process input file", Fcons (infile, Qnil)); | 168 | report_file_error ("Opening process input file", Fcons (args[1], Qnil)); |
| 168 | } | 169 | } |
| 169 | /* Search for program; barf if not found. */ | 170 | /* Search for program; barf if not found. */ |
| 170 | openp (Vexec_path, args[0], "", &path, 1); | 171 | openp (Vexec_path, args[0], "", &path, 1); |
| 171 | if (NILP (path)) | 172 | if (NULL (path)) |
| 172 | { | 173 | { |
| 173 | close (filefd); | 174 | close (filefd); |
| 174 | report_file_error ("Searching for program", Fcons (args[0], Qnil)); | 175 | report_file_error ("Searching for program", Fcons (args[0], Qnil)); |
| @@ -186,19 +187,19 @@ If you quit, the process is killed with SIGKILL.") | |||
| 186 | #endif | 187 | #endif |
| 187 | } | 188 | } |
| 188 | 189 | ||
| 189 | /* Make sure that the child will be able to chdir to the current | ||
| 190 | buffer's current directory. We can't just have the child check | ||
| 191 | for an error when it does the chdir, since it's in a vfork. */ | ||
| 192 | current_dir = expand_and_dir_to_file (current_buffer->directory, Qnil); | ||
| 193 | if (NILP (Ffile_accessible_directory_p (current_dir))) | ||
| 194 | report_file_error ("Setting current directory", | ||
| 195 | Fcons (current_buffer->directory, Qnil)); | ||
| 196 | |||
| 197 | { | 190 | { |
| 198 | /* child_setup must clobber environ in systems with true vfork. | 191 | /* child_setup must clobber environ in systems with true vfork. |
| 199 | Protect it from permanent change. */ | 192 | Protect it from permanent change. */ |
| 200 | register char **save_environ = environ; | 193 | register char **save_environ = environ; |
| 201 | register int fd1 = fd[1]; | 194 | register int fd1 = fd[1]; |
| 195 | char **env; | ||
| 196 | |||
| 197 | #ifdef MAINTAIN_ENVIRONMENT | ||
| 198 | env = (char **) alloca (size_of_current_environ ()); | ||
| 199 | get_current_environ (env); | ||
| 200 | #else | ||
| 201 | env = environ; | ||
| 202 | #endif /* MAINTAIN_ENVIRONMENT */ | ||
| 202 | 203 | ||
| 203 | #if 0 /* Some systems don't have sigblock. */ | 204 | #if 0 /* Some systems don't have sigblock. */ |
| 204 | mask = sigblock (sigmask (SIGCHLD)); | 205 | mask = sigblock (sigmask (SIGCHLD)); |
| @@ -218,7 +219,7 @@ If you quit, the process is killed with SIGKILL.") | |||
| 218 | #else | 219 | #else |
| 219 | setpgrp (pid, pid); | 220 | setpgrp (pid, pid); |
| 220 | #endif /* USG */ | 221 | #endif /* USG */ |
| 221 | child_setup (filefd, fd1, fd1, new_argv, 0, current_dir); | 222 | child_setup (filefd, fd1, fd1, new_argv, env, 0); |
| 222 | } | 223 | } |
| 223 | 224 | ||
| 224 | #if 0 | 225 | #if 0 |
| @@ -243,17 +244,13 @@ If you quit, the process is killed with SIGKILL.") | |||
| 243 | if (XTYPE (buffer) == Lisp_Int) | 244 | if (XTYPE (buffer) == Lisp_Int) |
| 244 | { | 245 | { |
| 245 | #ifndef subprocesses | 246 | #ifndef subprocesses |
| 246 | /* If Emacs has been built with asynchronous subprocess support, | ||
| 247 | we don't need to do this, I think because it will then have | ||
| 248 | the facilities for handling SIGCHLD. */ | ||
| 249 | wait_without_blocking (); | 247 | wait_without_blocking (); |
| 250 | #endif /* subprocesses */ | 248 | #endif /* subprocesses */ |
| 249 | |||
| 250 | UNGCPRO; | ||
| 251 | return Qnil; | 251 | return Qnil; |
| 252 | } | 252 | } |
| 253 | 253 | ||
| 254 | synch_process_death = 0; | ||
| 255 | synch_process_retcode = 0; | ||
| 256 | |||
| 257 | record_unwind_protect (call_process_cleanup, | 254 | record_unwind_protect (call_process_cleanup, |
| 258 | Fcons (make_number (fd[0]), make_number (pid))); | 255 | Fcons (make_number (fd[0]), make_number (pid))); |
| 259 | 256 | ||
| @@ -270,9 +267,9 @@ If you quit, the process is killed with SIGKILL.") | |||
| 270 | while ((nread = read (fd[0], buf, sizeof buf)) > 0) | 267 | while ((nread = read (fd[0], buf, sizeof buf)) > 0) |
| 271 | { | 268 | { |
| 272 | immediate_quit = 0; | 269 | immediate_quit = 0; |
| 273 | if (!NILP (buffer)) | 270 | if (!NULL (buffer)) |
| 274 | insert (buf, nread); | 271 | insert (buf, nread); |
| 275 | if (!NILP (display) && INTERACTIVE) | 272 | if (!NULL (display) && INTERACTIVE) |
| 276 | redisplay_preserve_echo_area (); | 273 | redisplay_preserve_echo_area (); |
| 277 | immediate_quit = 1; | 274 | immediate_quit = 1; |
| 278 | QUIT; | 275 | QUIT; |
| @@ -288,6 +285,8 @@ If you quit, the process is killed with SIGKILL.") | |||
| 288 | 285 | ||
| 289 | unbind_to (count, Qnil); | 286 | unbind_to (count, Qnil); |
| 290 | 287 | ||
| 288 | UNGCPRO; | ||
| 289 | |||
| 291 | if (synch_process_death) | 290 | if (synch_process_death) |
| 292 | return build_string (synch_process_death); | 291 | return build_string (synch_process_death); |
| 293 | return make_number (synch_process_retcode); | 292 | return make_number (synch_process_retcode); |
| @@ -311,7 +310,7 @@ Sixth arg DISPLAY non-nil means redisplay buffer as output is inserted.\n\ | |||
| 311 | Remaining args are passed to PROGRAM at startup as command args.\n\ | 310 | Remaining args are passed to PROGRAM at startup as command args.\n\ |
| 312 | If BUFFER is nil, returns immediately with value nil.\n\ | 311 | If BUFFER is nil, returns immediately with value nil.\n\ |
| 313 | Otherwise waits for PROGRAM to terminate\n\ | 312 | Otherwise waits for PROGRAM to terminate\n\ |
| 314 | and returns a numeric exit status or a signal description string.\n\ | 313 | and returns a numeric exit status or a signal name as a string.\n\ |
| 315 | If you quit, the process is killed with SIGKILL.") | 314 | If you quit, the process is killed with SIGKILL.") |
| 316 | (nargs, args) | 315 | (nargs, args) |
| 317 | int nargs; | 316 | int nargs; |
| @@ -320,6 +319,10 @@ If you quit, the process is killed with SIGKILL.") | |||
| 320 | register Lisp_Object filename_string, start, end; | 319 | register Lisp_Object filename_string, start, end; |
| 321 | char tempfile[20]; | 320 | char tempfile[20]; |
| 322 | int count = specpdl_ptr - specpdl; | 321 | int count = specpdl_ptr - specpdl; |
| 322 | struct gcpro gcpro1; | ||
| 323 | |||
| 324 | GCPRO1 (*args); | ||
| 325 | gcpro1.nvars = 2; | ||
| 323 | 326 | ||
| 324 | #ifdef VMS | 327 | #ifdef VMS |
| 325 | strcpy (tempfile, "tmp:emacsXXXXXX."); | 328 | strcpy (tempfile, "tmp:emacsXXXXXX."); |
| @@ -334,12 +337,13 @@ If you quit, the process is killed with SIGKILL.") | |||
| 334 | Fwrite_region (start, end, filename_string, Qnil, Qlambda); | 337 | Fwrite_region (start, end, filename_string, Qnil, Qlambda); |
| 335 | record_unwind_protect (delete_temp_file, filename_string); | 338 | record_unwind_protect (delete_temp_file, filename_string); |
| 336 | 339 | ||
| 337 | if (!NILP (args[3])) | 340 | if (!NULL (args[3])) |
| 338 | Fdelete_region (start, end); | 341 | Fdelete_region (start, end); |
| 339 | 342 | ||
| 340 | args[3] = filename_string; | 343 | args[3] = filename_string; |
| 341 | Fcall_process (nargs - 2, args + 2); | 344 | Fcall_process (nargs - 2, args + 2); |
| 342 | 345 | ||
| 346 | UNGCPRO; | ||
| 343 | return unbind_to (count, Qnil); | 347 | return unbind_to (count, Qnil); |
| 344 | } | 348 | } |
| 345 | 349 | ||
| @@ -358,21 +362,14 @@ If you quit, the process is killed with SIGKILL.") | |||
| 358 | ENV is the environment for the subprocess. | 362 | ENV is the environment for the subprocess. |
| 359 | 363 | ||
| 360 | SET_PGRP is nonzero if we should put the subprocess into a separate | 364 | SET_PGRP is nonzero if we should put the subprocess into a separate |
| 361 | process group. | 365 | process group. */ |
| 362 | |||
| 363 | CURRENT_DIR is an elisp string giving the path of the current | ||
| 364 | directory the subprocess should have. Since we can't really signal | ||
| 365 | a decent error from within the child, this should be verified as an | ||
| 366 | executable directory by the parent. */ | ||
| 367 | 366 | ||
| 368 | child_setup (in, out, err, new_argv, set_pgrp, current_dir) | 367 | child_setup (in, out, err, new_argv, env, set_pgrp) |
| 369 | int in, out, err; | 368 | int in, out, err; |
| 370 | register char **new_argv; | 369 | register char **new_argv; |
| 370 | char **env; | ||
| 371 | int set_pgrp; | 371 | int set_pgrp; |
| 372 | Lisp_Object current_dir; | ||
| 373 | { | 372 | { |
| 374 | char **env; | ||
| 375 | |||
| 376 | register int pid = getpid(); | 373 | register int pid = getpid(); |
| 377 | 374 | ||
| 378 | setpriority (PRIO_PROCESS, pid, 0); | 375 | setpriority (PRIO_PROCESS, pid, 0); |
| @@ -387,25 +384,24 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) | |||
| 387 | If using vfork and C_ALLOCA it is safe because that changes | 384 | If using vfork and C_ALLOCA it is safe because that changes |
| 388 | the superior's static variables as if the superior had done alloca | 385 | the superior's static variables as if the superior had done alloca |
| 389 | and will be cleaned up in the usual way. */ | 386 | and will be cleaned up in the usual way. */ |
| 390 | { | ||
| 391 | register unsigned char *temp; | ||
| 392 | register int i; | ||
| 393 | 387 | ||
| 394 | i = XSTRING (current_dir)->size; | 388 | if (XTYPE (current_buffer->directory) == Lisp_String) |
| 395 | temp = (unsigned char *) alloca (i + 2); | 389 | { |
| 396 | bcopy (XSTRING (current_dir)->data, temp, i); | 390 | register unsigned char *temp; |
| 397 | if (temp[i - 1] != '/') temp[i++] = '/'; | 391 | register int i; |
| 398 | temp[i] = 0; | 392 | |
| 399 | 393 | i = XSTRING (current_buffer->directory)->size; | |
| 400 | /* We can't signal an Elisp error here; we're in a vfork. Since | 394 | temp = (unsigned char *) alloca (i + 2); |
| 401 | the callers check the current directory before forking, this | 395 | bcopy (XSTRING (current_buffer->directory)->data, temp, i); |
| 402 | should only return an error if the directory's permissions | 396 | if (temp[i - 1] != '/') temp[i++] = '/'; |
| 403 | are changed between the check and this chdir, but we should | 397 | temp[i] = 0; |
| 404 | at least check. */ | 398 | /* Switch to that directory, and report any error. */ |
| 405 | if (chdir (temp) < 0) | 399 | if (chdir (temp) < 0) |
| 406 | exit (errno); | 400 | report_file_error ("In chdir", |
| 407 | } | 401 | Fcons (current_buffer->directory, Qnil)); |
| 402 | } | ||
| 408 | 403 | ||
| 404 | #ifndef MAINTAIN_ENVIRONMENT | ||
| 409 | /* Set `env' to a vector of the strings in Vprocess_environment. */ | 405 | /* Set `env' to a vector of the strings in Vprocess_environment. */ |
| 410 | { | 406 | { |
| 411 | register Lisp_Object tem; | 407 | register Lisp_Object tem; |
| @@ -422,7 +418,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) | |||
| 422 | /* new_length + 1 to include terminating 0 */ | 418 | /* new_length + 1 to include terminating 0 */ |
| 423 | env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *)); | 419 | env = new_env = (char **) alloca ((new_length + 1) * sizeof (char *)); |
| 424 | 420 | ||
| 425 | /* Copy the Vprocess_alist strings into new_env. */ | 421 | /* Copy the env strings into new_env. */ |
| 426 | for (tem = Vprocess_environment; | 422 | for (tem = Vprocess_environment; |
| 427 | (XTYPE (tem) == Lisp_Cons | 423 | (XTYPE (tem) == Lisp_Cons |
| 428 | && XTYPE (XCONS (tem)->car) == Lisp_String); | 424 | && XTYPE (XCONS (tem)->car) == Lisp_String); |
| @@ -430,6 +426,7 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) | |||
| 430 | *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data; | 426 | *new_env++ = (char *) XSTRING (XCONS (tem)->car)->data; |
| 431 | *new_env = 0; | 427 | *new_env = 0; |
| 432 | } | 428 | } |
| 429 | #endif /* Not MAINTAIN_ENVIRONMENT */ | ||
| 433 | 430 | ||
| 434 | close (0); | 431 | close (0); |
| 435 | close (1); | 432 | close (1); |
| @@ -442,11 +439,6 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) | |||
| 442 | close (out); | 439 | close (out); |
| 443 | close (err); | 440 | close (err); |
| 444 | 441 | ||
| 445 | #ifdef USG | ||
| 446 | setpgrp (); /* No arguments but equivalent in this case */ | ||
| 447 | #else | ||
| 448 | setpgrp (pid, pid); | ||
| 449 | #endif /* USG */ | ||
| 450 | setpgrp_of_tty (pid); | 442 | setpgrp_of_tty (pid); |
| 451 | 443 | ||
| 452 | #ifdef vipc | 444 | #ifdef vipc |
| @@ -464,111 +456,38 @@ child_setup (in, out, err, new_argv, set_pgrp, current_dir) | |||
| 464 | _exit (1); | 456 | _exit (1); |
| 465 | } | 457 | } |
| 466 | 458 | ||
| 467 | static int | ||
| 468 | getenv_internal (var, varlen, value, valuelen) | ||
| 469 | char *var; | ||
| 470 | int varlen; | ||
| 471 | char **value; | ||
| 472 | int *valuelen; | ||
| 473 | { | ||
| 474 | Lisp_Object scan; | ||
| 475 | |||
| 476 | for (scan = Vprocess_environment; CONSP (scan); scan = XCONS (scan)->cdr) | ||
| 477 | { | ||
| 478 | Lisp_Object entry = XCONS (scan)->car; | ||
| 479 | |||
| 480 | if (XTYPE (entry) == Lisp_String | ||
| 481 | && XSTRING (entry)->size > varlen | ||
| 482 | && XSTRING (entry)->data[varlen] == '=' | ||
| 483 | && ! bcmp (XSTRING (entry)->data, var, varlen)) | ||
| 484 | { | ||
| 485 | *value = (char *) XSTRING (entry)->data + (varlen + 1); | ||
| 486 | *valuelen = XSTRING (entry)->size - (varlen + 1); | ||
| 487 | return 1; | ||
| 488 | } | ||
| 489 | } | ||
| 490 | |||
| 491 | return 0; | ||
| 492 | } | ||
| 493 | |||
| 494 | DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0, | ||
| 495 | "Return the value of environment variable VAR, as a string.\n\ | ||
| 496 | VAR should be a string. Value is nil if VAR is undefined in the environment.\n\ | ||
| 497 | This function consults the variable ``process-environment'' for its value.") | ||
| 498 | (var) | ||
| 499 | Lisp_Object var; | ||
| 500 | { | ||
| 501 | char *value; | ||
| 502 | int valuelen; | ||
| 503 | |||
| 504 | CHECK_STRING (var, 0); | ||
| 505 | if (getenv_internal (XSTRING (var)->data, XSTRING (var)->size, | ||
| 506 | &value, &valuelen)) | ||
| 507 | return make_string (value, valuelen); | ||
| 508 | else | ||
| 509 | return Qnil; | ||
| 510 | } | ||
| 511 | |||
| 512 | /* A version of getenv that consults process_environment, easily | ||
| 513 | callable from C. */ | ||
| 514 | char * | ||
| 515 | egetenv (var) | ||
| 516 | char *var; | ||
| 517 | { | ||
| 518 | char *value; | ||
| 519 | int valuelen; | ||
| 520 | |||
| 521 | if (getenv_internal (var, strlen (var), &value, &valuelen)) | ||
| 522 | return value; | ||
| 523 | else | ||
| 524 | return 0; | ||
| 525 | } | ||
| 526 | |||
| 527 | #endif /* not VMS */ | 459 | #endif /* not VMS */ |
| 528 | 460 | ||
| 529 | init_callproc () | 461 | init_callproc () |
| 530 | { | 462 | { |
| 531 | register char * sh; | 463 | register char * sh; |
| 532 | register char **envp; | 464 | register char **envp; |
| 533 | Lisp_Object tempdir; | 465 | Lisp_Object execdir; |
| 534 | 466 | ||
| 535 | { | 467 | /* Turn PATH_EXEC into a path. `==' is just a string which we know |
| 536 | char *data_dir = egetenv ("EMACSDATA"); | 468 | will not be the name of an environment variable. */ |
| 537 | 469 | Vexec_path = decode_env_path ("==", PATH_EXEC); | |
| 538 | Vdata_directory = | ||
| 539 | Ffile_name_as_directory | ||
| 540 | (build_string (data_dir ? data_dir : PATH_DATA)); | ||
| 541 | } | ||
| 542 | |||
| 543 | /* Check the EMACSPATH environment variable, defaulting to the | ||
| 544 | PATH_EXEC path from paths.h. */ | ||
| 545 | Vexec_path = decode_env_path ("EMACSPATH", PATH_EXEC); | ||
| 546 | Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); | 470 | Vexec_directory = Ffile_name_as_directory (Fcar (Vexec_path)); |
| 547 | Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); | 471 | Vexec_path = nconc2 (decode_env_path ("PATH", ""), Vexec_path); |
| 548 | 472 | ||
| 549 | tempdir = Fdirectory_file_name (Vexec_directory); | 473 | execdir = Fdirectory_file_name (Vexec_directory); |
| 550 | if (access (XSTRING (tempdir)->data, 0) < 0) | 474 | if (access (XSTRING (execdir)->data, 0) < 0) |
| 551 | { | 475 | { |
| 552 | printf ("Warning: arch-dependent data dir (%s) does not exist.\n", | 476 | printf ("Warning: executable/documentation dir (%s) does not exist.\n", |
| 553 | XSTRING (Vexec_directory)->data); | 477 | XSTRING (Vexec_directory)->data); |
| 554 | sleep (2); | 478 | sleep (2); |
| 555 | } | 479 | } |
| 556 | 480 | ||
| 557 | tempdir = Fdirectory_file_name (Vdata_directory); | ||
| 558 | if (access (XSTRING (tempdir)->data, 0) < 0) | ||
| 559 | { | ||
| 560 | printf ("Warning: arch-independent data dir (%s) does not exist.\n", | ||
| 561 | XSTRING (Vdata_directory)->data); | ||
| 562 | sleep (2); | ||
| 563 | } | ||
| 564 | |||
| 565 | #ifdef VMS | 481 | #ifdef VMS |
| 566 | Vshell_file_name = build_string ("*dcl*"); | 482 | Vshell_file_name = build_string ("*dcl*"); |
| 567 | #else | 483 | #else |
| 568 | sh = (char *) getenv ("SHELL"); | 484 | sh = (char *) egetenv ("SHELL"); |
| 569 | Vshell_file_name = build_string (sh ? sh : "/bin/sh"); | 485 | Vshell_file_name = build_string (sh ? sh : "/bin/sh"); |
| 570 | #endif | 486 | #endif |
| 571 | 487 | ||
| 488 | #ifndef MAINTAIN_ENVIRONMENT | ||
| 489 | /* The equivalent of this operation was done | ||
| 490 | in init_environ in environ.c if MAINTAIN_ENVIRONMENT */ | ||
| 572 | Vprocess_environment = Qnil; | 491 | Vprocess_environment = Qnil; |
| 573 | #ifndef CANNOT_DUMP | 492 | #ifndef CANNOT_DUMP |
| 574 | if (initialized) | 493 | if (initialized) |
| @@ -576,6 +495,7 @@ init_callproc () | |||
| 576 | for (envp = environ; *envp; envp++) | 495 | for (envp = environ; *envp; envp++) |
| 577 | Vprocess_environment = Fcons (build_string (*envp), | 496 | Vprocess_environment = Fcons (build_string (*envp), |
| 578 | Vprocess_environment); | 497 | Vprocess_environment); |
| 498 | #endif /* MAINTAIN_ENVIRONMENT */ | ||
| 579 | } | 499 | } |
| 580 | 500 | ||
| 581 | syms_of_callproc () | 501 | syms_of_callproc () |
| @@ -589,22 +509,17 @@ Initialized from the SHELL environment variable."); | |||
| 589 | Each element is a string (directory name) or nil (try default directory)."); | 509 | Each element is a string (directory name) or nil (try default directory)."); |
| 590 | 510 | ||
| 591 | DEFVAR_LISP ("exec-directory", &Vexec_directory, | 511 | DEFVAR_LISP ("exec-directory", &Vexec_directory, |
| 592 | "Directory of architecture-dependent files that come with GNU Emacs,\n\ | 512 | "Directory that holds programs that come with GNU Emacs,\n\ |
| 593 | especially executable programs intended for Emacs to invoke."); | 513 | intended for Emacs to invoke."); |
| 594 | |||
| 595 | DEFVAR_LISP ("data-directory", &Vdata_directory, | ||
| 596 | "Directory of architecture-independent files that come with GNU Emacs,\n\ | ||
| 597 | intended for Emacs to use."); | ||
| 598 | 514 | ||
| 515 | #ifndef MAINTAIN_ENVIRONMENT | ||
| 599 | DEFVAR_LISP ("process-environment", &Vprocess_environment, | 516 | DEFVAR_LISP ("process-environment", &Vprocess_environment, |
| 600 | "List of environment variables for subprocesses to inherit.\n\ | 517 | "List of strings to append to environment of subprocesses that are started.\n\ |
| 601 | Each element should be a string of the form ENVVARNAME=VALUE.\n\ | 518 | Each string should have the format ENVVARNAME=VALUE."); |
| 602 | The environment which Emacs inherits is placed in this variable\n\ | 519 | #endif |
| 603 | when Emacs starts."); | ||
| 604 | 520 | ||
| 605 | #ifndef VMS | 521 | #ifndef VMS |
| 606 | defsubr (&Scall_process); | 522 | defsubr (&Scall_process); |
| 607 | #endif | 523 | #endif |
| 608 | defsubr (&Sgetenv); | ||
| 609 | defsubr (&Scall_process_region); | 524 | defsubr (&Scall_process_region); |
| 610 | } | 525 | } |