2019-03-19 01:12:38 +00:00
/*
2023-01-07 21:03:35 +00:00
* Copyright ( c ) 2023 Calvin Rose & contributors
2019-03-19 01:12:38 +00:00
*
* Permission is hereby granted , free of charge , to any person obtaining a copy
* of this software and associated documentation files ( the " Software " ) , to
* deal in the Software without restriction , including without limitation the
* rights to use , copy , modify , merge , publish , distribute , sublicense , and / or
* sell copies of the Software , and to permit persons to whom the Software is
* furnished to do so , subject to the following conditions :
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software .
*
* THE SOFTWARE IS PROVIDED " AS IS " , WITHOUT WARRANTY OF ANY KIND , EXPRESS OR
* IMPLIED , INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY ,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT . IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM , DAMAGES OR OTHER
* LIABILITY , WHETHER IN AN ACTION OF CONTRACT , TORT OR OTHERWISE , ARISING
* FROM , OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE .
*/
# ifndef JANET_AMALG
2019-12-31 00:06:15 +00:00
# include "features.h"
2019-03-19 01:12:38 +00:00
# include <janet.h>
# include "util.h"
# endif
2020-07-03 19:14:59 +00:00
# include <errno.h>
# include <stdlib.h>
# include <limits.h>
# include <inttypes.h>
# include <math.h>
2019-03-19 01:12:38 +00:00
/* Conditional compilation */
# ifdef JANET_INT_TYPES
2019-03-19 02:00:20 +00:00
# define MAX_INT_IN_DBL 9007199254740992ULL /* 2^53 */
2019-03-19 01:12:38 +00:00
2019-12-09 03:50:33 +00:00
static int it_s64_get ( void * p , Janet key , Janet * out ) ;
static int it_u64_get ( void * p , Janet key , Janet * out ) ;
2021-01-12 05:14:07 +00:00
static Janet janet_int64_next ( void * p , Janet key ) ;
static Janet janet_uint64_next ( void * p , Janet key ) ;
2019-03-19 01:12:38 +00:00
2019-12-28 20:57:36 +00:00
static int32_t janet_int64_hash ( void * p1 , size_t size ) {
( void ) size ;
int32_t * words = p1 ;
return words [ 0 ] ^ words [ 1 ] ;
}
static int janet_int64_compare ( void * p1 , void * p2 ) {
int64_t x = * ( ( int64_t * ) p1 ) ;
int64_t y = * ( ( int64_t * ) p2 ) ;
return x = = y ? 0 : x < y ? - 1 : 1 ;
}
static int janet_uint64_compare ( void * p1 , void * p2 ) {
uint64_t x = * ( ( uint64_t * ) p1 ) ;
uint64_t y = * ( ( uint64_t * ) p2 ) ;
return x = = y ? 0 : x < y ? - 1 : 1 ;
}
2019-03-19 01:12:38 +00:00
static void int64_marshal ( void * p , JanetMarshalContext * ctx ) {
2019-12-07 04:12:18 +00:00
janet_marshal_abstract ( ctx , p ) ;
2019-03-19 01:12:38 +00:00
janet_marshal_int64 ( ctx , * ( ( int64_t * ) p ) ) ;
}
2019-12-07 04:12:18 +00:00
static void * int64_unmarshal ( JanetMarshalContext * ctx ) {
int64_t * p = janet_unmarshal_abstract ( ctx , sizeof ( int64_t ) ) ;
p [ 0 ] = janet_unmarshal_int64 ( ctx ) ;
return p ;
2019-03-19 01:12:38 +00:00
}
2019-03-19 17:36:26 +00:00
static void it_s64_tostring ( void * p , JanetBuffer * buffer ) {
char str [ 32 ] ;
2019-12-01 10:10:52 +00:00
sprintf ( str , " % " PRId64 , * ( ( int64_t * ) p ) ) ;
2019-03-19 17:36:26 +00:00
janet_buffer_push_cstring ( buffer , str ) ;
}
static void it_u64_tostring ( void * p , JanetBuffer * buffer ) {
char str [ 32 ] ;
2019-12-01 10:10:52 +00:00
sprintf ( str , " % " PRIu64 , * ( ( uint64_t * ) p ) ) ;
2019-03-19 17:36:26 +00:00
janet_buffer_push_cstring ( buffer , str ) ;
}
2020-03-14 15:12:47 +00:00
const JanetAbstractType janet_s64_type = {
2019-03-19 01:12:38 +00:00
" core/s64 " ,
NULL ,
NULL ,
it_s64_get ,
NULL ,
int64_marshal ,
2019-03-19 17:36:26 +00:00
int64_unmarshal ,
2019-12-28 20:57:36 +00:00
it_s64_tostring ,
janet_int64_compare ,
2020-01-19 00:09:20 +00:00
janet_int64_hash ,
2021-01-12 05:14:07 +00:00
janet_int64_next ,
JANET_ATEND_NEXT
2019-03-19 01:12:38 +00:00
} ;
2020-03-14 15:12:47 +00:00
const JanetAbstractType janet_u64_type = {
2019-03-19 01:12:38 +00:00
" core/u64 " ,
NULL ,
NULL ,
it_u64_get ,
NULL ,
int64_marshal ,
2019-03-19 17:36:26 +00:00
int64_unmarshal ,
2019-12-28 20:57:36 +00:00
it_u64_tostring ,
janet_uint64_compare ,
2020-01-19 00:09:20 +00:00
janet_int64_hash ,
2021-01-12 05:14:07 +00:00
janet_uint64_next ,
JANET_ATEND_NEXT
2019-03-19 01:12:38 +00:00
} ;
int64_t janet_unwrap_s64 ( Janet x ) {
switch ( janet_type ( x ) ) {
2019-05-02 21:11:30 +00:00
default :
break ;
2019-03-19 01:12:38 +00:00
case JANET_NUMBER : {
double dbl = janet_unwrap_number ( x ) ;
if ( fabs ( dbl ) < = MAX_INT_IN_DBL )
return ( int64_t ) dbl ;
break ;
}
case JANET_STRING : {
int64_t value ;
const uint8_t * str = janet_unwrap_string ( x ) ;
if ( janet_scan_int64 ( str , janet_string_length ( str ) , & value ) )
return value ;
break ;
}
case JANET_ABSTRACT : {
void * abst = janet_unwrap_abstract ( x ) ;
2020-03-14 15:12:47 +00:00
if ( janet_abstract_type ( abst ) = = & janet_s64_type | |
( janet_abstract_type ( abst ) = = & janet_u64_type ) )
2019-03-19 01:12:38 +00:00
return * ( int64_t * ) abst ;
break ;
}
}
2021-01-09 18:43:33 +00:00
janet_panicf ( " bad s64 initializer: %t " , x ) ;
2019-03-19 01:12:38 +00:00
return 0 ;
}
uint64_t janet_unwrap_u64 ( Janet x ) {
switch ( janet_type ( x ) ) {
2019-05-02 21:11:30 +00:00
default :
break ;
2019-03-19 01:12:38 +00:00
case JANET_NUMBER : {
double dbl = janet_unwrap_number ( x ) ;
2021-01-09 18:43:33 +00:00
/* Allow negative values to be cast to "wrap around".
* This let ' s addition and subtraction work as expected . */
if ( fabs ( dbl ) < = MAX_INT_IN_DBL )
2019-03-19 01:12:38 +00:00
return ( uint64_t ) dbl ;
break ;
}
case JANET_STRING : {
uint64_t value ;
const uint8_t * str = janet_unwrap_string ( x ) ;
if ( janet_scan_uint64 ( str , janet_string_length ( str ) , & value ) )
return value ;
break ;
}
case JANET_ABSTRACT : {
void * abst = janet_unwrap_abstract ( x ) ;
2020-03-14 15:12:47 +00:00
if ( janet_abstract_type ( abst ) = = & janet_s64_type | |
( janet_abstract_type ( abst ) = = & janet_u64_type ) )
2019-03-19 01:12:38 +00:00
return * ( uint64_t * ) abst ;
break ;
}
}
2021-01-09 18:43:33 +00:00
janet_panicf ( " bad u64 initializer: %t " , x ) ;
2019-03-19 01:12:38 +00:00
return 0 ;
}
JanetIntType janet_is_int ( Janet x ) {
if ( ! janet_checktype ( x , JANET_ABSTRACT ) ) return JANET_INT_NONE ;
const JanetAbstractType * at = janet_abstract_type ( janet_unwrap_abstract ( x ) ) ;
2020-03-14 15:12:47 +00:00
return ( at = = & janet_s64_type ) ? JANET_INT_S64 :
( ( at = = & janet_u64_type ) ? JANET_INT_U64 :
2019-03-19 01:12:38 +00:00
JANET_INT_NONE ) ;
}
Janet janet_wrap_s64 ( int64_t x ) {
2020-03-14 15:12:47 +00:00
int64_t * box = janet_abstract ( & janet_s64_type , sizeof ( int64_t ) ) ;
2019-03-19 01:12:38 +00:00
* box = ( int64_t ) x ;
return janet_wrap_abstract ( box ) ;
}
Janet janet_wrap_u64 ( uint64_t x ) {
2020-03-14 15:12:47 +00:00
uint64_t * box = janet_abstract ( & janet_u64_type , sizeof ( uint64_t ) ) ;
2019-03-19 01:12:38 +00:00
* box = ( uint64_t ) x ;
return janet_wrap_abstract ( box ) ;
}
2021-07-26 12:52:02 +00:00
JANET_CORE_FN ( cfun_it_s64_new ,
" (int/s64 value) " ,
" Create a boxed signed 64 bit integer from a string value. " ) {
2019-03-19 01:12:38 +00:00
janet_fixarity ( argc , 1 ) ;
return janet_wrap_s64 ( janet_unwrap_s64 ( argv [ 0 ] ) ) ;
}
2021-07-26 12:52:02 +00:00
JANET_CORE_FN ( cfun_it_u64_new ,
" (int/u64 value) " ,
" Create a boxed unsigned 64 bit integer from a string value. " ) {
2019-03-19 01:12:38 +00:00
janet_fixarity ( argc , 1 ) ;
return janet_wrap_u64 ( janet_unwrap_u64 ( argv [ 0 ] ) ) ;
}
2022-02-20 21:16:52 +00:00
JANET_CORE_FN ( cfun_to_number ,
" (int/to-number value) " ,
" Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32. " ) {
janet_fixarity ( argc , 1 ) ;
if ( janet_type ( argv [ 0 ] ) = = JANET_ABSTRACT ) {
2022-02-25 00:07:22 +00:00
void * abst = janet_unwrap_abstract ( argv [ 0 ] ) ;
2022-02-20 21:16:52 +00:00
if ( janet_abstract_type ( abst ) = = & janet_s64_type ) {
2022-02-25 00:07:22 +00:00
int64_t value = * ( ( int64_t * ) abst ) ;
2022-02-21 17:54:38 +00:00
if ( value > JANET_INTMAX_INT64 ) {
janet_panicf ( " cannot convert %q to a number, must be in the range [%q, %q] " , argv [ 0 ] , janet_wrap_number ( JANET_INTMIN_DOUBLE ) , janet_wrap_number ( JANET_INTMAX_DOUBLE ) ) ;
2022-02-20 21:16:52 +00:00
}
2022-02-21 17:54:38 +00:00
if ( value < - JANET_INTMAX_INT64 ) {
janet_panicf ( " cannot convert %q to a number, must be in the range [%q, %q] " , argv [ 0 ] , janet_wrap_number ( JANET_INTMIN_DOUBLE ) , janet_wrap_number ( JANET_INTMAX_DOUBLE ) ) ;
2022-02-20 21:16:52 +00:00
}
2022-02-21 17:54:38 +00:00
return janet_wrap_number ( ( double ) value ) ;
2022-02-20 21:16:52 +00:00
}
if ( janet_abstract_type ( abst ) = = & janet_u64_type ) {
2022-02-25 00:07:22 +00:00
uint64_t value = * ( ( uint64_t * ) abst ) ;
2022-02-21 17:54:38 +00:00
if ( value > JANET_INTMAX_INT64 ) {
janet_panicf ( " cannot convert %q to a number, must be in the range [%q, %q] " , argv [ 0 ] , janet_wrap_number ( JANET_INTMIN_DOUBLE ) , janet_wrap_number ( JANET_INTMAX_DOUBLE ) ) ;
2022-02-20 21:16:52 +00:00
}
2022-02-21 17:54:38 +00:00
return janet_wrap_number ( ( double ) value ) ;
2022-02-20 21:16:52 +00:00
}
}
janet_panicf ( " expected int/u64 or int/s64, got %q " , argv [ 0 ] ) ;
}
2022-03-04 13:48:54 +00:00
JANET_CORE_FN ( cfun_to_bytes ,
2022-03-05 13:21:53 +00:00
" (int/to-bytes value &opt endianness buffer) " ,
" Write the bytes of an `int/s64` or `int/u64` into a buffer. \n "
" The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created. \n "
" Returns the modified buffer. \n "
" The `endianness` paramater indicates the byte order: \n "
2022-03-04 13:48:54 +00:00
" - `nil` (unset): system byte order \n "
" - `:le`: little-endian, least significant byte first \n "
" - `:be`: big-endian, most significant byte first \n " ) {
2022-03-05 13:21:53 +00:00
janet_arity ( argc , 1 , 3 ) ;
2022-03-04 13:48:54 +00:00
if ( janet_is_int ( argv [ 0 ] ) = = JANET_INT_NONE ) {
janet_panicf ( " int/to-bytes: expected an int/s64 or int/u64, got %q " , argv [ 0 ] ) ;
}
int reverse = 0 ;
if ( argc > 1 & & ! janet_checktype ( argv [ 1 ] , JANET_NIL ) ) {
JanetKeyword endianness_kw = janet_getkeyword ( argv , 1 ) ;
if ( ! janet_cstrcmp ( endianness_kw , " le " ) ) {
# if JANET_BIG_ENDIAN
reverse = 1 ;
# endif
} else if ( ! janet_cstrcmp ( endianness_kw , " be " ) ) {
# if JANET_LITTLE_ENDIAN
reverse = 1 ;
# endif
} else {
janet_panicf ( " int/to-bytes: expected endianness :le, :be or nil, got %v " , argv [ 1 ] ) ;
}
}
2022-03-05 13:21:53 +00:00
JanetBuffer * buffer = NULL ;
if ( argc > 2 & & ! janet_checktype ( argv [ 2 ] , JANET_NIL ) ) {
if ( ! janet_checktype ( argv [ 2 ] , JANET_BUFFER ) ) {
janet_panicf ( " int/to-bytes: expected buffer or nil, got %q " , argv [ 2 ] ) ;
}
buffer = janet_unwrap_buffer ( argv [ 2 ] ) ;
janet_buffer_extra ( buffer , 8 ) ;
} else {
buffer = janet_buffer ( 8 ) ;
}
2022-03-04 13:48:54 +00:00
uint8_t * bytes = janet_unwrap_abstract ( argv [ 0 ] ) ;
2022-03-05 13:21:53 +00:00
if ( reverse ) {
for ( int i = 0 ; i < 8 ; + + i ) {
buffer - > data [ buffer - > count + 7 - i ] = bytes [ i ] ;
}
} else {
memcpy ( buffer - > data + buffer - > count , bytes , 8 ) ;
2022-03-04 13:48:54 +00:00
}
2022-03-05 13:21:53 +00:00
buffer - > count + = 8 ;
2022-03-04 13:48:54 +00:00
2022-03-05 13:21:53 +00:00
return janet_wrap_buffer ( buffer ) ;
2022-03-04 13:48:54 +00:00
}
2021-01-09 18:43:33 +00:00
/*
* Code to support polymorphic comparison .
* int / u64 and int / s64 support a " compare " method that allows
* comparison to each other , and to Janet numbers , using the
* " compare " " compare< " . . . functions .
* In the following code explicit casts are sometimes used to help
* make it clear when int / float conversions are happening .
*/
2020-06-14 19:20:38 +00:00
static int compare_double_double ( double x , double y ) {
2020-06-04 22:27:48 +00:00
return ( x < y ) ? - 1 : ( ( x > y ) ? 1 : 0 ) ;
}
2020-06-14 19:20:38 +00:00
static int compare_int64_double ( int64_t x , double y ) {
2020-06-05 14:51:35 +00:00
if ( isnan ( y ) ) {
return 0 ; // clojure and python do this
2020-06-14 19:20:38 +00:00
} else if ( ( y > ( - ( ( double ) MAX_INT_IN_DBL ) ) ) & & ( y < ( ( double ) MAX_INT_IN_DBL ) ) ) {
2020-06-05 14:51:35 +00:00
double dx = ( double ) x ;
return compare_double_double ( dx , y ) ;
} else if ( y > ( ( double ) INT64_MAX ) ) {
return - 1 ;
} else if ( y < ( ( double ) INT64_MIN ) ) {
return 1 ;
} else {
int64_t yi = ( int64_t ) y ;
return ( x < yi ) ? - 1 : ( ( x > yi ) ? 1 : 0 ) ;
}
}
2020-06-14 19:20:38 +00:00
static int compare_uint64_double ( uint64_t x , double y ) {
2020-06-05 14:51:35 +00:00
if ( isnan ( y ) ) {
return 0 ; // clojure and python do this
} else if ( y < 0 ) {
return 1 ;
} else if ( ( y > = 0 ) & & ( y < ( ( double ) MAX_INT_IN_DBL ) ) ) {
double dx = ( double ) x ;
return compare_double_double ( dx , y ) ;
} else if ( y > ( ( double ) UINT64_MAX ) ) {
return - 1 ;
} else {
uint64_t yi = ( uint64_t ) y ;
return ( x < yi ) ? - 1 : ( ( x > yi ) ? 1 : 0 ) ;
}
}
2020-06-04 19:27:36 +00:00
static Janet cfun_it_s64_compare ( int32_t argc , Janet * argv ) {
janet_fixarity ( argc , 2 ) ;
if ( janet_is_int ( argv [ 0 ] ) ! = JANET_INT_S64 )
janet_panic ( " compare method requires int/s64 as first argument " ) ;
int64_t x = janet_unwrap_s64 ( argv [ 0 ] ) ;
switch ( janet_type ( argv [ 1 ] ) ) {
default :
break ;
case JANET_NUMBER : {
2020-06-04 22:27:48 +00:00
double y = janet_unwrap_number ( argv [ 1 ] ) ;
2020-06-05 14:51:35 +00:00
return janet_wrap_number ( compare_int64_double ( x , y ) ) ;
2020-06-04 19:27:36 +00:00
}
case JANET_ABSTRACT : {
void * abst = janet_unwrap_abstract ( argv [ 1 ] ) ;
if ( janet_abstract_type ( abst ) = = & janet_s64_type ) {
int64_t y = * ( int64_t * ) abst ;
return janet_wrap_number ( ( x < y ) ? - 1 : ( x > y ? 1 : 0 ) ) ;
} else if ( janet_abstract_type ( abst ) = = & janet_u64_type ) {
// comparing signed to unsigned -- be careful!
uint64_t y = * ( uint64_t * ) abst ;
if ( x < 0 ) {
return janet_wrap_number ( - 1 ) ;
} else if ( y > INT64_MAX ) {
return janet_wrap_number ( - 1 ) ;
} else {
int64_t y2 = ( int64_t ) y ;
return janet_wrap_number ( ( x < y2 ) ? - 1 : ( x > y2 ? 1 : 0 ) ) ;
}
}
break ;
}
}
return janet_wrap_nil ( ) ;
}
static Janet cfun_it_u64_compare ( int32_t argc , Janet * argv ) {
janet_fixarity ( argc , 2 ) ;
if ( janet_is_int ( argv [ 0 ] ) ! = JANET_INT_U64 ) // is this needed?
janet_panic ( " compare method requires int/u64 as first argument " ) ;
uint64_t x = janet_unwrap_u64 ( argv [ 0 ] ) ;
switch ( janet_type ( argv [ 1 ] ) ) {
default :
break ;
case JANET_NUMBER : {
2020-06-06 12:55:20 +00:00
double y = janet_unwrap_number ( argv [ 1 ] ) ;
2020-06-05 14:51:35 +00:00
return janet_wrap_number ( compare_uint64_double ( x , y ) ) ;
2020-06-04 19:27:36 +00:00
}
case JANET_ABSTRACT : {
void * abst = janet_unwrap_abstract ( argv [ 1 ] ) ;
if ( janet_abstract_type ( abst ) = = & janet_u64_type ) {
uint64_t y = * ( uint64_t * ) abst ;
return janet_wrap_number ( ( x < y ) ? - 1 : ( x > y ? 1 : 0 ) ) ;
} else if ( janet_abstract_type ( abst ) = = & janet_s64_type ) {
// comparing unsigned to signed -- be careful!
int64_t y = * ( int64_t * ) abst ;
if ( y < 0 ) {
return janet_wrap_number ( 1 ) ;
} else if ( x > INT64_MAX ) {
return janet_wrap_number ( 1 ) ;
} else {
int64_t x2 = ( int64_t ) x ;
return janet_wrap_number ( ( x2 < y ) ? - 1 : ( x2 > y ? 1 : 0 ) ) ;
}
}
break ;
}
}
return janet_wrap_nil ( ) ;
}
2022-08-30 01:32:33 +00:00
/*
* In C , signed arithmetic overflow is undefined behvior
* but unsigned arithmetic overflow is twos complement
*
* Reference :
* https : //en.cppreference.com/w/cpp/language/ub
* http : //blog.llvm.org/2011/05/what-every-c-programmer-should-know.html
*
* This means OPMETHOD & OPMETHODINVERT must always use
* unsigned arithmetic internally , regardless of the true type .
* This will not affect the end result ( property of twos complement ) .
*/
2019-03-19 01:12:38 +00:00
# define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_ # # type # # _ # # name ( int32_t argc , Janet * argv ) { \
janet_arity ( argc , 2 , - 1 ) ; \
2020-03-14 15:12:47 +00:00
T * box = janet_abstract ( & janet_ # # type # # _type , sizeof ( T ) ) ; \
2019-03-19 01:12:38 +00:00
* box = janet_unwrap_ # # type ( argv [ 0 ] ) ; \
2020-01-24 00:54:30 +00:00
for ( int32_t i = 1 ; i < argc ; i + + ) \
2022-08-30 01:32:33 +00:00
/* This avoids undefined behavior. See above for why. */ \
* box = ( T ) ( ( uint64_t ) ( * box ) ) oper ( ( uint64_t ) janet_unwrap_ # # type ( argv [ i ] ) ) ; \
2019-03-19 01:12:38 +00:00
return janet_wrap_abstract ( box ) ; \
} \
2020-01-23 00:59:41 +00:00
# define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_ # # type # # _ # # name ( int32_t argc , Janet * argv ) { \
janet_fixarity ( argc , 2 ) ; \
2020-03-14 15:12:47 +00:00
T * box = janet_abstract ( & janet_ # # type # # _type , sizeof ( T ) ) ; \
2020-01-23 00:59:41 +00:00
* box = janet_unwrap_ # # type ( argv [ 1 ] ) ; \
2022-08-30 01:32:33 +00:00
/* This avoids undefined behavior. See above for why. */ \
* box = ( T ) ( ( uint64_t ) * box ) oper ( ( uint64_t ) janet_unwrap_ # # type ( argv [ 0 ] ) ) ; \
2020-01-23 00:59:41 +00:00
return janet_wrap_abstract ( box ) ; \
} \
2019-03-19 01:12:38 +00:00
# define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_ # # type # # _ # # name ( int32_t argc , Janet * argv ) { \
janet_arity ( argc , 2 , - 1 ) ; \
2020-03-14 15:12:47 +00:00
T * box = janet_abstract ( & janet_ # # type # # _type , sizeof ( T ) ) ; \
2019-03-19 01:12:38 +00:00
* box = janet_unwrap_ # # type ( argv [ 0 ] ) ; \
2020-01-24 00:54:30 +00:00
for ( int32_t i = 1 ; i < argc ; i + + ) { \
2019-03-19 01:12:38 +00:00
T value = janet_unwrap_ # # type ( argv [ i ] ) ; \
if ( value = = 0 ) janet_panic ( " division by zero " ) ; \
* box oper # # = value ; \
} \
return janet_wrap_abstract ( box ) ; \
} \
2020-01-23 00:59:41 +00:00
# define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_ # # type # # _ # # name ( int32_t argc , Janet * argv ) { \
janet_fixarity ( argc , 2 ) ; \
2020-03-14 15:12:47 +00:00
T * box = janet_abstract ( & janet_ # # type # # _type , sizeof ( T ) ) ; \
2020-01-23 00:59:41 +00:00
* box = janet_unwrap_ # # type ( argv [ 1 ] ) ; \
T value = janet_unwrap_ # # type ( argv [ 0 ] ) ; \
if ( value = = 0 ) janet_panic ( " division by zero " ) ; \
* box oper # # = value ; \
return janet_wrap_abstract ( box ) ; \
} \
2019-03-19 01:12:38 +00:00
# define DIVMETHOD_SIGNED(T, type, name, oper) \
static Janet cfun_it_ # # type # # _ # # name ( int32_t argc , Janet * argv ) { \
janet_arity ( argc , 2 , - 1 ) ; \
2020-03-14 15:12:47 +00:00
T * box = janet_abstract ( & janet_ # # type # # _type , sizeof ( T ) ) ; \
2019-03-19 01:12:38 +00:00
* box = janet_unwrap_ # # type ( argv [ 0 ] ) ; \
2020-01-24 00:54:30 +00:00
for ( int32_t i = 1 ; i < argc ; i + + ) { \
2019-03-19 01:12:38 +00:00
T value = janet_unwrap_ # # type ( argv [ i ] ) ; \
if ( value = = 0 ) janet_panic ( " division by zero " ) ; \
if ( ( value = = - 1 ) & & ( * box = = INT64_MIN ) ) janet_panic ( " INT64_MIN divided by -1 " ) ; \
* box oper # # = value ; \
} \
return janet_wrap_abstract ( box ) ; \
} \
2020-01-23 00:59:41 +00:00
# define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_ # # type # # _ # # name ( int32_t argc , Janet * argv ) { \
2020-01-23 15:01:33 +00:00
janet_fixarity ( argc , 2 ) ; \
2020-03-14 15:12:47 +00:00
T * box = janet_abstract ( & janet_ # # type # # _type , sizeof ( T ) ) ; \
2020-01-23 00:59:41 +00:00
* box = janet_unwrap_ # # type ( argv [ 1 ] ) ; \
T value = janet_unwrap_ # # type ( argv [ 0 ] ) ; \
if ( value = = 0 ) janet_panic ( " division by zero " ) ; \
if ( ( value = = - 1 ) & & ( * box = = INT64_MIN ) ) janet_panic ( " INT64_MIN divided by -1 " ) ; \
* box oper # # = value ; \
return janet_wrap_abstract ( box ) ; \
} \
2020-01-24 00:54:30 +00:00
static Janet cfun_it_s64_mod ( int32_t argc , Janet * argv ) {
janet_fixarity ( argc , 2 ) ;
2020-03-14 15:12:47 +00:00
int64_t * box = janet_abstract ( & janet_s64_type , sizeof ( int64_t ) ) ;
2020-01-24 00:54:30 +00:00
int64_t op1 = janet_unwrap_s64 ( argv [ 0 ] ) ;
int64_t op2 = janet_unwrap_s64 ( argv [ 1 ] ) ;
int64_t x = op1 % op2 ;
2021-01-09 20:45:58 +00:00
* box = ( op1 > 0 )
2021-01-10 00:33:40 +00:00
? ( ( op2 > 0 ) ? x : ( 0 = = x ? x : x + op2 ) )
: ( ( op2 > 0 ) ? ( 0 = = x ? x : x + op2 ) : x ) ;
2020-01-24 00:54:30 +00:00
return janet_wrap_abstract ( box ) ;
}
2023-05-11 23:15:37 +00:00
static Janet cfun_it_s64_modi ( int32_t argc , Janet * argv ) {
janet_fixarity ( argc , 2 ) ;
int64_t * box = janet_abstract ( & janet_s64_type , sizeof ( int64_t ) ) ;
int64_t op2 = janet_unwrap_s64 ( argv [ 0 ] ) ;
int64_t op1 = janet_unwrap_s64 ( argv [ 1 ] ) ;
int64_t x = op1 % op2 ;
* box = ( op1 > 0 )
? ( ( op2 > 0 ) ? x : ( 0 = = x ? x : x + op2 ) )
: ( ( op2 > 0 ) ? ( 0 = = x ? x : x + op2 ) : x ) ;
return janet_wrap_abstract ( box ) ;
}
2019-03-19 01:12:38 +00:00
OPMETHOD ( int64_t , s64 , add , + )
OPMETHOD ( int64_t , s64 , sub , - )
2020-01-23 00:59:41 +00:00
OPMETHODINVERT ( int64_t , s64 , subi , - )
2019-03-19 01:12:38 +00:00
OPMETHOD ( int64_t , s64 , mul , * )
DIVMETHOD_SIGNED ( int64_t , s64 , div , / )
2020-01-24 00:54:30 +00:00
DIVMETHOD_SIGNED ( int64_t , s64 , rem , % )
2020-01-23 00:59:41 +00:00
DIVMETHODINVERT_SIGNED ( int64_t , s64 , divi , / )
2023-05-11 23:15:37 +00:00
DIVMETHODINVERT_SIGNED ( int64_t , s64 , remi , / )
2019-03-19 01:12:38 +00:00
OPMETHOD ( int64_t , s64 , and , & )
OPMETHOD ( int64_t , s64 , or , | )
OPMETHOD ( int64_t , s64 , xor , ^ )
OPMETHOD ( int64_t , s64 , lshift , < < )
OPMETHOD ( int64_t , s64 , rshift , > > )
OPMETHOD ( uint64_t , u64 , add , + )
OPMETHOD ( uint64_t , u64 , sub , - )
2020-01-23 00:59:41 +00:00
OPMETHODINVERT ( uint64_t , u64 , subi , - )
2019-03-19 01:12:38 +00:00
OPMETHOD ( uint64_t , u64 , mul , * )
DIVMETHOD ( uint64_t , u64 , div , / )
DIVMETHOD ( uint64_t , u64 , mod , % )
2020-01-23 00:59:41 +00:00
DIVMETHODINVERT ( uint64_t , u64 , divi , / )
2023-05-11 23:15:37 +00:00
DIVMETHODINVERT ( uint64_t , u64 , modi , % )
2019-03-19 01:12:38 +00:00
OPMETHOD ( uint64_t , u64 , and , & )
OPMETHOD ( uint64_t , u64 , or , | )
OPMETHOD ( uint64_t , u64 , xor , ^ )
OPMETHOD ( uint64_t , u64 , lshift , < < )
OPMETHOD ( uint64_t , u64 , rshift , > > )
# undef OPMETHOD
# undef DIVMETHOD
# undef DIVMETHOD_SIGNED
# undef COMPMETHOD
static JanetMethod it_s64_methods [ ] = {
{ " + " , cfun_it_s64_add } ,
2020-01-23 00:59:41 +00:00
{ " r+ " , cfun_it_s64_add } ,
2019-03-19 01:12:38 +00:00
{ " - " , cfun_it_s64_sub } ,
2020-01-23 00:59:41 +00:00
{ " r- " , cfun_it_s64_subi } ,
2019-03-19 01:12:38 +00:00
{ " * " , cfun_it_s64_mul } ,
2020-01-23 00:59:41 +00:00
{ " r* " , cfun_it_s64_mul } ,
2019-03-19 01:12:38 +00:00
{ " / " , cfun_it_s64_div } ,
2020-01-23 00:59:41 +00:00
{ " r/ " , cfun_it_s64_divi } ,
2020-01-24 00:54:30 +00:00
{ " mod " , cfun_it_s64_mod } ,
2023-05-11 23:15:37 +00:00
{ " rmod " , cfun_it_s64_modi } ,
2020-01-24 00:54:30 +00:00
{ " % " , cfun_it_s64_rem } ,
2023-05-11 23:15:37 +00:00
{ " r% " , cfun_it_s64_remi } ,
2019-03-19 01:12:38 +00:00
{ " & " , cfun_it_s64_and } ,
2020-01-23 00:59:41 +00:00
{ " r& " , cfun_it_s64_and } ,
2019-03-19 01:12:38 +00:00
{ " | " , cfun_it_s64_or } ,
2020-01-23 00:59:41 +00:00
{ " r| " , cfun_it_s64_or } ,
2019-03-19 01:12:38 +00:00
{ " ^ " , cfun_it_s64_xor } ,
2020-01-23 00:59:41 +00:00
{ " r^ " , cfun_it_s64_xor } ,
2019-03-19 01:12:38 +00:00
{ " << " , cfun_it_s64_lshift } ,
{ " >> " , cfun_it_s64_rshift } ,
2020-06-04 19:27:36 +00:00
{ " compare " , cfun_it_s64_compare } ,
2019-03-19 01:12:38 +00:00
{ NULL , NULL }
} ;
static JanetMethod it_u64_methods [ ] = {
{ " + " , cfun_it_u64_add } ,
2020-01-23 00:59:41 +00:00
{ " r+ " , cfun_it_u64_add } ,
2019-03-19 01:12:38 +00:00
{ " - " , cfun_it_u64_sub } ,
2020-01-23 00:59:41 +00:00
{ " r- " , cfun_it_u64_subi } ,
2019-03-19 01:12:38 +00:00
{ " * " , cfun_it_u64_mul } ,
2020-01-23 00:59:41 +00:00
{ " r* " , cfun_it_u64_mul } ,
2019-03-19 01:12:38 +00:00
{ " / " , cfun_it_u64_div } ,
2020-01-23 00:59:41 +00:00
{ " r/ " , cfun_it_u64_divi } ,
2020-01-24 00:54:30 +00:00
{ " mod " , cfun_it_u64_mod } ,
2023-05-11 23:15:37 +00:00
{ " rmod " , cfun_it_u64_modi } ,
2019-03-19 01:12:38 +00:00
{ " % " , cfun_it_u64_mod } ,
2023-05-11 23:15:37 +00:00
{ " r% " , cfun_it_u64_modi } ,
2019-03-19 01:12:38 +00:00
{ " & " , cfun_it_u64_and } ,
2020-01-23 00:59:41 +00:00
{ " r& " , cfun_it_u64_and } ,
2019-03-19 01:12:38 +00:00
{ " | " , cfun_it_u64_or } ,
2020-01-23 00:59:41 +00:00
{ " r| " , cfun_it_u64_or } ,
2019-03-19 01:12:38 +00:00
{ " ^ " , cfun_it_u64_xor } ,
2020-01-23 00:59:41 +00:00
{ " r^ " , cfun_it_u64_xor } ,
2019-03-19 01:12:38 +00:00
{ " << " , cfun_it_u64_lshift } ,
{ " >> " , cfun_it_u64_rshift } ,
2020-06-04 19:27:36 +00:00
{ " compare " , cfun_it_u64_compare } ,
2019-03-19 01:12:38 +00:00
{ NULL , NULL }
} ;
2021-01-12 05:14:07 +00:00
static Janet janet_int64_next ( void * p , Janet key ) {
( void ) p ;
return janet_nextmethod ( it_s64_methods , key ) ;
}
static Janet janet_uint64_next ( void * p , Janet key ) {
( void ) p ;
return janet_nextmethod ( it_u64_methods , key ) ;
}
2019-12-09 03:50:33 +00:00
static int it_s64_get ( void * p , Janet key , Janet * out ) {
2019-03-19 01:12:38 +00:00
( void ) p ;
if ( ! janet_checktype ( key , JANET_KEYWORD ) )
2019-12-09 03:50:33 +00:00
return 0 ;
2019-12-10 00:45:05 +00:00
return janet_getmethod ( janet_unwrap_keyword ( key ) , it_s64_methods , out ) ;
2019-03-19 01:12:38 +00:00
}
2019-12-09 03:50:33 +00:00
static int it_u64_get ( void * p , Janet key , Janet * out ) {
2019-03-19 01:12:38 +00:00
( void ) p ;
if ( ! janet_checktype ( key , JANET_KEYWORD ) )
2019-12-09 03:50:33 +00:00
return 0 ;
2019-12-10 00:45:05 +00:00
return janet_getmethod ( janet_unwrap_keyword ( key ) , it_u64_methods , out ) ;
2019-03-19 01:12:38 +00:00
}
/* Module entry point */
void janet_lib_inttypes ( JanetTable * env ) {
2021-07-26 12:52:02 +00:00
JanetRegExt it_cfuns [ ] = {
JANET_CORE_REG ( " int/s64 " , cfun_it_s64_new ) ,
JANET_CORE_REG ( " int/u64 " , cfun_it_u64_new ) ,
2022-02-20 21:16:52 +00:00
JANET_CORE_REG ( " int/to-number " , cfun_to_number ) ,
2022-03-04 13:48:54 +00:00
JANET_CORE_REG ( " int/to-bytes " , cfun_to_bytes ) ,
2021-07-26 12:52:02 +00:00
JANET_REG_END
} ;
janet_core_cfuns_ext ( env , NULL , it_cfuns ) ;
2020-03-14 15:12:47 +00:00
janet_register_abstract_type ( & janet_s64_type ) ;
janet_register_abstract_type ( & janet_u64_type ) ;
2019-03-19 01:12:38 +00:00
}
# endif