1 /********************************************************************/ 2 /* */ 3 /* s7 Seed7 interpreter */ 4 /* Copyright (C) 1990 - 2000 Thomas Mertes */ 5 /* */ 6 /* This program is free software; you can redistribute it and/or */ 7 /* modify it under the terms of the GNU General Public License as */ 8 /* published by the Free Software Foundation; either version 2 of */ 9 /* the License, or (at your option) any later version. */ 10 /* */ 11 /* This program is distributed in the hope that it will be useful, */ 12 /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ 13 /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ 14 /* GNU General Public License for more details. */ 15 /* */ 16 /* You should have received a copy of the GNU General Public */ 17 /* License along with this program; if not, write to the */ 18 /* Free Software Foundation, Inc., 51 Franklin Street, */ 19 /* Fifth Floor, Boston, MA 02110-1301, USA. */ 20 /* */ 21 /* Module: Runtime */ 22 /* File: seed7/src/objutl.h */ 23 /* Changes: 1992, 1993, 1994 Thomas Mertes */ 24 /* Content: isit_.. and bld_.. functions for primitive data types. */ 25 /* */ 26 /********************************************************************/ 27 28 #define arg_1(arguments) arguments->obj 29 #define arg_2(arguments) arguments->next->obj 30 #define arg_3(arguments) arguments->next->next->obj 31 #define arg_4(arguments) arguments->next->next->next->obj 32 #define arg_5(arguments) arguments->next->next->next->next->obj 33 #define arg_6(arguments) arguments->next->next->next->next->next->obj 34 #define arg_7(arguments) arguments->next->next->next->next->next->next->obj 35 #define arg_8(arguments) arguments->next->next->next->next->next->next->next->obj 36 #define arg_9(arguments) arguments->next->next->next->next->next->next->next->next->obj 37 #define arg_10(arguments) arguments->next->next->next->next->next->next->next->next->next->obj 38 #define arg_11(arguments) arguments->next->next->next->next->next->next->next->next->next->next->obj 39 #define arg_12(arguments) arguments->next->next->next->next->next->next->next->next->next->next->next->obj 40 41 #define take_act_obj(arg) (CATEGORY_OF_OBJ(arg) == MATCHOBJECT ? take_reflist(arg)->obj : (arg)) 42 #define take_action(arg) take_act_obj(arg)->value.actValue 43 #define take_array(arg) (arg)->value.arrayValue 44 #define take_binary(arg) (arg)->value.binaryValue 45 #define take_block(arg) (arg)->value.blockValue 46 #define take_bool(arg) (CATEGORY_OF_OBJ(arg) == CONSTENUMOBJECT || CATEGORY_OF_OBJ(arg) == VARENUMOBJECT ? (arg)->value.objValue : (arg)) 47 #define take_bstri(arg) (arg)->value.bstriValue 48 #define take_char(arg) (arg)->value.charValue 49 #define take_database(arg) (arg)->value.databaseValue 50 #define take_enum(arg) (CATEGORY_OF_OBJ(arg) == CONSTENUMOBJECT || CATEGORY_OF_OBJ(arg) == VARENUMOBJECT ? (arg)->value.objValue : (arg)) 51 #define take_file(arg) (arg)->value.fileValue 52 #define take_float(arg) (arg)->value.floatValue 53 #define take_hash(arg) (arg)->value.hashValue 54 #define take_int(arg) (arg)->value.intValue 55 #define take_interface(arg) (CATEGORY_OF_OBJ(arg) == INTERFACEOBJECT ? (arg)->value.objValue : (arg)) 56 #define take_bigint(arg) (arg)->value.bigIntValue 57 #define take_list(arg) (arg)->value.listValue 58 #define take_param(arg) (arg)->value.objValue 59 #define take_poll(arg) (arg)->value.pollValue 60 #define take_prog(arg) (arg)->value.progValue 61 #define take_reference(arg) (arg)->value.objValue 62 #define take_reflist(arg) (arg)->value.listValue 63 #define take_set(arg) (arg)->value.setValue 64 #define take_socket(arg) (arg)->value.socketValue 65 #define take_sqlstmt(arg) (arg)->value.sqlStmtValue 66 #define take_stri(arg) (arg)->value.striValue 67 #define take_struct(arg) (arg)->value.structValue 68 #define take_type(arg) (arg)->value.typeValue 69 #define take_win(arg) (arg)->value.winValue 70 #define take_process(arg) (arg)->value.processValue 71 72 #if WITH_TYPE_CHECK 73 #define run_exception(c,arg) { run_error(c, arg); return NULL; } 74 #define hasCategory(arg,cat) if (unlikely(CATEGORY_OF_OBJ(arg) != (cat))) run_exception(cat, arg) 75 #define hasCategory2(arg,cat1,cat2) if (unlikely(CATEGORY_OF_OBJ(arg) != (cat1) && \ 76 CATEGORY_OF_OBJ(arg) != (cat2))) run_exception(cat1, arg) 77 #define hasCategory3(arg,cat1,cat2,cat3) if (unlikely(CATEGORY_OF_OBJ(arg) != (cat1) && \ 78 CATEGORY_OF_OBJ(arg) != (cat2) && \ 79 CATEGORY_OF_OBJ(arg) != (cat3))) run_exception(cat1, arg) 80 #define isit_action(arg) hasCategory(take_act_obj(arg), ACTOBJECT) 81 #define isit_array(arg) hasCategory(arg, ARRAYOBJECT); \ 82 if (unlikely(take_array(arg) == NULL)) { empty_value(arg); return NULL; } 83 #define isit_binary(arg) hasCategory(arg, INTOBJECT) 84 #define isit_bigint(arg) hasCategory(arg, BIGINTOBJECT) 85 #define isit_block(arg) hasCategory(arg, BLOCKOBJECT) 86 #define isit_bool(arg) if (take_bool(arg) != SYS_TRUE_OBJECT && \ 87 take_bool(arg) != SYS_FALSE_OBJECT) { \ 88 run_exception(ENUMLITERALOBJECT, arg); \ 89 } 90 #define isit_bstri(arg) hasCategory(arg, BSTRIOBJECT); \ 91 if (unlikely(take_bstri(arg) == NULL)) { empty_value(arg); return NULL; } 92 #define isit_call(arg) hasCategory(arg, CALLOBJECT) 93 #define isit_char(arg) hasCategory(arg, CHAROBJECT) 94 #define isit_database(arg) hasCategory(arg, DATABASEOBJECT) 95 #define isit_interface(arg) hasCategory2(arg, INTERFACEOBJECT, STRUCTOBJECT); \ 96 if (unlikely(take_interface(arg) == NULL)) { empty_value(arg); return NULL; } 97 /* isit_enum(arg) */ 98 #define isit_file(arg) hasCategory(arg, FILEOBJECT) 99 #define isit_float(arg) hasCategory(arg, FLOATOBJECT) 100 #define isit_hash(arg) hasCategory(arg, HASHOBJECT); \ 101 if (unlikely(take_hash(arg) == NULL)) { empty_value(arg); return NULL; } 102 #define isit_int(arg) hasCategory(arg, INTOBJECT) 103 /* isit_list(arg) */ 104 #define isit_param(arg) hasCategory(arg, FORMPARAMOBJECT) 105 #define isit_poll(arg) hasCategory(arg, POLLOBJECT) 106 #define isit_proc(arg) hasCategory3(arg, BLOCKOBJECT, MATCHOBJECT, ACTOBJECT) 107 #define isit_prog(arg) hasCategory(arg, PROGOBJECT) 108 #define isit_reference(arg) hasCategory(arg, REFOBJECT) 109 #define isit_not_null(arg) if (unlikely(arg == NULL)) { empty_value(arg); return NULL; } 110 #define isit_reflist(arg) hasCategory3(arg, REFLISTOBJECT, MATCHOBJECT, CALLOBJECT) 111 #define isit_set(arg) hasCategory(arg, SETOBJECT); \ 112 if (unlikely(take_set(arg) == NULL)) { empty_value(arg); return NULL; } 113 #define isit_socket(arg) hasCategory(arg, SOCKETOBJECT) 114 #define isit_sqlstmt(arg) hasCategory(arg, SQLSTMTOBJECT) 115 #define isit_stri(arg) hasCategory(arg, STRIOBJECT); \ 116 if (unlikely(take_stri(arg) == NULL)) { empty_value(arg); return NULL; } 117 #define isit_struct(arg) hasCategory(arg, STRUCTOBJECT); \ 118 if (unlikely(take_struct(arg) == NULL)) { empty_value(arg); return NULL; } 119 #define isit_struct_ok(arg) if (unlikely(take_struct(arg) == NULL)) { empty_value(arg); return NULL; } 120 #define isit_type(arg) hasCategory(arg, TYPEOBJECT) 121 #define isit_win(arg) hasCategory(arg, WINOBJECT) 122 #define isit_process(arg) hasCategory(arg, PROCESSOBJECT) 123 #define is_variable(arg) if (unlikely(!VAR_OBJECT(arg))) { var_required(arg); return NULL; } 124 #define isit_int2(arg) if (unlikely(CATEGORY_OF_OBJ(arg) != INTOBJECT)) run_error(INTOBJECT, arg) 125 #define just_interface(arg) hasCategory(arg, INTERFACEOBJECT); \ 126 if (unlikely(take_interface(arg) == NULL)) { empty_value(arg); return NULL; } 127 #else 128 #define isit_action(arg) 129 #define isit_array(arg) 130 #define isit_bigint(arg) 131 #define isit_block(arg) 132 #define isit_bool(arg) 133 #define isit_bstri(arg) 134 #define isit_call(arg) 135 #define isit_char(arg) 136 #define isit_database(arg) 137 #define isit_interface(arg) 138 #define isit_enum(arg) 139 #define isit_file(arg) 140 #define isit_float(arg) 141 #define isit_hash(arg) 142 #define isit_int(arg) 143 #define isit_list(arg) 144 #define isit_param(arg) 145 #define isit_proc(arg) 146 #define isit_prog(arg) 147 #define isit_reference(arg) 148 #define isit_not_null(arg) 149 #define isit_reflist(arg) 150 #define isit_set(arg) 151 #define isit_socket(arg) 152 #define isit_sqlstmt(arg) 153 #define isit_stri(arg) 154 #define isit_struct(arg) 155 #define isit_struct_ok(arg) 156 #define isit_type(arg) 157 #define isit_win(arg) 158 #define isit_process(arg) 159 #define is_variable(arg) 160 #define isit_int2(arg) 161 #define just_interface(arg) 162 #endif 163 164 165 #if WITH_TYPE_CHECK 166 /* void isit_action (objectType argument); */ 167 /* void isit_array (objectType argument); */ 168 /* void isit_block (objectType argument); */ 169 /* void isit_bool (objectType argument); */ 170 /* void isit_bstri (objectType argument); */ 171 /* void isit_call (objectType argument); */ 172 /* void isit_char (objectType argument); */ 173 /* void isit_interface (objectType argument); */ 174 void isit_enum (objectType argument); 175 /* void isit_file (objectType argument); */ 176 #if WITH_FLOAT 177 /* void isit_float (objectType argument); */ 178 #endif 179 /* void isit_hash (objectType argument); */ 180 /* void isit_int (objectType argument); */ 181 void isit_list (objectType argument); 182 /* void isit_proc (objectType argument); */ 183 /* void isit_prog (objectType argument); */ 184 /* void isit_reference (objectType argument); */ 185 /* void isit_reflist (objectType argument); */ 186 /* void isit_set (objectType argument); */ 187 /* void isit_socket (objectType argument); */ 188 /* void isit_stri (objectType argument); */ 189 /* void isit_struct (objectType argument); */ 190 /* void isit_type (objectType argument); */ 191 /* void isit_win (objectType argument); */ 192 /* void isit_process (objectType argument); */ 193 #endif 194 objectType bld_action_temp (actType temp_action); 195 objectType bld_array_temp (arrayType temp_array); 196 objectType bld_bigint_temp (bigIntType temp_bigint); 197 objectType bld_binary_temp (uintType temp_binary); 198 objectType bld_block_temp (blockType temp_block); 199 objectType bld_bstri_temp (bstriType temp_bstri); 200 objectType bld_char_temp (charType temp_char); 201 objectType bld_database_temp (databaseType temp_database); 202 objectType bld_interface_temp (objectType temp_interface); 203 objectType bld_file_temp (fileType temp_file); 204 objectType bld_float_temp (double temp_float); 205 objectType bld_hash_temp (hashType temp_hash); 206 objectType bld_int_temp (intType temp_int); 207 objectType bld_list_temp (listType temp_list); 208 objectType bld_param_temp (objectType temp_param); 209 objectType bld_poll_temp (pollType temp_poll); 210 objectType bld_prog_temp (progType temp_prog); 211 objectType bld_reference_temp (objectType temp_reference); 212 objectType bld_reflist_temp (listType temp_reflist); 213 objectType bld_set_temp (setType temp_set); 214 objectType bld_socket_temp (socketType temp_socket); 215 objectType bld_sqlstmt_temp (sqlStmtType temp_sqlstmt); 216 objectType bld_stri_temp (striType temp_stri); 217 objectType bld_struct_temp (structType temp_struct); 218 objectType bld_type_temp (typeType temp_type); 219 objectType bld_win_temp (winType temp_win); 220 objectType bld_process_temp (processType temp_win); 221 void dump_temp_value (objectType object); 222 void dump_any_temp (objectType object); 223 void dump_list (listType list); 224