sys/vms/vmsunix.c

   1 /* NetHack 3.6  vmsunix.c       $NHDT-Date: 1449801743 2015/12/11 02:42:23 $  $NHDT-Branch: NetHack-3.6.0 $:$NHDT-Revision: 1.15 $ */
   2 /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
   3 /*-Copyright (c) Robert Patrick Rankin, 2011. */
   4 /* NetHack may be freely redistributed.  See license for details. */
   5
   6 /* This file implements things from unixunix.c, plus related stuff */
   7
   8 #include "hack.h"
   9
  10 #include <descrip.h>
  11 #include <dvidef.h>
  12 #include <jpidef.h>
  13 #include <ssdef.h>
  14 #include <errno.h>
  15 #include <signal.h>
  16 #undef off_t
  17 #ifdef GNUC
  18 #include <sys/stat.h>
  19 #else
  20 #define umask hide_umask_dummy /* DEC C: avoid conflict with system.h */
  21 #include <stat.h>
  22 #undef umask
  23 #endif
  24 #include <ctype.h>
  25
  26 extern int debuggable; /* defined in vmsmisc.c */
  27
  28 extern void VDECL(lib$signal, (unsigned, ...));
  29 extern unsigned long sys$setprv();
  30 extern unsigned long lib$getdvi(), lib$getjpi(), lib$spawn(), lib$attach();
  31 extern unsigned long smg$init_term_table_by_type(), smg$del_term_table();
  32 #define vms_ok(sts) ((sts) & 1) /* odd => success */
  33
  34 /* this could be static; it's only used within this file;
  35    it won't be used at all if C_LIB$INTIALIZE gets commented out below,
  36    so make it global so that compiler won't complain that it's not used */
  37 int FDECL(vmsexeini, (const void *, const void *, const unsigned char *));
  38
  39 static int FDECL(veryold, (int));
  40 static char *NDECL(verify_term);
  41 #if defined(SHELL) || defined(SUSPEND)
  42 static void FDECL(hack_escape, (BOOLEAN_P, const char *));
  43 static void FDECL(hack_resume, (BOOLEAN_P));
  44 #endif
  45
  46 static int
  47 veryold(fd)
  48 int fd;
  49 {
  50     register int i;
  51     time_t date;
  52     struct stat buf;
  53
  54     if (fstat(fd, &buf))
  55         return 0; /* cannot get status */
  56 #ifndef INSURANCE
  57     if (buf.st_size != sizeof(int))
  58         return 0; /* not an xlock file */
  59 #endif
  60     (void) time(&date);
  61     if (date - buf.st_mtime < 3L * 24L * 60L * 60L) { /* recent */
  62         int lockedpid; /* should be the same size as hackpid */
  63         unsigned long status, dummy, code = JPI$_PID;
  64
  65         if (read(fd, (genericptr_t) &lockedpid, sizeof(lockedpid))
  66             != sizeof(lockedpid)) /* strange ... */
  67             return 0;
  68         status = lib$getjpi(&code, &lockedpid, 0, &dummy);
  69         if (vms_ok(status) || status != SS$_NONEXPR)
  70             return 0;
  71     }
  72     (void) close(fd);
  73
  74     /* cannot use maxledgerno() here, because we need to find a lock name
  75      * before starting everything (including the dungeon initialization
  76      * that sets astral_level, needed for maxledgerno()) up
  77      */
  78     for (i = 1; i <= MAXDUNGEON * MAXLEVEL + 1; i++) {
  79         /* try to remove all */
  80         set_levelfile_name(lock, i);
  81         (void) delete (lock);
  82     }
  83     set_levelfile_name(lock, 0);
  84     if (delete (lock))
  85         return 0; /* cannot remove it */
  86     return 1;     /* success! */
  87 }
  88
  89 void
  90 getlock()
  91 {
  92     register int i = 0, fd;
  93
  94     /* idea from rpick%ucqais@uccba.uc.edu
  95      * prevent automated rerolling of characters
  96      * test input (fd0) so that tee'ing output to get a screen dump still
  97      * works
  98      * also incidentally prevents development of any hack-o-matic programs
  99      */
 100     if (isatty(0) <= 0)
 101         error("You must play from a terminal.");
 102
 103     /* we ignore QUIT and INT at this point */
 104     if (!lock_file(HLOCK, LOCKPREFIX, 10)) {
 105         wait_synch();
 106         error("Quitting.");
 107     }
 108
 109     /* default value of lock[] is "1lock" where '1' gets changed to
 110        'a','b',&c below; override the default and use <uid><charname>
 111        if we aren't restricting the number of simultaneous games */
 112     if (!locknum)
 113         Sprintf(lock, "_%u%s", (unsigned) getuid(), plname);
 114
 115     regularize(lock);
 116     set_levelfile_name(lock, 0);
 117     if (locknum > 25)
 118         locknum = 25;
 119
 120     do {
 121         if (locknum)
 122             lock[0] = 'a' + i++;
 123
 124         if ((fd = open(lock, 0, 0)) == -1) {
 125             if (errno == ENOENT)
 126                 goto gotlock; /* no such file */
 127             perror(lock);
 128             unlock_file(HLOCK);
 129             error("Cannot open %s", lock);
 130         }
 131
 132         if (veryold(fd)) /* if true, this closes fd and unlinks lock */
 133             goto gotlock;
 134         (void) close(fd);
 135     } while (i < locknum);
 136
 137     unlock_file(HLOCK);
 138     error(locknum ? "Too many hacks running now."
 139                   : "There is a game in progress under your name.");
 140
 141 gotlock:
 142     fd = creat(lock, FCMASK);
 143     unlock_file(HLOCK);
 144     if (fd == -1) {
 145         error("cannot creat lock file.");
 146     } else {
 147         if (write(fd, (char *) &hackpid, sizeof(hackpid))
 148             != sizeof(hackpid)) {
 149             error("cannot write lock");
 150         }
 151         if (close(fd) == -1) {
 152             error("cannot close lock");
 153         }
 154     }
 155 }
 156
 157 void regularize(s) /* normalize file name */
 158 register char *s;
 159 {
 160     register char *lp;
 161
 162     for (lp = s; *lp; lp++) /* note: '-' becomes '_' */
 163         if (!(isalpha(*lp) || isdigit(*lp) || *lp == '$'))
 164             *lp = '_';
 165 }
 166
 167 #undef getuid
 168 int
 169 vms_getuid()
 170 {
 171     return ((getgid() << 16) | getuid());
 172 }
 173
 174 #ifndef FAB$C_STMLF
 175 #define FAB$C_STMLF 5
 176 #endif
 177 /* check whether the open file specified by `fd' is in stream-lf format */
 178 boolean
 179 file_is_stmlf(fd)
 180 int fd;
 181 {
 182     int rfm;
 183     struct stat buf;
 184
 185     if (fstat(fd, &buf))
 186         return FALSE; /* cannot get status? */
 187
 188 #ifdef stat_alignment_fix /* gcc-vms alignment kludge */
 189     rfm = stat_alignment_fix(&buf)->st_fab_rfm;
 190 #else
 191     rfm = buf.st_fab_rfm;
 192 #endif
 193     return (boolean) (rfm == FAB$C_STMLF);
 194 }
 195
 196 /*------*/
 197 #ifndef LNM$_STRING
 198 #include <lnmdef.h> /* logical name definitions */
 199 #endif
 200 #define ENVSIZ LNM$C_NAMLENGTH /*255*/
 201
 202 #define ENV_USR 0 /* user-mode */
 203 #define ENV_SUP 1 /* supervisor-mode */
 204 #define ENV_JOB 2 /* job-wide entry */
 205
 206 /* vms_define() - assign a value to a logical name */
 207 int
 208 vms_define(name, value, flag)
 209 const char *name;
 210 const char *value;
 211 int flag;
 212 {
 213     struct dsc {
 214         unsigned short len, mbz;
 215         const char *adr;
 216     }; /* descriptor */
 217     struct itm3 {
 218         short buflen, itmcode;
 219         const char *bufadr;
 220         short *retlen;
 221     };
 222     static struct itm3 itm_lst[] = { { 0, LNM$_STRING, 0, 0 }, { 0, 0 } };
 223     struct dsc nam_dsc, val_dsc, tbl_dsc;
 224     unsigned long result, sys$crelnm(), lib$set_logical();
 225
 226     /* set up string descriptors */
 227     nam_dsc.mbz = val_dsc.mbz = tbl_dsc.mbz = 0;
 228     nam_dsc.len = strlen(nam_dsc.adr = name);
 229     val_dsc.len = strlen(val_dsc.adr = value);
 230     tbl_dsc.len = strlen(tbl_dsc.adr = "LNM$PROCESS");
 231
 232     switch (flag) {
 233     case ENV_JOB: /* job logical name */
 234         tbl_dsc.len = strlen(tbl_dsc.adr = "LNM$JOB");
 235     /*FALLTHRU*/
 236     case ENV_SUP: /* supervisor-mode process logical name */
 237         result = lib$set_logical(&nam_dsc, &val_dsc, &tbl_dsc);
 238         break;
 239     case ENV_USR: /* user-mode process logical name */
 240         itm_lst[0].buflen = val_dsc.len;
 241         itm_lst[0].bufadr = val_dsc.adr;
 242         result = sys$crelnm(0, &tbl_dsc, &nam_dsc, 0, itm_lst);
 243         break;
 244     default: /*[ bad input ]*/
 245         result = 0;
 246         break;
 247     }
 248     result &= 1;    /* odd => success (== 1), even => failure (== 0) */
 249     return !result; /* 0 == success, 1 == failure */
 250 }
 251
 252 /* vms_putenv() - create or modify an environment value */
 253 int
 254 vms_putenv(string)
 255 const char *string;
 256 {
 257     char name[ENVSIZ + 1], value[ENVSIZ + 1], *p; /* [255+1] */
 258
 259     p = strchr(string, '=');
 260     if (p > string && p < string + sizeof name
 261         && strlen(p + 1) < sizeof value) {
 262         (void) strncpy(name, string, p - string), name[p - string] = '\0';
 263         (void) strcpy(value, p + 1);
 264         return vms_define(name, value, ENV_USR);
 265     } else
 266         return 1; /* failure */
 267 }
 268
 269 /*
 270    Support for VT420 was added to VMS in version V5.4, but as of V5.5-2
 271    VAXCRTL still doesn't handle it and puts TERM=undefined into the
 272    environ[] array.  getenv("TERM") will return "undefined" instead of
 273    something sensible.  Even though that's finally fixed in V6.0, site
 274    defined terminals also return "undefined" so query SMG's TERMTABLE
 275    instead of just checking VMS's device-type value for VT400_Series.
 276
 277    Called by verify_termcap() for convenience.
 278  */
 279 static char *
 280 verify_term()
 281 {
 282     char *term = getenv("NETHACK_TERM");
 283     if (!term)
 284         term = getenv("HACK_TERM");
 285     if (!term)
 286         term = getenv("EMACS_TERM");
 287     if (!term)
 288         term = getenv("TERM");
 289     if (!term || !*term || !strcmpi(term, "undefined")
 290         || !strcmpi(term, "unknown")) {
 291         static char smgdevtyp[31 + 1]; /* size is somewhat arbitrary */
 292         static char dev_tty[] = "TT:";
 293         static $DESCRIPTOR(smgdsc, smgdevtyp);
 294         static $DESCRIPTOR(tt, dev_tty);
 295         unsigned short dvicode = DVI$_DEVTYPE;
 296         unsigned long devtype = 0L, termtab = 0L;
 297
 298         (void) lib$getdvi(&dvicode, (unsigned short *) 0, &tt, &devtype,
 299                           (genericptr_t) 0, (unsigned short *) 0);
 300
 301         if (devtype && vms_ok(smg$init_term_table_by_type(&devtype, &termtab,
 302                                                           &smgdsc))) {
 303             register char *p = &smgdevtyp[smgdsc.dsc$w_length];
 304             /* strip trailing blanks */
 305             while (p > smgdevtyp && *--p == ' ')
 306                 *p = '\0';
 307             /* (void) smg$del_term_table(); */
 308             term = smgdevtyp;
 309         }
 310     }
 311     return term;
 312 }
 313
 314 /*
 315    Figure out whether the termcap code will find a termcap file; if not,
 316    try to help it out.  This avoids modifying the GNU termcap sources and
 317    can simplify configuration for sites which don't already use termcap.
 318  */
 319 #define GNU_DEFAULT_TERMCAP "emacs_library:[etc]termcap.dat"
 320 #define NETHACK_DEF_TERMCAP "nethackdir:termcap"
 321 #define HACK_DEF_TERMCAP "hackdir:termcap"
 322
 323 char *verify_termcap() /* called from startup(src/termcap.c) */
 324 {
 325     struct stat dummy;
 326     const char *tc = getenv("TERMCAP");
 327     if (tc)
 328         return verify_term(); /* no termcap fixups needed */
 329     if (!tc && !stat(NETHACK_DEF_TERMCAP, &dummy))
 330         tc = NETHACK_DEF_TERMCAP;
 331     if (!tc && !stat(HACK_DEF_TERMCAP, &dummy))
 332         tc = HACK_DEF_TERMCAP;
 333     if (!tc && !stat(GNU_DEFAULT_TERMCAP, &dummy))
 334         tc = GNU_DEFAULT_TERMCAP;
 335     if (!tc && !stat("[]termcap", &dummy))
 336         tc = "[]termcap"; /* current dir */
 337     if (!tc && !stat("$TERMCAP", &dummy))
 338         tc = "$TERMCAP"; /* alt environ */
 339     if (tc) {
 340         /* putenv(strcat(strcpy(buffer,"TERMCAP="),tc)); */
 341         vms_define("TERMCAP", tc, ENV_USR);
 342     } else {
 343         /* perhaps someday we'll construct a termcap entry string */
 344     }
 345     return verify_term();
 346 }
 347 /*------*/
 348
 349 #ifdef SHELL
 350 #ifndef CLI$M_NOWAIT
 351 #define CLI$M_NOWAIT 1
 352 #endif
 353 #endif
 354
 355 #if defined(CHDIR) || defined(SHELL) || defined(SECURE)
 356 static unsigned long oprv[2];
 357
 358 void
 359 privoff()
 360 {
 361     unsigned long pid = 0, prv[2] = { ~0, ~0 };
 362     unsigned short code = JPI$_PROCPRIV;
 363
 364     (void) sys$setprv(0, prv, 0, oprv);
 365     (void) lib$getjpi(&code, &pid, (genericptr_t) 0, prv);
 366     (void) sys$setprv(1, prv, 0, (unsigned long *) 0);
 367 }
 368
 369 void
 370 privon()
 371 {
 372     (void) sys$setprv(1, oprv, 0, (unsigned long *) 0);
 373 }
 374 #endif /* CHDIR || SHELL || SECURE */
 375
 376 #if defined(SHELL) || defined(SUSPEND)
 377 static void
 378 hack_escape(screen_manip, msg_str)
 379 boolean screen_manip;
 380 const char *msg_str;
 381 {
 382     if (screen_manip)
 383         suspend_nhwindows(msg_str);  /* clear screen, reset terminal, &c */
 384     (void) signal(SIGQUIT, SIG_IGN); /* ignore ^Y */
 385     (void) signal(SIGINT, SIG_DFL);  /* don't trap ^C (implct cnvrs to ^Y) */
 386 }
 387
 388 static void
 389 hack_resume(screen_manip)
 390 boolean screen_manip;
 391 {
 392     (void) signal(SIGINT, (SIG_RET_TYPE) done1);
 393     if (wizard)
 394         (void) signal(SIGQUIT, SIG_DFL);
 395     if (screen_manip)
 396         resume_nhwindows(); /* setup terminal modes, redraw screen, &c */
 397 }
 398 #endif /* SHELL || SUSPEND */
 399
 400 #ifdef SHELL
 401 unsigned long dosh_pid = 0, /* this should cover any interactive escape */
 402               mail_pid = 0; /* this only covers the last mail or phone;
 403                                (mail & phone commands aren't expected to
 404                                leave any process hanging around) */
 405
 406 int
 407 dosh()
 408 {
 409     return vms_doshell("", TRUE); /* call for interactive child process */
 410 }
 411
 412 /* vms_doshell -- called by dosh() and readmail()
 413  *
 414  * If execstring is not a null string, then it will be executed in a spawned
 415  * subprocess, which will then return.  It is for handling mail or phone
 416  * interactive commands, which are only available if both MAIL and SHELL are
 417  * #defined, but we don't bother making the support code conditionalized on
 418  * MAIL here, just on SHELL being enabled.
 419  *
 420  * Normally, all output from this interaction will be 'piped' to the user's
 421  * screen (SYS$OUTPUT).  However, if 'screenoutput' is set to FALSE, output
 422  * will be piped into oblivion.  Used for silent phone call rejection.
 423  */
 424 int
 425 vms_doshell(execstring, screenoutput)
 426 const char *execstring;
 427 boolean screenoutput;
 428 {
 429     unsigned long status, new_pid, spawnflags = 0;
 430     struct dsc$descriptor_s comstring, *command, *inoutfile = 0;
 431     static char dev_null[] = "_NLA0:";
 432     static $DESCRIPTOR(nulldevice, dev_null);
 433
 434     /* Is this an interactive shell spawn, or do we have a command to do? */
 435     if (execstring && *execstring) {
 436         comstring.dsc$w_length = strlen(execstring);
 437         comstring.dsc$b_dtype = DSC$K_DTYPE_T;
 438         comstring.dsc$b_class = DSC$K_CLASS_S;
 439         comstring.dsc$a_pointer = (char *) execstring;
 440         command = &comstring;
 441     } else
 442         command = 0;
 443
 444     /* use asynch subprocess and suppress output iff one-shot command */
 445     if (!screenoutput) {
 446         spawnflags = CLI$M_NOWAIT;
 447         inoutfile = &nulldevice;
 448     }
 449
 450     hack_escape(screenoutput,
 451                 command ? (const char *) 0
 452  : "  \"Escaping\" into a subprocess; LOGOUT to reconnect and resume play. ");
 453
 454     if (command || !dosh_pid || !vms_ok(status = lib$attach(&dosh_pid))) {
 455 #ifdef CHDIR
 456         (void) chdir(getenv("PATH"));
 457 #endif
 458         privoff();
 459         new_pid = 0;
 460         status = lib$spawn(command, inoutfile, inoutfile, &spawnflags,
 461                            (struct dsc$descriptor_s *) 0, &new_pid);
 462         if (!command)
 463             dosh_pid = new_pid;
 464         else
 465             mail_pid = new_pid;
 466         privon();
 467 #ifdef CHDIR
 468         chdirx((char *) 0, 0);
 469 #endif
 470     }
 471
 472     hack_resume(screenoutput);
 473
 474     if (!vms_ok(status)) {
 475         pline("  Spawn failed.  (%%x%08lX) ", status);
 476         mark_synch();
 477     }
 478     return 0;
 479 }
 480 #endif /* SHELL */
 481
 482 #ifdef SUSPEND
 483 /* dosuspend() -- if we're a subprocess, attach to our parent;
 484  *                if not, there's nothing we can do.
 485  */
 486 int
 487 dosuspend()
 488 {
 489     static long owner_pid = -1;
 490     unsigned long status;
 491
 492     if (owner_pid == -1) /* need to check for parent */
 493         owner_pid = getppid();
 494     if (owner_pid == 0) {
 495         pline(
 496  "  No parent process.  Use '!' to Spawn, 'S' to Save, or '#quit' to Quit. ");
 497         mark_synch();
 498         return 0;
 499     }
 500
 501     /* restore normal tty environment & clear screen */
 502     hack_escape(1,
 503      " Attaching to parent process; use the ATTACH command to resume play. ");
 504
 505     status = lib$attach(&owner_pid); /* connect to parent */
 506
 507     hack_resume(1); /* resume game tty environment & refresh screen */
 508
 509     if (!vms_ok(status)) {
 510         pline("  Unable to attach to parent.  (%%x%08lX) ", status);
 511         mark_synch();
 512     }
 513     return 0;
 514 }
 515 #endif /* SUSPEND */
 516
 517 #ifdef SELECTSAVED
 518 /* this would fit better in vmsfiles.c except that that gets linked
 519    with the utility programs and we don't want this code there */
 520
 521 static void FDECL(savefile, (const char *, int, int *, char ***));
 522
 523 static void
 524 savefile(name, indx, asize, array)
 525 const char *name;
 526 int indx, *asize;
 527 char ***array;
 528 {
 529     char **newarray;
 530     int i, oldsize;
 531
 532     /* (asize - 1) guarantees that [indx + 1] will exist and be set to null */
 533     while (indx >= *asize - 1) {
 534         oldsize = *asize;
 535         *asize += 5;
 536         newarray = (char **) alloc(*asize * sizeof (char *));
 537         /* poor man's realloc() */
 538         for (i = 0; i < *asize; ++i)
 539             newarray[i] = (i < oldsize) ? (*array)[i] : 0;
 540         if (*array)
 541             free((genericptr_t) *array);
 542         *array = newarray;
 543     }
 544     (*array)[indx] = dupstr(name);
 545 }
 546
 547 struct dsc {
 548     unsigned short len, mbz;
 549     char *adr;
 550 };                             /* descriptor */
 551 typedef unsigned long vmscond; /* vms condition value */
 552 vmscond FDECL(lib$find_file, (const struct dsc *, struct dsc *, genericptr *));
 553 vmscond FDECL(lib$find_file_end, (void **));
 554
 555 /* collect a list of character names from all save files for this player */
 556 int
 557 vms_get_saved_games(savetemplate, outarray)
 558 const char *savetemplate; /* wildcarded save file name in native VMS format */
 559 char ***outarray;
 560 {
 561     struct dsc in, out;
 562     unsigned short l;
 563     int count, asize;
 564     char *charname, wildcard[255 + 1], filename[255 + 1];
 565     genericptr_t context = 0;
 566
 567     Strcpy(wildcard, savetemplate); /* plname_from_file overwrites SAVEF */
 568     in.mbz = 0; /* class and type; leave them unspecified */
 569     in.len = (unsigned short) strlen(wildcard);
 570     in.adr = wildcard;
 571     out.mbz = 0;
 572     out.len = (unsigned short) (sizeof filename - 1);
 573     out.adr = filename;
 574
 575     *outarray = 0;
 576     count = asize = 0;
 577     /* note: only works as intended if savetemplate is a wildcard filespec */
 578     while (lib$find_file(&in, &out, &context) & 1) {
 579         /* strip trailing blanks */
 580         for (l = out.len; l > 0; --l)
 581             if (filename[l - 1] != ' ')
 582                 break;
 583         filename[l] = '\0';
 584         if ((charname = plname_from_file(filename)) != 0)
 585             savefile(charname, count++, &asize, outarray);
 586     }
 587     (void) lib$find_file_end(&context);
 588
 589     return count;
 590 }
 591 #endif /* SELECTSAVED */
 592
 593 #ifdef PANICTRACE
 594 /* nethack has detected an internal error; try to give a trace of call stack
 595  */
 596 void
 597 vms_traceback(how)
 598 int how; /* 1: exit after traceback; 2: stay in debugger */
 599 {
 600     /* assumes that a static initializer applies to the first union
 601        field and that no padding will be placed between len and str */
 602     union dbgcmd {
 603         struct ascic {
 604             unsigned char len; /* 8-bit length prefix */
 605             char str[79]; /* could be up to 255, but we don't need so much */
 606         } cmd_fields;
 607         char cmd[1 + 79];
 608     };
 609 #define DBGCMD(arg) { (unsigned char) (sizeof arg - sizeof ""), arg }
 610     static union dbgcmd dbg[3] = {
 611         /* prologue for less verbose feedback (when combined with
 612            $ define/User_mode dbg$output _NL: ) */
 613         DBGCMD("set Log SYS$OUTPUT: ; set Output Log,noTerminal,noVerify"),
 614         /* enable modules with calls present on stack, then show those calls;
 615            limit traceback to 18 stack frames to avoid scrolling off screen
 616            (could check termcap LI and maybe give more, but we're operating
 617            in a last-gasp environment so apply the KISS principle...) */
 618         DBGCMD("set Module/Calls ; show Calls 18"),
 619         /* epilogue; "exit" ends the sequence it's part of, but it doesn't
 620            seem able to cause program termination end when used separately;
 621            instead of relying on it, we'll redirect debugger input to come
 622            from the null device so that it'll get an end-of-input condition
 623            when it tries to get a command from the user */
 624         DBGCMD("exit"),
 625     };
 626 #undef DBGCMD
 627
 628     /*
 629      * If we've been linked /noTraceback then we can't provide any
 630      * trace of the call stack.  Linking that way is required if
 631      * nethack.exe is going to be installed with privileges, so the
 632      * SECURE configuration usually won't have any trace feedback.
 633      */
 634     if (!debuggable) {
 635         ; /* debugger not available to catch lib$signal(SS$_DEBUG) */
 636     } else if (how == 2) {
 637         /* omit prologue and epilogue (dbg[0] and dbg[2]) */
 638         (void) lib$signal(SS$_DEBUG, 1, dbg[1].cmd);
 639     } else if (how == 1) {
 640         /*
 641          * Suppress most of debugger's initial feedback to avoid scaring
 642          * users (and scrolling panic message off the screen).  Also control
 643          * debugging environment to try to prevent unexpected complications.
 644          */
 645         /* start up with output going to /dev/null instead of stdout;
 646            once started, output is sent to log file that's actually stdout */
 647         (void) vms_define("DBG$OUTPUT", "_NL:", 0);
 648         /* take input from null device so debugger will see end-on-input
 649            and quit if/when it tries to get a command from the user */
 650         (void) vms_define("DBG$INPUT", "_NL:", 0);
 651         /* bypass any debugger initialization file the user might have */
 652         (void) vms_define("DBG$INIT", "_NL:", 0);
 653         /* force tty interface by suppressing DECwindows/Motif interface */
 654         (void) vms_define("DBG$DECW$DISPLAY", " ", 0);
 655         /* raise an exception for the debugger to catch */
 656         (void) lib$signal(SS$_DEBUG, 3, dbg[0].cmd, dbg[1].cmd, dbg[2].cmd);
 657     }
 658
 659     vms_exit(2); /* don't return to caller (2==arbitrary non-zero) */
 660     /* NOT REACHED */
 661 }
 662 #endif /* PANICTRACE */
 663
 664 /*
 665  * Play Hunt the Wumpus to see whether the debugger lurks nearby.
 666  * It all takes place before nethack even starts, and sets up
 667  * `debuggable' to control possible use of lib$signal(SS$_DEBUG).
 668  */
 669 typedef unsigned FDECL((*condition_handler), (unsigned *, unsigned *));
 670 extern condition_handler FDECL(lib$establish, (condition_handler));
 671 extern unsigned FDECL(lib$sig_to_ret, (unsigned *, unsigned *));
 672
 673 /* SYS$IMGSTA() is not documented:  if called at image startup, it controls
 674    access to the debugger; fortunately, the linker knows now to find it
 675    without needing to link against sys.stb (VAX) or use LINK/System (Alpha).
 676    We won't be calling it, but we indirectly check whether it has already
 677    been called by checking if nethack.exe has it as a transfer address. */
 678 extern unsigned FDECL(sys$imgsta, ());
 679
 680 /*
 681  * These structures are in header files contained in sys$lib_c.tlb,
 682  * but that isn't available on sufficiently old versions of VMS.
 683  * Construct our own:  partly stubs, with simpler field names and
 684  * without ugly unions.  Contents derived from Bliss32 definitions
 685  * in lib.req and/or Macro32 definitions in lib.mlb.
 686  */
 687 struct ihd { /* (vax) image header, $IHDDEF */
 688     unsigned short size, activoff;
 689     unsigned char otherstuff[512 - 4];
 690 };
 691 struct eihd { /* extended image header, $EIHDDEF */
 692     unsigned long majorid, minorid, size, isdoff, activoff;
 693     unsigned char otherstuff[512 - 20];
 694 };
 695 struct iha { /* (vax) image header activation block, $IHADEF */
 696     unsigned long trnadr1, trnadr2, trnadr3;
 697     unsigned long fill_, inishr;
 698 };
 699 struct eiha { /* extended image header activation block, $EIHADEF */
 700     unsigned long size, spare;
 701     unsigned long trnadr1[2], trnadr2[2], trnadr3[2], trnadr4[2], inishr[2];
 702 };
 703
 704 /*
 705  *      We're going to use lib$initialize, not because we need or
 706  *      want to be called before main(), but because one of the
 707  *      arguments passed to a lib$initialize callback is a pointer
 708  *      to the image header (somewhat complex data structure which
 709  *      includes the memory location(s) of where to start executing)
 710  *      of the program being initialized.  It comes in two flavors,
 711  *      one used by VAX and the other by Alpha and IA64.
 712  *
 713  *      An image can have up to three transfer addresses; one of them
 714  *      decides whether to run under debugger control (RUN/Debug, or
 715  *      LINK/Debug + plain RUN), another handles lib$initialize calls
 716  *      if that's used, and the last is to start the program itself
 717  *      (a jacket built around main() for code compiled with DEC C).
 718  *      They aren't always all present; some might be zero/null.
 719  *      A shareable image (pre-linked library) usually won't have any,
 720  *      but can have a separate initializer (not of interest here).
 721  *
 722  *      The transfer targets don't have fixed slots but do occur in a
 723  *      particular order:
 724  *                    link      link     lib$initialize lib$initialize
 725  *          sharable  /noTrace  /Trace    + /noTrace     + /Traceback
 726  *      1:  (none)    main      debugger  init-handler   debugger
 727  *      2:                      main      main           init-handler
 728  *      3:                                               main
 729  *
 730  *      We check whether the first transfer address is SYS$IMGSTA().
 731  *      If it is, the debugger should be available to catch SS$_DEBUG
 732  *      exception even when we don't start up under debugger control.
 733  *      One extra complication:  if we *do* start up under debugger
 734  *      control, the first address in the in-memory copy of the image
 735  *      header will be changed from sys$imgsta() to a value in system
 736  *      space.  [I don't know how to reference that one symbolically,
 737  *      so I'm going to treat any address in system space as meaning
 738  *      that the debugger is available.  pr]
 739  */
 740
 741 /* called via lib$initialize during image activation:  before main() and
 742    with magic arguments; C run-time library won't be initialized yet */
 743 /*ARGSUSED*/
 744 int
 745 vmsexeini(inirtn_unused, clirtn_unused, imghdr)
 746 const void *inirtn_unused, *clirtn_unused;
 747 const unsigned char *imghdr;
 748 {
 749     const struct ihd *vax_hdr;
 750     const struct eihd *axp_hdr;
 751     const struct iha *vax_xfr;
 752     const struct eiha *axp_xfr;
 753     unsigned long trnadr1;
 754
 755     (void) lib$establish(lib$sig_to_ret); /* set up condition handler */
 756
 757     /*
 758      * Check the first of three transfer addresses to see whether
 759      * it is SYS$IMGSTA().  Note that they come from a file,
 760      * where they reside as longword or quadword integers rather
 761      * than function pointers.  (Basically just a C type issue;
 762      * casting back and forth between integer and pointer doesn't
 763      * change any bits for the architectures VMS runs on.)
 764      */
 765     debuggable = 0;
 766     /* start with a guess rather than bothering to figure out architecture */
 767     vax_hdr = (struct ihd *) imghdr;
 768     if (vax_hdr->size >= 512) {
 769         /* this is a VAX-specific header; addresses are longwords */
 770         vax_xfr = (struct iha *) (imghdr + vax_hdr->activoff);
 771         trnadr1 = vax_xfr->trnadr1;
 772     } else {
 773         /* the guess above was wrong; imghdr's first word is not
 774            the size field, it's a version number component */
 775         axp_hdr = (struct eihd *) imghdr;
 776         /* this is an Alpha or IA64 header; addresses are quadwords
 777            but we ignore the upper half which will be all 0's or 0xF's
 778            (we hope; if not, assume it still won't matter for this test) */
 779         axp_xfr = (struct eiha *) (imghdr + axp_hdr->activoff);
 780         trnadr1 = axp_xfr->trnadr1[0];
 781     }
 782     if ((unsigned (*) ()) trnadr1 == sys$imgsta ||
 783         /* check whether first transfer address points to system space
 784            [we want (trnadr1 >= 0x80000000UL) but really old compilers
 785            don't support the UL suffix, so do a signed compare instead] */
 786         (long) trnadr1 < 0L)
 787         debuggable = 1;
 788     return 1; /* success (return value here doesn't actually matter) */
 789 }
 790
 791 /*
 792  * Setting up lib$initialize transfer block is trivial with Macro32,
 793  * but we don't want to introduce use of assembler code.  Doing it
 794  * with C requires jiggery-pokery here and again when linking, and
 795  * may not work with some compiler versions.  The lib$initialize
 796  * transfer block is an open-ended array of 32-bit routine addresses
 797  * in a psect named "lib$initialize" with particular attributes (one
 798  * being "concatenate" so that multiple instances of lib$initialize
 799  * are appended rather than overwriting each other).
 800  *
 801  * VAX C made global variables become named program sections, to be
 802  * compatable with Fortran COMMON blocks, simplifying mixed-language
 803  * programs.  GNU C for VAX/VMS did the same, to be compatable with
 804  * VAX C.  By default, DEC C makes global variables be global symbols
 805  * instead, with its /Extern_Model=Relaxed_Ref_Def mode, but can be
 806  * told to be VAX C compatable by using /Extern_Model=Common_Block.
 807  *
 808  * We don't want to force that for the whole program; occasional use
 809  * of /Extern_Model=Strict_Ref_Def to find mistakes is too useful.
 810  * Also, using symbols instead of psects is more robust when linking
 811  * with an object library if the module defining the symbol contains
 812  * only data.  With a psect, any declaration is enough to become a
 813  * definition and the linker won't bother hunting through a library
 814  * to find another one unless explicitly told to do so.  Bad news
 815  * if that other one happens to include the intended initial value
 816  * and someone bypasses `make' to link interactively but neglects
 817  * to give the linker enough explicit directions.  Linking like that
 818  * would work, but the program wouldn't.
 819  *
 820  * So, we switch modes for this hack only.  Besides, psect attributes
 821  * for lib$initialize are different from the ones used for ordinary
 822  * variables, so we'd need to resort to some linker magic anyway.
 823  * (With assembly language, in addtion to having full control of the
 824  * psect attributes in the source code, Macro32 would include enough
 825  * information in its object file such that linker wouldn't need any
 826  * extra instructions from us to make this work.)  [If anyone links
 827  * manually now and neglects the esoteric details, vmsexeini() won't
 828  * get called and `debuggable' will stay 0, so lib$signal(SS$_DEBUG)
 829  * will be avoided even when its use is viable.  But the program will
 830  * still work correctly.]
 831  */
 832 #define C_LIB$INITIALIZE /* comment out if this won't compile...   */
 833 /* (then `debuggable' will always stay 0) */
 834 #ifdef C_LIB$INITIALIZE
 835 #ifdef __DECC
 836 #pragma extern_model save         /* push current mode */
 837 #pragma extern_model common_block /* set new mode */
 838 #endif
 839 /* values are 32-bit function addresses; pointers might be 64 so avoid them */
 840 extern const unsigned long lib$initialize[1]; /* size is actually variable */
 841 const unsigned long lib$initialize[] = { (unsigned long) (void *) vmsexeini };
 842 #ifdef __DECC
 843 #pragma extern_model restore /* pop previous mode */
 844 #endif
 845 /*      We also need to link against a linker options file containing:
 846 sys$library:starlet.olb/Include=(lib$initialize)
 847 psect_attr=lib$initialize, Con,Usr,noPic,Rel,Gbl,noShr,noExe,Rd,noWrt,Long
 848  */
 849 #endif /* C_LIB$INITIALIZE */
 850 /* End of debugger hackery. */
 851
 852 /*vmsunix.c*/