~ubuntu-branches/debian/squeeze/erlang/squeeze

« back to all changes in this revision

Viewing changes to erts/emulator/beam/error.h

  • Committer: Bazaar Package Importer
  • Author(s): Erlang Packagers, Sergei Golovan
  • Date: 2006-12-03 17:07:44 UTC
  • mfrom: (2.1.11 feisty)
  • Revision ID: james.westby@ubuntu.com-20061203170744-rghjwupacqlzs6kv
Tags: 1:11.b.2-4
[ Sergei Golovan ]
Fixed erlang-base and erlang-base-hipe prerm scripts.

Show diffs side-by-side

added added

removed removed

Lines of Context:
20
20
 * There are three primary exception classes:
21
21
 *
22
22
 *      - exit                  Process termination - not an error.
23
 
 *      - error                 Error (will be logged).
 
23
 *      - error                 Error (adds stacktrace; will be logged).
24
24
 *      - thrown                Nonlocal return (turns into a 'nocatch'
25
25
 *                              error if not caught by the process).
26
26
 *
27
 
 * On top of these, we define a couple of often used special cases.
28
 
 *
29
 
 *      - fault                 Error; stack trace will be added.
30
 
 *      - normal                Exit with reason 'normal'.
31
 
 *
32
27
 * In addition, we define a number of exit codes as a convenient
33
28
 * short-hand: instead of building the error descriptor term at the time
34
29
 * the exception is raised, it is built as necessary when the exception
35
 
 * is handled. Examples are BADARG (EXC_BADARG), BADFUN, etc.
 
30
 * is handled. Examples are EXC_NORMAL, EXC_BADARG, EXC_BADARITH, etc.
 
31
 * Some of these have convenient aliases, like BADARG and BADARITH.
36
32
 */
37
33
 
38
34
/*
39
35
 * Bits 0-1 index the 'exception class tag' table.
40
36
 */
41
 
#define EXC_CLASSBITS 0x0003
 
37
#define EXC_CLASSBITS 3
42
38
#define GET_EXC_CLASS(x) ((x) & EXC_CLASSBITS)
43
39
 
44
40
/*
45
 
 * Exit code flags
 
41
 * Exception class tags (indices into the 'exception_tag' array)
 
42
 */
 
43
#define EXTAG_ERROR     0
 
44
#define EXTAG_EXIT      1
 
45
#define EXTAG_THROWN    2
 
46
 
 
47
#define NUMBER_EXC_TAGS 3       /* The number of exception class tags */
 
48
 
 
49
/*
 
50
 * Exit code flags (bits 2-7)
 
51
 *
 
52
 * These flags make is easier and quicker to decide what to do with the
 
53
 * exception in the early stages, before a handler is found, and also
 
54
 * maintains some separation between the class tag and the actions.
46
55
 */
47
56
#define EXF_PANIC       (1<<2)  /* ignore catches */
48
57
#define EXF_THROWN      (1<<3)  /* nonlocal return */
49
58
#define EXF_LOG         (1<<4)  /* write to logger on termination */
50
 
#define EXF_TRACE       (1<<5)  /* build backtrace */
51
 
#define EXF_ARGLIST     (1<<6)  /* has arglist for top of trace */
 
59
#define EXF_NATIVE      (1<<5)  /* occurred in native code */
 
60
#define EXF_SAVETRACE   (1<<6)  /* save stack trace in internal form */
 
61
#define EXF_ARGLIST     (1<<7)  /* has arglist for top of trace */
52
62
 
53
 
#define EXC_FLAGBITS 0x007c
 
63
#define EXC_FLAGBITS 0x00fc
54
64
 
55
65
/*
56
66
 * The primary fields of an exception code
57
67
 */
58
 
#define EXF_PRIMARY     (EXF_PANIC | EXF_THROWN | EXF_LOG)
 
68
#define EXF_PRIMARY     (EXF_PANIC | EXF_THROWN | EXF_LOG | EXF_NATIVE)
59
69
#define PRIMARY_EXCEPTION(x) ((x) & (EXF_PRIMARY | EXC_CLASSBITS))
60
 
 
61
 
/*
62
 
 * Exception class tags (indices into the 'exception_tag' array)
63
 
 */
64
 
#define EXTAG_EXIT      0
65
 
#define EXTAG_ERROR     1
66
 
#define EXTAG_THROWN    2
67
 
 
68
 
#define NUMBER_EXC_TAGS 3       /* The number of exception class tags */
69
 
 
70
 
/*
71
 
 * Bits 7-11 of the error code are used for indexing into
 
70
#define NATIVE_EXCEPTION(x) ((x) | EXF_NATIVE)
 
71
 
 
72
/*
 
73
 * Bits 8-12 of the error code are used for indexing into
72
74
 * the short-hand error descriptor table.
73
75
 */
74
 
#define EXC_INDEXBITS 0x0f80
75
 
#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> 7)
 
76
#define EXC_INDEXBITS 0x1f00
 
77
#define GET_EXC_INDEX(x) (((x) & EXC_INDEXBITS) >> 8)
76
78
 
77
79
/*
78
 
 * Exit codes. Note that indices are assigned low numbers starting at 0
79
 
 * to allow them to be used as array indices. The primary exceptions
80
 
 * share index 0.
 
80
 * Exit codes used for raising a fresh exception. The primary exceptions
 
81
 * share index 0 in the descriptor table. EXC_NULL signals that no
 
82
 * exception has occurred. The primary exit codes EXC_EXIT, EXC_ERROR
 
83
 * and EXC_THROWN are the basis for all other exit codes, and must
 
84
 * always have the EXF_SAVETRACE flag set so that a trace is saved
 
85
 * whenever a new exception occurs; the flag is then cleared.
81
86
 */
82
 
#define EXC_PRIMARY 0
83
 
#define EXC_EXIT   (EXTAG_EXIT)
84
 
                                        /* Generic exit (final exit
85
 
                                         * term in p->fvalue) */
86
 
#define EXC_ERROR  (EXTAG_ERROR | EXF_LOG)
87
 
                                        /* Generic error (final exit 
88
 
                                         * term in p->fvalue) */
89
 
#define EXC_THROWN (EXTAG_THROWN | EXF_THROWN)
 
87
#define EXC_NULL 0                      /* Initial value for p->freason */
 
88
#define EXC_PRIMARY (0 | EXF_SAVETRACE)
 
89
#define EXC_ERROR  (EXC_PRIMARY | EXTAG_ERROR | EXF_LOG)
 
90
                                        /* Generic error (exit term
 
91
                                         * in p->fvalue) */
 
92
#define EXC_EXIT   (EXC_PRIMARY | EXTAG_EXIT)
 
93
                                        /* Generic exit (exit term
 
94
                                         * in p->fvalue) */
 
95
#define EXC_THROWN (EXC_PRIMARY | EXTAG_THROWN | EXF_THROWN)
90
96
                                        /* Generic nonlocal return
91
97
                                         * (thrown term in p->fvalue) */
92
98
 
93
 
#define EXC_FAULT  (EXC_ERROR | EXF_TRACE)
94
 
                                        /* Fault = error + trace */
95
 
#define EXC_USER_ERROR EXC_FAULT        /* Alias for fault */
96
 
#define EXC_USER_ERROR2 (EXC_FAULT | EXF_ARGLIST)
97
 
                                        /* Fault with given arglist term
 
99
#define EXC_ERROR_2 (EXC_ERROR | EXF_ARGLIST)
 
100
                                        /* Error with given arglist term
98
101
                                         * (exit reason in p->fvalue) */
99
102
 
100
 
#define EXC_NORMAL              ((1 << 7) | EXC_EXIT)
 
103
#define EXC_NORMAL              ((1 << 8) | EXC_EXIT)
101
104
                                        /* Normal exit (reason 'normal') */
102
 
#define EXC_INTERNAL_ERROR      ((2 << 7) | EXC_FAULT | EXF_PANIC)
 
105
#define EXC_INTERNAL_ERROR      ((2 << 8) | EXC_ERROR | EXF_PANIC)
103
106
                                        /* Things that shouldn't happen */
104
 
#define EXC_BADARG              ((3 << 7) | EXC_FAULT)
 
107
#define EXC_BADARG              ((3 << 8) | EXC_ERROR)
105
108
                                        /* Bad argument to a BIF */
106
 
#define EXC_BADARITH            ((4 << 7) | EXC_FAULT)
 
109
#define EXC_BADARITH            ((4 << 8) | EXC_ERROR)
107
110
                                        /* Bad arithmetic */
108
 
#define EXC_BADMATCH            ((5 << 7) | EXC_FAULT)
 
111
#define EXC_BADMATCH            ((5 << 8) | EXC_ERROR)
109
112
                                        /* Bad match in function body */
110
 
#define EXC_FUNCTION_CLAUSE     ((6 << 7) | EXC_FAULT)
 
113
#define EXC_FUNCTION_CLAUSE     ((6 << 8) | EXC_ERROR)
111
114
                                         /* No matching function head */
112
 
#define EXC_CASE_CLAUSE         ((7 << 7) | EXC_FAULT)
 
115
#define EXC_CASE_CLAUSE         ((7 << 8) | EXC_ERROR)
113
116
                                        /* No matching case clause */
114
 
#define EXC_IF_CLAUSE           ((8 << 7) | EXC_FAULT)
 
117
#define EXC_IF_CLAUSE           ((8 << 8) | EXC_ERROR)
115
118
                                        /* No matching if clause */
116
 
#define EXC_UNDEF               ((9 << 7) | EXC_FAULT)
 
119
#define EXC_UNDEF               ((9 << 8) | EXC_ERROR)
117
120
                                        /* No farity that matches */
118
 
#define EXC_BADFUN              ((10 << 7) | EXC_FAULT)
 
121
#define EXC_BADFUN              ((10 << 8) | EXC_ERROR)
119
122
                                        /* Not an existing fun */
120
 
#define EXC_BADARITY            ((11 << 7) | EXC_FAULT)
 
123
#define EXC_BADARITY            ((11 << 8) | EXC_ERROR)
121
124
                                        /* Attempt to call fun with
122
125
                                         * wrong number of arguments. */
123
 
#define EXC_TIMEOUT_VALUE       ((12 << 7) | EXC_FAULT)
 
126
#define EXC_TIMEOUT_VALUE       ((12 << 8) | EXC_ERROR)
124
127
                                        /* Bad time out value */
125
 
#define EXC_NOPROC              ((13 << 7) | EXC_FAULT)
 
128
#define EXC_NOPROC              ((13 << 8) | EXC_ERROR)
126
129
                                        /* No process or port */
127
 
#define EXC_NOTALIVE            ((14 << 7) | EXC_FAULT)
 
130
#define EXC_NOTALIVE            ((14 << 8) | EXC_ERROR)
128
131
                                        /* Not distributed */
129
 
#define EXC_SYSTEM_LIMIT        ((15 << 7) | EXC_FAULT)
 
132
#define EXC_SYSTEM_LIMIT        ((15 << 8) | EXC_ERROR)
130
133
                                        /* Ran out of something */
131
 
#define EXC_TRY_CLAUSE          ((16 << 7) | EXC_FAULT)
 
134
#define EXC_TRY_CLAUSE          ((16 << 8) | EXC_ERROR)
132
135
                                        /* No matching try clause */
133
136
 
134
137
#define NUMBER_EXIT_CODES 17    /* The number of exit code indices */
136
139
/*
137
140
 * Internal pseudo-error codes.
138
141
 */
139
 
#define TRAP            31      /* BIF Trap to erlang code */
140
 
#define RESCHEDULE      30      /* BIF must be rescheduled */
 
142
#define TRAP            (1 << 8)        /* BIF Trap to erlang code */
 
143
#define RESCHEDULE      (2 << 8)        /* BIF must be rescheduled */
141
144
 
142
145
/*
143
146
 * Aliases for some common exit codes.
144
147
 */
145
 
 
146
 
#define USER_EXIT EXC_EXIT
147
 
#define USER_ERROR EXC_USER_ERROR
148
 
#define USER_ERROR2 EXC_USER_ERROR2
149
 
#define THROWN EXC_THROWN
150
148
#define BADARG EXC_BADARG
151
149
#define BADARITH EXC_BADARITH
152
150
#define BADMATCH EXC_BADMATCH
156
154
/*
157
155
 * Pseudo error codes (these are never seen by the user).
158
156
 */
159
 
 
160
157
#define TLOAD_OK 0              /* The threaded code linking was successful */
161
158
#define TLOAD_MAGIC_NUMBER 1    /* Wrong kind of object file */
162
159
#define TLOAD_FORMAT 2          /* Format error while reading object code */
164
161
#define TLOAD_SIZE 4            /* Given size in object code differs from actual size */
165
162
 
166
163
/*
 
164
 * The exception stack trace parameters.
 
165
 */
 
166
#define MAX_BACKTRACE_SIZE 64    /* whatever - just not too huge */
 
167
#define DEFAULT_BACKTRACE_SIZE 8
 
168
 
 
169
/*
167
170
 * The table translating an exception code to an atom.
168
171
 */
169
 
Eterm error_atom[NUMBER_EXIT_CODES];
 
172
extern Eterm error_atom[NUMBER_EXIT_CODES];
170
173
 
171
174
/*
172
175
 * The exception tag table.
173
176
 */
174
 
Eterm exception_tag[NUMBER_EXC_TAGS];
 
177
extern Eterm exception_tag[NUMBER_EXC_TAGS];
 
178
 
 
179
/* 
 
180
 * The quick-saved stack trace structure
 
181
 */
 
182
struct StackTrace {
 
183
    Eterm header;       /* bignum header - must be first in struct */
 
184
    Eterm freason; /* original exception reason is saved in the struct */
 
185
    Eterm* pc;
 
186
    Eterm* current;
 
187
    int depth;  /* number of saved pointers in trace[] */
 
188
    Eterm *trace[1];  /* varying size - must be last in struct */
 
189
};