1 /* sagittariusdefs.h -*- mode:c; coding:utf-8; -*- 2 * 3 * Copyright (c) 2010-2021 Takashi Kato <ktakashi@ymail.com> 4 * 5 * Redistribution and use in source and binary forms, with or without 6 * modification, are permitted provided that the following conditions 7 * are met: 8 * 9 * 1. Redistributions of source code must retain the above copyright 10 * notice, this list of conditions and the following disclaimer. 11 * 12 * 2. Redistributions in binary form must reproduce the above copyright 13 * notice, this list of conditions and the following disclaimer in the 14 * documentation and/or other materials provided with the distribution. 15 * 16 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 17 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 18 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 19 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 20 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 21 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED 22 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR 23 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF 24 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING 25 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 26 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 27 * 28 * $Id: $ 29 */ 30 #ifndef SAGITTARIUS_PRIVATE_DEFS_H_ 31 #define SAGITTARIUS_PRIVATE_DEFS_H_ 32 33 #include <sagittarius/platform.h> 34 35 #ifdef SAGITTARIUS_WINDOWS 36 #include "win-compat.h" 37 #endif 38 39 40 /* for convenience */ 41 #ifndef FALSE 42 # define FALSE 0 43 #endif 44 #ifndef TRUE 45 #define TRUE (!FALSE) 46 #endif 47 48 #define SG_CPP_CAT(a, b) a##b 49 #define SG_CPP_CAT3(a, b, c) a ## b ## c 50 51 #define array_sizeof(a) ((int)(sizeof(a)/sizeof(a[0]))) 52 53 /* to use limited macros */ 54 #ifdef HAVE_STDINT_H 55 # include <stdint.h> 56 #elif _MSC_VER 57 #ifndef _W64 58 # if !defined(__midl) && \ 59 (defined(_X86_) || defined(_M_IX86)) && _MSC_VER >= 1300 60 # define _W64 __w64 61 # else 62 # define _W64 63 # endif 64 #endif 65 /* define used types */ 66 typedef signed __int8 int8_t; 67 typedef signed __int16 int16_t; 68 typedef signed __int32 int32_t; 69 typedef unsigned __int8 uint8_t; 70 typedef unsigned __int16 uint16_t; 71 typedef unsigned __int32 uint32_t; 72 typedef signed __int64 int64_t; 73 typedef unsigned __int64 uint64_t; 74 75 #ifdef _WIN64 76 typedef int64_t intptr_t; 77 typedef uint64_t uintptr_t; 78 #else 79 typedef int32_t _W64 intptr_t; 80 typedef uint32_t _W64 uintptr_t; 81 #endif 82 83 #define INT8_MIN ((int8_t)_I8_MIN) 84 #define INT8_MAX _I8_MAX 85 #define INT16_MIN ((int16_t)_I16_MIN) 86 #define INT16_MAX _I16_MAX 87 #define INT32_MIN ((int32_t)_I32_MIN) 88 #define INT32_MAX _I32_MAX 89 #define INT64_MIN ((int64_t)_I64_MIN) 90 #define INT64_MAX _I64_MAX 91 #define UINT8_MAX _UI8_MAX 92 #define UINT16_MAX _UI16_MAX 93 #define UINT32_MAX _UI32_MAX 94 #define UINT64_MAX _UI64_MAX 95 96 #endif 97 #include <stdio.h> 98 #include <stdlib.h> 99 #include <limits.h> 100 #include <stdarg.h> 101 /* VC does not have inttypes.h */ 102 #ifndef _MSC_VER 103 #include <inttypes.h> 104 #else 105 #define snprintf(buf_, count_, ...) \ 106 _snprintf_s(buf_, count_, _TRUNCATE, __VA_ARGS__) 107 #pragma warning(disable : 4255) 108 #pragma warning(disable : 4820) 109 #pragma warning(disable : 4711) 110 #endif 111 112 #if __STDC_VERSION__ >= 199901L 113 /* "inline" is a keyword */ 114 #else 115 # ifndef __cplusplus 116 # define inline /* nothing */ 117 # endif 118 #endif 119 120 /* we need to include config.h here */ 121 #include <sagittarius/config.h> 122 123 #if __STDC_VERSION__ >= 201112L 124 # if defined(HAVE_STDNORETURN_H) 125 # include <stdnoreturn.h> 126 # define SG_NO_RETURN _Noreturn 127 # else 128 # define SG_NO_RETURN /* nothing */ 129 # endif 130 #else /* NOT C11 */ 131 # define SG_NO_RETURN /* nothing */ 132 #endif 133 134 /* alloca things */ 135 #ifndef __GNUC__ 136 # ifdef HAVE_ALLOCA_H 137 # include <alloca.h> 138 # else 139 # ifdef _AIX 140 # pragma alloca 141 # elif defined(_MSC_VER) 142 /* _alloca is in <malloc.h> */ 143 # include <malloc.h> 144 # define alloca _alloca 145 # else 146 # ifndef alloca /* predefined by HP cc +Olibcalls */ 147 char *alloca (); 148 # endif 149 # endif 150 # endif 151 #else 152 # ifdef HAVE_ALLOCA_H 153 # include <alloca.h> 154 # endif 155 # ifdef HAVE_MALLOC_H 156 /* MinGW helds alloca() in "malloc.h" instead of "alloca.h" */ 157 # include <malloc.h> 158 # endif 159 #endif 160 161 162 /* detect endianness(from boost/detail/endian.hpp) */ 163 #if defined (__GLIBC__) 164 # include <endian.h> 165 # if (__BYTE_ORDER == __LITTLE_ENDIAN) 166 # define BOOST_LITTLE_ENDIAN 167 # elif (__BYTE_ORDER == __BIG_ENDIAN) 168 # define BOOST_BIG_ENDIAN 169 # elif (__BYTE_ORDER == __PDP_ENDIAN) 170 # define BOOST_PDP_ENDIAN 171 # else 172 # error Unknown machine endianness detected. 173 # endif 174 # define BOOST_BYTE_ORDER __BYTE_ORDER 175 #elif defined(_BIG_ENDIAN) && !defined(_LITTLE_ENDIAN) 176 # define BOOST_BIG_ENDIAN 177 # define BOOST_BYTE_ORDER 4321 178 #elif defined(_LITTLE_ENDIAN) && !defined(_BIG_ENDIAN) 179 # define BOOST_LITTLE_ENDIAN 180 # define BOOST_BYTE_ORDER 1234 181 #elif defined(__sparc) || defined(__sparc__) \ 182 || defined(_POWER) || defined(__powerpc__) \ 183 || defined(__ppc__) || defined(__hpux) || defined(__hppa) \ 184 || defined(_MIPSEB) || defined(_POWER) \ 185 || defined(__s390__) 186 # define BOOST_BIG_ENDIAN 187 # define BOOST_BYTE_ORDER 4321 188 #elif defined(__i386__) || defined(__alpha__) \ 189 || defined(__ia64) || defined(__ia64__) \ 190 || defined(_M_IX86) || defined(_M_IA64) \ 191 || defined(_M_ALPHA) || defined(__amd64) \ 192 || defined(__amd64__) || defined(_M_AMD64) \ 193 || defined(__x86_64) || defined(__x86_64__) \ 194 || defined(_M_X64) || defined(__bfin__) \ 195 || defined(__arm__) 196 197 # define BOOST_LITTLE_ENDIAN 198 # define BOOST_BYTE_ORDER 1234 199 #else 200 # error Failed to detect endian 201 #endif 202 203 /* TODO is detecting apple universal build ok? */ 204 #if defined BOOST_BIG_ENDIAN 205 # ifdef MAC 206 # if defined __BIG_ENDIAN__ 207 # define WORDS_BIGENDIAN 1 208 # endif 209 # else 210 # define WORDS_BIGENDIAN 1 211 # endif 212 #endif 213 214 #define SG_MALLOC(size) Sg_malloc(size) 215 #define SG_MALLOC_ATOMIC(size) Sg_malloc_atomic(size) 216 217 #define SG_NEW(type) ((type*)SG_MALLOC(sizeof(type))) 218 #define SG_NEW2(type, size) ((type)SG_MALLOC(size)) 219 #define SG_NEW_ARRAY(type, nelts) ((type*)(SG_MALLOC(sizeof(type)*(nelts)))) 220 #define SG_NEW_ATOMIC(type) ((type*)(SG_MALLOC_ATOMIC(sizeof(type)))) 221 #define SG_NEW_ATOMIC2(type, size) ((type)(SG_MALLOC_ATOMIC(size))) 222 223 typedef intptr_t SgWord; 224 /* A common header for heap-allocated objects */ 225 typedef struct SgHeaderRec 226 { 227 SgByte *tag; 228 } SgHeader; 229 230 #include <sagittarius/uc.h> 231 232 /* read macro */ 233 typedef struct readtable_rec_t readtable_t; 234 235 236 /* 237 Sagittarius Tag construction 238 239 immediate: 240 nnnn nnnn nnnn nnnn nnnn nnnn nnnn nn01 : fixnum 241 cccc cccc cccc cccc cccc cccc 0000 0011 : char 242 ---- ---- ---- ---- ---- ---- 0001 0011 : #f, #t, '(), eof-object, undefined, unbound 243 ---- ---- ---- ---- ---- ---- ---- 1011 : immediate flonum 244 245 object header: 246 ---- ---- ---- ---- ---- ---- ---- --10 : heap object 247 248 */ 249 typedef struct SgBignumRec SgBignum; 250 typedef struct SgBoxRec SgBox; 251 typedef struct SgByteVectorRec SgByteVector; 252 typedef struct SgCharSetRec SgCharSet; 253 typedef struct SgClassRec SgClass; 254 typedef struct SgClosureRec SgClosure; 255 typedef struct SgCodeBuilderRec SgCodeBuilder; 256 typedef struct SgCodecRec SgCodec; 257 typedef struct SgComparatorRec SgComparator; 258 typedef struct SgComplexRec SgComplex; 259 typedef struct SgGlocRec SgGloc; 260 typedef struct SgFileRec SgFile; 261 typedef struct SgFlonumRec SgFlonum; 262 typedef struct SgHashTableRec SgHashTable; 263 typedef struct SgIdentifierRec SgIdentifier; 264 typedef struct SgInstanceRec SgInstance; /* instance of generic */ 265 typedef struct SgKeywordRec SgKeyword; 266 typedef struct SgLibraryRec SgLibrary; 267 typedef struct SgMacroRec SgMacro; 268 typedef struct SgPairRec SgPair; 269 typedef struct SgPortRec SgPort; 270 typedef struct SgProcedureRec SgProcedure; 271 typedef struct SgRationalRec SgRational; 272 typedef struct SgRecordTypeRec SgRecordType; 273 typedef struct SgStringRec SgString; 274 typedef struct SgSubrRec SgSubr; 275 typedef struct SgSymbolRec SgSymbol; 276 typedef struct SgSyntaxRec SgSyntax; 277 typedef struct SgTranscoderRec SgTranscoder; 278 typedef struct SgTreeMapRec SgTreeMap; 279 typedef struct SgWriteContextRec SgWriteContext; 280 typedef struct SgValuesRec SgValues; 281 typedef struct SgVectorRec SgVector; 282 typedef struct SgVMRec SgVM; 283 284 #ifdef DEBUG_VERSION 285 # define ASSERT(c) { if (!(c)) { fprintf(stderr, "ASSERT failure %s:%d: %s\n", __FILE__, __LINE__, #c); exit(-1);}} 286 # define FATAL(c) { fprintf(stderr, "ASSERT failure %s:%d: %s\n", __FILE__, __LINE__, #c); exit(-1);} 287 #else 288 # define ASSERT(c) /* */ 289 # define FATAL(c) /* */ 290 #endif 291 292 typedef enum { 293 SG_RAISE_ERROR, ///< Raises error when it's occured 294 SG_REPLACE_ERROR, ///< Replace 295 SG_IGNORE_ERROR ///< Ignore error 296 } SgErrorHandlingMode; 297 298 typedef enum { 299 SG_EOL_STYLE_LF = 0x0a, 300 SG_EOL_STYLE_CR = 0x0d, 301 SG_EOL_STYLE_NEL = 0x85, 302 SG_EOL_STYLE_LS = 0x2028, 303 SG_EOL_STYLE_CRNEL = 0x0d85, 304 SG_EOL_STYLE_CRLF = 0x0d0a, 305 SG_EOL_STYLE_E_NONE 306 } SgEolStyle; 307 308 typedef enum { 309 SG_BEGIN, 310 SG_CURRENT, 311 SG_END 312 } SgWhence; 313 314 /* Type coercer */ 315 #define SG_OBJ(obj) ((SgObject)(obj)) 316 #define SG_WORD(obj) ((SgWord)(obj)) 317 318 /* 319 get header value 320 assume(I will write) object's header is located 321 the first member. 322 */ 323 #define SG_HDR(obj) ((SgHeader*)(obj)) 324 #define SG_HEADER SgHeader hdr 325 326 /* Tag accessor */ 327 #define SG_TAG1(obj) (SG_WORD(obj) & 0x01) 328 #define SG_TAG2(obj) (SG_WORD(obj) & 0x03) 329 #define SG_TAG3(obj) (SG_WORD(obj) & 0x07) 330 #define SG_TAG4(obj) (SG_WORD(obj) & 0x0f) 331 #define SG_TAG8(obj) (SG_WORD(obj) & 0xff) 332 333 /* check if the object is a pointer */ 334 #define SG_PTRP(obj) (SG_TAG1(obj) == 0) 335 336 #define SG_HPTRP(obj) (SG_TAG2(obj) == 0) 337 338 #define SG_HTAG(obj) (SG_TAG3(SG_HDR(obj)->tag)) 339 340 /* Immediate objects*/ 341 #define SG_IMMEDIATEP(obj) (SG_TAG8(obj) == 0x13) 342 #define SG_ITAG(obj) (SG_WORD(obj)>>8) 343 344 #define SG_MAKEBITS(v, shift) ((intptr_t)(v)<<shift) 345 346 #define SG__MAKE_ITAG(num) (((num)<<8) + 0x13) 347 #define SG_FALSE SG_OBJ(SG__MAKE_ITAG(0)) /* #f */ 348 #define SG_TRUE SG_OBJ(SG__MAKE_ITAG(1)) /* #t */ 349 #define SG_NIL SG_OBJ(SG__MAKE_ITAG(2)) /* '() */ 350 #define SG_EOF SG_OBJ(SG__MAKE_ITAG(3)) /* eof-object */ 351 #define SG_UNDEF SG_OBJ(SG__MAKE_ITAG(4)) /* undefined */ 352 #define SG_UNBOUND SG_OBJ(SG__MAKE_ITAG(5)) /* unbound */ 353 354 #define SG_FALSEP(obj) ((obj) == SG_FALSE) 355 #define SG_TRUEP(obj) ((obj) == SG_TRUE) 356 #define SG_NULLP(obj) ((obj) == SG_NIL) 357 #define SG_EOFP(obj) ((obj) == SG_EOF) 358 #define SG_UNDEFP(obj) ((obj) == SG_UNDEF) 359 #define SG_UNBOUNDP(obj) ((obj) == SG_UNBOUND) 360 361 /* boolean */ 362 #define SG_BOOLP(obj) ((obj) == SG_TRUE || (obj) == SG_FALSE) 363 #define SG_MAKE_BOOL(obj) ((obj) ? SG_TRUE : SG_FALSE) 364 #define SG_BOOL_VALUE(obj) (SG_FALSEP(obj) ? FALSE : TRUE) 365 366 #define SG_EQ(x, y) ((x) == (y)) 367 368 /* fixnum */ 369 #define SG_INTP(obj) (SG_TAG2(obj) == 1) 370 #define SG_INT_VALUE(obj) (((long)SG_WORD(obj)) >> 2) 371 #define SG_MAKE_INT(obj) SG_OBJ(((long)((unsigned long)(obj) << 2) + 1)) 372 /* Do not use this!!! */ 373 #define SG_ENSURE_INT(obj) SG_OBJ((long)(obj) | 1) 374 #define SG_UINTP(obj) (SG_INTP(obj)&&((long)SG_WORD(obj) >= 0)) 375 #define SG_INT_SIZE (SIZEOF_LONG * 8 - 3) 376 #define SG_INT_MAX ((1L << SG_INT_SIZE) - 1) 377 #define SG_INT_MIN (-SG_INT_MAX - 1) 378 379 #define SG_CHAR(obj) ((SgChar)(obj)) 380 #define SG_CHARP(obj) (SG_TAG8(obj) == 3) 381 #define SG_CHAR_VALUE(obj) SG_CHAR(((unsigned long)SG_WORD(obj)) >> 8) 382 #define SG_MAKE_CHAR(obj) SG_OBJ(((unsigned long)(obj) << 8) + 0x03) 383 /* SgChar is typedef of int32_t, so max value is 24 bits */ 384 #define SG_CHAR_MAX (0xffffff) 385 386 #ifdef USE_IMMEDIATE_FLONUM 387 #define SG_IFLONUM_TAG 0x0b 388 #define SG_IFLONUM_MASK 0x0F 389 #define SG_IFLONUMP(obj) (SG_TAG4(obj) == SG_IFLONUM_TAG) 390 #endif /* USE_IMMEDIATE_FLONUM */ 391 392 /* CLOS */ 393 #define SG_HOBJP(obj) (SG_HPTRP(obj)&&(SG_HTAG(obj)==0x7)) 394 395 /* kludge for WATCOM */ 396 #ifdef __WATCOMC__ 397 #define CLASS_KEYWORD __far 398 #else 399 #define CLASS_KEYWORD 400 #endif 401 402 #define SG_CLASS2TAG(klass) ((SgByte*)(klass) + 7) 403 #define SG_CLASS_DECL(klass) \ 404 SG_CDECL_BEGIN \ 405 SG_EXTERN SgClass CLASS_KEYWORD klass; \ 406 SG_CDECL_END 407 408 #define SG_CLASS_STATIC_PTR(klass) (&klass) 409 #define SG_CLASS_STATIC_TAG(klass) SG_CLASS2TAG(&klass) 410 /* tag - 0b111 = pointer */ 411 #define SG_CLASS_OF(obj) SG_CLASS((SG_HDR(obj)->tag- 7)) 412 #define SG_SET_CLASS(obj, k) (SG_HDR(obj)->tag = (SgByte*)(k) + 7) 413 #define SG_XTYPEP(obj, klass) \ 414 (SG_HPTRP(obj)&&(SG_HDR(obj)->tag == SG_CLASS2TAG(klass))) 415 416 /* safe coercer */ 417 #define SG_OBJ_SAFE(obj) ((obj)?SG_OBJ(obj):SG_UNDEF) 418 419 /* utility for vector, string, etc 420 TODO move somewhere 421 */ 422 #define SG_CHECK_START_END(start, end, len) \ 423 do { \ 424 if ((start) < 0 || (start) > (len)) { \ 425 Sg_Error(UC("start argument out of range: start=%d, length=%d\n"), \ 426 (start), (len)); \ 427 } \ 428 if ((end) <0) (end) = (len); \ 429 else if ((end) > (len)) { \ 430 Sg_Error(UC("end argument out of range: end=%d, length=%d\n"), \ 431 (end), (len)); \ 432 } else if ((end) < (start)) { \ 433 Sg_Error(UC("end argument (%d) must be greater then or " \ 434 "equal to the start argument (%d)"), (end), (start)); \ 435 } \ 436 } while(0) 437 438 /* For convenience */ 439 #include <sagittarius/alloc.h> 440 441 #endif /* SAGITTARIUS_DEFS_H_ */ 442 443 /* 444 end of file 445 Local Variables: 446 coding: utf-8-unix 447 End: 448 */ 449