aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
authorRichard M. Stallman1992-08-04 21:22:43 +0000
committerRichard M. Stallman1992-08-04 21:22:43 +0000
commit044512ed541a3dead8fcc29f4d5e56a00926895e (patch)
tree6bddfd1e1b367735818054fe4c31dc4e9d9ae2b4 /src
parentcefabdab1ccc77ed0ee43474f947d3e5177404b6 (diff)
downloademacs-044512ed541a3dead8fcc29f4d5e56a00926895e.tar.gz
emacs-044512ed541a3dead8fcc29f4d5e56a00926895e.zip
entered into RCS
Diffstat (limited to 'src')
-rw-r--r--src/bytecode.c267
-rw-r--r--src/callproc.c277
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
4This file is part of GNU Emacs. 4This file is part of GNU Emacs.
5 5
6GNU Emacs is free software; you can redistribute it and/or modify 6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by 7it under the terms of the GNU General Public License as published by
8the Free Software Foundation; either version 2, or (at your option) 8the Free Software Foundation; either version 1, or (at your option)
9any later version. 9any later version.
10 10
11GNU Emacs is distributed in the hope that it will be useful, 11GNU 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
17along with GNU Emacs; see the file COPYING. If not, write to 17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19 19
20hacked on by jwz@lucid.com 17-jun-91 20hacked 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
52Lisp_Object Vbyte_code_meter, Qbyte_code_meter; 55Lisp_Object Vbyte_code_meter;
53int byte_metering_on; 56int 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
80Lisp_Object Qbytecode; 81Lisp_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
4This file is part of GNU Emacs. 4This 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
61Lisp_Object Vexec_path, Vexec_directory, Vdata_directory; 60Lisp_Object Vexec_path, Vexec_directory;
62 61
63Lisp_Object Vshell_file_name; 62Lisp_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
65Lisp_Object Vprocess_environment; 68Lisp_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\
99Remaining arguments are strings passed as command arguments to PROGRAM.\n\ 103Remaining arguments are strings passed as command arguments to PROGRAM.\n\
100If BUFFER is nil or 0, returns immediately with value nil.\n\ 104If BUFFER is nil or 0, returns immediately with value nil.\n\
101Otherwise waits for PROGRAM to terminate\n\ 105Otherwise waits for PROGRAM to terminate\n\
102and returns a numeric exit status or a signal description string.\n\ 106and returns a numeric exit status or a signal name as a string.\n\
103If you quit, the process is killed with SIGKILL.") 107If 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\
311Remaining args are passed to PROGRAM at startup as command args.\n\ 310Remaining args are passed to PROGRAM at startup as command args.\n\
312If BUFFER is nil, returns immediately with value nil.\n\ 311If BUFFER is nil, returns immediately with value nil.\n\
313Otherwise waits for PROGRAM to terminate\n\ 312Otherwise waits for PROGRAM to terminate\n\
314and returns a numeric exit status or a signal description string.\n\ 313and returns a numeric exit status or a signal name as a string.\n\
315If you quit, the process is killed with SIGKILL.") 314If 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
368child_setup (in, out, err, new_argv, set_pgrp, current_dir) 367child_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
467static int
468getenv_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
494DEFUN ("getenv", Fgetenv, Sgetenv, 1, 2, 0,
495 "Return the value of environment variable VAR, as a string.\n\
496VAR should be a string. Value is nil if VAR is undefined in the environment.\n\
497This 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. */
514char *
515egetenv (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
529init_callproc () 461init_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
581syms_of_callproc () 501syms_of_callproc ()
@@ -589,22 +509,17 @@ Initialized from the SHELL environment variable.");
589Each element is a string (directory name) or nil (try default directory)."); 509Each 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\
593especially executable programs intended for Emacs to invoke."); 513intended for Emacs to invoke.");
594
595 DEFVAR_LISP ("data-directory", &Vdata_directory,
596 "Directory of architecture-independent files that come with GNU Emacs,\n\
597intended 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\
601Each element should be a string of the form ENVVARNAME=VALUE.\n\ 518Each string should have the format ENVVARNAME=VALUE.");
602The environment which Emacs inherits is placed in this variable\n\ 519#endif
603when 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}