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 | |
---|