src/sysdep.c

   1 /* Interfaces to system-dependent kernel and library entries.
   2    Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc.
   3
   4 This file is part of GNU Emacs.
   5
   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
   8 the Free Software Foundation; either version 1, or (at your option)
   9 any later version.
  10
  11 GNU Emacs is distributed in the hope that it will be useful,
  12 but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 GNU General Public License for more details.
  15
  16 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
  18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19
  20
  21 #include <signal.h>
  22 #include <setjmp.h>
  23
  24 #include "config.h"
  25 #include "lisp.h"
  26 #undef NULL
  27
  28 #define min(x,y) ((x) > (y) ? (y) : (x))
  29
  30 /* In this file, open, read and write refer to the system calls,
  31    not our sugared interfaces  sys_open, sys_read and sys_write.
  32    Contrariwise, for systems where we use the system calls directly,
  33    define sys_read, etc. here as aliases for them.  */
  34 #ifndef read
  35 #define sys_read read
  36 #define sys_write write
  37 #endif /* `read' is not a macro */
  38
  39 #undef read
  40 #undef write
  41
  42 #ifndef close
  43 #define sys_close close
  44 #else
  45 #undef close
  46 #endif
  47
  48 #ifndef open
  49 #define sys_open open
  50 #else /* `open' is a macro */
  51 #undef open
  52 #endif /* `open' is a macro */
  53
  54 /* Does anyone other than VMS need this? */
  55 #ifndef fwrite
  56 #define sys_fwrite fwrite
  57 #else
  58 #undef fwrite
  59 #endif
  60
  61 #include <stdio.h>
  62 #include <sys/types.h>
  63 #include <sys/stat.h>
  64 #include <errno.h>
  65
  66 extern int errno;
  67 #ifndef VMS
  68 extern char *sys_errlist[];
  69 #endif
  70
  71 #ifdef VMS
  72 #include <rms.h>
  73 #include <ttdef.h>
  74 #include <tt2def.h>
  75 #include <iodef.h>
  76 #include <ssdef.h>
  77 #include <descrip.h>
  78 #include <fibdef.h>
  79 #include <atrdef.h>
  80 #include <ctype.h>
  81 #include <string.h>
  82 #ifdef __GNUC__
  83 #include <sys/file.h>
  84 #else
  85 #include <file.h>
  86 #endif
  87 #undef F_SETFL
  88 #ifndef RAB$C_BID
  89 #include <rab.h>
  90 #endif
  91 #define MAXIOSIZE ( 32 * PAGESIZE )     /* Don't I/O more than 32 blocks at a time */
  92 #endif /* VMS */
  93
  94 #ifndef BSD4_1
  95 #ifdef BSD /* this is done this way to avoid defined (BSD) || defined (USG)
  96               because the vms compiler doesn't grok `defined' */
  97 #include <fcntl.h>
  98 #endif
  99 #ifdef USG
 100 #ifndef USG5
 101 #include <fcntl.h>
 102 #endif
 103 #endif
 104 #endif /* not 4.1 bsd */
 105
 106 /* Get DGUX definition for FASYNC - DJB */
 107 #ifdef DGUX
 108 #include <sys/file.h>
 109 #endif /* DGUX */
 110
 111 #include <sys/ioctl.h>
 112 #include "systty.h"
 113
 114 #ifdef BSD
 115 #ifdef BSD4_1
 116 #include <wait.h>
 117 #else /* not 4.1 */
 118 #include <sys/wait.h>
 119 #endif /* not 4.1 */
 120 #endif /* BSD */
 121
 122 #ifdef BROKEN_TIOCGWINSZ
 123 #undef TIOCGWINSZ
 124 #endif
 125
 126 #ifdef USG
 127 #include <sys/utsname.h>
 128 #include <string.h>
 129 #ifndef MEMORY_IN_STRING_H
 130 #include <memory.h>
 131 #endif
 132 #ifdef TIOCGWINSZ
 133 #ifdef NEED_SIOCTL
 134 #include <sys/sioctl.h>
 135 #endif
 136 #ifdef NEED_PTEM_H
 137 #include <sys/stream.h>
 138 #include <sys/ptem.h>
 139 #endif
 140 #endif /* TIOCGWINSZ */
 141 #endif /* USG */
 142
 143 extern int quit_char;
 144
 145 #include "frame.h"
 146 #include "window.h"
 147 #include "termhooks.h"
 148 #include "termchar.h"
 149 #include "termopts.h"
 150 #include "dispextern.h"
 151 #include "process.h"
 152
 153 #ifdef NONSYSTEM_DIR_LIBRARY
 154 #include "ndir.h"
 155 #endif /* NONSYSTEM_DIR_LIBRARY */
 156
 157 #include "syssignal.h"
 158 #include "systime.h"
 159
 160 static int baud_convert[] =
 161 #ifdef BAUD_CONVERT
 162   BAUD_CONVERT;
 163 #else
 164   {
 165     0, 50, 75, 110, 135, 150, 200, 300, 600, 1200,
 166     1800, 2400, 4800, 9600, 19200, 38400
 167   };
 168 #endif
 169
 170 extern short ospeed;
 171
 172 /* The file descriptor for Emacs's input terminal.
 173    Under Unix, this is always left zero;
 174    under VMS, we place the input channel number here.
 175    This allows us to write more code that works for both VMS and Unix.  */
 176 static int input_fd;
 177
 178 discard_tty_input ()
 179 {
 180   struct emacs_tty buf;
 181
 182   if (noninteractive)
 183     return;
 184
 185   /* Discarding input is not safe when the input could contain
 186      replies from the X server.  So don't do it.  */
 187   if (read_socket_hook)
 188     return;
 189
 190 #ifdef VMS
 191   end_kbd_input ();
 192   SYS$QIOW (0, input_fd, IO$_READVBLK|IO$M_PURGE, input_iosb, 0, 0,
 193             &buf.main, 0, 0, terminator_mask, 0, 0);
 194   queue_kbd_input ();
 195 #else /* not VMS */
 196 #ifdef APOLLO
 197   {
 198     int zero = 0;
 199     ioctl (0, TIOCFLUSH, &zero);
 200   }
 201 #else /* not Apollo */
 202   EMACS_GET_TTY (input_fd, &buf);
 203   EMACS_SET_TTY (input_fd, &buf, 0);
 204 #endif /* not Apollo */
 205 #endif /* not VMS */
 206 }
 207
 208 #ifdef SIGTSTP
 209
 210 stuff_char (c)
 211      char c;
 212 {
 213 /* Should perhaps error if in batch mode */
 214 #ifdef TIOCSTI
 215   ioctl (0, TIOCSTI, &c);
 216 #else /* no TIOCSTI */
 217   error ("Cannot stuff terminal input characters in this version of Unix.");
 218 #endif /* no TIOCSTI */
 219 }
 220
 221 #endif /* SIGTSTP */
 222
 223 init_baud_rate ()
 224 {
 225   if (noninteractive)
 226     ospeed = 0;
 227   else
 228     {
 229 #ifdef VMS
 230       struct sensemode sg;
 231
 232       SYS$QIOW (0, input_fd, IO$_SENSEMODE, &sg, 0, 0,
 233                 &sg.class, 12, 0, 0, 0, 0 );
 234       ospeed = sg.xmit_baud;
 235 #else /* not VMS */
 236 #ifdef HAVE_TERMIOS
 237       struct termios sg;
 238
 239       sg.c_cflag = (sg.c_cflag & ~CBAUD) | B9600;
 240       tcgetattr (0, &sg);
 241       ospeed = sg.c_cflag & CBAUD;
 242 #else /* neither VMS nor TERMIOS */
 243 #ifdef HAVE_TERMIO
 244       struct termio sg;
 245
 246       sg.c_cflag = (sg.c_cflag & ~CBAUD) | B9600;
 247 #ifdef HAVE_TCATTR
 248       tcgetattr (0, &sg);
 249 #else
 250       ioctl (input_fd, TCGETA, &sg);
 251 #endif
 252       ospeed = sg.c_cflag & CBAUD;
 253 #else /* neither VMS nor TERMIOS nor TERMIO */
 254       struct sgttyb sg;
 255
 256       sg.sg_ospeed = B9600;
 257       ioctl (0, TIOCGETP, &sg);
 258       ospeed = sg.sg_ospeed;
 259 #endif /* not HAVE_TERMIO */
 260 #endif /* not HAVE_TERMIOS */
 261 #endif /* not VMS */
 262     }
 263
 264   baud_rate = (ospeed < sizeof baud_convert / sizeof baud_convert[0]
 265                ? baud_convert[ospeed] : 9600);
 266   if (baud_rate == 0)
 267     baud_rate = 1200;
 268 }
 269
 270 /*ARGSUSED*/
 271 set_exclusive_use (fd)
 272      int fd;
 273 {
 274 #ifdef FIOCLEX
 275   ioctl (fd, FIOCLEX, 0);
 276 #endif
 277   /* Ok to do nothing if this feature does not exist */
 278 }
 279
 280 #ifndef subprocesses
 281
 282 wait_without_blocking ()
 283 {
 284 #ifdef BSD
 285   wait3 (0, WNOHANG | WUNTRACED, 0);
 286 #else
 287   croak ("wait_without_blocking");
 288 #endif
 289   synch_process_alive = 0;
 290 }
 291
 292 #endif /* not subprocesses */
 293
 294 int wait_debugging;   /* Set nonzero to make following function work under dbx
 295                          (at least for bsd).  */
 296
 297 SIGTYPE
 298 wait_for_termination_signal ()
 299 {}
 300
 301 /* Wait for subprocess with process id `pid' to terminate and
 302    make sure it will get eliminated (not remain forever as a zombie) */
 303
 304 wait_for_termination (pid)
 305      int pid;
 306 {
 307   while (1)
 308     {
 309 #ifdef subprocesses
 310 #ifdef VMS
 311       int status;
 312
 313       status = SYS$FORCEX (&pid, 0, 0);
 314       break;
 315 #else /* not VMS */
 316
 317       /* Exit if the process has terminated.  */
 318       if (!synch_process_alive)
 319         break;
 320       /* Otherwise wait 1 second or until a signal comes in.  */
 321       signal (SIGALRM, wait_for_termination_signal);
 322       alarm (1);
 323       pause ();
 324       alarm (0);
 325       signal (SIGALRM, SIG_IGN);
 326 #endif /* not VMS */
 327 #else /* not subprocesses */
 328 #ifndef BSD4_1
 329       if (kill (pid, 0) < 0)
 330         break;
 331       wait (0);
 332 #else /* BSD4_1 */
 333       int status;
 334       status = wait (0);
 335       if (status == pid || status == -1)
 336         break;
 337 #endif /* BSD4_1 */
 338 #endif /* not subprocesses */
 339     }
 340 }
 341
 342 #ifdef subprocesses
 343
 344 /*
 345  *      flush any pending output
 346  *      (may flush input as well; it does not matter the way we use it)
 347  */
 348
 349 flush_pending_output (channel)
 350      int channel;
 351 {
 352 #ifdef HAVE_TERMIOS
 353   /* If we try this, we get hit with SIGTTIN, because
 354      the child's tty belongs to the child's pgrp. */
 355 #else
 356 #ifdef TCFLSH
 357   ioctl (channel, TCFLSH, 1);
 358 #else
 359 #ifdef TIOCFLUSH
 360   int zero = 0;
 361   /* 3rd arg should be ignored
 362      but some 4.2 kernels actually want the address of an int
 363      and nonzero means something different.  */
 364   ioctl (channel, TIOCFLUSH, &zero);
 365 #endif
 366 #endif
 367 #endif
 368 }
 369
 370 #ifndef VMS
 371 /*  Set up the terminal at the other end of a pseudo-terminal that
 372     we will be controlling an inferior through.
 373     It should not echo or do line-editing, since that is done
 374     in Emacs.  No padding needed for insertion into an Emacs buffer.  */
 375
 376 child_setup_tty (out)
 377      int out;
 378 {
 379   struct emacs_tty s;
 380
 381   EMACS_GET_TTY (out, &s);
 382
 383 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
 384   s.main.c_oflag |= OPOST;      /* Enable output postprocessing */
 385   s.main.c_oflag &= ~ONLCR;     /* Disable map of NL to CR-NL on output */
 386   s.main.c_oflag &= ~(NLDLY|CRDLY|TABDLY|BSDLY|VTDLY|FFDLY);
 387                                 /* No output delays */
 388   s.main.c_lflag &= ~ECHO;      /* Disable echo */
 389   s.main.c_lflag |= ISIG;       /* Enable signals */
 390   s.main.c_iflag &= ~IUCLC;     /* Disable map of upper case to lower on
 391                                    input */
 392   s.main.c_oflag &= ~OLCUC;     /* Disable map of lower case to upper on
 393                                    output */
 394 #if 0
 395   /* Said to be unnecesary:  */
 396   s.main.c_cc[VMIN] = 1;        /* minimum number of characters to accept  */
 397   s.main.c_cc[VTIME] = 0;       /* wait forever for at least 1 character  */
 398 #endif
 399
 400   s.main.c_lflag |= ICANON;     /* Enable erase/kill and eof processing */
 401   s.main.c_cc[VEOF] = 04;       /* insure that EOF is Control-D */
 402   s.main.c_cc[VERASE] = 0377;   /* disable erase processing */
 403   s.main.c_cc[VKILL] = 0377;    /* disable kill processing */
 404
 405 #ifdef HPUX
 406   s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */
 407 #endif /* HPUX */
 408
 409 #ifdef AIX
 410 /* AIX enhanced edit loses NULs, so disable it */
 411 #ifndef IBMR2AIX
 412   s.main.c_line = 0;
 413   s.main.c_iflag &= ~ASCEDIT;
 414 #endif
 415   /* Also, PTY overloads NUL and BREAK.
 416      don't ignore break, but don't signal either, so it looks like NUL.  */
 417   s.main.c_iflag &= ~IGNBRK;
 418   s.main.c_iflag &= ~BRKINT;
 419   /* QUIT and INTR work better as signals, so disable character forms */
 420   s.main.c_cc[VQUIT] = 0377;
 421   s.main.c_cc[VINTR] = 0377;
 422   s.main.c_cc[VEOL] = 0377;
 423   s.main.c_lflag &= ~ISIG;
 424   s.main.c_cflag = (s.main.c_cflag & ~CBAUD) | B9600; /* baud rate sanity */
 425 #endif /* AIX */
 426
 427 #else /* not HAVE_TERMIO */
 428
 429   s.main.sg_flags &= ~(ECHO | CRMOD | ANYP | ALLDELAY | RAW | LCASE
 430                        | CBREAK | TANDEM);
 431   s.main.sg_erase = 0377;
 432   s.main.sg_kill = 0377;
 433
 434 #endif /* not HAVE_TERMIO */
 435
 436   EMACS_SET_TTY (out, &s, 0);
 437
 438 #ifdef BSD4_1
 439   if (interrupt_input)
 440     reset_sigio ();
 441 #endif /* BSD4_1 */
 442 #ifdef RTU
 443   {
 444     int zero = 0;
 445     ioctl (out, FIOASYNC, &zero);
 446   }
 447 #endif /* RTU */
 448 }
 449 #endif /* not VMS */
 450
 451 #endif /* subprocesses */
 452
 453 /*ARGSUSED*/
 454 setpgrp_of_tty (pid)
 455      int pid;
 456 {
 457   EMACS_SET_TTY_PGRP (input_fd, &pid);
 458 }
 459
 460 /* Record a signal code and the handler for it.  */
 461 struct save_signal
 462 {
 463   int code;
 464   SIGTYPE (*handler) ();
 465 };
 466
 467 /* Suspend the Emacs process; give terminal to its superior.  */
 468
 469 sys_suspend ()
 470 {
 471 #ifdef VMS
 472   /* "Foster" parentage allows emacs to return to a subprocess that attached
 473      to the current emacs as a cheaper than starting a whole new process.  This
 474      is set up by KEPTEDITOR.COM.  */
 475   unsigned long parent_id, foster_parent_id;
 476   char *fpid_string;
 477
 478   fpid_string = getenv ("EMACS_PARENT_PID");
 479   if (fpid_string != NULL)
 480     {
 481       sscanf (fpid_string, "%x", &foster_parent_id);
 482       if (foster_parent_id != 0)
 483         parent_id = foster_parent_id;
 484       else
 485         parent_id = getppid ();
 486     }
 487   else
 488     parent_id = getppid ();
 489
 490   free (fpid_string);           /* On VMS, this was malloc'd */
 491
 492   if (parent_id && parent_id != 0xffffffff)
 493     {
 494       SIGTYPE (*oldsig)() = (int) signal (SIGINT, SIG_IGN);
 495       int status = LIB$ATTACH (&parent_id) & 1;
 496       signal (SIGINT, oldsig);
 497       return status;
 498     }
 499   else
 500     {
 501       struct {
 502         int     l;
 503         char    *a;
 504       } d_prompt;
 505       d_prompt.l = sizeof ("Emacs: ");          /* Our special prompt */
 506       d_prompt.a = "Emacs: ";                   /* Just a reminder */
 507       LIB$SPAWN (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, &d_prompt, 0);
 508       return 1;
 509     }
 510   return -1;
 511 #else
 512 #ifdef SIGTSTP
 513
 514   EMACS_KILLPG (getpgrp (0), SIGTSTP);
 515
 516 #else /* No SIGTSTP */
 517 #ifdef USG_JOBCTRL /* If you don't know what this is don't mess with it */
 518   ptrace (0, 0, 0, 0);          /* set for ptrace - caught by csh */
 519   kill (getpid (), SIGQUIT);
 520
 521 #else /* No SIGTSTP or USG_JOBCTRL */
 522
 523 /* On a system where suspending is not implemented,
 524    instead fork a subshell and let it talk directly to the terminal
 525    while we wait.  */
 526   int pid = fork ();
 527   struct save_signal saved_handlers[5];
 528
 529   saved_handlers[0].code = SIGINT;
 530   saved_handlers[1].code = SIGQUIT;
 531   saved_handlers[2].code = SIGTERM;
 532 #ifdef SIGIO
 533   saved_handlers[3].code = SIGIO;
 534   saved_handlers[4].code = 0;
 535 #else
 536   saved_handlers[3].code = 0;
 537 #endif
 538
 539   if (pid == -1)
 540     error ("Can't spawn subshell");
 541   if (pid == 0)
 542     {
 543       char *sh;
 544
 545       sh = (char *) egetenv ("SHELL");
 546       if (sh == 0)
 547         sh = "sh";
 548       /* Use our buffer's default directory for the subshell.  */
 549       {
 550         Lisp_Object dir;
 551         unsigned char *str;
 552         int len;
 553
 554         /* mentioning current_buffer->buffer would mean including buffer.h,
 555            which somehow wedges the hp compiler.  So instead... */
 556
 557         dir = intern ("default-directory");
 558         /* Can't use NULL */
 559         if (XFASTINT (Fboundp (dir)) == XFASTINT (Qnil))
 560           goto xyzzy;
 561         dir = Fsymbol_value (dir);
 562         if (XTYPE (dir) != Lisp_String)
 563           goto xyzzy;
 564
 565         str = (unsigned char *) alloca (XSTRING (dir)->size + 2);
 566         len = XSTRING (dir)->size;
 567         bcopy (XSTRING (dir)->data, str, len);
 568         if (str[len - 1] != '/') str[len++] = '/';
 569         str[len] = 0;
 570         chdir (str);
 571       }
 572     xyzzy:
 573 #ifdef subprocesses
 574       close_process_descs ();   /* Close Emacs's pipes/ptys */
 575 #endif
 576
 577 #ifdef PRIO_PROCESS
 578       {
 579         extern int emacs_priority;
 580
 581         if (emacs_priority)
 582           nice (-emacs_priority);
 583       }
 584 #endif
 585
 586       execlp (sh, sh, 0);
 587       write (1, "Can't execute subshell", 22);
 588       _exit (1);
 589     }
 590
 591   save_signal_handlers (saved_handlers);
 592   wait_for_termination (pid);
 593   restore_signal_handlers (saved_handlers);
 594
 595 #endif /* no USG_JOBCTRL */
 596 #endif /* no SIGTSTP */
 597 #endif /* not VMS */
 598 }
 599
 600 save_signal_handlers (saved_handlers)
 601      struct save_signal *saved_handlers;
 602 {
 603   while (saved_handlers->code)
 604     {
 605       saved_handlers->handler
 606         = (SIGTYPE (*) ()) signal (saved_handlers->code, SIG_IGN);
 607       saved_handlers++;
 608     }
 609 }
 610
 611 restore_signal_handlers (saved_handlers)
 612      struct save_signal *saved_handlers;
 613 {
 614   while (saved_handlers->code)
 615     {
 616       signal (saved_handlers->code, saved_handlers->handler);
 617       saved_handlers++;
 618     }
 619 }
 620 \f
 621 #ifdef F_SETFL
 622
 623 int old_fcntl_flags;
 624
 625 init_sigio ()
 626 {
 627 #ifdef FASYNC
 628   old_fcntl_flags = fcntl (0, F_GETFL, 0) & ~FASYNC;
 629 #endif
 630   request_sigio ();
 631 }
 632
 633 reset_sigio ()
 634 {
 635   unrequest_sigio ();
 636 }
 637
 638 #ifdef FASYNC           /* F_SETFL does not imply existance of FASYNC */
 639
 640 request_sigio ()
 641 {
 642 #ifdef SIGWINCH
 643   sigunblock (sigmask (SIGWINCH));
 644 #endif
 645   fcntl (0, F_SETFL, old_fcntl_flags | FASYNC);
 646
 647   interrupts_deferred = 0;
 648 }
 649
 650 unrequest_sigio ()
 651 {
 652 #ifdef SIGWINCH
 653   sigblock (sigmask (SIGWINCH));
 654 #endif
 655   fcntl (0, F_SETFL, old_fcntl_flags);
 656   interrupts_deferred = 1;
 657 }
 658
 659 #else /* no FASYNC */
 660 #ifdef STRIDE           /* Stride doesn't have FASYNC - use FIOASYNC */
 661
 662 request_sigio ()
 663 {
 664   int on = 1;
 665   ioctl (0, FIOASYNC, &on);
 666   interrupts_deferred = 0;
 667 }
 668
 669 unrequest_sigio ()
 670 {
 671   int off = 0;
 672
 673   ioctl (0, FIOASYNC, &off);
 674   interrupts_deferred = 1;
 675 }
 676
 677 #else /* not FASYNC, not STRIDE */
 678
 679 request_sigio ()
 680 {
 681   croak ("request_sigio");
 682 }
 683
 684 unrequest_sigio ()
 685 {
 686   croak ("unrequest_sigio");
 687 }
 688
 689 #endif /* STRIDE */
 690 #endif /* FASYNC */
 691 #endif /* F_SETFL */
 692 \f
 693 /* The initial tty mode bits */
 694 struct emacs_tty old_tty;
 695
 696 int term_initted;               /* 1 if outer tty status has been recorded */
 697
 698 #ifdef BSD4_1
 699 /* BSD 4.1 needs to keep track of the lmode bits in order to start
 700    sigio.  */
 701 int lmode;
 702 #endif
 703
 704 #ifdef F_SETOWN
 705 int old_fcntl_owner;
 706 #endif /* F_SETOWN */
 707
 708 /* This may also be defined in stdio,
 709    but if so, this does no harm,
 710    and using the same name avoids wasting the other one's space.  */
 711
 712 #if defined (USG) || defined (DGUX)
 713 unsigned char _sobuf[BUFSIZ+8];
 714 #else
 715 char _sobuf[BUFSIZ];
 716 #endif
 717
 718 #ifdef TIOCGLTC
 719 static struct ltchars new_ltchars = {-1,-1,-1,-1,-1,-1};
 720 #endif
 721 #ifdef TIOCGETC
 722   static struct tchars new_tchars = {-1,-1,-1,-1,-1,-1};
 723 #endif
 724
 725 init_sys_modes ()
 726 {
 727   struct emacs_tty tty;
 728
 729 #ifdef VMS
 730 #if 0
 731   static int oob_chars[2] = {0, 1 << 7}; /* catch C-g's */
 732   extern int (*interrupt_signal) ();
 733 #endif
 734 #endif
 735
 736   if (noninteractive)
 737     return;
 738
 739 #ifdef VMS
 740   if (!input_ef)
 741     input_ef = get_kbd_event_flag ();
 742     /* LIB$GET_EF (&input_ef); */
 743   SYS$CLREF (input_ef);
 744   waiting_for_ast = 0;
 745   if (!timer_ef)
 746     timer_ef = get_timer_event_flag ();
 747     /* LIB$GET_EF (&timer_ef); */
 748   SYS$CLREF (timer_ef);
 749 #if 0
 750   if (!process_ef)
 751     {
 752       LIB$GET_EF (&process_ef);
 753       SYS$CLREF (process_ef);
 754     }
 755   if (input_ef / 32 != process_ef / 32)
 756     croak ("Input and process event flags in different clusters.");
 757 #endif
 758   if (input_ef / 32 != timer_ef / 32)
 759     croak ("Input and timer event flags in different clusters.");
 760 #if 0
 761   input_eflist = ((unsigned) 1 << (input_ef % 32)) |
 762     ((unsigned) 1 << (process_ef % 32));
 763 #endif
 764   timer_eflist = ((unsigned) 1 << (input_ef % 32)) |
 765     ((unsigned) 1 << (timer_ef % 32));
 766 #ifndef VMS4_4
 767   sys_access_reinit ();
 768 #endif
 769 #endif /* not VMS */
 770
 771   EMACS_GET_TTY (input_fd, &old_tty);
 772
 773   if (!read_socket_hook && EQ (Vwindow_system, Qnil))
 774     {
 775       tty = old_tty;
 776
 777 #if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS)
 778       tty.main.c_iflag |= (IGNBRK);     /* Ignore break condition */
 779       tty.main.c_iflag &= ~ICRNL;       /* Disable map of CR to NL on input */
 780 #ifdef ISTRIP
 781       tty.main.c_iflag &= ~ISTRIP;      /* don't strip 8th bit on input */
 782 #endif
 783       tty.main.c_lflag &= ~ECHO;        /* Disable echo */
 784       tty.main.c_lflag &= ~ICANON;      /* Disable erase/kill processing */
 785 #ifdef IEXTEN
 786       tty.main.c_iflag &= ~IEXTEN;      /* Disable other editing characters.  */
 787 #endif
 788       tty.main.c_lflag |= ISIG; /* Enable signals */
 789       if (flow_control)
 790         {
 791           tty.main.c_iflag |= IXON;     /* Enable start/stop output control */
 792 #ifdef IXANY
 793           tty.main.c_iflag &= ~IXANY;
 794 #endif /* IXANY */
 795         }
 796       else
 797         tty.main.c_iflag &= ~IXON;      /* Disable start/stop output control */
 798       tty.main.c_oflag &= ~ONLCR;       /* Disable map of NL to CR-NL
 799                                            on output */
 800       tty.main.c_oflag &= ~TAB3;        /* Disable tab expansion */
 801 #ifdef CS8
 802       if (meta_key)
 803         {
 804           tty.main.c_cflag |= CS8;      /* allow 8th bit on input */
 805           tty.main.c_cflag &= ~PARENB;/* Don't check parity */
 806         }
 807 #endif
 808       tty.main.c_cc[VINTR] = quit_char; /* C-g (usually) gives SIGINT */
 809       /* Set up C-g for both SIGQUIT and SIGINT.
 810          We don't know which we will get, but we handle both alike
 811          so which one it really gives us does not matter.  */
 812       tty.main.c_cc[VQUIT] = quit_char;
 813       tty.main.c_cc[VMIN] = 1;  /* Input should wait for at least 1 char */
 814       tty.main.c_cc[VTIME] = 0; /* no matter how long that takes.  */
 815 #ifdef VSWTCH
 816       tty.main.c_cc[VSWTCH] = CDISABLE; /* Turn off shell layering use
 817                                            of C-z */
 818 #endif /* VSWTCH */
 819 #if defined (mips) || defined (HAVE_TCATTR)
 820 #ifdef VSUSP
 821       tty.main.c_cc[VSUSP] = CDISABLE;  /* Turn off mips handling of C-z.  */
 822 #endif /* VSUSP */
 823 #ifdef V_DSUSP
 824       tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off mips handling of C-y.  */
 825 #endif /* V_DSUSP */
 826 #ifdef VDSUSP /* Some systems have VDSUSP, some have V_DSUSP.  */
 827       tty.main.c_cc[VDSUSP] = CDISABLE;
 828 #endif /* VDSUSP */
 829 #endif /* mips or HAVE_TCATTR */
 830 #ifdef AIX
 831 #ifndef IBMR2AIX
 832       /* AIX enhanced edit loses NULs, so disable it */
 833       tty.main.c_line = 0;
 834       tty.main.c_iflag &= ~ASCEDIT;
 835 #else
 836       tty.main.c_cc[VSTRT] = 255;
 837       tty.main.c_cc[VSTOP] = 255;
 838       tty.main.c_cc[VSUSP] = 255;
 839       tty.main.c_cc[VDSUSP] = 255;
 840 #endif /* IBMR2AIX */
 841       /* Also, PTY overloads NUL and BREAK.
 842          don't ignore break, but don't signal either, so it looks like NUL.
 843          This really serves a purpose only if running in an XTERM window
 844          or via TELNET or the like, but does no harm elsewhere.  */
 845       tty.main.c_iflag &= ~IGNBRK;
 846       tty.main.c_iflag &= ~BRKINT;
 847 #endif
 848 #else /* if not HAVE_TERMIO */
 849 #ifdef VMS
 850       tty.main.tt_char |= TT$M_NOECHO;
 851       if (meta_key)
 852         tty.main.tt_char |= TT$M_EIGHTBIT;
 853       if (flow_control)
 854         tty.main.tt_char |= TT$M_TTSYNC;
 855       else
 856         tty.main.tt_char &= ~TT$M_TTSYNC;
 857       tty.main.tt2_char |= TT2$M_PASTHRU | TT2$M_XON;
 858 #else /* not VMS (BSD, that is) */
 859       tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS);
 860       if (meta_key)
 861         tty.main.sg_flags |= ANYP;
 862       tty.main.sg_flags |= interrupt_input ? RAW : CBREAK;
 863 #endif /* not VMS (BSD, that is) */
 864 #endif /* not HAVE_TERMIO */
 865
 866       /* If going to use CBREAK mode, we must request C-g to interrupt
 867          and turn off start and stop chars, etc.  If not going to use
 868          CBREAK mode, do this anyway so as to turn off local flow
 869          control for user coming over network on 4.2; in this case,
 870          only t_stopc and t_startc really matter.  */
 871 #ifndef HAVE_TERMIO
 872 #ifdef TIOCGETC
 873       /* Note: if not using CBREAK mode, it makes no difference how we
 874          set this */
 875       tty.tchars = new_tchars;
 876       tty.tchars.t_intrc = quit_char;
 877       if (flow_control)
 878         {
 879           tty.tchars.t_startc = '\021';
 880           tty.tchars.t_stopc = '\023';
 881         }
 882
 883 /* LPASS8 is new in 4.3, and makes cbreak mode provide all 8 bits.  */
 884 #ifndef LPASS8
 885 #define LPASS8 0
 886 #endif
 887
 888 #ifdef BSD4_1
 889 #define LNOFLSH 0100000
 890 #endif
 891
 892       tty.lmode = LDECCTQ | LLITOUT | LPASS8 | LNOFLSH | old_tty.lmode;
 893
 894 #ifdef BSD4_1
 895       lmode = tty.lmode;
 896 #endif
 897
 898 #endif /* TIOCGETC */
 899 #endif /* not HAVE_TERMIO */
 900
 901 #ifdef TIOCGLTC
 902       tty.ltchars = new_ltchars;
 903 #endif /* TIOCGLTC */
 904
 905       EMACS_SET_TTY (input_fd, &tty, 0);
 906
 907       /* This code added to insure that, if flow-control is not to be used,
 908          we have an unlocked terminal at the start. */
 909
 910 #ifdef TCXONC
 911       if (!flow_control) ioctl (0, TCXONC, 1);
 912 #endif
 913 #ifndef APOLLO
 914 #ifdef TIOCSTART
 915       if (!flow_control) ioctl (0, TIOCSTART, 0);
 916 #endif
 917 #endif
 918
 919 #ifdef AIX
 920       hft_init ();
 921 #ifdef IBMR2AIX
 922       {
 923         /* IBM's HFT device usually thinks a ^J should be LF/CR.  We need it
 924            to be only LF.  This is the way that is done. */
 925         struct termio tty;
 926
 927         if (ioctl (1, HFTGETID, &tty) != -1)
 928           write (1, "\033[20l", 5);
 929       }
 930 #endif
 931 #endif
 932
 933 #ifdef VMS
 934 /*  Appears to do nothing when in PASTHRU mode.
 935       SYS$QIOW (0, input_fd, IO$_SETMODE|IO$M_OUTBAND, 0, 0, 0,
 936                 interrupt_signal, oob_chars, 0, 0, 0, 0);
 937 */
 938       queue_kbd_input (0);
 939 #endif /* VMS */
 940     }
 941
 942 #ifdef F_SETFL
 943 #ifdef F_GETOWN         /* F_SETFL does not imply existance of F_GETOWN */
 944   if (interrupt_input)
 945     {
 946       old_fcntl_owner = fcntl (0, F_GETOWN, 0);
 947       fcntl (0, F_SETOWN, getpid ());
 948       init_sigio ();
 949     }
 950 #endif /* F_GETOWN */
 951 #endif /* F_SETFL */
 952
 953 #ifdef BSD4_1
 954   if (interrupt_input)
 955     init_sigio ();
 956 #endif
 957
 958 #ifdef VMS  /* VMS sometimes has this symbol but lacks setvbuf.  */
 959 #undef _IOFBF
 960 #endif
 961 #ifdef _IOFBF
 962   /* This symbol is defined on recent USG systems.
 963      Someone says without this call USG won't really buffer the file
 964      even with a call to setbuf. */
 965   setvbuf (stdout, _sobuf, _IOFBF, sizeof _sobuf);
 966 #else
 967   setbuf (stdout, _sobuf);
 968 #endif
 969   set_terminal_modes ();
 970   if (term_initted && no_redraw_on_reenter)
 971     {
 972       if (display_completed)
 973         direct_output_forward_char (0);
 974     }
 975   else
 976     {
 977       frame_garbaged = 1;
 978 #ifdef MULTI_FRAME
 979       if (FRAMEP (Vterminal_frame))
 980         FRAME_GARBAGED_P (XFRAME (Vterminal_frame)) = 1;
 981 #endif
 982     }
 983
 984   term_initted = 1;
 985 }
 986
 987 /* Return nonzero if safe to use tabs in output.
 988    At the time this is called, init_sys_modes has not been done yet.  */
 989
 990 tabs_safe_p ()
 991 {
 992   struct emacs_tty tty;
 993
 994   EMACS_GET_TTY (input_fd, &tty);
 995   return EMACS_TTY_TABS_OK (&tty);
 996 }
 997
 998 /* Get terminal size from system.
 999    Store number of lines into *heightp and width into *widthp.
1000    If zero or a negative number is stored, the value is not valid.  */
1001
1002 get_frame_size (widthp, heightp)
1003      int *widthp, *heightp;
1004 {
1005
1006 #ifdef TIOCGWINSZ
1007
1008   /* BSD-style.  */
1009   struct winsize size;
1010
1011   if (ioctl (input_fd, TIOCGWINSZ, &size) == -1)
1012     *widthp = *heightp = 0;
1013   else
1014     {
1015       *widthp = size.ws_col;
1016       *heightp = size.ws_row;
1017     }
1018
1019 #else
1020 #ifdef TIOCGSIZE
1021
1022   /* SunOS - style.  */
1023   struct ttysize size;
1024
1025   if (ioctl (input_fd, TIOCGSIZE, &size) == -1)
1026     *widthp = *heightp = 0;
1027   else
1028     {
1029       *widthp = size.ts_cols;
1030       *heightp = size.ts_lines;
1031     }
1032
1033 #else
1034 #ifdef VMS
1035
1036   struct sensemode tty;
1037
1038   SYS$QIOW (0, input_fd, IO$_SENSEMODE, &tty, 0, 0,
1039             &tty.class, 12, 0, 0, 0, 0);
1040   *widthp = tty.scr_wid;
1041   *heightp = tty.scr_len;
1042
1043 #else /* system doesn't know size */
1044
1045   *widthp = 0;
1046   *heightp = 0;
1047
1048 #endif /* not VMS */
1049 #endif /* not SunOS-style */
1050 #endif /* not BSD-style */
1051 }
1052
1053 \f
1054 /* Prepare the terminal for exiting Emacs; move the cursor to the
1055    bottom of the frame, turn off interrupt-driven I/O, etc.  */
1056 reset_sys_modes ()
1057 {
1058   if (noninteractive)
1059     {
1060       fflush (stdout);
1061       return;
1062     }
1063   if (!term_initted)
1064     return;
1065   if (read_socket_hook || !EQ (Vwindow_system, Qnil))
1066     return;
1067   cursor_to (FRAME_HEIGHT (selected_frame) - 1, 0);
1068   clear_end_of_line (FRAME_WIDTH (selected_frame));
1069   /* clear_end_of_line may move the cursor */
1070   cursor_to (FRAME_HEIGHT (selected_frame) - 1, 0);
1071 #ifdef IBMR2AIX
1072   {
1073     /* HFT devices normally use ^J as a LF/CR.  We forced it to
1074        do the LF only.  Now, we need to reset it. */
1075     struct termio tty;
1076
1077     if (ioctl (1, HFTGETID, &tty) != -1)
1078       write (1, "\033[20h", 5);
1079   }
1080 #endif
1081
1082   reset_terminal_modes ();
1083   fflush (stdout);
1084 #ifdef BSD
1085 #ifndef BSD4_1
1086   /* Avoid possible loss of output when changing terminal modes.  */
1087   fsync (fileno (stdout));
1088 #endif
1089 #endif
1090
1091 #ifdef F_SETFL
1092 #ifdef F_SETOWN         /* F_SETFL does not imply existance of F_SETOWN */
1093   if (interrupt_input)
1094     {
1095       reset_sigio ();
1096       fcntl (0, F_SETOWN, old_fcntl_owner);
1097     }
1098 #endif /* F_SETOWN */
1099 #endif /* F_SETFL */
1100 #ifdef BSD4_1
1101   if (interrupt_input)
1102     reset_sigio ();
1103 #endif /* BSD4_1 */
1104
1105   while (EMACS_SET_TTY (input_fd, &old_tty, 0) < 0 && errno == EINTR)
1106     ;
1107
1108 #ifdef AIX
1109   hft_reset ();
1110 #endif
1111 }
1112 \f
1113 #ifdef HAVE_PTYS
1114
1115 /* Set up the proper status flags for use of a pty.  */
1116
1117 setup_pty (fd)
1118      int fd;
1119 {
1120   /* I'm told that TOICREMOTE does not mean control chars
1121      "can't be sent" but rather that they don't have
1122      input-editing or signaling effects.
1123      That should be good, because we have other ways
1124      to do those things in Emacs.
1125      However, telnet mode seems not to work on 4.2.
1126      So TIOCREMOTE is turned off now. */
1127
1128   /* Under hp-ux, if TIOCREMOTE is turned on, some calls
1129      will hang.  In particular, the "timeout" feature (which
1130      causes a read to return if there is no data available)
1131      does this.  Also it is known that telnet mode will hang
1132      in such a way that Emacs must be stopped (perhaps this
1133      is the same problem).
1134
1135      If TIOCREMOTE is turned off, then there is a bug in
1136      hp-ux which sometimes loses data.  Apparently the
1137      code which blocks the master process when the internal
1138      buffer fills up does not work.  Other than this,
1139      though, everything else seems to work fine.
1140
1141      Since the latter lossage is more benign, we may as well
1142      lose that way.  -- cph */
1143 #ifdef FIONBIO
1144 #ifdef SYSV_PTYS
1145   {
1146     int on = 1;
1147     ioctl (fd, FIONBIO, &on);
1148   }
1149 #endif
1150 #endif
1151 #ifdef IBMRTAIX
1152   /* On AIX, the parent gets SIGHUP when a pty attached child dies.  So, we */
1153   /* ignore SIGHUP once we've started a child on a pty.  Note that this may */
1154   /* cause EMACS not to die when it should, i.e., when its own controlling  */
1155   /* tty goes away.  I've complained to the AIX developers, and they may    */
1156   /* change this behavior, but I'm not going to hold my breath.             */
1157   signal (SIGHUP, SIG_IGN);
1158 #endif
1159 }
1160 #endif /* HAVE_PTYS */
1161 \f
1162 #ifdef VMS
1163
1164 /* Assigning an input channel is done at the start of Emacs execution.
1165    This is called each time Emacs is resumed, also, but does nothing
1166    because input_chain is no longer zero.  */
1167
1168 init_vms_input ()
1169 {
1170   int status;
1171
1172   if (input_fd == 0)
1173     {
1174       status = SYS$ASSIGN (&input_dsc, &input_fd, 0, 0);
1175       if (! (status & 1))
1176         LIB$STOP (status);
1177     }
1178 }
1179
1180 /* Deassigning the input channel is done before exiting.  */
1181
1182 stop_vms_input ()
1183 {
1184   return SYS$DASSGN (input_fd);
1185 }
1186
1187 short input_buffer;
1188
1189 /* Request reading one character into the keyboard buffer.
1190    This is done as soon as the buffer becomes empty.  */
1191
1192 queue_kbd_input ()
1193 {
1194   int status;
1195   extern kbd_input_ast ();
1196
1197   waiting_for_ast = 0;
1198   stop_input = 0;
1199   status = SYS$QIO (0, input_fd, IO$_READVBLK,
1200                     &input_iosb, kbd_input_ast, 1,
1201                     &input_buffer, 1, 0, terminator_mask, 0, 0);
1202 }
1203
1204 int input_count;
1205
1206 /* Ast routine that is called when keyboard input comes in
1207    in accord with the SYS$QIO above.  */
1208
1209 kbd_input_ast ()
1210 {
1211   register int c = -1;
1212   int old_errno = errno;
1213   extern EMACS_TIME *input_available_clear_time;
1214
1215   if (waiting_for_ast)
1216     SYS$SETEF (input_ef);
1217   waiting_for_ast = 0;
1218   input_count++;
1219 #ifdef ASTDEBUG
1220   if (input_count == 25)
1221     exit (1);
1222   printf ("Ast # %d,", input_count);
1223   printf (" iosb = %x, %x, %x, %x",
1224           input_iosb.offset, input_iosb.status, input_iosb.termlen,
1225           input_iosb.term);
1226 #endif
1227   if (input_iosb.offset)
1228     {
1229       c = input_buffer;
1230 #ifdef ASTDEBUG
1231       printf (", char = 0%o", c);
1232 #endif
1233     }
1234 #ifdef ASTDEBUG
1235   printf ("\n");
1236   fflush (stdout);
1237   sleep (1);
1238 #endif
1239   if (! stop_input)
1240     queue_kbd_input ();
1241   if (c >= 0)
1242     {
1243       struct input_event e;
1244       e.kind = ascii_keystroke;
1245       XSET (e.code, Lisp_Int, c);
1246 #ifdef MULTI_FRAME
1247       XSET(e.frame_or_window, Lisp_Frame, selected_frame);
1248 #else
1249       e.frame_or_window = Qnil;
1250 #endif
1251       kbd_buffer_store_event (&e);
1252     }
1253   if (input_available_clear_time)
1254     EMACS_SET_SECS_USECS (*input_available_clear_time, 0, 0);
1255   errno = old_errno;
1256 }
1257
1258 /* Wait until there is something in kbd_buffer.  */
1259
1260 wait_for_kbd_input ()
1261 {
1262   extern int have_process_input, process_exited;
1263
1264   /* If already something, avoid doing system calls.  */
1265   if (detect_input_pending ())
1266     {
1267       return;
1268     }
1269   /* Clear a flag, and tell ast routine above to set it.  */
1270   SYS$CLREF (input_ef);
1271   waiting_for_ast = 1;
1272   /* Check for timing error: ast happened while we were doing that.  */
1273   if (!detect_input_pending ())
1274     {
1275       /* No timing error: wait for flag to be set.  */
1276       set_waiting_for_input (0);
1277       SYS$WFLOR (input_ef, input_eflist);
1278       clear_waiting_for_input (0);
1279       if (!detect_input_pending ())
1280         /* Check for subprocess input availability */
1281         {
1282           int dsp = have_process_input || process_exited;
1283
1284           SYS$CLREF (process_ef);
1285           if (have_process_input)
1286             process_command_input ();
1287           if (process_exited)
1288             process_exit ();
1289           if (dsp)
1290             {
1291               update_mode_lines++;
1292               redisplay_preserve_echo_area ();
1293             }
1294         }
1295     }
1296   waiting_for_ast = 0;
1297 }
1298
1299 /* Get rid of any pending QIO, when we are about to suspend
1300    or when we want to throw away pending input.
1301    We wait for a positive sign that the AST routine has run
1302    and therefore there is no I/O request queued when we return.
1303    SYS$SETAST is used to avoid a timing error.  */
1304
1305 end_kbd_input ()
1306 {
1307 #ifdef ASTDEBUG
1308   printf ("At end_kbd_input.\n");
1309   fflush (stdout);
1310   sleep (1);
1311 #endif
1312   if (LIB$AST_IN_PROG ())  /* Don't wait if suspending from kbd_buffer_store_event! */
1313     {
1314       SYS$CANCEL (input_fd);
1315       return;
1316     }
1317
1318   SYS$SETAST (0);
1319   /* Clear a flag, and tell ast routine above to set it.  */
1320   SYS$CLREF (input_ef);
1321   waiting_for_ast = 1;
1322   stop_input = 1;
1323   SYS$CANCEL (input_fd);
1324   SYS$SETAST (1);
1325   SYS$WAITFR (input_ef);
1326   waiting_for_ast = 0;
1327 }
1328
1329 /* Wait for either input available or time interval expiry.  */
1330
1331 input_wait_timeout (timeval)
1332      int timeval;               /* Time to wait, in seconds */
1333 {
1334   int time [2];
1335   static int zero = 0;
1336   static int large = -10000000;
1337
1338   LIB$EMUL (&timeval, &large, &zero, time);       /* Convert to VMS format */
1339
1340   /* If already something, avoid doing system calls.  */
1341   if (detect_input_pending ())
1342     {
1343       return;
1344     }
1345   /* Clear a flag, and tell ast routine above to set it.  */
1346   SYS$CLREF (input_ef);
1347   waiting_for_ast = 1;
1348   /* Check for timing error: ast happened while we were doing that.  */
1349   if (!detect_input_pending ())
1350     {
1351       /* No timing error: wait for flag to be set.  */
1352       SYS$CANTIM (1, 0);
1353       if (SYS$SETIMR (timer_ef, time, 0, 1) & 1) /* Set timer */
1354         SYS$WFLOR (timer_ef, timer_eflist);       /* Wait for timer expiry or input */
1355     }
1356   waiting_for_ast = 0;
1357 }
1358
1359 /* The standard `sleep' routine works some other way
1360    and it stops working if you have ever quit out of it.
1361    This one continues to work.  */
1362
1363 sys_sleep (timeval)
1364      int timeval;
1365 {
1366   int time [2];
1367   static int zero = 0;
1368   static int large = -10000000;
1369
1370   LIB$EMUL (&timeval, &large, &zero, time);       /* Convert to VMS format */
1371
1372   SYS$CANTIM (1, 0);
1373   if (SYS$SETIMR (timer_ef, time, 0, 1) & 1) /* Set timer */
1374     SYS$WAITFR (timer_ef);        /* Wait for timer expiry only */
1375 }
1376
1377 init_sigio ()
1378 {
1379   request_sigio ();
1380 }
1381
1382 reset_sigio ()
1383 {
1384   unrequest_sigio ();
1385 }
1386
1387 request_sigio ()
1388 {
1389   croak ("request sigio");
1390 }
1391
1392 unrequest_sigio ()
1393 {
1394   croak ("unrequest sigio");
1395 }
1396
1397 #endif /* VMS */
1398 \f
1399 /* Note that VMS compiler won't accept defined (CANNOT_DUMP).  */
1400 #ifndef CANNOT_DUMP
1401 #define NEED_STARTS
1402 #endif
1403
1404 #ifndef SYSTEM_MALLOC
1405 #ifndef NEED_STARTS
1406 #define NEED_STARTS
1407 #endif
1408 #endif
1409
1410 #ifdef NEED_STARTS
1411 /* Some systems that cannot dump also cannot implement these.  */
1412
1413 /*
1414  *      Return the address of the start of the text segment prior to
1415  *      doing an unexec.  After unexec the return value is undefined.
1416  *      See crt0.c for further explanation and _start.
1417  *
1418  */
1419
1420 #ifndef CANNOT_UNEXEC
1421 char *
1422 start_of_text ()
1423 {
1424 #ifdef TEXT_START
1425   return ((char *) TEXT_START);
1426 #else
1427 #ifdef GOULD
1428   extern csrt ();
1429   return ((char *) csrt);
1430 #else /* not GOULD */
1431   extern int _start ();
1432   return ((char *) _start);
1433 #endif /* GOULD */
1434 #endif /* TEXT_START */
1435 }
1436 #endif /* not CANNOT_UNEXEC */
1437
1438 /*
1439  *      Return the address of the start of the data segment prior to
1440  *      doing an unexec.  After unexec the return value is undefined.
1441  *      See crt0.c for further information and definition of data_start.
1442  *
1443  *      Apparently, on BSD systems this is etext at startup.  On
1444  *      USG systems (swapping) this is highly mmu dependent and
1445  *      is also dependent on whether or not the program is running
1446  *      with shared text.  Generally there is a (possibly large)
1447  *      gap between end of text and start of data with shared text.
1448  *
1449  *      On Uniplus+ systems with shared text, data starts at a
1450  *      fixed address.  Each port (from a given oem) is generally
1451  *      different, and the specific value of the start of data can
1452  *      be obtained via the UniPlus+ specific "uvar" system call,
1453  *      however the method outlined in crt0.c seems to be more portable.
1454  *
1455  *      Probably what will have to happen when a USG unexec is available,
1456  *      at least on UniPlus, is temacs will have to be made unshared so
1457  *      that text and data are contiguous.  Then once loadup is complete,
1458  *      unexec will produce a shared executable where the data can be
1459  *      at the normal shared text boundry and the startofdata variable
1460  *      will be patched by unexec to the correct value.
1461  *
1462  */
1463
1464 char *
1465 start_of_data ()
1466 {
1467 #ifdef DATA_START
1468   return ((char *) DATA_START);
1469 #else
1470 #ifdef ORDINARY_LINK
1471   /*
1472    * This is a hack.  Since we're not linking crt0.c or pre_crt0.c,
1473    * data_start isn't defined.  We take the address of environ, which
1474    * is known to live at or near the start of the system crt0.c, and
1475    * we don't sweat the handful of bytes that might lose.
1476    */
1477   extern char **environ;
1478
1479   return((char *) &environ);
1480 #else
1481   extern int data_start;
1482   return ((char *) &data_start);
1483 #endif /* ORDINARY_LINK */
1484 #endif /* DATA_START */
1485 }
1486 #endif /* NEED_STARTS (not CANNOT_DUMP or not SYSTEM_MALLOC) */
1487
1488 #ifndef CANNOT_DUMP
1489 /* Some systems that cannot dump also cannot implement these.  */
1490
1491 /*
1492  *      Return the address of the end of the text segment prior to
1493  *      doing an unexec.  After unexec the return value is undefined.
1494  */
1495
1496 char *
1497 end_of_text ()
1498 {
1499 #ifdef TEXT_END
1500   return ((char *) TEXT_END);
1501 #else
1502   extern int etext;
1503   return ((char *) &etext);
1504 #endif
1505 }
1506
1507 /*
1508  *      Return the address of the end of the data segment prior to
1509  *      doing an unexec.  After unexec the return value is undefined.
1510  */
1511
1512 char *
1513 end_of_data ()
1514 {
1515 #ifdef DATA_END
1516   return ((char *) DATA_END);
1517 #else
1518   extern int edata;
1519   return ((char *) &edata);
1520 #endif
1521 }
1522
1523 #endif /* not CANNOT_DUMP */
1524 \f
1525 /* Get_system_name returns as its value
1526  a string for the Lisp function system-name to return. */
1527
1528 #ifdef BSD4_1
1529 #include <whoami.h>
1530 #endif
1531
1532 /* Can't have this within the function since `static' is #defined to
1533    nothing for some USG systems.  */
1534 #ifdef USG
1535 #ifdef HAVE_GETHOSTNAME
1536 static char get_system_name_name[256];
1537 #else /* not HAVE_GETHOSTNAME */
1538 static struct utsname get_system_name_name;
1539 #endif /* not HAVE_GETHOSTNAME */
1540 #endif /* USG */
1541
1542 char *
1543 get_system_name ()
1544 {
1545 #ifdef USG
1546 #ifdef HAVE_GETHOSTNAME
1547   gethostname (get_system_name_name, sizeof (get_system_name_name));
1548   return get_system_name_name;
1549 #else /* not HAVE_GETHOSTNAME */
1550   uname (&get_system_name_name);
1551   return (get_system_name_name.nodename);
1552 #endif /* not HAVE_GETHOSTNAME */
1553 #else /* Not USG */
1554 #ifdef BSD4_1
1555   return sysname;
1556 #else /* not USG, not 4.1 */
1557   static char system_name_saved[32];
1558 #ifdef VMS
1559   char *sp;
1560   if ((sp = egetenv ("SYS$NODE")) == 0)
1561     sp = "vax-vms";
1562   else
1563     {
1564       char *end;
1565
1566       if ((end = index (sp, ':')) != 0)
1567         *end = '\0';
1568     }
1569   strcpy (system_name_saved, sp);
1570 #else /* not VMS */
1571   gethostname (system_name_saved, sizeof (system_name_saved));
1572 #endif /* not VMS */
1573   return system_name_saved;
1574 #endif /* not USG, not 4.1 */
1575 #endif /* not USG */
1576 }
1577
1578 #ifdef VMS
1579 #ifndef HAVE_GETHOSTNAME
1580 void gethostname(buf, len)
1581     char *buf;
1582     int len;
1583 {
1584     char *s;
1585     s = getenv ("SYS$NODE");
1586     if (s == NULL)
1587         buf[0] = '\0';
1588     else {
1589         strncpy (buf, s, len - 2);
1590         buf[len - 1] = '\0';
1591     } /* else */
1592 } /* static void gethostname */
1593 #endif /* ! HAVE_GETHOSTNAME */
1594 #endif /* VMS */
1595
1596 \f
1597 #ifndef VMS
1598 #ifndef HAVE_SELECT
1599
1600 #ifdef HAVE_X_WINDOWS
1601 /* Cause explanatory error message at compile time,
1602    since the select emulation is not good enough for X.  */
1603 int *x = &x_windows_lose_if_no_select_system_call;
1604 #endif
1605
1606 /* Emulate as much as select as is possible under 4.1 and needed by Gnu Emacs
1607  * Only checks read descriptors.
1608  */
1609 /* How long to wait between checking fds in select */
1610 #define SELECT_PAUSE 1
1611 int select_alarmed;
1612
1613 /* For longjmp'ing back to read_input_waiting.  */
1614
1615 jmp_buf read_alarm_throw;
1616
1617 /* Nonzero if the alarm signal should throw back to read_input_waiting.
1618    The read_socket_hook function sets this to 1 while it is waiting.  */
1619
1620 int read_alarm_should_throw;
1621
1622 SIGTYPE
1623 select_alarm ()
1624 {
1625   select_alarmed = 1;
1626 #ifdef BSD4_1
1627   sigrelse (SIGALRM);
1628 #else /* not BSD4_1 */
1629   signal (SIGALRM, SIG_IGN);
1630 #endif /* not BSD4_1 */
1631   if (read_alarm_should_throw)
1632     longjmp (read_alarm_throw, 1);
1633 }
1634
1635 /* Only rfds are checked.  */
1636 int
1637 select (nfds, rfds, wfds, efds, timeout)
1638      int nfds;
1639      int *rfds, *wfds, *efds, *timeout;
1640 {
1641   int ravail = 0, orfds = 0, old_alarm;
1642   int timeoutval = timeout ? *timeout : 100000;
1643   int *local_timeout = &timeoutval;
1644   extern int proc_buffered_char[];
1645 #ifndef subprocesses
1646   int process_tick = 0, update_tick = 0;
1647 #else
1648   extern int process_tick, update_tick;
1649 #endif
1650   SIGTYPE (*old_trap) ();
1651   unsigned char buf;
1652
1653   if (rfds)
1654     {
1655       orfds = *rfds;
1656       *rfds = 0;
1657     }
1658   if (wfds)
1659     *wfds = 0;
1660   if (efds)
1661     *efds = 0;
1662
1663   /* If we are looking only for the terminal, with no timeout,
1664      just read it and wait -- that's more efficient.  */
1665   if (orfds == 1 && *local_timeout == 100000 && process_tick == update_tick)
1666     {
1667       if (! detect_input_pending ())
1668         read_input_waiting ();
1669       *rfds = 1;
1670       return 1;
1671     }
1672
1673   /* Once a second, till the timer expires, check all the flagged read
1674    * descriptors to see if any input is available.  If there is some then
1675    * set the corresponding bit in the return copy of rfds.
1676    */
1677   while (1)
1678     {
1679       register int to_check, bit, fd;
1680
1681       if (rfds)
1682         {
1683           for (to_check = nfds, bit = 1, fd = 0; --to_check >= 0; bit <<= 1, fd++)
1684             {
1685               if (orfds & bit)
1686                 {
1687                   int avail = 0, status = 0;
1688
1689                   if (bit == 1)
1690                     avail = detect_input_pending (); /* Special keyboard handler */
1691                   else
1692                     {
1693 #ifdef FIONREAD
1694                       status = ioctl (fd, FIONREAD, &avail);
1695 #else /* no FIONREAD */
1696                       /* Hoping it will return -1 if nothing available
1697                          or 0 if all 0 chars requested are read.  */
1698                       if (proc_buffered_char[fd] >= 0)
1699                         avail = 1;
1700                       else
1701                         {
1702                           avail = read (fd, &buf, 1);
1703                           if (avail > 0)
1704                             proc_buffered_char[fd] = buf;
1705                         }
1706 #endif /* no FIONREAD */
1707                     }
1708                   if (status >= 0 && avail > 0)
1709                     {
1710                       (*rfds) |= bit;
1711                       ravail++;
1712                     }
1713                 }
1714             }
1715         }
1716       if (*local_timeout == 0 || ravail != 0 || process_tick != update_tick)
1717         break;
1718       old_alarm = alarm (0);
1719       old_trap = signal (SIGALRM, select_alarm);
1720       select_alarmed = 0;
1721       alarm (SELECT_PAUSE);
1722       /* Wait for a SIGALRM (or maybe a SIGTINT) */
1723       while (select_alarmed == 0 && *local_timeout != 0
1724              && process_tick == update_tick)
1725         {
1726           /* If we are interested in terminal input,
1727              wait by reading the terminal.
1728              That makes instant wakeup for terminal input at least.  */
1729           if (orfds & 1)
1730             {
1731               read_input_waiting ();
1732               if (detect_input_pending ())
1733                 select_alarmed = 1;
1734             }
1735           else
1736             pause ();
1737         }
1738       (*local_timeout) -= SELECT_PAUSE;
1739       /* Reset the old alarm if there was one */
1740       alarm (0);
1741       signal (SIGALRM, old_trap);
1742       if (old_alarm != 0)
1743         {
1744           /* Reset or forge an interrupt for the original handler. */
1745           old_alarm -= SELECT_PAUSE;
1746           if (old_alarm <= 0)
1747             kill (getpid (), SIGALRM); /* Fake an alarm with the orig' handler */
1748           else
1749             alarm (old_alarm);
1750         }
1751       if (*local_timeout == 0)  /* Stop on timer being cleared */
1752         break;
1753     }
1754   return ravail;
1755 }
1756
1757 /* Read keyboard input into the standard buffer,
1758    waiting for at least one character.  */
1759
1760 /* Make all keyboard buffers much bigger when using X windows.  */
1761 #ifdef HAVE_X_WINDOWS
1762 #define BUFFER_SIZE_FACTOR 16
1763 #else
1764 #define BUFFER_SIZE_FACTOR 1
1765 #endif
1766
1767 read_input_waiting ()
1768 {
1769   char buf[256 * BUFFER_SIZE_FACTOR];
1770   struct input_event e;
1771   int nread, i;
1772   extern int quit_char;
1773
1774   if (read_socket_hook)
1775     {
1776       read_alarm_should_throw = 0;
1777       if (! setjmp (read_alarm_throw))
1778         nread = (*read_socket_hook) (0, buf, 256 * BUFFER_SIZE_FACTOR, 1, 0);
1779       else
1780         nread = -1;
1781     }
1782   else
1783     nread = read (fileno (stdin), buf, 1);
1784
1785   /* Scan the chars for C-g and store them in kbd_buffer.  */
1786   e.kind = ascii_keystroke;
1787   e.frame_or_window = selected_frame;
1788   for (i = 0; i < nread; i++)
1789     {
1790       XSET (e.code, Lisp_Int, buf[i]);
1791       kbd_buffer_store_event (&e);
1792       /* Don't look at input that follows a C-g too closely.
1793          This reduces lossage due to autorepeat on C-g.  */
1794       if (buf[i] == quit_char)
1795         break;
1796     }
1797 }
1798
1799 #endif /* not HAVE_SELECT */
1800 #endif /* not VMS */
1801 \f
1802 #ifdef BSD4_1
1803 /*
1804  * Partially emulate 4.2 open call.
1805  * open is defined as this in 4.1.
1806  *
1807  * - added by Michael Bloom @ Citicorp/TTI
1808  *
1809  */
1810
1811 int
1812 sys_open (path, oflag, mode)
1813      char *path;
1814      int oflag, mode;
1815 {
1816   if (oflag & O_CREAT)
1817     return creat (path, mode);
1818   else
1819     return open (path, oflag);
1820 }
1821
1822 init_sigio ()
1823 {
1824   if (noninteractive)
1825     return;
1826   lmode = LINTRUP | lmode;
1827   ioctl (0, TIOCLSET, &lmode);
1828 }
1829
1830 reset_sigio ()
1831 {
1832   if (noninteractive)
1833     return;
1834   lmode = ~LINTRUP & lmode;
1835   ioctl (0, TIOCLSET, &lmode);
1836 }
1837
1838 request_sigio ()
1839 {
1840   sigrelse (SIGTINT);
1841
1842   interrupts_deferred = 0;
1843 }
1844
1845 unrequest_sigio ()
1846 {
1847   sighold (SIGTINT);
1848
1849   interrupts_deferred = 1;
1850 }
1851
1852 /* still inside #ifdef BSD4_1 */
1853 #ifdef subprocesses
1854
1855 int sigheld; /* Mask of held signals */
1856
1857 sigholdx (signum)
1858      int signum;
1859 {
1860   sigheld |= sigbit (signum);
1861   sighold (signum);
1862 }
1863
1864 sigisheld (signum)
1865      int signum;
1866 {
1867   sigheld |= sigbit (signum);
1868 }
1869
1870 sigunhold (signum)
1871      int signum;
1872 {
1873   sigheld &= ~sigbit (signum);
1874   sigrelse (signum);
1875 }
1876
1877 sigfree ()    /* Free all held signals */
1878 {
1879   int i;
1880   for (i = 0; i < NSIG; i++)
1881     if (sigheld & sigbit (i))
1882       sigrelse (i);
1883   sigheld = 0;
1884 }
1885
1886 sigbit (i)
1887 {
1888   return 1 << (i - 1);
1889 }
1890 #endif /* subprocesses */
1891 #endif /* BSD4_1 */
1892 \f
1893 /* POSIX signals support - DJB */
1894 /* Anyone with POSIX signals should have ANSI C declarations */
1895
1896 #ifdef POSIX_SIGNALS
1897
1898 sigset_t old_mask, empty_mask, full_mask, temp_mask;
1899 static struct sigaction new_action, old_action;
1900
1901 init_signals ()
1902 {
1903 #ifdef POSIX_SIGNALS
1904   sigemptyset (&signal_empty_mask);
1905   sigfillset (&signal_full_mask);
1906 #endif
1907 }
1908
1909 int (*signal_handler_t) ();
1910
1911 signal_handler_t
1912 sys_signal (int signal_number, signal_handler_t action)
1913 {
1914 #ifdef DGUX
1915   /* This gets us restartable system calls for efficiency.
1916      The "else" code will works as well. */
1917   return (berk_signal (signal_number, action));
1918 #else
1919   sigemptyset (&new_action.sa_mask);
1920   new_action.sa_handler = action;
1921   new_action.sa_flags = NULL;
1922   sigaction (signal_number, &new_action, &old_action);
1923   return (old_action.sa_handler);
1924 #endif /* DGUX */
1925 }
1926
1927 #ifndef __GNUC__
1928 /* If we're compiling with GCC, we don't need this function, since it
1929    can be written as a macro.  */
1930 sigset_t
1931 sys_sigmask (int sig)
1932 {
1933   sigset_t mask;
1934   sigemptyset (&mask);
1935   sigaddset (&mask, sig);
1936   return mask;
1937 }
1938 #endif
1939
1940 int
1941 sys_sigpause (sigset_t new_mask)
1942 {
1943   /* pause emulating berk sigpause... */
1944   sigsuspend (&new_mask);
1945   return (EINTR);
1946 }
1947
1948 /* I'd like to have these guys return pointers to the mask storage in here,
1949    but there'd be trouble if the code was saving multiple masks.  I'll be
1950    safe and pass the structure.  It normally won't be more than 2 bytes
1951    anyhow. - DJB */
1952
1953 sigset_t
1954 sys_sigblock (sigset_t new_mask)
1955 {
1956   sigset_t old_mask;
1957   sigprocmask (SIG_BLOCK, &new_mask, &old_mask);
1958   return (old_mask);
1959 }
1960
1961 sigset_t
1962 sys_sigunblock (sigset_t new_mask)
1963 {
1964   sigset_t old_mask;
1965   sigprocmask (SIG_UNBLOCK, &new_mask, &old_mask);
1966   return (old_mask);
1967 }
1968
1969 sigset_t
1970 sys_sigsetmask (sigset_t new_mask)
1971 {
1972   sigset_t old_mask;
1973   sigprocmask (SIG_SETMASK, &new_mask, &old_mask);
1974   return (old_mask);
1975 }
1976
1977 #endif /* POSIX_SIGNALS */
1978 \f
1979 #ifndef BSTRING
1980
1981 void
1982 bzero (b, length)
1983      register char *b;
1984      register int length;
1985 {
1986 #ifdef VMS
1987   short zero = 0;
1988   long max_str = 65535;
1989
1990   while (length > max_str) {
1991     (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b);
1992     length -= max_str;
1993     b += max_str;
1994   }
1995   max_str = length;
1996   (void) LIB$MOVC5 (&zero, &zero, &zero, &max_str, b);
1997 #else
1998   while (length-- > 0)
1999     *b++ = 0;
2000 #endif /* not VMS */
2001 }
2002
2003 /* Saying `void' requires a declaration, above, where bcopy is used
2004    and that declaration causes pain for systems where bcopy is a macro.  */
2005 bcopy (b1, b2, length)
2006      register char *b1;
2007      register char *b2;
2008      register int length;
2009 {
2010 #ifdef VMS
2011   long max_str = 65535;
2012
2013   while (length > max_str) {
2014     (void) LIB$MOVC3 (&max_str, b1, b2);
2015     length -= max_str;
2016     b1 += max_str;
2017     b2 += max_str;
2018   }
2019   max_str = length;
2020   (void) LIB$MOVC3 (&length, b1, b2);
2021 #else
2022   while (length-- > 0)
2023     *b2++ = *b1++;
2024 #endif /* not VMS */
2025 }
2026
2027 int
2028 bcmp (b1, b2, length)   /* This could be a macro! */
2029      register char *b1;
2030      register char *b2;
2031      register int length;
2032 {
2033 #ifdef VMS
2034   struct dsc$descriptor_s src1 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b1};
2035   struct dsc$descriptor_s src2 = {length, DSC$K_DTYPE_T, DSC$K_CLASS_S, b2};
2036
2037   return STR$COMPARE (&src1, &src2);
2038 #else
2039   while (length-- > 0)
2040     if (*b1++ != *b2++)
2041       return 1;
2042
2043   return 0;
2044 #endif /* not VMS */
2045 }
2046 #endif /* not BSTRING */
2047 \f
2048 #ifdef USG
2049 /*
2050  *      The BSD random returns numbers in the range of
2051  *      0 to 2e31 - 1.  The USG rand returns numbers in the
2052  *      range of 0 to 2e15 - 1.  This is probably not significant
2053  *      in this usage.
2054  */
2055
2056 long
2057 random ()
2058 {
2059   /* Arrange to return a range centered on zero.  */
2060   return (rand () << 15) + rand () - (1 << 29);
2061 }
2062
2063 srandom (arg)
2064      int arg;
2065 {
2066   srand (arg);
2067 }
2068
2069 #endif /* USG */
2070
2071 #ifdef BSD4_1
2072 long random ()
2073 {
2074   /* Arrange to return a range centered on zero.  */
2075   return (rand () << 15) + rand () - (1 << 29);
2076 }
2077
2078 srandom (arg)
2079      int arg;
2080 {
2081   srand (arg);
2082 }
2083 #endif /* BSD4_1 */
2084 \f
2085 #ifdef WRONG_NAME_INSQUE
2086
2087 insque (q,p)
2088      caddr_t q,p;
2089 {
2090   _insque (q,p);
2091 }
2092
2093 #endif
2094 \f
2095 #ifdef VMS
2096
2097 #ifdef getenv
2098 /* If any place else asks for the TERM variable,
2099    allow it to be overridden with the EMACS_TERM variable
2100    before attempting to translate the logical name TERM.  As a last
2101    resort, ask for VAX C's special idea of the TERM variable.  */
2102 #undef getenv
2103 char *
2104 sys_getenv (name)
2105      char *name;
2106 {
2107   register char *val;
2108   static char buf[256];
2109   static struct dsc$descriptor_s equiv
2110     = {sizeof (buf), DSC$K_DTYPE_T, DSC$K_CLASS_S, buf};
2111   static struct dsc$descriptor_s d_name
2112     = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
2113   short eqlen;
2114
2115   if (!strcmp (name, "TERM"))
2116     {
2117       val = (char *) getenv ("EMACS_TERM");
2118       if (val)
2119         return val;
2120     }
2121
2122   d_name.dsc$w_length = strlen (name);
2123   d_name.dsc$a_pointer = name;
2124   if (LIB$SYS_TRNLOG (&d_name, &eqlen, &equiv) == 1)
2125     {
2126       char *str = (char *) xmalloc (eqlen + 1);
2127       bcopy (buf, str, eqlen);
2128       str[eqlen] = '\0';
2129       /* This is a storage leak, but a pain to fix.  With luck,
2130          no one will ever notice.  */
2131       return str;
2132     }
2133   return (char *) getenv (name);
2134 }
2135 #endif /* getenv */
2136
2137 #ifdef abort
2138 /* Since VMS doesn't believe in core dumps, the only way to debug this beast is
2139    to force a call on the debugger from within the image. */
2140 #undef abort
2141 sys_abort ()
2142 {
2143   reset_sys_modes ();
2144   LIB$SIGNAL (SS$_DEBUG);
2145 }
2146 #endif /* abort */
2147 #endif /* VMS */
2148 \f
2149 #ifdef VMS
2150 #ifdef LINK_CRTL_SHARE
2151 #ifdef SHAREABLE_LIB_BUG
2152 /* Variables declared noshare and initialized in shareable libraries
2153    cannot be shared.  The VMS linker incorrectly forces you to use a private
2154    version which is uninitialized... If not for this "feature", we
2155    could use the C library definition of sys_nerr and sys_errlist. */
2156 int sys_nerr = 35;
2157 char *sys_errlist[] =
2158   {
2159     "error 0",
2160     "not owner",
2161     "no such file or directory",
2162     "no such process",
2163     "interrupted system call",
2164     "i/o error",
2165     "no such device or address",
2166     "argument list too long",
2167     "exec format error",
2168     "bad file number",
2169     "no child process",
2170     "no more processes",
2171     "not enough memory",
2172     "permission denied",
2173     "bad address",
2174     "block device required",
2175     "mount devices busy",
2176     "file exists",
2177     "cross-device link",
2178     "no such device",
2179     "not a directory",
2180     "is a directory",
2181     "invalid argument",
2182     "file table overflow",
2183     "too many open files",
2184     "not a typewriter",
2185     "text file busy",
2186     "file too big",
2187     "no space left on device",
2188     "illegal seek",
2189     "read-only file system",
2190     "too many links",
2191     "broken pipe",
2192     "math argument",
2193     "result too large",
2194     "I/O stream empty",
2195     "vax/vms specific error code nontranslatable error"
2196   };
2197 #endif /* SHAREABLE_LIB_BUG */
2198 #endif /* LINK_CRTL_SHARE */
2199 #endif /* VMS */
2200 \f
2201 #ifdef INTERRUPTIBLE_OPEN
2202
2203 int
2204 /* VARARGS 2 */
2205 sys_open (path, oflag, mode)
2206      char *path;
2207      int oflag, mode;
2208 {
2209   register int rtnval;
2210
2211   while ((rtnval = open (path, oflag, mode)) == -1
2212          && (errno == EINTR));
2213   return (rtnval);
2214 }
2215
2216 #endif /* INTERRUPTIBLE_OPEN */
2217
2218 #ifdef INTERRUPTIBLE_CLOSE
2219
2220 sys_close (fd)
2221      int fd;
2222 {
2223   register int rtnval;
2224
2225   while ((rtnval = close (fd)) == -1
2226          && (errno == EINTR));
2227   return rtnval;
2228 }
2229
2230 #endif /* INTERRUPTIBLE_CLOSE */
2231
2232 #ifdef INTERRUPTIBLE_IO
2233
2234 int
2235 sys_read (fildes, buf, nbyte)
2236      int fildes;
2237      char *buf;
2238      unsigned int nbyte;
2239 {
2240   register int rtnval;
2241
2242   while ((rtnval = read (fildes, buf, nbyte)) == -1
2243          && (errno == EINTR));
2244   return (rtnval);
2245 }
2246
2247 int
2248 sys_write (fildes, buf, nbyte)
2249      int fildes;
2250      char *buf;
2251      unsigned int nbyte;
2252 {
2253   register int rtnval;
2254
2255   while ((rtnval = write (fildes, buf, nbyte)) == -1
2256          && (errno == EINTR));
2257   return (rtnval);
2258 }
2259
2260 #endif /* INTERRUPTIBLE_IO */
2261 \f
2262 #ifdef USG
2263 /*
2264  *      All of the following are for USG.
2265  *
2266  *      On USG systems the system calls are INTERRUPTIBLE by signals
2267  *      that the user program has elected to catch.  Thus the system call
2268  *      must be retried in these cases.  To handle this without massive
2269  *      changes in the source code, we remap the standard system call names
2270  *      to names for our own functions in sysdep.c that do the system call
2271  *      with retries.  Actually, for portability reasons, it is good
2272  *      programming practice, as this example shows, to limit all actual
2273  *      system calls to a single occurance in the source.  Sure, this
2274  *      adds an extra level of function call overhead but it is almost
2275  *      always negligible.   Fred Fish, Unisoft Systems Inc.
2276  */
2277
2278 char *sys_siglist[NSIG + 1] =
2279 {
2280 #ifdef AIX
2281 /* AIX has changed the signals a bit */
2282   "bogus signal",                       /* 0 */
2283   "hangup",                             /* 1  SIGHUP */
2284   "interrupt",                          /* 2  SIGINT */
2285   "quit",                               /* 3  SIGQUIT */
2286   "illegal instruction",                /* 4  SIGILL */
2287   "trace trap",                         /* 5  SIGTRAP */
2288   "IOT instruction",                    /* 6  SIGIOT */
2289   "crash likely",                       /* 7  SIGDANGER */
2290   "floating point exception",           /* 8  SIGFPE */
2291   "kill",                               /* 9  SIGKILL */
2292   "bus error",                          /* 10 SIGBUS */
2293   "segmentation violation",             /* 11 SIGSEGV */
2294   "bad argument to system call",        /* 12 SIGSYS */
2295   "write on a pipe with no one to read it", /* 13 SIGPIPE */
2296   "alarm clock",                        /* 14 SIGALRM */
2297   "software termination signum",        /* 15 SIGTERM */
2298   "user defined signal 1",              /* 16 SIGUSR1 */
2299   "user defined signal 2",              /* 17 SIGUSR2 */
2300   "death of a child",                   /* 18 SIGCLD */
2301   "power-fail restart",                 /* 19 SIGPWR */
2302   "bogus signal",                       /* 20 */
2303   "bogus signal",                       /* 21 */
2304   "bogus signal",                       /* 22 */
2305   "bogus signal",                       /* 23 */
2306   "bogus signal",                       /* 24 */
2307   "LAN I/O interrupt",                  /* 25 SIGAIO */
2308   "PTY I/O interrupt",                  /* 26 SIGPTY */
2309   "I/O intervention required",          /* 27 SIGIOINT */
2310   "HFT grant",                          /* 28 SIGGRANT */
2311   "HFT retract",                        /* 29 SIGRETRACT */
2312   "HFT sound done",                     /* 30 SIGSOUND */
2313   "HFT input ready",                    /* 31 SIGMSG */
2314 #else /* not AIX */
2315   "bogus signal",                       /* 0 */
2316   "hangup",                             /* 1  SIGHUP */
2317   "interrupt",                          /* 2  SIGINT */
2318   "quit",                               /* 3  SIGQUIT */
2319   "illegal instruction",                /* 4  SIGILL */
2320   "trace trap",                         /* 5  SIGTRAP */
2321   "IOT instruction",                    /* 6  SIGIOT */
2322   "EMT instruction",                    /* 7  SIGEMT */
2323   "floating point exception",           /* 8  SIGFPE */
2324   "kill",                               /* 9  SIGKILL */
2325   "bus error",                          /* 10 SIGBUS */
2326   "segmentation violation",             /* 11 SIGSEGV */
2327   "bad argument to system call",        /* 12 SIGSYS */
2328   "write on a pipe with no one to read it", /* 13 SIGPIPE */
2329   "alarm clock",                        /* 14 SIGALRM */
2330   "software termination signum",        /* 15 SIGTERM */
2331   "user defined signal 1",              /* 16 SIGUSR1 */
2332   "user defined signal 2",              /* 17 SIGUSR2 */
2333   "death of a child",                   /* 18 SIGCLD */
2334   "power-fail restart",                 /* 19 SIGPWR */
2335 #endif /* not AIX */
2336   0
2337   };
2338
2339 /*
2340  *      Warning, this function may not duplicate 4.2 action properly
2341  *      under error conditions.
2342  */
2343
2344 #ifndef MAXPATHLEN
2345 /* In 4.1, param.h fails to define this.  */
2346 #define MAXPATHLEN 1024
2347 #endif
2348
2349 #ifndef HAVE_GETWD
2350
2351 char *
2352 getwd (pathname)
2353      char *pathname;
2354 {
2355   char *npath, *spath;
2356   extern char *getcwd ();
2357
2358   spath = npath = getcwd ((char *) 0, MAXPATHLEN);
2359   /* On Altos 3068, getcwd can return @hostname/dir, so discard
2360      up to first slash.  Should be harmless on other systems.  */
2361   while (*npath && *npath != '/')
2362     npath++;
2363   strcpy (pathname, npath);
2364   free (spath);                 /* getcwd uses malloc */
2365   return pathname;
2366 }
2367
2368 #endif /* HAVE_GETWD */
2369
2370 /*
2371  *      Emulate rename using unlink/link.  Note that this is
2372  *      only partially correct.  Also, doesn't enforce restriction
2373  *      that files be of same type (regular->regular, dir->dir, etc).
2374  */
2375
2376 #ifndef HAVE_RENAME
2377
2378 rename (from, to)
2379      char *from;
2380      char *to;
2381 {
2382   if (access (from, 0) == 0)
2383     {
2384       unlink (to);
2385       if (link (from, to) == 0)
2386         if (unlink (from) == 0)
2387           return (0);
2388     }
2389   return (-1);
2390 }
2391
2392 #endif
2393
2394 #ifndef HAVE_VFORK
2395
2396 /*
2397  *      Substitute fork for vfork on USG flavors.
2398  */
2399
2400 vfork ()
2401 {
2402   return (fork ());
2403 }
2404
2405 #endif /* not HAVE_VFORK */
2406
2407 #ifdef MISSING_UTIMES
2408
2409 /* HPUX (among others) sets HAVE_TIMEVAL but does not implement utimes.  */
2410
2411 utimes ()
2412 {
2413 }
2414 #endif
2415
2416 #ifdef IRIS_UTIME
2417
2418 /* The IRIS (3.5) has timevals, but uses sys V utime, and doesn't have the
2419    utimbuf structure defined anywhere but in the man page. */
2420
2421 struct utimbuf
2422  {
2423    long actime;
2424    long modtime;
2425  };
2426
2427 utimes (name, tvp)
2428      char *name;
2429      struct timeval tvp[];
2430 {
2431   struct utimbuf utb;
2432   utb.actime  = tvp[0].tv_sec;
2433   utb.modtime = tvp[1].tv_sec;
2434   utime (name, &utb);
2435 }
2436 #endif /* IRIS_UTIME */
2437
2438
2439 #ifdef HPUX
2440 #ifndef HAVE_PERROR
2441
2442 /* HPUX curses library references perror, but as far as we know
2443    it won't be called.  Anyway this definition will do for now.  */
2444
2445 perror ()
2446 {
2447 }
2448
2449 #endif /* not HAVE_PERROR */
2450 #endif /* HPUX */
2451
2452 #ifndef HAVE_DUP2
2453
2454 /*
2455  *      Emulate BSD dup2.  First close newd if it already exists.
2456  *      Then, attempt to dup oldd.  If not successful, call dup2 recursively
2457  *      until we are, then close the unsuccessful ones.
2458  */
2459
2460 dup2 (oldd, newd)
2461      int oldd;
2462      int newd;
2463 {
2464   register int fd, ret;
2465
2466   sys_close (newd);
2467
2468 #ifdef F_DUPFD
2469   fd = fcntl (oldd, F_DUPFD, newd);
2470   if (fd != newd)
2471     error ("can't dup2 (%i,%i) : %s", oldd, newd, sys_errlist[errno]);
2472 #else
2473   fd = dup (old);
2474   if (fd == -1)
2475     return -1;
2476   if (fd == new)
2477     return new;
2478   ret = dup2 (old,new);
2479   sys_close (fd);
2480   return ret;
2481 #endif
2482 }
2483
2484 #endif /* not HAVE_DUP2 */
2485
2486 /*
2487  *      Gettimeofday.  Simulate as much as possible.  Only accurate
2488  *      to nearest second.  Emacs doesn't use tzp so ignore it for now.
2489  *      Only needed when subprocesses are defined.
2490  */
2491
2492 #ifdef subprocesses
2493 #ifndef VMS
2494 #ifndef HAVE_GETTIMEOFDAY
2495 #ifdef HAVE_TIMEVAL
2496
2497 /* ARGSUSED */
2498 gettimeofday (tp, tzp)
2499      struct timeval *tp;
2500      struct timezone *tzp;
2501 {
2502   extern long time ();
2503
2504   tp->tv_sec = time ((long *)0);
2505   tp->tv_usec = 0;
2506   tzp->tz_minuteswest = -1;
2507 }
2508
2509 #endif
2510 #endif
2511 #endif
2512 #endif /* subprocess && !HAVE_GETTIMEOFDAY && HAVE_TIMEVAL && !VMS */
2513
2514 /*
2515  *      This function will go away as soon as all the stubs fixed. (fnf)
2516  */
2517
2518 croak (badfunc)
2519      char *badfunc;
2520 {
2521   printf ("%s not yet implemented\r\n", badfunc);
2522   reset_sys_modes ();
2523   exit (1);
2524 }
2525
2526 #endif /* USG */
2527 \f
2528 #ifdef DGUX
2529
2530 char *sys_siglist[NSIG + 1] =
2531 {
2532   "null signal",                         /*  0 SIGNULL   */
2533   "hangup",                              /*  1 SIGHUP    */
2534   "interrupt",                           /*  2 SIGINT    */
2535   "quit",                                /*  3 SIGQUIT   */
2536   "illegal instruction",                 /*  4 SIGILL    */
2537   "trace trap",                          /*  5 SIGTRAP   */
2538   "abort termination",                   /*  6 SIGABRT   */
2539   "SIGEMT",                              /*  7 SIGEMT    */
2540   "floating point exception",            /*  8 SIGFPE    */
2541   "kill",                                /*  9 SIGKILL   */
2542   "bus error",                           /* 10 SIGBUS    */
2543   "segmentation violation",              /* 11 SIGSEGV   */
2544   "bad argument to system call",         /* 12 SIGSYS    */
2545   "write on a pipe with no reader",      /* 13 SIGPIPE   */
2546   "alarm clock",                         /* 14 SIGALRM   */
2547   "software termination signal",         /* 15 SIGTERM   */
2548   "user defined signal 1",               /* 16 SIGUSR1   */
2549   "user defined signal 2",               /* 17 SIGUSR2   */
2550   "child stopped or terminated",         /* 18 SIGCLD    */
2551   "power-fail restart",                  /* 19 SIGPWR    */
2552   "window size changed",                 /* 20 SIGWINCH  */
2553   "undefined",                           /* 21           */
2554   "pollable event occured",              /* 22 SIGPOLL   */
2555   "sendable stop signal not from tty",   /* 23 SIGSTOP   */
2556   "stop signal from tty",                /* 24 SIGSTP    */
2557   "continue a stopped process",          /* 25 SIGCONT   */
2558   "attempted background tty read",       /* 26 SIGTTIN   */
2559   "attempted background tty write",      /* 27 SIGTTOU   */
2560   "undefined",                           /* 28           */
2561   "undefined",                           /* 29           */
2562   "undefined",                           /* 30           */
2563   "undefined",                           /* 31           */
2564   "undefined",                           /* 32           */
2565   "socket (TCP/IP) urgent data arrival", /* 33 SIGURG    */
2566   "I/O is possible",                     /* 34 SIGIO     */
2567   "exceeded cpu time limit",             /* 35 SIGXCPU   */
2568   "exceeded file size limit",            /* 36 SIGXFSZ   */
2569   "virtual time alarm",                  /* 37 SIGVTALRM */
2570   "profiling time alarm",                /* 38 SIGPROF   */
2571   "undefined",                           /* 39           */
2572   "file record locks revoked",           /* 40 SIGLOST   */
2573   "undefined",                           /* 41           */
2574   "undefined",                           /* 42           */
2575   "undefined",                           /* 43           */
2576   "undefined",                           /* 44           */
2577   "undefined",                           /* 45           */
2578   "undefined",                           /* 46           */
2579   "undefined",                           /* 47           */
2580   "undefined",                           /* 48           */
2581   "undefined",                           /* 49           */
2582   "undefined",                           /* 50           */
2583   "undefined",                           /* 51           */
2584   "undefined",                           /* 52           */
2585   "undefined",                           /* 53           */
2586   "undefined",                           /* 54           */
2587   "undefined",                           /* 55           */
2588   "undefined",                           /* 56           */
2589   "undefined",                           /* 57           */
2590   "undefined",                           /* 58           */
2591   "undefined",                           /* 59           */
2592   "undefined",                           /* 60           */
2593   "undefined",                           /* 61           */
2594   "undefined",                           /* 62           */
2595   "undefined",                           /* 63           */
2596   "notification message in mess. queue", /* 64 SIGDGNOTIFY */
2597   0
2598 };
2599
2600 #endif /* DGUX */
2601 \f
2602 /* Directory routines for systems that don't have them. */
2603
2604 #ifdef SYSV_SYSTEM_DIR
2605
2606 #include <dirent.h>
2607
2608 #ifndef AIX
2609 int
2610 closedir (dirp)
2611      register DIR *dirp;              /* stream from opendir */
2612 {
2613   sys_close (dirp->dd_fd);
2614   free ((char *) dirp->dd_buf);       /* directory block defined in <dirent.h> */
2615   free ((char *) dirp);
2616 }
2617 #endif /* not AIX */
2618 #endif /* SYSV_SYSTEM_DIR */
2619
2620 #ifdef NONSYSTEM_DIR_LIBRARY
2621
2622 DIR *
2623 opendir (filename)
2624      char *filename;    /* name of directory */
2625 {
2626   register DIR *dirp;           /* -> malloc'ed storage */
2627   register int fd;              /* file descriptor for read */
2628   struct stat sbuf;             /* result of fstat */
2629
2630   fd = sys_open (filename, 0);
2631   if (fd < 0)
2632     return 0;
2633
2634   if (fstat (fd, &sbuf) < 0
2635       || (sbuf.st_mode & S_IFMT) != S_IFDIR
2636       || (dirp = (DIR *) malloc (sizeof (DIR))) == 0)
2637     {
2638       sys_close (fd);
2639       return 0;         /* bad luck today */
2640     }
2641
2642   dirp->dd_fd = fd;
2643   dirp->dd_loc = dirp->dd_size = 0;     /* refill needed */
2644
2645   return dirp;
2646 }
2647
2648 void
2649 closedir (dirp)
2650      register DIR *dirp;                /* stream from opendir */
2651 {
2652   sys_close (dirp->dd_fd);
2653   free ((char *) dirp);
2654 }
2655
2656
2657 #ifndef VMS
2658 #define DIRSIZ  14
2659 struct olddir
2660   {
2661     ino_t od_ino;               /* inode */
2662     char od_name[DIRSIZ];       /* filename */
2663   };
2664 #endif /* not VMS */
2665
2666 struct direct dir_static;       /* simulated directory contents */
2667
2668 /* ARGUSED */
2669 struct direct *
2670 readdir (dirp)
2671      register DIR *dirp;        /* stream from opendir */
2672 {
2673 #ifndef VMS
2674   register struct olddir *dp;   /* -> directory data */
2675 #else /* VMS */
2676   register struct dir$_name *dp; /* -> directory data */
2677   register struct dir$_version *dv; /* -> version data */
2678 #endif /* VMS */
2679
2680   for (; ;)
2681     {
2682       if (dirp->dd_loc >= dirp->dd_size)
2683         dirp->dd_loc = dirp->dd_size = 0;
2684
2685       if (dirp->dd_size == 0    /* refill buffer */
2686           && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0)
2687         return 0;
2688
2689 #ifndef VMS
2690       dp = (struct olddir *) &dirp->dd_buf[dirp->dd_loc];
2691       dirp->dd_loc += sizeof (struct olddir);
2692
2693       if (dp->od_ino != 0)      /* not deleted entry */
2694         {
2695           dir_static.d_ino = dp->od_ino;
2696           strncpy (dir_static.d_name, dp->od_name, DIRSIZ);
2697           dir_static.d_name[DIRSIZ] = '\0';
2698           dir_static.d_namlen = strlen (dir_static.d_name);
2699           dir_static.d_reclen = sizeof (struct direct)
2700             - MAXNAMLEN + 3
2701               + dir_static.d_namlen - dir_static.d_namlen % 4;
2702           return &dir_static;   /* -> simulated structure */
2703         }
2704 #else /* VMS */
2705       dp = (struct dir$_name *) dirp->dd_buf;
2706       if (dirp->dd_loc == 0)
2707         dirp->dd_loc = (dp->dir$b_namecount&1) ? dp->dir$b_namecount + 1
2708           : dp->dir$b_namecount;
2709       dv = (struct dir$_version *)&dp->dir$t_name[dirp->dd_loc];
2710       dir_static.d_ino = dv->dir$w_fid_num;
2711       dir_static.d_namlen = dp->dir$b_namecount;
2712       dir_static.d_reclen = sizeof (struct direct)
2713         - MAXNAMLEN + 3
2714           + dir_static.d_namlen - dir_static.d_namlen % 4;
2715       strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount);
2716       dir_static.d_name[dir_static.d_namlen] = '\0';
2717       dirp->dd_loc = dirp->dd_size; /* only one record at a time */
2718       return &dir_static;
2719 #endif /* VMS */
2720     }
2721 }
2722
2723 #ifdef VMS
2724 /* readdirver is just like readdir except it returns all versions of a file
2725    as separate entries.  */
2726
2727 /* ARGUSED */
2728 struct direct *
2729 readdirver (dirp)
2730      register DIR *dirp;        /* stream from opendir */
2731 {
2732   register struct dir$_name *dp; /* -> directory data */
2733   register struct dir$_version *dv; /* -> version data */
2734
2735   if (dirp->dd_loc >= dirp->dd_size - sizeof (struct dir$_name))
2736     dirp->dd_loc = dirp->dd_size = 0;
2737
2738   if (dirp->dd_size == 0        /* refill buffer */
2739       && (dirp->dd_size = sys_read (dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ)) <= 0)
2740     return 0;
2741
2742   dp = (struct dir$_name *) dirp->dd_buf;
2743   if (dirp->dd_loc == 0)
2744     dirp->dd_loc = (dp->dir$b_namecount & 1) ? dp->dir$b_namecount + 1
2745                    : dp->dir$b_namecount;
2746   dv = (struct dir$_version *) &dp->dir$t_name[dirp->dd_loc];
2747   strncpy (dir_static.d_name, dp->dir$t_name, dp->dir$b_namecount);
2748   sprintf (&dir_static.d_name[dp->dir$b_namecount], ";%d", dv->dir$w_version);
2749   dir_static.d_namlen = strlen (dir_static.d_name);
2750   dir_static.d_ino = dv->dir$w_fid_num;
2751   dir_static.d_reclen = sizeof (struct direct) - MAXNAMLEN + 3
2752                         + dir_static.d_namlen - dir_static.d_namlen % 4;
2753   dirp->dd_loc = ((char *) (++dv) - dp->dir$t_name);
2754   return &dir_static;
2755 }
2756
2757 #endif /* VMS */
2758
2759 #endif /* NONSYSTEM_DIR_LIBRARY */
2760 \f
2761 /* Functions for VMS */
2762 #ifdef VMS
2763 #include "vms-pwd.h"
2764 #include <acldef.h>
2765 #include <chpdef.h>
2766 #include <jpidef.h>
2767
2768 /* Return as a string the VMS error string pertaining to STATUS.
2769    Reuses the same static buffer each time it is called.  */
2770
2771 char *
2772 vmserrstr (status)
2773      int status;                /* VMS status code */
2774 {
2775   int bufadr[2];
2776   short len;
2777   static char buf[257];
2778
2779   bufadr[0] = sizeof buf - 1;
2780   bufadr[1] = (int) buf;
2781   if (! (SYS$GETMSG (status, &len, bufadr, 0x1, 0) & 1))
2782     return "untranslatable VMS error status";
2783   buf[len] = '\0';
2784   return buf;
2785 }
2786
2787 #ifdef access
2788 #undef access
2789
2790 /* The following is necessary because 'access' emulation by VMS C (2.0) does
2791  * not work correctly.  (It also doesn't work well in version 2.3.)
2792  */
2793
2794 #ifdef VMS4_4
2795
2796 #define DESCRIPTOR(name,string) struct dsc$descriptor_s name = \
2797         { strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string }
2798
2799 typedef union {
2800     struct {
2801         unsigned short s_buflen;
2802         unsigned short s_code;
2803         char *s_bufadr;
2804         unsigned short *s_retlenadr;
2805     } s;
2806     int end;
2807 } item;
2808 #define buflen s.s_buflen
2809 #define code s.s_code
2810 #define bufadr s.s_bufadr
2811 #define retlenadr s.s_retlenadr
2812
2813 #define R_OK 4  /* test for read permission */
2814 #define W_OK 2  /* test for write permission */
2815 #define X_OK 1  /* test for execute (search) permission */
2816 #define F_OK 0  /* test for presence of file */
2817
2818 int
2819 sys_access (path, mode)
2820      char *path;
2821      int mode;
2822 {
2823   static char *user = NULL;
2824   char dir_fn[512];
2825
2826   /* translate possible directory spec into .DIR file name, so brain-dead
2827    * access can treat the directory like a file.  */
2828   if (directory_file_name (path, dir_fn))
2829     path = dir_fn;
2830
2831   if (mode == F_OK)
2832     return access (path, mode);
2833   if (user == NULL && (user = (char *) getenv ("USER")) == NULL)
2834     return -1;
2835   {
2836     int stat;
2837     int flags;
2838     int acces;
2839     unsigned short int dummy;
2840     item itemlst[3];
2841     static int constant = ACL$C_FILE;
2842     DESCRIPTOR (path_desc, path);
2843     DESCRIPTOR (user_desc, user);
2844
2845     flags = 0;
2846     acces = 0;
2847     if ((mode & X_OK) && ((stat = access (path, mode)) < 0 || mode == X_OK))
2848       return stat;
2849     if (mode & R_OK)
2850       acces |= CHP$M_READ;
2851     if (mode & W_OK)
2852       acces |= CHP$M_WRITE;
2853     itemlst[0].buflen = sizeof (int);
2854     itemlst[0].code = CHP$_FLAGS;
2855     itemlst[0].bufadr = (char *) &flags;
2856     itemlst[0].retlenadr = &dummy;
2857     itemlst[1].buflen = sizeof (int);
2858     itemlst[1].code = CHP$_ACCESS;
2859     itemlst[1].bufadr = (char *) &acces;
2860     itemlst[1].retlenadr = &dummy;
2861     itemlst[2].end = CHP$_END;
2862     stat = SYS$CHECK_ACCESS (&constant, &path_desc, &user_desc, itemlst);
2863     return stat == SS$_NORMAL ? 0 : -1;
2864   }
2865 }
2866
2867 #else /* not VMS4_4 */
2868
2869 #include <prvdef.h>
2870 #define ACE$M_WRITE     2
2871 #define ACE$C_KEYID     1
2872
2873 static unsigned short memid, grpid;
2874 static unsigned int uic;
2875
2876 /* Called from init_sys_modes, so it happens not very often
2877    but at least each time Emacs is loaded.  */
2878 sys_access_reinit ()
2879 {
2880   uic = 0;
2881 }
2882
2883 int
2884 sys_access (filename, type)
2885      char * filename;
2886      int type;
2887 {
2888   struct FAB fab;
2889   struct XABPRO xab;
2890   int status, size, i, typecode, acl_controlled;
2891   unsigned int *aclptr, *aclend, aclbuf[60];
2892   union prvdef prvmask;
2893
2894   /* Get UIC and GRP values for protection checking.  */
2895   if (uic == 0)
2896     {
2897       status = LIB$GETJPI (&JPI$_UIC, 0, 0, &uic, 0, 0);
2898       if (! (status & 1))
2899         return -1;
2900       memid = uic & 0xFFFF;
2901       grpid = uic >> 16;
2902     }
2903
2904   if (type != 2)                /* not checking write access */
2905     return access (filename, type);
2906
2907   /* Check write protection. */
2908
2909 #define CHECKPRIV(bit)    (prvmask.bit)
2910 #define WRITEABLE(field)  (! ((xab.xab$w_pro >> field) & XAB$M_NOWRITE))
2911
2912   /* Find privilege bits */
2913   status = SYS$SETPRV (0, 0, 0, prvmask);
2914   if (! (status & 1))
2915     error ("Unable to find privileges: %s", vmserrstr (status));
2916   if (CHECKPRIV (PRV$V_BYPASS))
2917     return 0;                   /* BYPASS enabled */
2918   fab = cc$rms_fab;
2919   fab.fab$b_fac = FAB$M_GET;
2920   fab.fab$l_fna = filename;
2921   fab.fab$b_fns = strlen (filename);
2922   fab.fab$l_xab = &xab;
2923   xab = cc$rms_xabpro;
2924   xab.xab$l_aclbuf = aclbuf;
2925   xab.xab$w_aclsiz = sizeof (aclbuf);
2926   status = SYS$OPEN (&fab, 0, 0);
2927   if (! (status & 1))
2928     return -1;
2929   SYS$CLOSE (&fab, 0, 0);
2930   /* Check system access */
2931   if (CHECKPRIV (PRV$V_SYSPRV) && WRITEABLE (XAB$V_SYS))
2932     return 0;
2933   /* Check ACL entries, if any */
2934   acl_controlled = 0;
2935   if (xab.xab$w_acllen > 0)
2936     {
2937       aclptr = aclbuf;
2938       aclend = &aclbuf[xab.xab$w_acllen / 4];
2939       while (*aclptr && aclptr < aclend)
2940         {
2941           size = (*aclptr & 0xff) / 4;
2942           typecode = (*aclptr >> 8) & 0xff;
2943           if (typecode == ACE$C_KEYID)
2944             for (i = size - 1; i > 1; i--)
2945               if (aclptr[i] == uic)
2946                 {
2947                   acl_controlled = 1;
2948                   if (aclptr[1] & ACE$M_WRITE)
2949                     return 0;   /* Write access through ACL */
2950                 }
2951           aclptr = &aclptr[size];
2952         }
2953       if (acl_controlled)       /* ACL specified, prohibits write access */
2954         return -1;
2955     }
2956   /* No ACL entries specified, check normal protection */
2957   if (WRITEABLE (XAB$V_WLD))    /* World writeable */
2958     return 0;
2959   if (WRITEABLE (XAB$V_GRP) &&
2960       (unsigned short) (xab.xab$l_uic >> 16) == grpid)
2961     return 0;                   /* Group writeable */
2962   if (WRITEABLE (XAB$V_OWN) &&
2963       (xab.xab$l_uic & 0xFFFF) == memid)
2964     return 0;                   /* Owner writeable */
2965
2966   return -1;    /* Not writeable */
2967 }
2968 #endif /* not VMS4_4 */
2969 #endif /* access */
2970
2971 static char vtbuf[NAM$C_MAXRSS+1];
2972
2973 /* translate a vms file spec to a unix path */
2974 char *
2975 sys_translate_vms (vfile)
2976      char * vfile;
2977 {
2978   char * p;
2979   char * targ;
2980
2981   if (!vfile)
2982     return 0;
2983
2984   targ = vtbuf;
2985
2986   /* leading device or logical name is a root directory */
2987   if (p = strchr (vfile, ':'))
2988     {
2989       *targ++ = '/';
2990       while (vfile < p)
2991         *targ++ = *vfile++;
2992       vfile++;
2993       *targ++ = '/';
2994     }
2995   p = vfile;
2996   if (*p == '[' || *p == '<')
2997     {
2998       while (*++vfile != *p + 2)
2999         switch (*vfile)
3000           {
3001           case '.':
3002             if (vfile[-1] == *p)
3003               *targ++ = '.';
3004             *targ++ = '/';
3005             break;
3006
3007           case '-':
3008             *targ++ = '.';
3009             *targ++ = '.';
3010             break;
3011
3012           default:
3013             *targ++ = *vfile;
3014             break;
3015           }
3016       vfile++;
3017       *targ++ = '/';
3018     }
3019   while (*vfile)
3020     *targ++ = *vfile++;
3021
3022   return vtbuf;
3023 }
3024
3025 static char utbuf[NAM$C_MAXRSS+1];
3026
3027 /* translate a unix path to a VMS file spec */
3028 char *
3029 sys_translate_unix (ufile)
3030      char * ufile;
3031 {
3032   int slash_seen = 0;
3033   char *p;
3034   char * targ;
3035
3036   if (!ufile)
3037     return 0;
3038
3039   targ = utbuf;
3040
3041   if (*ufile == '/')
3042     {
3043       ufile++;
3044     }
3045
3046   while (*ufile)
3047     {
3048       switch (*ufile)
3049         {
3050         case '/':
3051           if (slash_seen)
3052             if (index (&ufile[1], '/'))
3053               *targ++ = '.';
3054             else
3055               *targ++ = ']';
3056           else
3057             {
3058               *targ++ = ':';
3059               if (index (&ufile[1], '/'))
3060                 *targ++ = '[';
3061               slash_seen = 1;
3062             }
3063           break;
3064
3065         case '.':
3066           if (strncmp (ufile, "./", 2) == 0)
3067             {
3068               if (!slash_seen)
3069                 {
3070                   *targ++ = '[';
3071                   slash_seen = 1;
3072                 }
3073               ufile++;          /* skip the dot */
3074               if (index (&ufile[1], '/'))
3075                 *targ++ = '.';
3076               else
3077                 *targ++ = ']';
3078             }
3079           else if (strncmp (ufile, "../", 3) == 0)
3080             {
3081               if (!slash_seen)
3082                 {
3083                   *targ++ = '[';
3084                   slash_seen = 1;
3085                 }
3086               *targ++ = '-';
3087               ufile += 2;       /* skip the dots */
3088               if (index (&ufile[1], '/'))
3089                 *targ++ = '.';
3090               else
3091                 *targ++ = ']';
3092             }
3093           else
3094             *targ++ = *ufile;
3095           break;
3096
3097         default:
3098           *targ++ = *ufile;
3099           break;
3100         }
3101       ufile++;
3102     }
3103   *targ = '\0';
3104
3105   return utbuf;
3106 }
3107
3108 char *
3109 getwd (pathname)
3110      char *pathname;
3111 {
3112   char *ptr;
3113   extern char *getcwd ();
3114
3115 #define MAXPATHLEN 1024
3116
3117   ptr = malloc (MAXPATHLEN);
3118   getcwd (ptr, MAXPATHLEN);
3119   strcpy (pathname, ptr);
3120   free (ptr);
3121
3122  return pathname;
3123 }
3124
3125 getppid ()
3126 {
3127   long item_code = JPI$_OWNER;
3128   unsigned long parent_id;
3129   int status;
3130
3131   if (((status = LIB$GETJPI (&item_code, 0, 0, &parent_id)) & 1) == 0)
3132     {
3133       errno = EVMSERR;
3134       vaxc$errno = status;
3135       return -1;
3136     }
3137   return parent_id;
3138 }
3139
3140 #undef getuid
3141 unsigned
3142 sys_getuid ()
3143 {
3144   return (getgid () << 16) | getuid ();
3145 }
3146
3147 int
3148 sys_read (fildes, buf, nbyte)
3149      int fildes;
3150      char *buf;
3151      unsigned int nbyte;
3152 {
3153   return read (fildes, buf, (nbyte < MAXIOSIZE ? nbyte : MAXIOSIZE));
3154 }
3155
3156 #if 0
3157 int
3158 sys_write (fildes, buf, nbyte)
3159      int fildes;
3160      char *buf;
3161      unsigned int nbyte;
3162 {
3163   register int nwrote, rtnval = 0;
3164
3165   while (nbyte > MAXIOSIZE && (nwrote = write (fildes, buf, MAXIOSIZE)) > 0) {
3166     nbyte -= nwrote;
3167     buf += nwrote;
3168     rtnval += nwrote;
3169   }
3170   if (nwrote < 0)
3171     return rtnval ? rtnval : -1;
3172   if ((nwrote = write (fildes, buf, nbyte)) < 0)
3173     return rtnval ? rtnval : -1;
3174   return (rtnval + nwrote);
3175 }
3176 #endif /* 0 */
3177
3178 /*
3179  *      VAX/VMS VAX C RTL really loses. It insists that records
3180  *      end with a newline (carriage return) character, and if they
3181  *      don't it adds one (nice of it isn't it!)
3182  *
3183  *      Thus we do this stupidity below.
3184  */
3185
3186 int
3187 sys_write (fildes, buf, nbytes)
3188      int fildes;
3189      char *buf;
3190      unsigned int nbytes;
3191 {
3192   register char *p;
3193   register char *e;
3194   int sum = 0;
3195   struct stat st;
3196
3197   fstat (fildes, &st);
3198   p = buf;
3199   while (nbytes > 0)
3200     {
3201       int len, retval;
3202
3203       /* Handle fixed-length files with carriage control.  */
3204       if (st.st_fab_rfm == FAB$C_FIX
3205           && ((st.st_fab_rat & (FAB$M_FTN | FAB$M_CR)) != 0))
3206         {
3207           len = st.st_fab_mrs;
3208           retval = write (fildes, p, min (len, nbytes));
3209           if (retval != len)
3210             return -1;
3211           retval++;     /* This skips the implied carriage control */
3212         }
3213       else
3214         {
3215           e =  p + min (MAXIOSIZE, nbytes) - 1;
3216           while (*e != '\n' && e > p) e--;
3217           if (p == e)           /* Ok.. so here we add a newline... sigh. */
3218             e = p + min (MAXIOSIZE, nbytes) - 1;
3219           len = e + 1 - p;
3220           retval = write (fildes, p, len);
3221           if (retval != len)
3222             return -1;
3223         }
3224       p += retval;
3225       sum += retval;
3226       nbytes -= retval;
3227     }
3228   return sum;
3229 }
3230
3231 /* Create file NEW copying its attributes from file OLD.  If
3232    OLD is 0 or does not exist, create based on the value of
3233    vms_stmlf_recfm. */
3234
3235 /* Protection value the file should ultimately have.
3236    Set by create_copy_attrs, and use by rename_sansversions.  */
3237 static unsigned short int fab_final_pro;
3238
3239 int
3240 creat_copy_attrs (old, new)
3241      char *old, *new;
3242 {
3243   struct FAB fab = cc$rms_fab;
3244   struct XABPRO xabpro;
3245   char aclbuf[256];     /* Choice of size is arbitrary.  See below. */
3246   extern int vms_stmlf_recfm;
3247
3248   if (old)
3249     {
3250       fab.fab$b_fac = FAB$M_GET;
3251       fab.fab$l_fna = old;
3252       fab.fab$b_fns = strlen (old);
3253       fab.fab$l_xab = (char *) &xabpro;
3254       xabpro = cc$rms_xabpro;
3255       xabpro.xab$l_aclbuf = aclbuf;
3256       xabpro.xab$w_aclsiz = sizeof aclbuf;
3257       /* Call $OPEN to fill in the fab & xabpro fields. */
3258       if (SYS$OPEN (&fab, 0, 0) & 1)
3259         {
3260           SYS$CLOSE (&fab, 0, 0);
3261           fab.fab$l_alq = 0;    /* zero the allocation quantity */
3262           if (xabpro.xab$w_acllen > 0)
3263             {
3264               if (xabpro.xab$w_acllen > sizeof aclbuf)
3265                 /* If the acl buffer was too short, redo open with longer one.
3266                    Wouldn't need to do this if there were some system imposed
3267                    limit on the size of an ACL, but I can't find any such. */
3268                 {
3269                   xabpro.xab$l_aclbuf = (char *) alloca (xabpro.xab$w_acllen);
3270                   xabpro.xab$w_aclsiz = xabpro.xab$w_acllen;
3271                   if (SYS$OPEN (&fab, 0, 0) & 1)
3272                     SYS$CLOSE (&fab, 0, 0);
3273                   else
3274                     old = 0;
3275                 }
3276             }
3277           else
3278             xabpro.xab$l_aclbuf = 0;
3279         }
3280       else
3281         old = 0;
3282     }
3283   fab.fab$l_fna = new;
3284   fab.fab$b_fns = strlen (new);
3285   if (!old)
3286     {
3287       fab.fab$l_xab = 0;
3288       fab.fab$b_rfm = vms_stmlf_recfm ? FAB$C_STMLF : FAB$C_VAR;
3289       fab.fab$b_rat = FAB$M_CR;
3290     }
3291
3292   /* Set the file protections such that we will be able to manipulate
3293      this file.  Once we are done writing and renaming it, we will set
3294      the protections back.  */
3295   if (old)
3296     fab_final_pro = xabpro.xab$w_pro;
3297   else
3298     SYS$SETDFPROT (0, &fab_final_pro);
3299   xabpro.xab$w_pro &= 0xff0f; /* set O:rewd for now. This is set back later. */
3300
3301   /* Create the new file with either default attrs or attrs copied
3302      from old file. */
3303   if (!(SYS$CREATE (&fab, 0, 0) & 1))
3304     return -1;
3305   SYS$CLOSE (&fab, 0, 0);
3306   /* As this is a "replacement" for creat, return a file descriptor
3307      opened for writing. */
3308   return open (new, O_WRONLY);
3309 }
3310
3311 #ifdef creat
3312 #undef creat
3313 #include <varargs.h>
3314 #ifdef __GNUC__
3315 #ifndef va_count
3316 #define va_count(X) ((X) = *(((int *) &(va_alist)) - 1))
3317 #endif
3318 #endif
3319
3320 sys_creat (va_alist)
3321      va_dcl
3322 {
3323   va_list list_incrementor;
3324   char *name;
3325   int mode;
3326   int rfd;                      /* related file descriptor */
3327   int fd;                       /* Our new file descriptor */
3328   int count;
3329   struct stat st_buf;
3330   char rfm[12];
3331   char rat[15];
3332   char mrs[13];
3333   char fsz[13];
3334   extern int vms_stmlf_recfm;
3335
3336   va_count (count);
3337   va_start (list_incrementor);
3338   name = va_arg (list_incrementor, char *);
3339   mode = va_arg (list_incrementor, int);
3340   if (count > 2)
3341     rfd = va_arg (list_incrementor, int);
3342   va_end (list_incrementor);
3343   if (count > 2)
3344     {
3345       /* Use information from the related file descriptor to set record
3346          format of the newly created file. */
3347       fstat (rfd, &st_buf);
3348       switch (st_buf.st_fab_rfm)
3349         {
3350         case FAB$C_FIX:
3351           strcpy (rfm, "rfm = fix");
3352           sprintf (mrs, "mrs = %d", st_buf.st_fab_mrs);
3353           strcpy (rat, "rat = ");
3354           if (st_buf.st_fab_rat & FAB$M_CR)
3355             strcat (rat, "cr");
3356           else if (st_buf.st_fab_rat & FAB$M_FTN)
3357             strcat (rat, "ftn");
3358           else if (st_buf.st_fab_rat & FAB$M_PRN)
3359             strcat (rat, "prn");
3360           if (st_buf.st_fab_rat & FAB$M_BLK)
3361             if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN))
3362               strcat (rat, ", blk");
3363             else
3364               strcat (rat, "blk");
3365           return creat (name, 0, rfm, rat, mrs);
3366
3367         case FAB$C_VFC:
3368           strcpy (rfm, "rfm = vfc");
3369           sprintf (fsz, "fsz = %d", st_buf.st_fab_fsz);
3370           strcpy (rat, "rat = ");
3371           if (st_buf.st_fab_rat & FAB$M_CR)
3372             strcat (rat, "cr");
3373           else if (st_buf.st_fab_rat & FAB$M_FTN)
3374             strcat (rat, "ftn");
3375           else if (st_buf.st_fab_rat & FAB$M_PRN)
3376             strcat (rat, "prn");
3377           if (st_buf.st_fab_rat & FAB$M_BLK)
3378             if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN))
3379               strcat (rat, ", blk");
3380             else
3381               strcat (rat, "blk");
3382           return creat (name, 0, rfm, rat, fsz);
3383
3384         case FAB$C_STM:
3385           strcpy (rfm, "rfm = stm");
3386           break;
3387
3388         case FAB$C_STMCR:
3389           strcpy (rfm, "rfm = stmcr");
3390           break;
3391
3392         case FAB$C_STMLF:
3393           strcpy (rfm, "rfm = stmlf");
3394           break;
3395
3396         case FAB$C_UDF:
3397           strcpy (rfm, "rfm = udf");
3398           break;
3399
3400         case FAB$C_VAR:
3401           strcpy (rfm, "rfm = var");
3402           break;
3403         }
3404       strcpy (rat, "rat = ");
3405       if (st_buf.st_fab_rat & FAB$M_CR)
3406         strcat (rat, "cr");
3407       else if (st_buf.st_fab_rat & FAB$M_FTN)
3408         strcat (rat, "ftn");
3409       else if (st_buf.st_fab_rat & FAB$M_PRN)
3410         strcat (rat, "prn");
3411       if (st_buf.st_fab_rat & FAB$M_BLK)
3412         if (st_buf.st_fab_rat & (FAB$M_CR|FAB$M_FTN|FAB$M_PRN))
3413           strcat (rat, ", blk");
3414         else
3415           strcat (rat, "blk");
3416     }
3417   else
3418     {
3419       strcpy (rfm, vms_stmlf_recfm ? "rfm = stmlf" : "rfm=var");
3420       strcpy (rat, "rat=cr");
3421     }
3422   /* Until the VAX C RTL fixes the many bugs with modes, always use
3423      mode 0 to get the user's default protection. */
3424   fd = creat (name, 0, rfm, rat);
3425   if (fd < 0 && errno == EEXIST)
3426     {
3427       if (unlink (name) < 0)
3428         report_file_error ("delete", build_string (name));
3429       fd = creat (name, 0, rfm, rat);
3430     }
3431   return fd;
3432 }
3433 #endif /* creat */
3434
3435 /* fwrite to stdout is S L O W.  Speed it up by using fputc...*/
3436 sys_fwrite (ptr, size, num, fp)
3437      register char * ptr;
3438      FILE * fp;
3439 {
3440   register int tot = num * size;
3441
3442   while (tot--)
3443     fputc (*ptr++, fp);
3444 }
3445
3446 /*
3447  * The VMS C library routine creat actually creates a new version of an
3448  * existing file rather than truncating the old version.  There are times
3449  * when this is not the desired behavior, for instance, when writing an
3450  * auto save file (you only want one version), or when you don't have
3451  * write permission in the directory containing the file (but the file
3452  * itself is writable).  Hence this routine, which is equivalent to
3453  * "close (creat (fn, 0));" on Unix if fn already exists.
3454  */
3455 int
3456 vms_truncate (fn)
3457      char *fn;
3458 {
3459   struct FAB xfab = cc$rms_fab;
3460   struct RAB xrab = cc$rms_rab;
3461   int status;
3462
3463   xfab.fab$l_fop = FAB$M_TEF;   /* free allocated but unused blocks on close */
3464   xfab.fab$b_fac = FAB$M_TRN | FAB$M_GET; /* allow truncate and get access */
3465   xfab.fab$b_shr = FAB$M_NIL;   /* allow no sharing - file must be locked */
3466   xfab.fab$l_fna = fn;
3467   xfab.fab$b_fns = strlen (fn);
3468   xfab.fab$l_dna = ";0";        /* default to latest version of the file */
3469   xfab.fab$b_dns = 2;
3470   xrab.rab$l_fab = &xfab;
3471
3472   /* This gibberish opens the file, positions to the first record, and
3473      deletes all records from there until the end of file. */
3474   if ((SYS$OPEN (&xfab) & 01) == 01)
3475     {
3476       if ((SYS$CONNECT (&xrab) & 01) == 01 &&
3477           (SYS$FIND (&xrab) & 01) == 01 &&
3478           (SYS$TRUNCATE (&xrab) & 01) == 01)
3479         status = 0;
3480       else
3481         status = -1;
3482     }
3483   else
3484     status = -1;
3485   SYS$CLOSE (&xfab);
3486   return status;
3487 }
3488
3489 /* Define this symbol to actually read SYSUAF.DAT.  This requires either
3490    SYSPRV or a readable SYSUAF.DAT. */
3491
3492 #ifdef READ_SYSUAF
3493 /*
3494  * getuaf.c
3495  *
3496  * Routine to read the VMS User Authorization File and return
3497  * a specific user's record.
3498  */
3499
3500 static struct UAF retuaf;
3501
3502 struct UAF *
3503 get_uaf_name (uname)
3504      char * uname;
3505 {
3506   register status;
3507   struct FAB uaf_fab;
3508   struct RAB uaf_rab;
3509
3510   uaf_fab = cc$rms_fab;
3511   uaf_rab = cc$rms_rab;
3512   /* initialize fab fields */
3513   uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT";
3514   uaf_fab.fab$b_fns = 21;
3515   uaf_fab.fab$b_fac = FAB$M_GET;
3516   uaf_fab.fab$b_org = FAB$C_IDX;
3517   uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL;
3518   /* initialize rab fields */
3519   uaf_rab.rab$l_fab = &uaf_fab;
3520   /* open the User Authorization File */
3521   status = SYS$OPEN (&uaf_fab);
3522   if (!(status&1))
3523     {
3524       errno = EVMSERR;
3525       vaxc$errno = status;
3526       return 0;
3527     }
3528   status = SYS$CONNECT (&uaf_rab);
3529   if (!(status&1))
3530     {
3531       errno = EVMSERR;
3532       vaxc$errno = status;
3533       return 0;
3534     }
3535   /* read the requested record - index is in uname */
3536   uaf_rab.rab$l_kbf = uname;
3537   uaf_rab.rab$b_ksz = strlen (uname);
3538   uaf_rab.rab$b_rac = RAB$C_KEY;
3539   uaf_rab.rab$l_ubf = (char *)&retuaf;
3540   uaf_rab.rab$w_usz = sizeof retuaf;
3541   status = SYS$GET (&uaf_rab);
3542   if (!(status&1))
3543     {
3544       errno = EVMSERR;
3545       vaxc$errno = status;
3546       return 0;
3547     }
3548   /* close the User Authorization File */
3549   status = SYS$DISCONNECT (&uaf_rab);
3550   if (!(status&1))
3551     {
3552       errno = EVMSERR;
3553       vaxc$errno = status;
3554       return 0;
3555     }
3556   status = SYS$CLOSE (&uaf_fab);
3557   if (!(status&1))
3558     {
3559       errno = EVMSERR;
3560       vaxc$errno = status;
3561       return 0;
3562     }
3563   return &retuaf;
3564 }
3565
3566 struct UAF *
3567 get_uaf_uic (uic)
3568      unsigned long uic;
3569 {
3570   register status;
3571   struct FAB uaf_fab;
3572   struct RAB uaf_rab;
3573
3574   uaf_fab = cc$rms_fab;
3575   uaf_rab = cc$rms_rab;
3576   /* initialize fab fields */
3577   uaf_fab.fab$l_fna = "SYS$SYSTEM:SYSUAF.DAT";
3578   uaf_fab.fab$b_fns = 21;
3579   uaf_fab.fab$b_fac = FAB$M_GET;
3580   uaf_fab.fab$b_org = FAB$C_IDX;
3581   uaf_fab.fab$b_shr = FAB$M_GET|FAB$M_PUT|FAB$M_UPD|FAB$M_DEL;
3582   /* initialize rab fields */
3583   uaf_rab.rab$l_fab = &uaf_fab;
3584   /* open the User Authorization File */
3585   status = SYS$OPEN (&uaf_fab);
3586   if (!(status&1))
3587     {
3588       errno = EVMSERR;
3589       vaxc$errno = status;
3590       return 0;
3591     }
3592   status = SYS$CONNECT (&uaf_rab);
3593   if (!(status&1))
3594     {
3595       errno = EVMSERR;
3596       vaxc$errno = status;
3597       return 0;
3598     }
3599   /* read the requested record - index is in uic */
3600   uaf_rab.rab$b_krf = 1;        /* 1st alternate key */
3601   uaf_rab.rab$l_kbf = (char *) &uic;
3602   uaf_rab.rab$b_ksz = sizeof uic;
3603   uaf_rab.rab$b_rac = RAB$C_KEY;
3604   uaf_rab.rab$l_ubf = (char *)&retuaf;
3605   uaf_rab.rab$w_usz = sizeof retuaf;
3606   status = SYS$GET (&uaf_rab);
3607   if (!(status&1))
3608     {
3609       errno = EVMSERR;
3610       vaxc$errno = status;
3611       return 0;
3612     }
3613   /* close the User Authorization File */
3614   status = SYS$DISCONNECT (&uaf_rab);
3615   if (!(status&1))
3616     {
3617       errno = EVMSERR;
3618       vaxc$errno = status;
3619       return 0;
3620     }
3621   status = SYS$CLOSE (&uaf_fab);
3622   if (!(status&1))
3623     {
3624       errno = EVMSERR;
3625       vaxc$errno = status;
3626       return 0;
3627     }
3628   return &retuaf;
3629 }
3630
3631 static struct passwd retpw;
3632
3633 struct passwd *
3634 cnv_uaf_pw (up)
3635      struct UAF * up;
3636 {
3637   char * ptr;
3638
3639   /* copy these out first because if the username is 32 chars, the next
3640      section will overwrite the first byte of the UIC */
3641   retpw.pw_uid = up->uaf$w_mem;
3642   retpw.pw_gid = up->uaf$w_grp;
3643
3644   /* I suppose this is not the best sytle, to possibly overwrite one
3645      byte beyond the end of the field, but what the heck... */
3646   ptr = &up->uaf$t_username[UAF$S_USERNAME];
3647   while (ptr[-1] == ' ')
3648     ptr--;
3649   *ptr = '\0';
3650   strcpy (retpw.pw_name, up->uaf$t_username);
3651
3652   /* the rest of these are counted ascii strings */
3653   strncpy (retpw.pw_gecos, &up->uaf$t_owner[1], up->uaf$t_owner[0]);
3654   retpw.pw_gecos[up->uaf$t_owner[0]] = '\0';
3655   strncpy (retpw.pw_dir, &up->uaf$t_defdev[1], up->uaf$t_defdev[0]);
3656   retpw.pw_dir[up->uaf$t_defdev[0]] = '\0';
3657   strncat (retpw.pw_dir, &up->uaf$t_defdir[1], up->uaf$t_defdir[0]);
3658   retpw.pw_dir[up->uaf$t_defdev[0] + up->uaf$t_defdir[0]] = '\0';
3659   strncpy (retpw.pw_shell, &up->uaf$t_defcli[1], up->uaf$t_defcli[0]);
3660   retpw.pw_shell[up->uaf$t_defcli[0]] = '\0';
3661
3662   return &retpw;
3663 }
3664 #else /* not READ_SYSUAF */
3665 static struct passwd retpw;
3666 #endif /* not READ_SYSUAF */
3667
3668 struct passwd *
3669 getpwnam (name)
3670      char * name;
3671 {
3672 #ifdef READ_SYSUAF
3673   struct UAF *up;
3674 #else
3675   char * user;
3676   char * dir;
3677   unsigned char * full;
3678 #endif /* READ_SYSUAF */
3679   char *ptr = name;
3680
3681   while (*ptr)
3682     {
3683       if ('a' <= *ptr && *ptr <= 'z')
3684         *ptr -= 040;
3685       ptr++;
3686     }
3687 #ifdef READ_SYSUAF
3688   if (!(up = get_uaf_name (name)))
3689     return 0;
3690   return cnv_uaf_pw (up);
3691 #else
3692   if (strcmp (name, getenv ("USER")) == 0)
3693     {
3694       retpw.pw_uid = getuid ();
3695       retpw.pw_gid = getgid ();
3696       strcpy (retpw.pw_name, name);
3697       if (full = egetenv ("FULLNAME"))
3698         strcpy (retpw.pw_gecos, full);
3699       else
3700         *retpw.pw_gecos = '\0';
3701       strcpy (retpw.pw_dir, egetenv ("HOME"));
3702       *retpw.pw_shell = '\0';
3703       return &retpw;
3704     }
3705   else
3706     return 0;
3707 #endif /* not READ_SYSUAF */
3708 }
3709
3710 struct passwd *
3711 getpwuid (uid)
3712      unsigned long uid;
3713 {
3714 #ifdef READ_SYSUAF
3715   struct UAF * up;
3716
3717   if (!(up = get_uaf_uic (uid)))
3718     return 0;
3719   return cnv_uaf_pw (up);
3720 #else
3721   if (uid == sys_getuid ())
3722     return getpwnam (egetenv ("USER"));
3723   else
3724     return 0;
3725 #endif /* not READ_SYSUAF */
3726 }
3727
3728 /* return total address space available to the current process.  This is
3729    the sum of the current p0 size, p1 size and free page table entries
3730    available. */
3731 vlimit ()
3732 {
3733   int item_code;
3734   unsigned long free_pages;
3735   unsigned long frep0va;
3736   unsigned long frep1va;
3737   register status;
3738
3739   item_code = JPI$_FREPTECNT;
3740   if (((status = LIB$GETJPI (&item_code, 0, 0, &free_pages)) & 1) == 0)
3741     {
3742       errno = EVMSERR;
3743       vaxc$errno = status;
3744       return -1;
3745     }
3746   free_pages *= 512;
3747
3748   item_code = JPI$_FREP0VA;
3749   if (((status = LIB$GETJPI (&item_code, 0, 0, &frep0va)) & 1) == 0)
3750     {
3751       errno = EVMSERR;
3752       vaxc$errno = status;
3753       return -1;
3754     }
3755   item_code = JPI$_FREP1VA;
3756   if (((status = LIB$GETJPI (&item_code, 0, 0, &frep1va)) & 1) == 0)
3757     {
3758       errno = EVMSERR;
3759       vaxc$errno = status;
3760       return -1;
3761     }
3762
3763   return free_pages + frep0va + (0x7fffffff - frep1va);
3764 }
3765
3766 define_logical_name (varname, string)
3767      char *varname;
3768      char *string;
3769 {
3770   struct dsc$descriptor_s strdsc =
3771     {strlen (string), DSC$K_DTYPE_T, DSC$K_CLASS_S, string};
3772   struct dsc$descriptor_s envdsc =
3773     {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname};
3774   struct dsc$descriptor_s lnmdsc =
3775     {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"};
3776
3777   return LIB$SET_LOGICAL (&envdsc, &strdsc, &lnmdsc, 0, 0);
3778 }
3779
3780 delete_logical_name (varname)
3781      char *varname;
3782 {
3783   struct dsc$descriptor_s envdsc =
3784     {strlen (varname), DSC$K_DTYPE_T, DSC$K_CLASS_S, varname};
3785   struct dsc$descriptor_s lnmdsc =
3786     {7, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$JOB"};
3787
3788   return LIB$DELETE_LOGICAL (&envdsc, &lnmdsc);
3789 }
3790
3791 ulimit ()
3792 {}
3793
3794 setpgrp ()
3795 {}
3796
3797 execvp ()
3798 {
3799   error ("execvp system call not implemented");
3800 }
3801
3802 int
3803 rename (from, to)
3804      char *from, *to;
3805 {
3806   int status;
3807   struct FAB from_fab = cc$rms_fab, to_fab = cc$rms_fab;
3808   struct NAM from_nam = cc$rms_nam, to_nam = cc$rms_nam;
3809   char from_esn[NAM$C_MAXRSS];
3810   char to_esn[NAM$C_MAXRSS];
3811
3812   from_fab.fab$l_fna = from;
3813   from_fab.fab$b_fns = strlen (from);
3814   from_fab.fab$l_nam = &from_nam;
3815   from_fab.fab$l_fop = FAB$M_NAM;
3816
3817   from_nam.nam$l_esa = from_esn;
3818   from_nam.nam$b_ess = sizeof from_esn;
3819
3820   to_fab.fab$l_fna = to;
3821   to_fab.fab$b_fns = strlen (to);
3822   to_fab.fab$l_nam = &to_nam;
3823   to_fab.fab$l_fop = FAB$M_NAM;
3824
3825   to_nam.nam$l_esa = to_esn;
3826   to_nam.nam$b_ess = sizeof to_esn;
3827
3828   status = SYS$RENAME (&from_fab, 0, 0, &to_fab);
3829
3830   if (status & 1)
3831     return 0;
3832   else
3833     {
3834       if (status == RMS$_DEV)
3835         errno = EXDEV;
3836       else
3837         errno = EVMSERR;
3838       vaxc$errno = status;
3839       return -1;
3840     }
3841 }
3842
3843 /* This function renames a file like `rename', but it strips
3844    the version number from the "to" filename, such that the "to" file is
3845    will always be a new version.  It also sets the file protection once it is
3846    finished.  The protection that we will use is stored in fab_final_pro,
3847    and was set when we did a creat_copy_attrs to create the file that we
3848    are renaming.
3849
3850    We could use the chmod function, but Eunichs uses 3 bits per user category
3851    to describe the protection, and VMS uses 4 (write and delete are seperate
3852    bits).  To maintain portability, the VMS implementation of `chmod' wires
3853    the W and D bits together.  */
3854
3855
3856 static struct fibdef fib;       /* We need this initialized to zero */
3857 char vms_file_written[NAM$C_MAXRSS];
3858
3859 int
3860 rename_sans_version (from,to)
3861      char *from, *to;
3862 {
3863   short int chan;
3864   int stat;
3865   short int iosb[4];
3866   int status;
3867   struct FAB to_fab = cc$rms_fab;
3868   struct NAM to_nam = cc$rms_nam;
3869   struct dsc$descriptor fib_d ={sizeof (fib),0,0,(char*) &fib};
3870   struct dsc$descriptor fib_attr[2]
3871     = {{sizeof (fab_final_pro),ATR$C_FPRO,0,(char*) &fab_final_pro},{0,0,0,0}};
3872   char to_esn[NAM$C_MAXRSS];
3873
3874   $DESCRIPTOR (disk,to_esn);
3875
3876   to_fab.fab$l_fna = to;
3877   to_fab.fab$b_fns = strlen (to);
3878   to_fab.fab$l_nam = &to_nam;
3879   to_fab.fab$l_fop = FAB$M_NAM;
3880
3881   to_nam.nam$l_esa = to_esn;
3882   to_nam.nam$b_ess = sizeof to_esn;
3883
3884   status = SYS$PARSE (&to_fab, 0, 0); /* figure out the full file name */
3885
3886   if (to_nam.nam$l_fnb && NAM$M_EXP_VER)
3887     *(to_nam.nam$l_ver) = '\0';
3888
3889   stat = rename (from, to_esn);
3890   if (stat < 0)
3891     return stat;
3892
3893   strcpy (vms_file_written, to_esn);
3894
3895   to_fab.fab$l_fna = vms_file_written; /* this points to the versionless name */
3896   to_fab.fab$b_fns = strlen (vms_file_written);
3897
3898   /* Now set the file protection to the correct value */
3899   SYS$OPEN (&to_fab, 0, 0);     /* This fills in the nam$w_fid fields */
3900
3901   /* Copy these fields into the fib */
3902   fib.fib$r_fid_overlay.fib$w_fid[0] = to_nam.nam$w_fid[0];
3903   fib.fib$r_fid_overlay.fib$w_fid[1] = to_nam.nam$w_fid[1];
3904   fib.fib$r_fid_overlay.fib$w_fid[2] = to_nam.nam$w_fid[2];
3905
3906   SYS$CLOSE (&to_fab, 0, 0);
3907
3908   stat = SYS$ASSIGN (&disk, &chan, 0, 0); /* open a channel to the disk */
3909   if (!stat)
3910     LIB$SIGNAL (stat);
3911   stat = SYS$QIOW (0, chan, IO$_MODIFY, iosb, 0, 0, &fib_d,
3912                    0, 0, 0, &fib_attr, 0);
3913   if (!stat)
3914     LIB$SIGNAL (stat);
3915   stat = SYS$DASSGN (chan);
3916   if (!stat)
3917     LIB$SIGNAL (stat);
3918   strcpy (vms_file_written, to_esn); /* We will write this to the terminal*/
3919   return 0;
3920 }
3921
3922 link (file, new)
3923      char * file, * new;
3924 {
3925   register status;
3926   struct FAB fab;
3927   struct NAM nam;
3928   unsigned short fid[3];
3929   char esa[NAM$C_MAXRSS];
3930
3931   fab = cc$rms_fab;
3932   fab.fab$l_fop = FAB$M_OFP;
3933   fab.fab$l_fna = file;
3934   fab.fab$b_fns = strlen (file);
3935   fab.fab$l_nam = &nam;
3936
3937   nam = cc$rms_nam;
3938   nam.nam$l_esa = esa;
3939   nam.nam$b_ess = NAM$C_MAXRSS;
3940
3941   status = SYS$PARSE (&fab);
3942   if ((status & 1) == 0)
3943     {
3944       errno = EVMSERR;
3945       vaxc$errno = status;
3946       return -1;
3947     }
3948   status = SYS$SEARCH (&fab);
3949   if ((status & 1) == 0)
3950     {
3951       errno = EVMSERR;
3952       vaxc$errno = status;
3953       return -1;
3954     }
3955
3956   fid[0] = nam.nam$w_fid[0];
3957   fid[1] = nam.nam$w_fid[1];
3958   fid[2] = nam.nam$w_fid[2];
3959
3960   fab.fab$l_fna = new;
3961   fab.fab$b_fns = strlen (new);
3962
3963   status = SYS$PARSE (&fab);
3964   if ((status & 1) == 0)
3965     {
3966       errno = EVMSERR;
3967       vaxc$errno = status;
3968       return -1;
3969     }
3970
3971   nam.nam$w_fid[0] = fid[0];
3972   nam.nam$w_fid[1] = fid[1];
3973   nam.nam$w_fid[2] = fid[2];
3974
3975   nam.nam$l_esa = nam.nam$l_name;
3976   nam.nam$b_esl = nam.nam$b_name + nam.nam$b_type + nam.nam$b_ver;
3977
3978   status = SYS$ENTER (&fab);
3979   if ((status & 1) == 0)
3980     {
3981       errno = EVMSERR;
3982       vaxc$errno = status;
3983       return -1;
3984     }
3985
3986   return 0;
3987 }
3988
3989 croak (badfunc)
3990      char *badfunc;
3991 {
3992   printf ("%s not yet implemented\r\n", badfunc);
3993   reset_sys_modes ();
3994   exit (1);
3995 }
3996
3997 long
3998 random ()
3999 {
4000   /* Arrange to return a range centered on zero.  */
4001   return rand () - (1 << 30);
4002 }
4003
4004 srandom (seed)
4005 {
4006   srand (seed);
4007 }
4008 #endif /* VMS */
4009 \f
4010 #ifdef AIX
4011
4012 /* Called from init_sys_modes.  */
4013 hft_init ()
4014 {
4015   int junk;
4016
4017   /* If we're not on an HFT we shouldn't do any of this.  We determine
4018      if we are on an HFT by trying to get an HFT error code.  If this
4019      call fails, we're not on an HFT. */
4020 #ifdef IBMR2AIX
4021   if (ioctl (0, HFQERROR, &junk) < 0)
4022     return;
4023 #else /* not IBMR2AIX */
4024   if (ioctl (0, HFQEIO, 0) < 0)
4025     return;
4026 #endif /* not IBMR2AIX */
4027
4028   /* On AIX the default hft keyboard mapping uses backspace rather than delete
4029      as the rubout key's ASCII code.  Here this is changed.  The bug is that
4030      there's no way to determine the old mapping, so in reset_sys_modes
4031      we need to assume that the normal map had been present.  Of course, this
4032      code also doesn't help if on a terminal emulator which doesn't understand
4033      HFT VTD's. */
4034   {
4035     struct hfbuf buf;
4036     struct hfkeymap keymap;
4037
4038     buf.hf_bufp = (char *)&keymap;
4039     buf.hf_buflen = sizeof (keymap);
4040     keymap.hf_nkeys = 2;
4041     keymap.hfkey[0].hf_kpos = 15;
4042     keymap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFNONE;
4043 #ifdef IBMR2AIX
4044     keymap.hfkey[0].hf_keyidh = '<';
4045 #else /* not IBMR2AIX */
4046     keymap.hfkey[0].hf_page = '<';
4047 #endif /* not IBMR2AIX */
4048     keymap.hfkey[0].hf_char = 127;
4049     keymap.hfkey[1].hf_kpos = 15;
4050     keymap.hfkey[1].hf_kstate = HFMAPCHAR | HFSHFSHFT;
4051 #ifdef IBMR2AIX
4052     keymap.hfkey[1].hf_keyidh = '<';
4053 #else /* not IBMR2AIX */
4054     keymap.hfkey[1].hf_page = '<';
4055 #endif /* not IBMR2AIX */
4056     keymap.hfkey[1].hf_char = 127;
4057     hftctl (0, HFSKBD, &buf);
4058   }
4059   /* The HFT system on AIX doesn't optimize for scrolling, so it's really ugly
4060      at times.  */
4061   line_ins_del_ok = char_ins_del_ok = 0;
4062 }
4063
4064 /* Reset the rubout key to backspace. */
4065
4066 hft_reset ()
4067 {
4068   struct hfbuf buf;
4069   struct hfkeymap keymap;
4070   int junk;
4071
4072 #ifdef IBMR2AIX
4073   if (ioctl (0, HFQERROR, &junk) < 0)
4074     return;
4075 #else /* not IBMR2AIX */
4076   if (ioctl (0, HFQEIO, 0) < 0)
4077     return;
4078 #endif /* not IBMR2AIX */
4079
4080   buf.hf_bufp = (char *)&keymap;
4081   buf.hf_buflen = sizeof (keymap);
4082   keymap.hf_nkeys = 2;
4083   keymap.hfkey[0].hf_kpos = 15;
4084   keymap.hfkey[0].hf_kstate = HFMAPCHAR | HFSHFNONE;
4085 #ifdef IBMR2AIX
4086   keymap.hfkey[0].hf_keyidh = '<';
4087 #else /* not IBMR2AIX */
4088   keymap.hfkey[0].hf_page = '<';
4089 #endif /* not IBMR2AIX */
4090   keymap.hfkey[0].hf_char = 8;
4091   keymap.hfkey[1].hf_kpos = 15;
4092   keymap.hfkey[1].hf_kstate = HFMAPCHAR | HFSHFSHFT;
4093 #ifdef IBMR2AIX
4094   keymap.hfkey[1].hf_keyidh = '<';
4095 #else /* not IBMR2AIX */
4096   keymap.hfkey[1].hf_page = '<';
4097 #endif /* not IBMR2AIX */
4098   keymap.hfkey[1].hf_char = 8;
4099   hftctl (0, HFSKBD, &buf);
4100 }
4101
4102 #endif /* AIX */