/** * 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. */ #include #include #include /* * wide characters */ #include #include #ifndef __consspaceobject_h #define __consspaceobject_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 */ /** * A word within a bignum - arbitrary precision integer. */ #define BIGNUMTAG "BIGN" #define BIGNUMTV 1313294658 /** * An ordinary cons cell: 1397641027 */ #define CONSTAG "CONS" #define CONSTV 1397641027 /** * An exception. */ #define EXCEPTIONTAG "EXEP" #define EXCEPTIONTV 1346721861 /** * An unallocated cell on the free list - should never be encountered by a Lisp * function. 1162170950 */ #define FREETAG "FREE" #define FREETV 1162170950 /** * An ordinary Lisp function - one whose arguments are pre-evaluated and passed as * a stack frame. 1129207110 */ #define FUNCTIONTAG "FUNC" #define FUNCTIONTV 1129207110 /** * An integer number. 1381256777 */ #define INTEGERTAG "INTR" #define INTEGERTV 1381256777 /** * A lambda cell. */ #define LAMBDATAG "LMDA" #define LAMBDATV 1094995276 /** * The special cons cell at address {0,0} whose car and cdr both point to itself. * 541870414 */ #define NILTAG "NIL " #define NILTV 541870414 /** * An nlambda cell. */ #define NLAMBDATAG "NLMD" #define NLAMBDATV 1145916494 /** * An open read stream. */ #define READTAG "READ" #define READTV 1145128274 /** * A real number. */ #define REALTAG "REAL" #define REALTV 1279346002 /** * A ratio. */ #define RATIOTAG "RTIO" #define RATIOTV 1330205778 /** * A special form - one whose arguments are not pre-evaluated but passed as a * s-expression. 1296453715 */ #define SPECIALTAG "SPFM" #define SPECIALTV 1296453715 /** * A string of characters, organised as a linked list. 1196577875 */ #define STRINGTAG "STRG" #define STRINGTV 1196577875 /** * A symbol is just like a string except not self-evaluating. 1112365395 */ #define SYMBOLTAG "SYMB" #define SYMBOLTV 1112365395 /** * The special cons cell at address {0,1} which is canonically different from NIL. * 1163219540 */ #define TRUETAG "TRUE" #define TRUETV 1163219540 /** * A pointer to an object in vector space. */ #define VECTORPOINTTAG "VECP" #define VECTORPOINTTV 0 /** * An open write stream. */ #define WRITETAG "WRIT" #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) #define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset])) /** * true if conspointer 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,NILTAG)) /** * true if conspointer points to a cons cell, else false */ #define bignump(conspoint) (check_tag(conspoint,BIGNUMTAG)) /** * true if conspointer points to a cons cell, else false */ #define consp(conspoint) (check_tag(conspoint,CONSTAG)) /** * true if conspointer points to an exception, else false */ #define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTAG)) /** * true if conspointer points to a function cell, else false */ #define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG)) /** * true if conspointer points to a special Lambda cell, else false */ #define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG)) /** * true if conspointer points to a special form cell, else false */ #define specialp(conspoint) (check_tag(conspoint,SPECIALTAG)) /** * true if conspointer points to a string cell, else false */ #define stringp(conspoint) (check_tag(conspoint,STRINGTAG)) /** * true if conspointer points to a symbol cell, else false */ #define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG)) /** * true if conspointer points to an integer cell, else false */ #define integerp(conspoint) (check_tag(conspoint,INTEGERTAG)) /** * true if conspointer points to a rational number cell, else false */ #define ratiop(conspoint) (check_tag(conspoint,RATIOTAG)) /** * true if conspointer points to a read stream cell, else false */ #define readp(conspoint) (check_tag(conspoint,READTAG)) /** * true if conspointer points to a real number cell, else false */ #define realp(conspoint) (check_tag(conspoint,REALTAG)) /** * true if conspointer points to some sort of a number cell, * else false */ #define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG)||check_tag(conspoint,BIGNUMTAG)) #define sequencep(conspoint) (check_tag(conspoint,CONSTAG)||check_tag(conspoint,STRINGTAG)||check_tag(conspoint,SYMBOLTAG)) /** * true if thr conspointer points to a vector pointer. */ #define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTAG)) /** * true if conspointer points to a write stream cell, else false. */ #define writep(conspoint) (check_tag(conspoint,WRITETAG)) /** * true if conspointer 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) (checktag(conspoint,TRUETAG)) /** * true if conspoint points to something that is truthy, i.e. * anything but NIL. */ #define truep(conspoint) (!checktag(conspoint,NILTAG)) /** * An indirect pointer to a cons cell */ struct cons_pointer { uint32_t page; /* the index of the page on which this cell * resides */ uint32_t offset; /* the index of the cell within the page */ }; /* * 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 { struct cons_pointer previous; /* the previous frame */ struct cons_pointer arg[args_in_frame]; /* * first 8 arument bindings */ struct cons_pointer more; /* list of any further argument bindings */ struct cons_pointer function; /* the function to be called */ int args; }; /** * payload of a bignum cell. Intentionally similar to an integer payload, but * with a next pointer. */ struct bignum_payload { int64_t value; struct cons_pointer next; }; /** * payload of a cons cell. */ struct cons_payload { struct cons_pointer car; 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 { struct cons_pointer message; 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 { struct cons_pointer source; 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. For the time being just a signed integer; * later might be a signed 128 bit integer, or might have some flag to point to an * optional bignum object. */ struct integer_payload { int64_t value; }; /** * payload for lambda and nlambda cells */ struct lambda_payload { struct cons_pointer args; struct cons_pointer body; }; /** * payload for ratio cells. Both dividend and divisor must point to integer (or, later, bignum) cells. */ struct ratio_payload { struct cons_pointer dividend; 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 { long double value; }; /** * Payload of a special form 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 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 special_payload { struct cons_pointer source; struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ); }; /** * payload of a read or write stream cell. */ struct stream_payload { FILE *stream; }; /** * 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 cell is identical to the * payload of a string cell. */ struct string_payload { wint_t character; /* the actual character stored in this cell */ uint32_t padding; /* unused padding to word-align the cdr */ struct cons_pointer cdr; }; /** * payload of a vector pointer cell. */ struct vectorp_payload { union { char bytes[TAGLENGTH]; /* the tag (type) of the * vector-space object this cell * points to, considered as bytes. * NOTE that the vector space object * should itself have the identical * tag. */ uint32_t value; /* the tag considered as a number */ } tag; struct vector_space_object *address; /* the address of the actual vector space * object (TODO: will change when I actually * implement vector space) */ }; /** * an object in cons space. */ struct cons_space_object { union { char bytes[TAGLENGTH]; /* the tag (type) of this cell, * considered as bytes */ uint32_t value; /* the tag considered as a number */ } tag; uint32_t count; /* the count of the number of references to * this cell */ struct cons_pointer access; /* cons pointer to the access control list of * this cell */ union { /* * if tag == CONSTAG */ struct cons_payload cons; /* * if tag == EXCEPTIONTAG */ 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 == TRUETAG; we'll treat the special cell T as just a cons */ struct cons_payload t; /* * if tag == VECTORPTAG */ struct vectorp_payload vectorp; } payload; }; /** * Check that the tag on the cell at this pointer is this tag */ int check_tag( struct cons_pointer pointer, char *tag ); /** * increment the reference count of the object at this cons pointer */ void inc_ref( struct cons_pointer pointer ); /** * decrement the reference count of the object at this cons pointer */ void dec_ref( struct cons_pointer pointer ); 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 ); /** * Construct a cell which points to an executable Lisp special form. */ struct cons_pointer make_function( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ); /** * Construct a lambda (interpretable source) cell */ struct cons_pointer make_lambda( struct cons_pointer args, struct cons_pointer body ); /** * Construct an nlambda (interpretable source) cell; to a * lambda as a special form is to a function. */ struct cons_pointer make_nlambda( struct cons_pointer args, struct cons_pointer body ); /** * Construct a cell which points to an executable Lisp special form. */ struct cons_pointer make_special( struct cons_pointer src, struct cons_pointer ( *executable ) ( struct stack_frame *, struct cons_pointer, struct cons_pointer ) ); /** * Construct a string from this character and this tail. A string is * implemented as a flat list of cells each of which has one character and a * pointer to the next; in the last cell the pointer to next is NIL. */ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ); /** * Construct a symbol from this character and this tail. A symbol is identical * to a string except for having a different tag. */ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ); /** * Construct a cell which points to a stream open for reading. * @param input the C stream to wrap. */ struct cons_pointer make_read_stream( FILE * input ); /** * Construct a cell which points to a stream open for writeing. * @param output the C stream to wrap. */ struct cons_pointer make_write_stream( FILE * output ); /** * Return a lisp string representation of this old skool ASCII string. */ struct cons_pointer c_string_to_lisp_string( char *string ); /** * Return a lisp symbol representation of this old skool ASCII string. */ struct cons_pointer c_string_to_lisp_symbol( char *symbol ); #endif