/* * consspaceobject.h * * Declarations common to all cons space objects. * * * (c) 2017 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ #ifndef __psse_consspaceobject_h #define __psse_consspaceobject_h #include #include #include /* * wide characters */ #include #include #include "io/fopen.h" // #include "memory/conspage.h" /** * The length of a tag, in bytes. */ #define TAGLENGTH 4 /* * tag values, all of which must be 4 bytes. Must not collide with vector space * tag values */ /** * An ordinary cons cell: */ #define CONSTAG "CONS" /** * The string `CONS`, considered as an `unsigned int`. * @todo tag values should be collected into an enum. */ #define CONSTV 1397641027 /** * An exception. TODO: we need a means of dealing with different classes of * exception, and we don't have one yet. */ #define EXCEPTIONTAG "EXEP" /** * The string `EXEP`, considered as an `unsigned int`. */ #define EXCEPTIONTV 1346721861 /** * An unallocated cell on the free list - should never be encountered by a Lisp * function. */ #define FREETAG "FREE" /** * The string `FREE`, considered as an `unsigned int`. */ #define FREETV 1162170950 /** * An ordinary Lisp function - one whose arguments are pre-evaluated. * \see LAMBDATAG for interpretable functions. * \see SPECIALTAG for functions whose arguments are not pre-evaluated. */ #define FUNCTIONTAG "FUNC" /** * The string `FUNC`, considered as an `unsigned int`. */ #define FUNCTIONTV 1129207110 /** * An integer number (bignums are integers). */ #define INTEGERTAG "INTR" /** * The string `INTR`, considered as an `unsigned int`. */ #define INTEGERTV 1381256777 /** * A keyword - an interned, self-evaluating string. */ #define KEYTAG "KEYW" /** * The string `KEYW`, considered as an `unsigned int`. */ #define KEYTV 1465468235 /** * A lambda cell. Lambdas are the interpretable (source) versions of functions. * \see FUNCTIONTAG. */ #define LAMBDATAG "LMDA" /** * The string `LMDA`, considered as an `unsigned int`. */ #define LAMBDATV 1094995276 /** * A loop exit is a special kind of exception which has exactly the same * payload as an exception. */ #define LOOPTAG "LOOP" /** * The string `LOOX`, considered as an `unsigned int`. */ #define LOOPTV 1347374924 /** * The special cons cell at address {0,0} whose car and cdr both point to * itself. */ #define NILTAG "NIL " /** * The string `NIL `, considered as an `unsigned int`. */ #define NILTV 541870414 /** * An nlambda cell. NLambdas are the interpretable (source) versions of special * forms. \see SPECIALTAG. */ #define NLAMBDATAG "NLMD" /** * The string `NLMD`, considered as an `unsigned int`. */ #define NLAMBDATV 1145916494 /** * A rational number, stored as pointers two integers representing dividend * and divisor respectively. */ #define RATIOTAG "RTIO" /** * The string `RTIO`, considered as an `unsigned int`. */ #define RATIOTV 1330205778 /** * An open read stream. */ #define READTAG "READ" /** * The string `READ`, considered as an `unsigned int`. */ #define READTV 1145128274 /** * A real number, represented internally as an IEEE 754-2008 `binary64`. */ #define REALTAG "REAL" /** * The string `REAL`, considered as an `unsigned int`. */ #define REALTV 1279346002 /** * A special form - one whose arguments are not pre-evaluated but passed as * provided. * \see NLAMBDATAG. */ #define SPECIALTAG "SPFM" /** * The string `SPFM`, considered as an `unsigned int`. */ #define SPECIALTV 1296453715 /** * A string of characters, organised as a linked list. */ #define STRINGTAG "STRG" /** * The string `STRG`, considered as an `unsigned int`. */ #define STRINGTV 1196577875 /** * A symbol is just like a string except not self-evaluating. */ #define SYMBOLTAG "SYMB" /** * The string `SYMB`, considered as an `unsigned int`. */ #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. */ #define TRUETAG "TRUE" /** * The string `TRUE`, considered as an `unsigned int`. */ #define TRUETV 1163219540 /** * A pointer to an object in vector space. */ #define VECTORPOINTTAG "VECP" /** * The string `VECP`, considered as an `unsigned int`. */ #define VECTORPOINTTV 1346585942 /** * An open write stream. */ #define WRITETAG "WRIT" /** * The string `WRIT`, considered as an `unsigned int`. */ #define WRITETV 1414091351 /** * a cons pointer which points to the special NIL cell */ #define NIL (struct cons_pointer){ 0, 0} /** * a cons pointer which points to the special T cell */ #define TRUE (struct cons_pointer){ 0, 1} /** * the maximum possible value of a reference count */ #define MAXREFERENCE 4294967295 /** * a macro to convert a tag into a number */ #define tag2uint(tag) ((uint32_t)*tag) /** * given a cons_pointer as argument, return the cell. */ #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset])) /** * true if `conspoint` points to the special cell NIL, else false * (there should only be one of these so it's slightly redundant). */ #define nilp(conspoint) (check_tag(conspoint,NILTV)) /** * true if `conspoint` points to a cons cell, else false */ #define consp(conspoint) (check_tag(conspoint,CONSTV)) /** * true if `conspoint` points to an exception, else false */ #define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTV)) /** * true if `conspoint` points to a function cell, else false */ #define functionp(conspoint) (check_tag(conspoint,FUNCTIONTV)) /** * true if `conspoint` points to a keyword, else false */ #define keywordp(conspoint) (check_tag(conspoint,KEYTV)) /** * true if `conspoint` points to a Lambda binding cell, else false */ #define lambdap(conspoint) (check_tag(conspoint,LAMBDATV)) /** * true if `conspoint` points to a loop recursion, else false. */ #define loopp(conspoint) (check_tag(conspoint,LOOPTV)) /** * true if `conspoint` points to a special form cell, else false */ #define specialp(conspoint) (check_tag(conspoint,SPECIALTV)) /** * true if `conspoint` points to a string cell, else false */ #define stringp(conspoint) (check_tag(conspoint,STRINGTV)) /** * true if `conspoint` points to a symbol cell, else false */ #define symbolp(conspoint) (check_tag(conspoint,SYMBOLTV)) /** * true if `conspoint` points to an integer cell, else false */ #define integerp(conspoint) (check_tag(conspoint,INTEGERTV)) /** * true if `conspoint` points to a rational number cell, else false */ #define ratiop(conspoint) (check_tag(conspoint,RATIOTV)) /** * true if `conspoint` points to a read stream cell, else false */ #define readp(conspoint) (check_tag(conspoint,READTV)) /** * true if `conspoint` points to a real number cell, else false */ #define realp(conspoint) (check_tag(conspoint,REALTV)) /** * true if `conspoint` points to some sort of a number cell, * else false */ #define numberp(conspoint) (check_tag(conspoint,INTEGERTV)||check_tag(conspoint,RATIOTV)||check_tag(conspoint,REALTV)) /** * true if `conspoint` points to a sequence (list, string or, later, vector), * else false. */ #define sequencep(conspoint) (check_tag(conspoint,CONSTV)||check_tag(conspoint,STRINGTV)||check_tag(conspoint,SYMBOLTV)) /** * true if `conspoint` points to a vector pointer, else false. */ #define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTV)) /** * true if `conspoint` points to a write stream cell, else false. */ #define writep(conspoint) (check_tag(conspoint,WRITETV)) #define streamp(conspoint) (check_tag(conspoint,READTV)||check_tag(conspoint,WRITETV)) /** * true if `conspoint` points to a true cell, else false * (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) (check_tag(conspoint,TRUETV)) /** * true if `conspoint` points to a time cell, else false. */ #define timep(conspoint) (check_tag(conspoint,TIMETV)) /** * true if `conspoint` points to something that is truthy, i.e. * anything but NIL. */ #define truep(conspoint) (!check_tag(conspoint,NILTV)) /** * An indirect pointer to a cons cell */ struct cons_pointer { /** the index of the page on which this cell resides */ uint32_t page; /** the index of the cell within the page */ uint32_t offset; }; /* * number of arguments stored in a stack frame */ #define args_in_frame 8 /** * A stack frame. Yes, I know it isn't a cons-space object, but it's defined * here to avoid circularity. \todo refactor. */ struct stack_frame { /** the previous frame. */ struct cons_pointer previous; /** first 8 arument bindings. */ struct cons_pointer arg[args_in_frame]; /** list of any further argument bindings. */ struct cons_pointer more; /** the function to be called. */ struct cons_pointer function; /** the number of arguments provided. */ int args; }; /** * payload of a cons cell. */ struct cons_payload { /** Contents of the Address Register, naturally. */ struct cons_pointer car; /** Contents of the Decrement Register, naturally. */ struct cons_pointer cdr; }; /** * Payload of an exception. * Message should be a Lisp string; frame should be a pointer to an (unfreed) stack frame. */ struct exception_payload { /** The payload: usually a Lisp string but in practice anything printable will do. */ struct cons_pointer payload; /** pointer to the (unfreed) stack frame in which the exception was thrown. */ struct cons_pointer frame; }; /** * Payload of a function cell. * source points to the source from which the function was compiled, or NIL * if it is a primitive. * executable points to a function which takes a pointer to a stack frame * (representing its stack frame) and a cons pointer (representing its * environment) as arguments and returns a cons pointer (representing its * result). */ struct function_payload { /** * pointer to metadata (e.g. the source from which the function was compiled). */ struct cons_pointer meta; /** pointer to a function which takes a cons pointer (representing * its argument list) and a cons pointer (representing its environment) and a * stack frame (representing the previous stack frame) as arguments and returns * a cons pointer (representing its result). * \todo check this documentation is current! */ struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ); }; /** * payload of a free cell. For the time being identical to a cons cell, * but it may not be so in future. */ struct free_payload { struct cons_pointer car; struct cons_pointer cdr; }; /** * payload of an integer cell. An integer is in principle a sequence of cells; * only 60 bits (+ sign bit) are actually used in each cell. If the value * exceeds 60 bits, the least significant 60 bits are stored in the first cell * in the chain, the next 60 in the next cell, and so on. Only the value of the * first cell in any chain should be negative. */ struct integer_payload { /** the value of the payload (i.e. 60 bits) of this cell. */ int64_t value; /** the next (more significant) cell in the chain, ir `NIL` if there are no * more. */ struct cons_pointer more; }; /** * payload for lambda and nlambda cells. */ struct lambda_payload { /** the arument list */ struct cons_pointer args; /** the body of the function to be applied to the arguments. */ struct cons_pointer body; }; /** * payload for ratio cells. Both `dividend` and `divisor` must point to integer cells. */ struct ratio_payload { /** a pointer to an integer representing the dividend */ struct cons_pointer dividend; /** a pointer to an integer representing the divisor. */ struct cons_pointer divisor; }; /** * payload for a real number cell. Internals of this liable to change to give 128 bits * precision, but I'm not sure of the detail. */ struct real_payload { /** the value of the number */ long double value; }; /** * Payload of a special form cell. Currently identical to the payload of a * function cell. * \see function_payload */ struct special_payload { /** * pointer to the source from which the special form was compiled, or NIL * if it is a primitive. */ struct cons_pointer meta; /** pointer to a function which takes a cons pointer (representing * its argument list) and a cons pointer (representing its environment) and a * stack frame (representing the previous stack frame) as arguments and returns * a cons pointer (representing its result). */ struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ); }; /** * payload of a read or write stream cell. */ struct stream_payload { /** the stream to read from or write to. */ URL_FILE *stream; /** metadata on the stream (e.g. its file attributes if a file, its HTTP * headers if a URL, etc). Expected to be an association, or nil. Not yet * implemented. */ struct cons_pointer meta; }; /** * payload of a string cell. At least at first, only one UTF character will * be stored in each cell. The doctrine that 'a symbol is just a string' * didn't work; however, the payload of a symbol or keyword cell is identical * to the payload of a string cell, except that a keyword may store a hash * of its own value in the padding. */ struct string_payload { /** the actual character stored in this cell */ wint_t character; /** a hash of the string value, computed at store time. */ uint32_t hash; /** the remainder of the string following this character. */ 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. */ struct vectorp_payload { /** the tag of the vector-space object. NOTE that the vector space object * should itself have the identical tag. */ union { /** the tag (type) of the vector-space object this cell * points to, considered as bytes. */ char bytes[TAGLENGTH]; /** the tag considered as a number */ uint32_t value; } tag; /** unused padding to word-align the address */ uint32_t padding; /** the address of the actual vector space * object (\todo will change when I actually * implement vector space) */ void *address; }; /** * an object in cons space. */ struct cons_space_object { union { /** the tag (type) of this cell, * considered as bytes */ char bytes[TAGLENGTH]; /** the tag considered as a number */ uint32_t value; } tag; /** the count of the number of references to this cell */ uint32_t count; /** cons pointer to the access control list of this cell */ struct cons_pointer access; union { /** * if tag == CONSTAG */ struct cons_payload cons; /** * if tag == EXCEPTIONTAG || tag == LOOPTAG */ struct exception_payload exception; /** * if tag == FREETAG */ struct free_payload free; /** * if tag == FUNCTIONTAG */ struct function_payload function; /** * if tag == INTEGERTAG */ struct integer_payload integer; /** * if tag == LAMBDATAG or NLAMBDATAG */ struct lambda_payload lambda; /** * if tag == NILTAG; we'll treat the special cell NIL as just a cons */ struct cons_payload nil; /** * if tag == RATIOTAG */ struct ratio_payload ratio; /** * if tag == READTAG || tag == WRITETAG */ struct stream_payload stream; /** * if tag == REALTAG */ struct real_payload real; /** * if tag == SPECIALTAG */ struct special_payload special; /** * 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 */ struct cons_payload t; /** * if tag == VECTORPTAG */ struct vectorp_payload vectorp; } payload; }; bool check_tag( struct cons_pointer pointer, uint32_t value ); struct cons_pointer inc_ref( struct cons_pointer pointer ); struct cons_pointer dec_ref( struct cons_pointer pointer ); struct cons_pointer c_type( struct cons_pointer pointer ); 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 ); struct cons_pointer make_exception( struct cons_pointer message, struct cons_pointer frame_pointer ); struct cons_pointer make_function( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ); struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ); struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ); struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ); struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ); struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ); struct cons_pointer make_string( wint_t c, struct cons_pointer tail ); struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail, uint32_t tag ); #define make_symbol(c, t) (make_symbol_or_key( c, t, SYMBOLTV)) #define make_keyword(c, t) (make_symbol_or_key( c, t, KEYTV)) struct cons_pointer make_read_stream( URL_FILE * input, struct cons_pointer metadata ); struct cons_pointer make_write_stream( URL_FILE * output, struct cons_pointer metadata ); struct cons_pointer c_string_to_lisp_string( wchar_t *string ); struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ); #endif