1 | /* +++begin copyright+++ ******************************************* */
|
---|
2 | /* */
|
---|
3 | /* COPYRIGHT (c) 1997, 1998, 1999, 2000 Stratus Computer (DE), Inc. */
|
---|
4 | /* */
|
---|
5 | /* This program is free software; you can redistribute it and/or */
|
---|
6 | /* modify it under the terms of either: */
|
---|
7 | /* */
|
---|
8 | /* a) the GNU General Public License as published by the Free */
|
---|
9 | /* Software Foundation; either version 1, or (at your option) any */
|
---|
10 | /* later version, or */
|
---|
11 | /* */
|
---|
12 | /* b) the "Artistic License" which comes with this Kit. */
|
---|
13 | /* */
|
---|
14 | /* This program is distributed in the hope that it will be useful, */
|
---|
15 | /* but WITHOUT ANY WARRANTY; without even the implied warranty of */
|
---|
16 | /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either */
|
---|
17 | /* the GNU General Public License or the Artistic License for more */
|
---|
18 | /* details. */
|
---|
19 | /* */
|
---|
20 | /* You should have received a copy of the Artistic License with this */
|
---|
21 | /* Kit, in the file named "Artistic". If not, you can get one from */
|
---|
22 | /* the Perl distribution. */
|
---|
23 | /* */
|
---|
24 | /* You should also have received a copy of the GNU General Public */
|
---|
25 | /* License along with this program; if not, you can get one from */
|
---|
26 | /* the Perl distribution or else write to the Free Software */
|
---|
27 | /* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA */
|
---|
28 | /* 02111-1307, USA. */
|
---|
29 | /* */
|
---|
30 | /* +++end copyright+++ ********************************************* */
|
---|
31 |
|
---|
32 | #define _POSIX_C_SOURCE 199309L
|
---|
33 |
|
---|
34 | #include <stdio.h>
|
---|
35 | #include <string.h>
|
---|
36 | #include <sys/types.h>
|
---|
37 |
|
---|
38 | extern void s$stop_program (char_varying (256) *command_line,
|
---|
39 | short int *error_code);
|
---|
40 | extern void s$write_code (char_varying *record_buffer,
|
---|
41 | short int *error_code);
|
---|
42 | extern int vos_call_debug ();
|
---|
43 |
|
---|
44 | #pragma page
|
---|
45 | static void bomb (char *p_name)
|
---|
46 | {
|
---|
47 | char_varying(256) msgvs;
|
---|
48 |
|
---|
49 | strcpy_vstr_nstr (&msgvs, "FATAL ERROR: Call to unimplemented function '");
|
---|
50 | strcat_vstr_nstr (&msgvs, p_name);
|
---|
51 | strcat_vstr_nstr (&msgvs, "'. Entering debugger.");
|
---|
52 | s$write_code (&msgvs, &0);
|
---|
53 |
|
---|
54 | strcpy_vstr_nstr (&msgvs, "Please capture the output of the 'trace' request and mail it to Paul_Green@stratus.com.");
|
---|
55 | s$write_code (&msgvs, &0);
|
---|
56 |
|
---|
57 | vos_call_debug ();
|
---|
58 |
|
---|
59 | strcpy_vstr_nstr (&msgvs, "Return from debugger. Stopping program. Sorry but this error is unrecoverable.");
|
---|
60 | s$write_code (&msgvs, &0);
|
---|
61 | s$stop_program (&"", &1);
|
---|
62 | }
|
---|
63 |
|
---|
64 | extern int dup (int _fildes)
|
---|
65 | {
|
---|
66 | bomb ("dup");
|
---|
67 | }
|
---|
68 |
|
---|
69 | extern int do_aspawn ()
|
---|
70 | {
|
---|
71 | bomb ("do_aspawn");
|
---|
72 | }
|
---|
73 |
|
---|
74 | extern int do_spawn ()
|
---|
75 | {
|
---|
76 | bomb ("do_spawn");
|
---|
77 | }
|
---|
78 |
|
---|
79 | extern pid_t fork (void)
|
---|
80 | {
|
---|
81 | bomb ("fork");
|
---|
82 | }
|
---|
83 |
|
---|
84 | extern void Perl_dump_mstats (char *s)
|
---|
85 | {
|
---|
86 | bomb ("Perl_dump_mstats");
|
---|
87 | }
|
---|
88 |
|
---|
89 | extern int Perl_get_mstats (struct perl_mstats *buf, int buflen, int level)
|
---|
90 | {
|
---|
91 | bomb ("Perl_get_mstats");
|
---|
92 | }
|
---|
93 |
|
---|
94 | extern pid_t waitpid (pid_t pid, int *stat_loc, int options)
|
---|
95 | {
|
---|
96 |
|
---|
97 | bomb ("waitpid");
|
---|
98 | }
|
---|
99 |
|
---|