sys/vms/vmsunix.c

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