kerror.c (6173B)
1 2 #include <stdio.h> 3 #include <string.h> 4 #include <stdlib.h> 5 #include <errno.h> 6 #include <string.h> 7 8 #include "klisp.h" 9 #include "kpair.h" 10 #include "kstate.h" 11 #include "kmem.h" 12 #include "kstring.h" 13 #include "kerror.h" 14 15 /* TODO: check that all objects passed to throw are rooted */ 16 17 /* GC: assumes all objs passed are rooted */ 18 TValue klispE_new(klisp_State *K, TValue who, TValue cont, TValue msg, 19 TValue irritants) 20 { 21 Error *new_error = klispM_new(K, Error); 22 23 /* header + gc_fields */ 24 klispC_link(K, (GCObject *) new_error, K_TERROR, 0); 25 26 /* error specific fields */ 27 new_error->who = who; 28 new_error->cont = cont; 29 new_error->msg = msg; 30 new_error->irritants = irritants; 31 return gc2error(new_error); 32 } 33 34 TValue klispE_new_with_errno_irritants(klisp_State *K, const char *service, 35 int errnum, TValue irritants) 36 { 37 TValue error_description = klispE_describe_errno(K, service, errnum); 38 krooted_tvs_push(K, error_description); 39 TValue all_irritants = kimm_cons(K, error_description, irritants); 40 krooted_tvs_push(K, all_irritants); 41 TValue error_obj = klispE_new(K, K->next_obj, K->curr_cont, 42 kcaddr(error_description), 43 all_irritants); 44 krooted_tvs_pop(K); 45 krooted_tvs_pop(K); 46 return error_obj; 47 } 48 49 /* This is meant to be called by the GC */ 50 /* LOCK: GIL should be acquired */ 51 void klispE_free(klisp_State *K, Error *error) 52 { 53 klispM_free(K, error); 54 } 55 56 /* 57 ** Clear all stacks & buffers 58 */ 59 void clear_buffers(klisp_State *K) 60 { 61 /* These shouldn't cause GC, but just in case do them first, 62 an object may be protected in tvs or vars */ 63 ks_sclear(K); 64 ks_tbclear(K); 65 K->shared_dict = KNIL; 66 67 krooted_tvs_clear(K); 68 krooted_vars_clear(K); 69 } 70 71 /* 72 ** Throw a simple error obj with: 73 ** { 74 ** who: current operative/continuation, 75 ** cont: current continuation, 76 ** message: msg, 77 ** irritants: () 78 ** } 79 */ 80 /* GC: assumes all objs passed are rooted */ 81 void klispE_throw_simple(klisp_State *K, char *msg) 82 { 83 TValue error_msg = kstring_new_b_imm(K, msg); 84 krooted_tvs_push(K, error_msg); 85 TValue error_obj = 86 klispE_new(K, K->next_obj, K->curr_cont, error_msg, KNIL); 87 /* clear buffer shouldn't cause GC, but just in case... */ 88 krooted_tvs_push(K, error_obj); 89 clear_buffers(K); /* this pops both error_msg & error_obj */ 90 /* call_cont protects error from gc */ 91 kcall_cont(K, G(K)->error_cont, error_obj); 92 } 93 94 /* 95 ** Throw an error obj with: 96 ** { 97 ** who: current operative/continuation, 98 ** cont: current continuation, 99 ** message: msg, 100 ** irritants: irritants 101 ** } 102 */ 103 /* GC: assumes all objs passed are rooted */ 104 void klispE_throw_with_irritants(klisp_State *K, char *msg, TValue irritants) 105 { 106 /* it's important that this is immutable, because it's user 107 accessible */ 108 TValue error_msg = kstring_new_b_imm(K, msg); 109 krooted_tvs_push(K, error_msg); 110 TValue error_obj = 111 klispE_new(K, K->next_obj, K->curr_cont, error_msg, irritants); 112 /* clear buffer shouldn't cause GC, but just in case... */ 113 krooted_tvs_push(K, error_obj); 114 clear_buffers(K); /* this pops both error_msg & error_obj */ 115 /* call_cont protects error from gc */ 116 kcall_cont(K, G(K)->error_cont, error_obj); 117 } 118 119 void klispE_throw_system_error_with_irritants( 120 klisp_State *K, const char *service, int errnum, TValue irritants) 121 { 122 TValue error_obj = klispE_new_with_errno_irritants(K, service, errnum, 123 irritants); 124 krooted_tvs_push(K, error_obj); 125 clear_buffers(K); 126 kcall_cont(K, G(K)->system_error_cont, error_obj); 127 } 128 129 /* The array symbolic_error_codes[] assigns locale and target 130 * platform configuration independent strings to errno values. 131 * 132 * Generated from Linux header files: 133 * 134 * awk '{printf(" c(%s),\n", $2)}' /usr/include/asm-generic/errno-base.h 135 * awk '{printf(" c(%s),\n", $2)}' /usr/include/asm-generic/errno.h 136 * 137 * and removed errnos not present in mingw. 138 * 139 */ 140 #define c(N) [N] = # N 141 static const char * const symbolic_error_codes[] = { 142 c(EPERM), 143 c(ENOENT), 144 c(ESRCH), 145 c(EINTR), 146 c(EIO), 147 c(ENXIO), 148 c(E2BIG), 149 c(ENOEXEC), 150 c(EBADF), 151 c(ECHILD), 152 c(EAGAIN), 153 c(ENOMEM), 154 c(EACCES), 155 c(EFAULT), 156 c(EBUSY), 157 c(EEXIST), 158 c(EXDEV), 159 c(ENODEV), 160 c(ENOTDIR), 161 c(EISDIR), 162 c(EINVAL), 163 c(ENFILE), 164 c(EMFILE), 165 c(ENOTTY), 166 c(EFBIG), 167 c(ENOSPC), 168 c(ESPIPE), 169 c(EROFS), 170 c(EMLINK), 171 c(EPIPE), 172 c(EDOM), 173 c(ERANGE), 174 /**/ 175 c(EDEADLK), 176 c(ENAMETOOLONG), 177 c(ENOLCK), 178 c(ENOSYS), 179 c(ENOTEMPTY), 180 }; 181 #undef c 182 183 /* klispE_describe_errno(K, ERRNUM, SERVICE) returns a list 184 * 185 * (SERVICE CODE MESSAGE ERRNUM) 186 * 187 * SERVICE (string) identifies the failed system call or service, 188 * e.g. "rename" or "fopen". 189 * 190 * CODE (string) is a platform-independent symbolic representation 191 * of the error. It corresponds to symbolic constants of <errno.h>, 192 * e.g. "ENOENT" or "ENOMEM". 193 * 194 * MESSAGE (string) platform-dependent human-readable description. 195 * The MESSAGE may depend on locale or operating system configuration. 196 * 197 * ERRNUM (fixint) is the value of errno for debugging puroposes. 198 * 199 */ 200 TValue klispE_describe_errno(klisp_State *K, const char *service, int errnum) 201 { 202 const char *code = NULL; 203 int tabsize = sizeof(symbolic_error_codes) / 204 sizeof(symbolic_error_codes[0]); 205 if (0 <= errnum && errnum < tabsize) 206 code = symbolic_error_codes[errnum]; 207 if (code == NULL) 208 code = "UNKNOWN"; 209 210 TValue service_tv = kstring_new_b_imm(K, service); 211 krooted_tvs_push(K, service_tv); 212 TValue code_tv = kstring_new_b_imm(K, code); 213 krooted_tvs_push(K, code_tv); 214 TValue message_tv = kstring_new_b_imm(K, strerror(errnum)); 215 krooted_tvs_push(K, message_tv); 216 217 TValue v = kimm_list(K, 4, service_tv, code_tv, message_tv, i2tv(errnum)); 218 krooted_tvs_pop(K); 219 krooted_tvs_pop(K); 220 krooted_tvs_pop(K); 221 return v; 222 }