src/sysdep.c

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