diff --git a/.gitignore b/.gitignore index ec1281e..1968658 100644 --- a/.gitignore +++ b/.gitignore @@ -36,3 +36,5 @@ utils_src/readprintwc/out *.bak src/io/fopen + +hi\.* diff --git a/src/arith/integer.c b/src/arith/integer.c index 1195c53..48992ca 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -12,12 +12,6 @@ #include #include #include -/* safe_iop, as available in the Ubuntu repository, is this one: - * https://code.google.com/archive/p/safe-iop/wikis/README.wiki - * which is installed as `libsafe-iop-dev`. There is an alternate - * implementation here: https://github.com/redpig/safe-iop/ - * which shares the same version number but is not compatible. */ -#include /* * wide characters */ diff --git a/src/init.c b/src/init.c index 47ba772..275cc40 100644 --- a/src/init.c +++ b/src/init.c @@ -26,10 +26,12 @@ #include "intern.h" #include "io.h" #include "lispops.h" +#include "map.h" #include "meta.h" #include "peano.h" #include "print.h" #include "repl.h" +#include "time.h" // extern char *optarg; /* defined in unistd.h */ @@ -67,7 +69,7 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable ) n ), NIL ) ); - deep_bind( n, make_special( NIL, executable ) ); + deep_bind( n, make_special( meta, executable ) ); } /** @@ -195,6 +197,7 @@ int main( int argc, char *argv[] ) { bind_function( L"eval", &lisp_eval ); bind_function( L"exception", &lisp_exception ); bind_function( L"inspect", &lisp_inspect ); + bind_function( L"make-map", &lisp_make_map); bind_function( L"meta", &lisp_metadata ); bind_function( L"metadata", &lisp_metadata ); bind_function( L"multiply", &lisp_multiply ); @@ -212,6 +215,7 @@ int main( int argc, char *argv[] ) { bind_function( L"source", &lisp_source ); bind_function( L"subtract", &lisp_subtract ); bind_function( L"throw", &lisp_exception ); + bind_function( L"time", &lisp_time ); bind_function( L"type", &lisp_type ); bind_function( L"+", &lisp_add ); bind_function( L"*", &lisp_multiply ); diff --git a/src/io/io.c b/src/io/io.c index dd41190..7e6a3c0 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -15,6 +15,7 @@ #include #include #include +#include #include #include #include @@ -266,16 +267,8 @@ struct cons_pointer add_meta_string( struct cons_pointer meta, wchar_t *key, char *value ) { value = trim( value); wchar_t buffer[strlen( value ) + 1]; - /* \todo something goes wrong here: I sometimes get junk characters on the - * end of the string. */ mbstowcs( buffer, value, strlen( value ) + 1 ); - /* hack: get rid of 32766 as a junk character, to see whether there are - * others. - for (int i = 0; i < wcslen( buffer); i++) { - if (buffer[i] == (wchar_t)32766) buffer[i] = (wchar_t)0; - } */ - return make_cons( make_cons( c_string_to_lisp_keyword( key ), c_string_to_lisp_string( buffer ) ), meta ); } @@ -285,9 +278,11 @@ struct cons_pointer add_meta_time( struct cons_pointer meta, wchar_t *key, /* I don't yet have a concept of a date-time object, which is a * bit of an oversight! */ char datestring[256]; - struct tm *tm = localtime( value ); - strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ), tm ); + strftime( datestring, + sizeof( datestring ), + nl_langinfo( D_T_FMT ), + localtime( value ) ); return add_meta_string( meta, key, datestring ); } diff --git a/src/io/print.c b/src/io/print.c index 854c63a..343160e 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -20,8 +20,12 @@ #include "conspage.h" #include "consspaceobject.h" #include "integer.h" +#include "intern.h" +#include "map.h" #include "stack.h" #include "print.h" +#include "time.h" +#include "vectorspace.h" /** * Whether or not we colorise output. @@ -97,7 +101,43 @@ void print_list( URL_FILE * output, struct cons_pointer pointer ) { } else { url_fputws( L")", output ); } +} + +void print_map( URL_FILE * output, struct cons_pointer map) { + if ( vectorpointp( map)) { + struct vector_space_object *vso = pointer_to_vso( map); + + if ( mapp( vso ) ) { + url_fputwc( btowc( '{' ), output ); + + for ( struct cons_pointer ks = keys( map); + !nilp( ks); ks = c_cdr( ks)) { + print( output, c_car( ks)); + url_fputwc( btowc( ' ' ), output ); + print( output, c_assoc( c_car( ks), map)); + + if ( !nilp( c_cdr( ks))) { + url_fputws( L", ", output ); + } + } + + url_fputwc( btowc( '}' ), output ); + } + } +} + + +void print_vso( URL_FILE * output, struct cons_pointer pointer) { + struct vector_space_object *vso = + pointer2cell( pointer ).payload.vectorp.address; + + switch ( vso->header.tag.value) { + case MAPTV: + print_map( output, pointer); + break; + // \todo: others. + } } /** @@ -122,7 +162,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { dump_stack_trace( output, pointer ); break; case FUNCTIONTV: - url_fwprintf( output, L"" ); + url_fputws( L"', output); break; case INTEGERTV:{ struct cons_pointer s = integer_to_string( pointer, 10 ); @@ -174,7 +216,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print( output, cell.payload.ratio.divisor ); break; case READTV: - url_fwprintf( output, L"" ); + url_fwprintf( output, L"', output); break; case REALTV: /* \todo using the C heap is a bad plan because it will fragment. @@ -208,13 +252,23 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print_string_contents( output, pointer ); break; case SPECIALTV: - url_fwprintf( output, L"" ); + url_fwprintf( output, L"', output); + break; + case TIMETV: + print_string(output, time_to_string( pointer)); break; case TRUETV: url_fwprintf( output, L"t" ); break; + case VECTORPOINTTV: + print_vso( output, pointer); + break; case WRITETV: - url_fwprintf( output, L"" ); + url_fwprintf( output, L"', output); break; default: fwprintf( stderr, diff --git a/src/io/read.c b/src/io/read.c index c49d043..4f3ed0a 100644 --- a/src/io/read.c +++ b/src/io/read.c @@ -24,6 +24,7 @@ #include "intern.h" #include "io.h" #include "lispops.h" +#include "map.h" #include "peano.h" #include "print.h" #include "ratio.h" @@ -44,6 +45,9 @@ struct cons_pointer read_number( struct stack_frame *frame, struct cons_pointer read_list( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE * input, wint_t initial ); +struct cons_pointer read_map( struct stack_frame *frame, + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag, wint_t initial ); @@ -100,6 +104,10 @@ struct cons_pointer read_continuation( struct stack_frame *frame, read_list( frame, frame_pointer, input, url_fgetwc( input ) ); break; + case '{': + result = read_map( frame, frame_pointer, input, + url_fgetwc( input ) ); + break; case '"': result = read_string( input, url_fgetwc( input ) ); break; @@ -126,9 +134,10 @@ struct cons_pointer read_continuation( struct stack_frame *frame, } else if ( iswblank( next ) ) { /* dotted pair. \todo this isn't right, we * really need to backtrack up a level. */ - result = - read_continuation( frame, frame_pointer, input, + result = read_continuation( frame, frame_pointer, input, url_fgetwc( input ) ); + debug_print( L"read_continuation: dotted pair; read cdr ", + DEBUG_IO); } else { read_symbol_or_key( input, SYMBOLTAG, c ); } @@ -275,19 +284,38 @@ struct cons_pointer read_number( struct stack_frame *frame, * left parenthesis. */ struct cons_pointer read_list( struct stack_frame *frame, - struct cons_pointer frame_pointer, - URL_FILE * input, wint_t initial ) { + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ) { struct cons_pointer result = NIL; + wint_t c; + if ( initial != ')' ) { debug_printf( DEBUG_IO, - L"read_list starting '%C' (%d)\n", initial, initial ); + L"read_list starting '%C' (%d)\n", initial, initial ); struct cons_pointer car = read_continuation( frame, frame_pointer, input, - initial ); - result = - make_cons( car, - read_list( frame, frame_pointer, input, - url_fgetwc( input ) ) ); + initial ); + + /* skip whitespace */ + for (c = url_fgetwc( input ); + iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input )); + + if ( c == L'.') { + /* might be a dotted pair; indeed, if we rule out numbers with + * initial periods, it must be a dotted pair. \todo Ought to check, + * howerver, that there's only one form after the period. */ + result = + make_cons( car, + c_car( read_list( frame, + frame_pointer, + input, + url_fgetwc( input ) ) ) ); + } else { + result = + make_cons( car, + read_list( frame, frame_pointer, input, c ) ); + } } else { debug_print( L"End of list detected\n", DEBUG_IO ); } @@ -295,6 +323,37 @@ struct cons_pointer read_list( struct stack_frame *frame, return result; } + +struct cons_pointer read_map( struct stack_frame *frame, + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ) { + struct cons_pointer result = make_empty_map( NIL); + wint_t c = initial; + + while ( c != L'}' ) { + struct cons_pointer key = + read_continuation( frame, frame_pointer, input, c ); + + /* skip whitespace */ + for (c = url_fgetwc( input ); + iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input )); + + struct cons_pointer value = + read_continuation( frame, frame_pointer, input, c ); + + /* skip commaa and whitespace at this point. */ + for (c = url_fgetwc( input ); + c == L',' || iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input )); + + result = merge_into_map( result, make_cons( make_cons( key, value), NIL)); + } + + return result; +} + + /** * Read a string. This means either a string delimited by double quotes * (is_quoted == true), in which case it may contain whitespace but may diff --git a/src/memory/consspaceobject.c b/src/memory/consspaceobject.c index aa1cece..344f4ae 100644 --- a/src/memory/consspaceobject.c +++ b/src/memory/consspaceobject.c @@ -96,18 +96,41 @@ struct cons_pointer c_car( struct cons_pointer arg ) { } /** - * Implementation of cdr in C. If arg is not a cons, does not error but returns nil. + * Implementation of cdr in C. If arg is not a sequence, does not error but returns nil. */ struct cons_pointer c_cdr( struct cons_pointer arg ) { struct cons_pointer result = NIL; - if ( consp( arg ) || stringp( arg ) || symbolp( arg ) ) { + struct cons_space_object cell = pointer2cell( arg ); + + switch (cell.tag.value) { + case CONSTV: result = pointer2cell( arg ).payload.cons.cdr; + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + result = pointer2cell( arg ).payload.string.cdr; + break; } return result; } +/** + * Implementation of `length` in C. If arg is not a cons, does not error but returns 0. + */ +int c_length( struct cons_pointer arg) { + int result = 0; + + for (struct cons_pointer c = arg; !nilp(c); c = c_cdr(c)) { + result ++; + } + + return result; +} + + /** * Construct a cons cell from this pair of pointers. */ diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 1bbbcd1..9197172 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -193,6 +193,16 @@ */ #define SYMBOLTV 1112365395 +/** + * A time stamp. + */ +#define TIMETAG "TIME" + +/** + * The string `TIME`, considered as an `unsigned int`. + */ +#define TIMETV 1162692948 + /** * The special cons cell at address {0,1} which is canonically different * from NIL. @@ -344,13 +354,18 @@ * (there should only be one of these so it's slightly redundant). * Also note that anything that is not NIL is truthy. */ -#define tp(conspoint) (checktag(conspoint,TRUETAG)) +#define tp(conspoint) (check_tag(conspoint,TRUETAG)) + +/** + * true if `conspoint` points to a time cell, else false. + */ +#define timep(conspoint) (check_tag(conspoint,TIMETAG)) /** * true if `conspoint` points to something that is truthy, i.e. * anything but NIL. */ -#define truep(conspoint) (!checktag(conspoint,NILTAG)) +#define truep(conspoint) (!check_tag(conspoint,NILTAG)) /** * An indirect pointer to a cons cell @@ -531,6 +546,15 @@ struct string_payload { struct cons_pointer cdr; }; +/** + * The payload of a time cell: an unsigned 128 bit value representing micro- + * seconds since the estimated date of the Big Bang (actually, for + * convenience, 14Bn years before 1st Jan 1970 (the UNIX epoch)) + */ +struct time_payload { + unsigned __int128 value; +}; + /** * payload of a vector pointer cell. */ @@ -616,6 +640,10 @@ struct cons_space_object { * if tag == STRINGTAG || tag == SYMBOLTAG */ struct string_payload string; + /** + * if tag == TIMETAG + */ + struct time_payload time; /** * if tag == TRUETAG; we'll treat the special cell T as just a cons */ @@ -639,6 +667,8 @@ struct cons_pointer c_car( struct cons_pointer arg ); struct cons_pointer c_cdr( struct cons_pointer arg ); +int c_length( struct cons_pointer arg); + struct cons_pointer make_cons( struct cons_pointer car, struct cons_pointer cdr ); diff --git a/src/memory/dump.c b/src/memory/dump.c index 28bd36a..074d1c4 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -21,6 +21,8 @@ #include "conspage.h" #include "consspaceobject.h" #include "debug.h" +#include "intern.h" +#include "map.h" #include "print.h" #include "stack.h" #include "vectorspace.h" @@ -146,6 +148,9 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { case STACKFRAMETV: dump_frame( output, pointer ); break; + case MAPTV: + dump_map( output, pointer); + break; } } break; diff --git a/src/memory/lookup3.c b/src/memory/lookup3.c new file mode 100644 index 0000000..006d513 --- /dev/null +++ b/src/memory/lookup3.c @@ -0,0 +1,1001 @@ +/* +------------------------------------------------------------------------------- +lookup3.c, by Bob Jenkins, May 2006, Public Domain. + +These are functions for producing 32-bit hashes for hash table lookup. +hashword(), hashlittle(), hashlittle2(), hashbig(), mix(), and final() +are externally useful functions. Routines to test the hash are included +if SELF_TEST is defined. You can use this free for any purpose. It's in +the public domain. It has no warranty. + +You probably want to use hashlittle(). hashlittle() and hashbig() +hash byte arrays. hashlittle() is is faster than hashbig() on +little-endian machines. Intel and AMD are little-endian machines. +On second thought, you probably want hashlittle2(), which is identical to +hashlittle() except it returns two 32-bit hashes for the price of one. +You could implement hashbig2() if you wanted but I haven't bothered here. + +If you want to find a hash of, say, exactly 7 integers, do + a = i1; b = i2; c = i3; + mix(a,b,c); + a += i4; b += i5; c += i6; + mix(a,b,c); + a += i7; + final(a,b,c); +then use c as the hash value. If you have a variable length array of +4-byte integers to hash, use hashword(). If you have a byte array (like +a character string), use hashlittle(). If you have several byte arrays, or +a mix of things, see the comments above hashlittle(). + +Why is this so big? I read 12 bytes at a time into 3 4-byte integers, +then mix those integers. This is fast (you can do a lot more thorough +mixing with 12*3 instructions on 3 integers than you can with 3 instructions +on 1 byte), but shoehorning those bytes into integers efficiently is messy. +------------------------------------------------------------------------------- +*/ +// #define SELF_TEST 1 + +#include /* defines printf for tests */ +#include /* defines time_t for timings in the test */ +#include /* defines uint32_t etc */ +#include /* attempt to define endianness */ +#ifdef linux +# include /* attempt to define endianness */ +#endif + +/* + * My best guess at if you are big-endian or little-endian. This may + * need adjustment. + */ +#if (defined(__BYTE_ORDER) && defined(__LITTLE_ENDIAN) && \ + __BYTE_ORDER == __LITTLE_ENDIAN) || \ + (defined(i386) || defined(__i386__) || defined(__i486__) || \ + defined(__i586__) || defined(__i686__) || defined(vax) || defined(MIPSEL)) +# define HASH_LITTLE_ENDIAN 1 +# define HASH_BIG_ENDIAN 0 +#elif (defined(__BYTE_ORDER) && defined(__BIG_ENDIAN) && \ + __BYTE_ORDER == __BIG_ENDIAN) || \ + (defined(sparc) || defined(POWERPC) || defined(mc68000) || defined(sel)) +# define HASH_LITTLE_ENDIAN 0 +# define HASH_BIG_ENDIAN 1 +#else +# define HASH_LITTLE_ENDIAN 0 +# define HASH_BIG_ENDIAN 0 +#endif + +#define hashsize(n) ((uint32_t)1<<(n)) +#define hashmask(n) (hashsize(n)-1) +#define rot(x,k) (((x)<<(k)) | ((x)>>(32-(k)))) + +/* +------------------------------------------------------------------------------- +mix -- mix 3 32-bit values reversibly. + +This is reversible, so any information in (a,b,c) before mix() is +still in (a,b,c) after mix(). + +If four pairs of (a,b,c) inputs are run through mix(), or through +mix() in reverse, there are at least 32 bits of the output that +are sometimes the same for one pair and different for another pair. +This was tested for: +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +Some k values for my "a-=c; a^=rot(c,k); c+=b;" arrangement that +satisfy this are + 4 6 8 16 19 4 + 9 15 3 18 27 15 + 14 9 3 7 17 3 +Well, "9 15 3 18 27 15" didn't quite get 32 bits diffing +for "differ" defined as + with a one-bit base and a two-bit delta. I +used http://burtleburtle.net/bob/hash/avalanche.html to choose +the operations, constants, and arrangements of the variables. + +This does not achieve avalanche. There are input bits of (a,b,c) +that fail to affect some output bits of (a,b,c), especially of a. The +most thoroughly mixed value is c, but it doesn't really even achieve +avalanche in c. + +This allows some parallelism. Read-after-writes are good at doubling +the number of bits affected, so the goal of mixing pulls in the opposite +direction as the goal of parallelism. I did what I could. Rotates +seem to cost as much as shifts on every machine I could lay my hands +on, and rotates are much kinder to the top and bottom bits, so I used +rotates. +------------------------------------------------------------------------------- +*/ +#define mix(a,b,c) \ +{ \ + a -= c; a ^= rot(c, 4); c += b; \ + b -= a; b ^= rot(a, 6); a += c; \ + c -= b; c ^= rot(b, 8); b += a; \ + a -= c; a ^= rot(c,16); c += b; \ + b -= a; b ^= rot(a,19); a += c; \ + c -= b; c ^= rot(b, 4); b += a; \ +} + +/* +------------------------------------------------------------------------------- +final -- final mixing of 3 32-bit values (a,b,c) into c + +Pairs of (a,b,c) values differing in only a few bits will usually +produce values of c that look totally different. This was tested for +* pairs that differed by one bit, by two bits, in any combination + of top bits of (a,b,c), or in any combination of bottom bits of + (a,b,c). +* "differ" is defined as +, -, ^, or ~^. For + and -, I transformed + the output delta to a Gray code (a^(a>>1)) so a string of 1's (as + is commonly produced by subtraction) look like a single 1-bit + difference. +* the base values were pseudorandom, all zero but one bit set, or + all zero plus a counter that starts at zero. + +These constants passed: + 14 11 25 16 4 14 24 + 12 14 25 16 4 14 24 +and these came close: + 4 8 15 26 3 22 24 + 10 8 15 26 3 22 24 + 11 8 15 26 3 22 24 +------------------------------------------------------------------------------- +*/ +#define final(a,b,c) \ +{ \ + c ^= b; c -= rot(b,14); \ + a ^= c; a -= rot(c,11); \ + b ^= a; b -= rot(a,25); \ + c ^= b; c -= rot(b,16); \ + a ^= c; a -= rot(c,4); \ + b ^= a; b -= rot(a,14); \ + c ^= b; c -= rot(b,24); \ +} + +/* +-------------------------------------------------------------------- + This works on all machines. To be useful, it requires + -- that the key be an array of uint32_t's, and + -- that the length be the number of uint32_t's in the key + + The function hashword() is identical to hashlittle() on little-endian + machines, and identical to hashbig() on big-endian machines, + except that the length has to be measured in uint32_ts rather than in + bytes. hashlittle() is more complicated than hashword() only because + hashlittle() has to dance around fitting the key bytes into registers. +-------------------------------------------------------------------- +*/ +uint32_t hashword( +const uint32_t *k, /* the key, an array of uint32_t values */ +size_t length, /* the length of the key, in uint32_ts */ +uint32_t initval) /* the previous hash, or an arbitrary value */ +{ + uint32_t a,b,c; + + /* Set up the internal state */ + a = b = c = 0xdeadbeef + (((uint32_t)length)<<2) + initval; + + /*------------------------------------------------- handle most of the key */ + while (length > 3) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 3; + k += 3; + } + + /*------------------------------------------- handle the last 3 uint32_t's */ + switch(length) /* all the case statements fall through */ + { + case 3 : c+=k[2]; + case 2 : b+=k[1]; + case 1 : a+=k[0]; + final(a,b,c); + case 0: /* case 0: nothing left to add */ + break; + } + /*------------------------------------------------------ report the result */ + return c; +} + + +/* +-------------------------------------------------------------------- +hashword2() -- same as hashword(), but take two seeds and return two +32-bit values. pc and pb must both be nonnull, and *pc and *pb must +both be initialized with seeds. If you pass in (*pb)==0, the output +(*pc) will be the same as the return value from hashword(). +-------------------------------------------------------------------- +*/ +void hashword2 ( +const uint32_t *k, /* the key, an array of uint32_t values */ +size_t length, /* the length of the key, in uint32_ts */ +uint32_t *pc, /* IN: seed OUT: primary hash value */ +uint32_t *pb) /* IN: more seed OUT: secondary hash value */ +{ + uint32_t a,b,c; + + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ((uint32_t)(length<<2)) + *pc; + c += *pb; + + /*------------------------------------------------- handle most of the key */ + while (length > 3) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 3; + k += 3; + } + + /*------------------------------------------- handle the last 3 uint32_t's */ + switch(length) /* all the case statements fall through */ + { + case 3 : c+=k[2]; + case 2 : b+=k[1]; + case 1 : a+=k[0]; + final(a,b,c); + case 0: /* case 0: nothing left to add */ + break; + } + /*------------------------------------------------------ report the result */ + *pc=c; *pb=b; +} + + +/* +------------------------------------------------------------------------------- +hashlittle() -- hash a variable-length key into a 32-bit value + k : the key (the unaligned variable-length array of bytes) + length : the length of the key, counting by bytes + initval : can be any 4-byte value +Returns a 32-bit value. Every bit of the key affects every bit of +the return value. Two keys differing by one or two bits will have +totally different hash values. + +The best hash table sizes are powers of 2. There is no need to do +mod a prime (mod is sooo slow!). If you need less than 32 bits, +use a bitmask. For example, if you need only 10 bits, do + h = (h & hashmask(10)); +In which case, the hash table should have hashsize(10) elements. + +If you are hashing n strings (uint8_t **)k, do it like this: + for (i=0, h=0; i 12) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; + case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; + case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=k[1]&0xffffff; a+=k[0]; break; + case 6 : b+=k[1]&0xffff; a+=k[0]; break; + case 5 : b+=k[1]&0xff; a+=k[0]; break; + case 4 : a+=k[0]; break; + case 3 : a+=k[0]&0xffffff; break; + case 2 : a+=k[0]&0xffff; break; + case 1 : a+=k[0]&0xff; break; + case 0 : return c; /* zero length strings require no mixing */ + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]; break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ + case 1 : a+=k8[0]; break; + case 0 : return c; + } + +#endif /* !valgrind */ + + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; + + /*--------------- all but last block: aligned reads and different mixing */ + while (length > 12) + { + a += k[0] + (((uint32_t)k[1])<<16); + b += k[2] + (((uint32_t)k[3])<<16); + c += k[4] + (((uint32_t)k[5])<<16); + mix(a,b,c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) block */ + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[4]+(((uint32_t)k[5])<<16); + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=k[4]; + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=k[2]; + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=k[0]; + break; + case 1 : a+=k8[0]; + break; + case 0 : return c; /* zero length requires no mixing */ + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length > 12) + { + a += k[0]; + a += ((uint32_t)k[1])<<8; + a += ((uint32_t)k[2])<<16; + a += ((uint32_t)k[3])<<24; + b += k[4]; + b += ((uint32_t)k[5])<<8; + b += ((uint32_t)k[6])<<16; + b += ((uint32_t)k[7])<<24; + c += k[8]; + c += ((uint32_t)k[9])<<8; + c += ((uint32_t)k[10])<<16; + c += ((uint32_t)k[11])<<24; + mix(a,b,c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch(length) /* all the case statements fall through */ + { + case 12: c+=((uint32_t)k[11])<<24; + case 11: c+=((uint32_t)k[10])<<16; + case 10: c+=((uint32_t)k[9])<<8; + case 9 : c+=k[8]; + case 8 : b+=((uint32_t)k[7])<<24; + case 7 : b+=((uint32_t)k[6])<<16; + case 6 : b+=((uint32_t)k[5])<<8; + case 5 : b+=k[4]; + case 4 : a+=((uint32_t)k[3])<<24; + case 3 : a+=((uint32_t)k[2])<<16; + case 2 : a+=((uint32_t)k[1])<<8; + case 1 : a+=k[0]; + break; + case 0 : return c; + } + } + + final(a,b,c); + return c; +} + + +/* + * hashlittle2: return 2 32-bit hash values + * + * This is identical to hashlittle(), except it returns two 32-bit hash + * values instead of just one. This is good enough for hash table + * lookup with 2^^64 buckets, or if you want a second hash if you're not + * happy with the first, or if you want a probably-unique 64-bit ID for + * the key. *pc is better mixed than *pb, so use *pc first. If you want + * a 64-bit value do something like "*pc + (((uint64_t)*pb)<<32)". + */ +void hashlittle2( + const void *key, /* the key to hash */ + size_t length, /* length of the key */ + uint32_t *pc, /* IN: primary initval, OUT: primary hash */ + uint32_t *pb) /* IN: secondary initval, OUT: secondary hash */ +{ + uint32_t a,b,c; /* internal state */ + union { const void *ptr; size_t i; } u; /* needed for Mac Powerbook G4 */ + + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ((uint32_t)length) + *pc; + c += *pb; + + u.ptr = key; + if (HASH_LITTLE_ENDIAN && ((u.i & 0x3) == 0)) { + const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ + const uint8_t *k8; + + /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ + while (length > 12) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]&0xffffff" actually reads beyond the end of the string, but + * then masks off the part it's not allowed to read. Because the + * string is aligned, the masked-off tail is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=k[2]&0xffffff; b+=k[1]; a+=k[0]; break; + case 10: c+=k[2]&0xffff; b+=k[1]; a+=k[0]; break; + case 9 : c+=k[2]&0xff; b+=k[1]; a+=k[0]; break; + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=k[1]&0xffffff; a+=k[0]; break; + case 6 : b+=k[1]&0xffff; a+=k[0]; break; + case 5 : b+=k[1]&0xff; a+=k[0]; break; + case 4 : a+=k[0]; break; + case 3 : a+=k[0]&0xffffff; break; + case 2 : a+=k[0]&0xffff; break; + case 1 : a+=k[0]&0xff; break; + case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=((uint32_t)k8[9])<<8; /* fall through */ + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=((uint32_t)k8[5])<<8; /* fall through */ + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]; break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=((uint32_t)k8[1])<<8; /* fall through */ + case 1 : a+=k8[0]; break; + case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ + } + +#endif /* !valgrind */ + + } else if (HASH_LITTLE_ENDIAN && ((u.i & 0x1) == 0)) { + const uint16_t *k = (const uint16_t *)key; /* read 16-bit chunks */ + const uint8_t *k8; + + /*--------------- all but last block: aligned reads and different mixing */ + while (length > 12) + { + a += k[0] + (((uint32_t)k[1])<<16); + b += k[2] + (((uint32_t)k[3])<<16); + c += k[4] + (((uint32_t)k[5])<<16); + mix(a,b,c); + length -= 12; + k += 6; + } + + /*----------------------------- handle the last (probably partial) block */ + k8 = (const uint8_t *)k; + switch(length) + { + case 12: c+=k[4]+(((uint32_t)k[5])<<16); + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 11: c+=((uint32_t)k8[10])<<16; /* fall through */ + case 10: c+=k[4]; + b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 9 : c+=k8[8]; /* fall through */ + case 8 : b+=k[2]+(((uint32_t)k[3])<<16); + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 7 : b+=((uint32_t)k8[6])<<16; /* fall through */ + case 6 : b+=k[2]; + a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 5 : b+=k8[4]; /* fall through */ + case 4 : a+=k[0]+(((uint32_t)k[1])<<16); + break; + case 3 : a+=((uint32_t)k8[2])<<16; /* fall through */ + case 2 : a+=k[0]; + break; + case 1 : a+=k8[0]; + break; + case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ + } + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length > 12) + { + a += k[0]; + a += ((uint32_t)k[1])<<8; + a += ((uint32_t)k[2])<<16; + a += ((uint32_t)k[3])<<24; + b += k[4]; + b += ((uint32_t)k[5])<<8; + b += ((uint32_t)k[6])<<16; + b += ((uint32_t)k[7])<<24; + c += k[8]; + c += ((uint32_t)k[9])<<8; + c += ((uint32_t)k[10])<<16; + c += ((uint32_t)k[11])<<24; + mix(a,b,c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch(length) /* all the case statements fall through */ + { + case 12: c+=((uint32_t)k[11])<<24; + case 11: c+=((uint32_t)k[10])<<16; + case 10: c+=((uint32_t)k[9])<<8; + case 9 : c+=k[8]; + case 8 : b+=((uint32_t)k[7])<<24; + case 7 : b+=((uint32_t)k[6])<<16; + case 6 : b+=((uint32_t)k[5])<<8; + case 5 : b+=k[4]; + case 4 : a+=((uint32_t)k[3])<<24; + case 3 : a+=((uint32_t)k[2])<<16; + case 2 : a+=((uint32_t)k[1])<<8; + case 1 : a+=k[0]; + break; + case 0 : *pc=c; *pb=b; return; /* zero length strings require no mixing */ + } + } + + final(a,b,c); + *pc=c; *pb=b; +} + + + +/* + * hashbig(): + * This is the same as hashword() on big-endian machines. It is different + * from hashlittle() on all machines. hashbig() takes advantage of + * big-endian byte ordering. + */ +uint32_t hashbig( const void *key, size_t length, uint32_t initval) +{ + uint32_t a,b,c; + union { const void *ptr; size_t i; } u; /* to cast key to (size_t) happily */ + + /* Set up the internal state */ + a = b = c = 0xdeadbeef + ((uint32_t)length) + initval; + + u.ptr = key; + if (HASH_BIG_ENDIAN && ((u.i & 0x3) == 0)) { + const uint32_t *k = (const uint32_t *)key; /* read 32-bit chunks */ + const uint8_t *k8; + + /*------ all but last block: aligned reads and affect 32 bits of (a,b,c) */ + while (length > 12) + { + a += k[0]; + b += k[1]; + c += k[2]; + mix(a,b,c); + length -= 12; + k += 3; + } + + /*----------------------------- handle the last (probably partial) block */ + /* + * "k[2]<<8" actually reads beyond the end of the string, but + * then shifts out the part it's not allowed to read. Because the + * string is aligned, the illegal read is in the same word as the + * rest of the string. Every machine with memory protection I've seen + * does it on word boundaries, so is OK with this. But VALGRIND will + * still catch it and complain. The masking trick does make the hash + * noticably faster for short strings (like English words). + */ +#ifndef VALGRIND + + switch(length) + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=k[2]&0xffffff00; b+=k[1]; a+=k[0]; break; + case 10: c+=k[2]&0xffff0000; b+=k[1]; a+=k[0]; break; + case 9 : c+=k[2]&0xff000000; b+=k[1]; a+=k[0]; break; + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=k[1]&0xffffff00; a+=k[0]; break; + case 6 : b+=k[1]&0xffff0000; a+=k[0]; break; + case 5 : b+=k[1]&0xff000000; a+=k[0]; break; + case 4 : a+=k[0]; break; + case 3 : a+=k[0]&0xffffff00; break; + case 2 : a+=k[0]&0xffff0000; break; + case 1 : a+=k[0]&0xff000000; break; + case 0 : return c; /* zero length strings require no mixing */ + } + +#else /* make valgrind happy */ + + k8 = (const uint8_t *)k; + switch(length) /* all the case statements fall through */ + { + case 12: c+=k[2]; b+=k[1]; a+=k[0]; break; + case 11: c+=((uint32_t)k8[10])<<8; /* fall through */ + case 10: c+=((uint32_t)k8[9])<<16; /* fall through */ + case 9 : c+=((uint32_t)k8[8])<<24; /* fall through */ + case 8 : b+=k[1]; a+=k[0]; break; + case 7 : b+=((uint32_t)k8[6])<<8; /* fall through */ + case 6 : b+=((uint32_t)k8[5])<<16; /* fall through */ + case 5 : b+=((uint32_t)k8[4])<<24; /* fall through */ + case 4 : a+=k[0]; break; + case 3 : a+=((uint32_t)k8[2])<<8; /* fall through */ + case 2 : a+=((uint32_t)k8[1])<<16; /* fall through */ + case 1 : a+=((uint32_t)k8[0])<<24; break; + case 0 : return c; + } + +#endif /* !VALGRIND */ + + } else { /* need to read the key one byte at a time */ + const uint8_t *k = (const uint8_t *)key; + + /*--------------- all but the last block: affect some 32 bits of (a,b,c) */ + while (length > 12) + { + a += ((uint32_t)k[0])<<24; + a += ((uint32_t)k[1])<<16; + a += ((uint32_t)k[2])<<8; + a += ((uint32_t)k[3]); + b += ((uint32_t)k[4])<<24; + b += ((uint32_t)k[5])<<16; + b += ((uint32_t)k[6])<<8; + b += ((uint32_t)k[7]); + c += ((uint32_t)k[8])<<24; + c += ((uint32_t)k[9])<<16; + c += ((uint32_t)k[10])<<8; + c += ((uint32_t)k[11]); + mix(a,b,c); + length -= 12; + k += 12; + } + + /*-------------------------------- last block: affect all 32 bits of (c) */ + switch(length) /* all the case statements fall through */ + { + case 12: c+=k[11]; + case 11: c+=((uint32_t)k[10])<<8; + case 10: c+=((uint32_t)k[9])<<16; + case 9 : c+=((uint32_t)k[8])<<24; + case 8 : b+=k[7]; + case 7 : b+=((uint32_t)k[6])<<8; + case 6 : b+=((uint32_t)k[5])<<16; + case 5 : b+=((uint32_t)k[4])<<24; + case 4 : a+=k[3]; + case 3 : a+=((uint32_t)k[2])<<8; + case 2 : a+=((uint32_t)k[1])<<16; + case 1 : a+=((uint32_t)k[0])<<24; + break; + case 0 : return c; + } + } + + final(a,b,c); + return c; +} + + +#ifdef SELF_TEST + +/* used for timings */ +void driver1() +{ + uint8_t buf[256]; + uint32_t i; + uint32_t h=0; + time_t a,z; + + time(&a); + for (i=0; i<256; ++i) buf[i] = 'x'; + for (i=0; i<1; ++i) + { + h = hashlittle(&buf[0],1,h); + } + time(&z); + if (z-a > 0) printf("time %d %.8x\n", z-a, h); +} + +/* check that every input bit changes every output bit half the time */ +#define HASHSTATE 1 +#define HASHLEN 1 +#define MAXPAIR 60 +#define MAXLEN 70 +void driver2() +{ + uint8_t qa[MAXLEN+1], qb[MAXLEN+2], *a = &qa[0], *b = &qb[1]; + uint32_t c[HASHSTATE], d[HASHSTATE], i=0, j=0, k, l, m=0, z; + uint32_t e[HASHSTATE],f[HASHSTATE],g[HASHSTATE],h[HASHSTATE]; + uint32_t x[HASHSTATE],y[HASHSTATE]; + uint32_t hlen; + + printf("No more than %d trials should ever be needed \n",MAXPAIR/2); + for (hlen=0; hlen < MAXLEN; ++hlen) + { + z=0; + for (i=0; i>(8-j)); + c[0] = hashlittle(a, hlen, m); + b[i] ^= ((k+1)<>(8-j)); + d[0] = hashlittle(b, hlen, m); + /* check every bit is 1, 0, set, and not set at least once */ + for (l=0; lz) z=k; + if (k==MAXPAIR) + { + printf("Some bit didn't change: "); + printf("%.8x %.8x %.8x %.8x %.8x %.8x ", + e[0],f[0],g[0],h[0],x[0],y[0]); + printf("i %d j %d m %d len %d\n", i, j, m, hlen); + } + if (z==MAXPAIR) goto done; + } + } + } + done: + if (z < MAXPAIR) + { + printf("Mix success %2d bytes %2d initvals ",i,m); + printf("required %d trials\n", z/2); + } + } + printf("\n"); +} + +/* Check for reading beyond the end of the buffer and alignment problems */ +void driver3() +{ + uint8_t buf[MAXLEN+20], *b; + uint32_t len; + uint8_t q[] = "This is the time for all good men to come to the aid of their country..."; + uint32_t h; + uint8_t qq[] = "xThis is the time for all good men to come to the aid of their country..."; + uint32_t i; + uint8_t qqq[] = "xxThis is the time for all good men to come to the aid of their country..."; + uint32_t j; + uint8_t qqqq[] = "xxxThis is the time for all good men to come to the aid of their country..."; + uint32_t ref,x,y; + uint8_t *p; + + printf("Endianness. These lines should all be the same (for values filled in):\n"); + printf("%.8x %.8x %.8x\n", + hashword((const uint32_t *)q, (sizeof(q)-1)/4, 13), + hashword((const uint32_t *)q, (sizeof(q)-5)/4, 13), + hashword((const uint32_t *)q, (sizeof(q)-9)/4, 13)); + p = q; + printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), + hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), + hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), + hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), + hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), + hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); + p = &qq[1]; + printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), + hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), + hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), + hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), + hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), + hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); + p = &qqq[2]; + printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), + hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), + hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), + hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), + hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), + hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); + p = &qqqq[3]; + printf("%.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x %.8x\n", + hashlittle(p, sizeof(q)-1, 13), hashlittle(p, sizeof(q)-2, 13), + hashlittle(p, sizeof(q)-3, 13), hashlittle(p, sizeof(q)-4, 13), + hashlittle(p, sizeof(q)-5, 13), hashlittle(p, sizeof(q)-6, 13), + hashlittle(p, sizeof(q)-7, 13), hashlittle(p, sizeof(q)-8, 13), + hashlittle(p, sizeof(q)-9, 13), hashlittle(p, sizeof(q)-10, 13), + hashlittle(p, sizeof(q)-11, 13), hashlittle(p, sizeof(q)-12, 13)); + printf("\n"); + + /* check that hashlittle2 and hashlittle produce the same results */ + i=47; j=0; + hashlittle2(q, sizeof(q), &i, &j); + if (hashlittle(q, sizeof(q), 47) != i) + printf("hashlittle2 and hashlittle mismatch\n"); + + /* check that hashword2 and hashword produce the same results */ + len = 0xdeadbeef; + i=47, j=0; + hashword2(&len, 1, &i, &j); + if (hashword(&len, 1, 47) != i) + printf("hashword2 and hashword mismatch %x %x\n", + i, hashword(&len, 1, 47)); + + /* check hashlittle doesn't read before or after the ends of the string */ + for (h=0, b=buf+1; h<8; ++h, ++b) + { + for (i=0; i + * Public domain. + */ + +#ifndef __lookup3_h +#define __lookup3_h + +uint32_t hashword( +const uint32_t *k, +size_t length, +uint32_t initval); + +#endif diff --git a/src/memory/map.c b/src/memory/map.c new file mode 100644 index 0000000..cbad3df --- /dev/null +++ b/src/memory/map.c @@ -0,0 +1,289 @@ +/* + * map.c + * + * An immutable hashmap in vector space. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "consspaceobject.h" +#include "conspage.h" +#include "debug.h" +#include "dump.h" +#include "fopen.h" +#include "intern.h" +#include "io.h" +#include "lookup3.h" +#include "map.h" +#include "print.h" +#include "vectorspace.h" + +/* \todo: a lot of this will be inherited by namespaces, regularities and + * homogeneities. Exactly how I don't yet know. */ + +/** + * Get a hash value for this key. + */ +uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key) { + uint32_t result = 0; + int l = c_length(key); + + if (keywordp(key) || stringp(key) || symbolp( key)) { + if ( l > 0) { + uint32_t buffer[l]; + + if (!nilp(f)) { + fputws(L"Custom hashing functions are not yet implemented.\n", stderr); + } + for (int i = 0; i < l; i++) { + buffer[i] = (uint32_t)pointer2cell(key).payload.string.character; + } + + result = hashword( buffer, l, 0); + } + } else { + fputws(L"Hashing is thus far implemented only for keys, strings and symbols.\n", stderr); + } + + return result; +} + +/** + * get the actual map object from this `pointer`, or NULL if + * `pointer` is not a map pointer. + */ +struct map_payload *get_map_payload( struct cons_pointer pointer ) { + struct map_payload *result = NULL; + struct vector_space_object *vso = + pointer2cell( pointer ).payload.vectorp.address; + + if (vectorpointp(pointer) && mapp( vso ) ) { + result = ( struct map_payload * ) &( vso->payload ); + debug_printf( DEBUG_BIND, + L"get_map_payload: all good, returning %p\n", result ); + } else { + debug_print( L"get_map_payload: fail, returning NULL\n", DEBUG_BIND ); + } + + return result; +} + + +/** + * Make an empty immutable map, and return it. + * + * @param hash_function a pointer to a function of one argument, which + * returns an integer; or (more usually) `nil`. + * @return the new map, or NULL if memory is exhausted. + */ +struct cons_pointer make_empty_map( struct cons_pointer hash_function ) { + debug_print( L"Entering make_empty_map\n", DEBUG_BIND ); + struct cons_pointer result = + make_vso( MAPTAG, sizeof( struct map_payload ) ); + + if ( !nilp( result ) ) { + struct map_payload *payload = get_map_payload( result ); + + payload->hash_function = functionp( hash_function) ? hash_function : NIL; + inc_ref(hash_function); + + for ( int i = 0; i < BUCKETSINMAP; i++) { + payload->buckets[i] = NIL; + } + } + + debug_print( L"Leaving make_empty_map\n", DEBUG_BIND ); + return result; +} + + +struct cons_pointer make_duplicate_map( struct cons_pointer parent) { + struct cons_pointer result = NIL; + struct map_payload * parent_payload = get_map_payload(parent); + + if (parent_payload != NULL) { + result = + make_vso( MAPTAG, sizeof( struct map_payload ) ); + + if ( !nilp( result ) ) { + struct map_payload *payload = get_map_payload( result ); + + payload->hash_function = parent_payload->hash_function; + inc_ref(payload->hash_function); + + for ( int i = 0; i < BUCKETSINMAP; i++) { + payload->buckets[i] = parent_payload->buckets[i]; + inc_ref(payload->buckets[i]); + } + } + } + + return result; +} + + +struct cons_pointer bind_in_map( struct cons_pointer parent, + struct cons_pointer key, + struct cons_pointer value) { + struct cons_pointer result = make_duplicate_map(parent); + + if ( !nilp( result)) { + struct map_payload * payload = get_map_payload( result ); + int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP; + + payload->buckets[bucket] = make_cons( + make_cons(key, value), payload->buckets[bucket]); + + inc_ref(payload->buckets[bucket]); + } + + return result; +} + + +struct cons_pointer keys( struct cons_pointer store) { + debug_print( L"Entering keys\n", DEBUG_BIND ); + struct cons_pointer result = NIL; + + struct cons_space_object cell = pointer2cell( store ); + + switch (pointer2cell( store ).tag.value) { + case CONSTV: + for (struct cons_pointer c = store; !nilp(c); c = c_cdr(c)) { + result = make_cons( c_car( c_car( c)), result); + } + break; + case VECTORPOINTTV: { + struct vector_space_object *vso = + pointer2cell( store ).payload.vectorp.address; + + if ( mapp( vso ) ) { + struct map_payload * payload = get_map_payload( store ); + + for (int bucket = 0; bucket < BUCKETSINMAP; bucket++) { + for (struct cons_pointer c = payload->buckets[bucket]; + !nilp(c); c = c_cdr(c)) { + debug_print( L"keys: c is ", DEBUG_BIND); + debug_print_object( c, DEBUG_BIND); + + result = make_cons( c_car( c_car( c)), result); + debug_print( L"; result is ", DEBUG_BIND); + debug_print_object( result, DEBUG_BIND); + debug_println( DEBUG_BIND); + } + } + } + } + break; + } + debug_print( L"keys returning ", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND ); + debug_println( DEBUG_BIND); + + return result; +} + +/** + * Return a new map which represents the merger of `to_merge` into + * `parent`. `parent` must be a map, but `to_merge` may be a map or + * an assoc list. + * + * @param parent a map; + * @param to_merge an association from which key/value pairs will be merged. + * @result a new map, containing all key/value pairs from `to_merge` + * together with those key/value pairs from `parent` whose keys did not + * collide. + */ +struct cons_pointer merge_into_map( struct cons_pointer parent, + struct cons_pointer to_merge) { + debug_print( L"Entering merge_into_map\n", DEBUG_BIND ); + struct cons_pointer result = make_duplicate_map(parent); + + if (!nilp(result)) { + struct map_payload *payload = get_map_payload( result ); + for (struct cons_pointer c = keys(to_merge); + !nilp(c); c = c_cdr(c)) { + struct cons_pointer key = c_car( c); + int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP; + + payload->buckets[bucket] = make_cons( + make_cons( key, c_assoc( key, to_merge)), + payload->buckets[bucket]); + } + } + + debug_print( L"Leaving merge_into_map\n", DEBUG_BIND ); + + return result; +} + + +struct cons_pointer assoc_in_map( struct cons_pointer key, + struct cons_pointer map) { + debug_print( L"Entering assoc_in_map\n", DEBUG_BIND ); + struct cons_pointer result = NIL; + struct map_payload *payload = get_map_payload( map ); + + if (payload != NULL) { + int bucket = get_hash_32(payload->hash_function, key) % BUCKETSINMAP; + result = c_assoc(key, payload->buckets[bucket]); + } + + debug_print( L"assoc_in_map returning ", DEBUG_BIND ); + debug_print_object( result, DEBUG_BIND); + debug_println( DEBUG_BIND); + + return result; +} + + +/** + * Function: create a map initialised with key/value pairs from my + * first argument. + * + * * (make-map) + * * (make-map store) + * + * @param frame the stack frame in which the expression is to be interpreted; + * @param frame_pointer a pointer to my stack_frame. + * @param env the environment in which it is to be intepreted. + * @return a new containing all the key/value pairs from store. + */ +struct cons_pointer +lisp_make_map( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return merge_into_map( make_empty_map( NIL), frame->arg[0]); +} + +/** + * Dump a map to this stream for debugging + * @param output the stream + * @param map_pointer the pointer to the frame + */ +void dump_map( URL_FILE * output, struct cons_pointer map_pointer ) { + struct vector_space_object *vso = + pointer2cell( map_pointer ).payload.vectorp.address; + + if (vectorpointp(map_pointer) && mapp( vso ) ) { + struct map_payload *payload = get_map_payload( map_pointer ); + + if ( payload != NULL ) { + url_fputws( L"Immutable map; hash function: ", output ); + + if (nilp(payload->hash_function)) { + url_fputws( L"default", output); + } else { + dump_object( output, payload->hash_function); + } + + for (int i = 0; i < BUCKETSINMAP; i++) { + url_fwprintf(output, L"\n\tBucket %d: ", i); + print( output, payload->buckets[i]); + } + } + } +} + diff --git a/src/memory/map.h b/src/memory/map.h new file mode 100644 index 0000000..c9b5cfc --- /dev/null +++ b/src/memory/map.h @@ -0,0 +1,96 @@ +/* + * map.h + * + * An immutable hashmap in vector space. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_map_h +#define __psse_map_h + +#include "consspaceobject.h" +#include "conspage.h" + +/** + * macros for the tag of a mutable map. + */ +#define MAPTAG "IMAP" +#define MAPTV 1346456905 + +/** + * Number of buckets in a single tier map. + */ +#define BUCKETSINMAP 256 + +/** + * Maximum number of entries in an association-list bucket. + */ +#define MAXENTRIESINASSOC 16 + +/** + * true if this vector_space_object is a map, else false. + */ +#define mapp( vso) (((struct vector_space_object *)vso)->header.tag.value == MAPTV) + +/** + * The vector-space payload of a map object. Essentially a vector of + * `BUCKETSINMAP` + 1 `cons_pointer`s, but the first one is considered + * special. + */ +struct map_payload { + /** + * There is a default hash function, which is used if `hash_function` is + * `nil` (which it normally should be); and keywords will probably carry + * their own hash values. But it will be possible to override the hash + * function by putting a function of one argument returning an integer + * here. */ + struct cons_pointer hash_function; + + /** + * Obviously the number of buckets in a map is a trade off, and this may need + * tuning - or it may even be necessary to have different sized base maps. The + * idea here is that the value of a bucket is + * + * 1. `nil`; or + * 2. an association list; or + * 3. a map. + * + * All buckets are initially `nil`. Adding a value to a `nil` bucket returns + * a map with a new bucket in the form of an assoc list. Subsequent additions + * cons new key/value pairs onto the assoc list, until there are + * `MAXENTRIESINASSOC` pairs, at which point if a further value is added to + * the same bucket the bucket returned will be in the form of a second level + * map. My plan is that buckets the first level map will be indexed on the + * first sixteen bits of the hash value, those in the second on the second + * sixteen, and, potentially, so on. + */ + struct cons_pointer buckets[BUCKETSINMAP]; +}; + +uint32_t get_hash_32(struct cons_pointer f, struct cons_pointer key); + +struct map_payload *get_map_payload( struct cons_pointer pointer ); + +struct cons_pointer make_empty_map( struct cons_pointer hash_function ); + +struct cons_pointer bind_in_map( struct cons_pointer parent, + struct cons_pointer key, + struct cons_pointer value); + +struct cons_pointer keys( struct cons_pointer store); + +struct cons_pointer merge_into_map( struct cons_pointer parent, + struct cons_pointer to_merge); + +struct cons_pointer assoc_in_map( struct cons_pointer key, + struct cons_pointer map); + +struct cons_pointer lisp_make_map( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); + +void dump_map( URL_FILE * output, struct cons_pointer map_pointer ); + +#endif diff --git a/src/memory/stack.h b/src/memory/stack.h index 0ea903c..f132c69 100644 --- a/src/memory/stack.h +++ b/src/memory/stack.h @@ -18,12 +18,12 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#ifndef __psse_stack_h +#define __psse_stack_h + #include "consspaceobject.h" #include "conspage.h" -#ifndef __stack_h -#define __stack_h - /** * macros for the tag of a stack frame. */ diff --git a/src/ops/intern.c b/src/ops/intern.c index 87d116e..cf86e6b 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -24,6 +24,7 @@ #include "debug.h" #include "equal.h" #include "lispops.h" +#include "map.h" #include "print.h" /** @@ -51,7 +52,7 @@ struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer store ) { struct cons_pointer result = NIL; - if ( symbolp( key ) ) { + if ( symbolp( key ) || keywordp( key ) ) { for ( struct cons_pointer next = store; nilp( result ) && consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { @@ -73,7 +74,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { debug_print_object( key, DEBUG_BIND ); debug_print( L"` is a ", DEBUG_BIND ); debug_print_object( c_type( key ), DEBUG_BIND ); - debug_print( L", not a SYMB", DEBUG_BIND ); + debug_print( L", not a KEYW or SYMB", DEBUG_BIND ); } return result; @@ -88,20 +89,32 @@ internedp( struct cons_pointer key, struct cons_pointer store ) { * of that key from the store; otherwise return NIL. */ struct cons_pointer c_assoc( struct cons_pointer key, - struct cons_pointer store ) { + struct cons_pointer store ) { struct cons_pointer result = NIL; - for ( struct cons_pointer next = store; - consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { - struct cons_space_object entry = - pointer2cell( pointer2cell( next ).payload.cons.car ); + debug_print( L"c_assoc; key is `", DEBUG_BIND); + debug_print_object( key, DEBUG_BIND); + debug_print( L"`\n", DEBUG_BIND); - if ( equal( key, entry.payload.cons.car ) ) { - result = entry.payload.cons.cdr; - break; + if (consp(store)) { + for ( struct cons_pointer next = store; + consp( next ); next = pointer2cell( next ).payload.cons.cdr ) { + struct cons_space_object entry = + pointer2cell( pointer2cell( next ).payload.cons.car ); + + if ( equal( key, entry.payload.cons.car ) ) { + result = entry.payload.cons.cdr; + break; + } } + } else if (vectorpointp( store)) { + result = assoc_in_map( key, store); } + debug_print( L"c_assoc returning ", DEBUG_BIND); + debug_print_object( result, DEBUG_BIND); + debug_println( DEBUG_BIND); + return result; } @@ -110,15 +123,29 @@ struct cons_pointer c_assoc( struct cons_pointer key, * with this key/value pair added to the front. */ struct cons_pointer -set( struct cons_pointer key, struct cons_pointer value, - struct cons_pointer store ) { - debug_print( L"Binding ", DEBUG_BIND ); + set( struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store ) { + struct cons_pointer result = NIL; + + debug_print( L"set: binding `", DEBUG_BIND ); debug_print_object( key, DEBUG_BIND ); - debug_print( L" to ", DEBUG_BIND ); + debug_print( L"` to `", DEBUG_BIND ); debug_print_object( value, DEBUG_BIND ); + debug_print( L"` in store ", DEBUG_BIND ); + debug_dump_object( store, DEBUG_BIND); debug_println( DEBUG_BIND ); - return make_cons( make_cons( key, value ), store ); + if (nilp( store) || consp(store)) { + result = make_cons( make_cons( key, value ), store ); + } else if (vectorpointp( store)) { + result = bind_in_map( store, key, value); + } + + debug_print( L"set returning ", DEBUG_BIND); + debug_print_object( result, DEBUG_BIND); + debug_println( DEBUG_BIND); + + return result; } /** @@ -131,11 +158,19 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) { debug_print( L"Entering deep_bind\n", DEBUG_BIND ); struct cons_pointer old = oblist; + debug_print( L"deep_bind: binding `", DEBUG_BIND ); + debug_print_object( key, DEBUG_BIND ); + debug_print( L"` to ", DEBUG_BIND ); + debug_print_object( value, DEBUG_BIND ); + debug_println( DEBUG_BIND ); + oblist = set( key, value, oblist ); inc_ref( oblist ); dec_ref( old ); - debug_print( L"Leaving deep_bind\n", DEBUG_BIND ); + debug_print( L"deep_bind returning ", DEBUG_BIND ); + debug_print_object( oblist, DEBUG_BIND ); + debug_println( DEBUG_BIND ); return oblist; } diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 5471c3f..cb58cf9 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -269,8 +269,8 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, * @return the result of evaluating the function with its arguments. */ struct cons_pointer -c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, - struct cons_pointer env ) { + c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { debug_print( L"Entering c_apply\n", DEBUG_EVAL ); struct cons_pointer result = NIL; @@ -285,38 +285,47 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, switch ( fn_cell.tag.value ) { case EXCEPTIONTV: - /* just pass exceptions straight back */ - result = fn_pointer; - break; + /* just pass exceptions straight back */ + result = fn_pointer; + break; case FUNCTIONTV: - { - struct cons_pointer exep = NIL; - struct cons_pointer next_pointer = - make_stack_frame( frame_pointer, args, env ); - inc_ref( next_pointer ); - if ( exceptionp( next_pointer ) ) { - result = next_pointer; - } else { - struct stack_frame *next = - get_stack_frame( next_pointer ); + { + struct cons_pointer exep = NIL; + struct cons_pointer next_pointer = + make_stack_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { + result = next_pointer; + } else { + struct stack_frame *next = + get_stack_frame( next_pointer ); - result = - ( *fn_cell.payload.function.executable ) ( next, - next_pointer, - env ); - dec_ref( next_pointer ); - } + result = + ( *fn_cell.payload.function.executable ) ( next, + next_pointer, + env ); + dec_ref( next_pointer ); } - break; + } + break; + + case KEYTV: + result = c_assoc( fn_pointer, + eval_form(frame, + frame_pointer, + c_car( c_cdr( frame->arg[0])), + env)); + break; + case LAMBDATV: - { - struct cons_pointer exep = NIL; - struct cons_pointer next_pointer = - make_stack_frame( frame_pointer, args, env ); - inc_ref( next_pointer ); - if ( exceptionp( next_pointer ) ) { - result = next_pointer; - } else { + { + struct cons_pointer exep = NIL; + struct cons_pointer next_pointer = + make_stack_frame( frame_pointer, args, env ); + inc_ref( next_pointer ); + if ( exceptionp( next_pointer ) ) { + result = next_pointer; + } else { struct stack_frame *next = get_stack_frame( next_pointer ); result = @@ -416,9 +425,7 @@ lisp_eval( struct stack_frame *frame, struct cons_pointer frame_pointer, switch ( cell.tag.value ) { case CONSTV: - { result = c_apply( frame, frame_pointer, env ); - } break; case SYMBOLTV: @@ -709,6 +716,22 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, return result; } +/** + * Function: return, as an integer, the length of the sequence indicated by + * the first argument, or zero if it is not a sequence. + * + * * (length any) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment (ignored). + * @return the length of `any`, if it is a sequence, or zero otherwise. + */ +struct cons_pointer lisp_length( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return make_integer( c_length( frame->arg[0]), NIL); +} + /** * Function; look up the value of a `key` in a `store`. * @@ -1265,6 +1288,7 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame, } dump_object( output, frame->arg[0] ); + url_fputws( L"\n", output ); if ( writep( out_stream ) ) { dec_ref( out_stream ); diff --git a/src/ops/lispops.h b/src/ops/lispops.h index ea8a883..122635f 100644 --- a/src/ops/lispops.h +++ b/src/ops/lispops.h @@ -85,7 +85,9 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_lambda( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); - +struct cons_pointer lisp_length( struct stack_frame *frame, + struct cons_pointer frame_pointer, + struct cons_pointer env ); /** * Construct an interpretable special form. * diff --git a/src/time/time.c b/src/time/time.c new file mode 100644 index 0000000..146f296 --- /dev/null +++ b/src/time/time.c @@ -0,0 +1,98 @@ +/* + * time.h + * + * Bare bones of PSSE time. See issue #16. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include +#include +/* + * wide characters + */ +#include +#include + +#include "conspage.h" +#include "consspaceobject.h" +#include "integer.h" +#include "time.h" +#define _GNU_SOURCE + +#define seconds_per_year 31557600L + +/** + * PSSE Lisp epoch is 14 Bn years, or 441,806,400,000,000,000 seconds, before + * the UNIX epoch; the value in microseconds will break the C reader. + */ +unsigned __int128 epoch_offset = ((__int128)(seconds_per_year * 1000000000L) * + (__int128)(14L * 1000000000L)); + +/** + * Return the UNIX time value which represents this time, if it falls within + * the period representable in UNIX time, or zero otherwise. + */ +long int lisp_time_to_unix_time(struct cons_pointer t) { + long int result = 0; + + if (timep( t)) { + unsigned __int128 value = pointer2cell(t).payload.time.value; + + if (value > epoch_offset) { // \todo && value < UNIX time rollover + result = ((value - epoch_offset) / 1000000000); + } + } + + return result; +} + +unsigned __int128 unix_time_to_lisp_time( time_t t) { + unsigned __int128 result = epoch_offset + (t * 1000000000); + + return result; +} + +struct cons_pointer make_time( struct cons_pointer integer_or_nil) { + struct cons_pointer pointer = allocate_cell( TIMETAG ); + struct cons_space_object *cell = &pointer2cell( pointer ); + + if (integerp(integer_or_nil)) { + cell->payload.time.value = pointer2cell(integer_or_nil).payload.integer.value; + // \todo: if integer is a bignum, deal with it. + } else { + cell->payload.time.value = unix_time_to_lisp_time( time(NULL)); + } + + return pointer; +} + +/** + * Function; return a time representation of the first argument in the frame; + * further arguments are ignored. + * + * * (time integer_or_nil) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return a lisp time; if `integer_or_nil` is an integer, return a time which + * is that number of microseconds after the notional big bang; else the current + * time. + */ +struct cons_pointer lisp_time( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return make_time( frame->arg[0]); +} + +/** + * This is temporary, for bootstrapping. + */ +struct cons_pointer time_to_string( struct cons_pointer pointer) { + long int t = lisp_time_to_unix_time(pointer); + + return c_string_to_lisp_string( t == 0 ? + L"Not yet implemented: cannot print times outside UNIX time\n" : + ctime(&t)); +} diff --git a/src/time/time.h b/src/time/time.h new file mode 100644 index 0000000..661decf --- /dev/null +++ b/src/time/time.h @@ -0,0 +1,20 @@ +/* + * time.h + * + * Bare bones of PSSE time. See issue #16. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_time_h +#define __psse_time_h + +#define _GNU_SOURCE +#include "consspaceobject.h" + +struct cons_pointer lisp_time( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); +struct cons_pointer time_to_string( struct cons_pointer pointer); + +#endif diff --git a/src/utils.c b/src/utils.c index 5b22516..9919dbe 100644 --- a/src/utils.c +++ b/src/utils.c @@ -12,7 +12,7 @@ #include -int index_of( char c, char *s ) { +int index_of( char c, const char *s ) { int i; for ( i = 0; s[i] != c && s[i] != 0; i++ ); @@ -27,7 +27,7 @@ char *trim( char *s ) { i-- ) { s[i] = '\0'; } - for ( i = 0; ( isblank( s[i] ) || iscntrl( s[i] ) ) && s[i] != '\0'; i++ ); + for ( i = 0; s[i] != '\0' && ( isblank( s[i] ) || iscntrl( s[i] ) ); i++ ); return ( char * ) &s[i]; } diff --git a/src/utils.h b/src/utils.h index e56fd6e..456e4d0 100644 --- a/src/utils.h +++ b/src/utils.h @@ -10,6 +10,8 @@ #ifndef __psse_utils_h #define __psse_utils_h -int index_of( char c, char *s ); +int index_of( char c, const char *s ); + char *trim( char *s ); + #endif diff --git a/unit-tests/eval-quote-symbol.sh b/unit-tests/eval-quote-symbol.sh index 7e80c48..e977461 100755 --- a/unit-tests/eval-quote-symbol.sh +++ b/unit-tests/eval-quote-symbol.sh @@ -1,6 +1,6 @@ #!/bin/bash -expected='' +expected='' actual=`echo "(eval 'cond)" | target/psse | tail -1` if [ "${expected}" = "${actual}" ] diff --git a/unit-tests/slurp.sh b/unit-tests/slurp.sh index b389143..0a9bc7c 100755 --- a/unit-tests/slurp.sh +++ b/unit-tests/slurp.sh @@ -1,6 +1,6 @@ #!/bin/bash -tmp=hi$$ +tmp=hi.$$ echo "Hello, there." > ${tmp} expected='"Hello, there.' actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1`