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