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