diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c new file mode 100644 index 0000000..f7ec199 --- /dev/null +++ b/src/c/environment/environment.c @@ -0,0 +1,36 @@ +/** + * environment/environment.c + * + * Initialise a MINIMAL environment. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "memory/node.h" +#include "memory/pointer.h" + +/** + * @brief Flag to prevent re-initialisation. + */ +bool environment_initialised = false; + +/** + * @brief Initialise a minimal environment, so that Lisp can be bootstrapped. + * + * @param node theindex of the node we are initialising. + * @return struct pso_pointer t on success, else an exception. + */ + +struct pso_pointer initialise_environment( uint32_t node) { + struct pso_pointer result = t; + if (environment_initialised) { + // TODO: throw an exception "Attempt to reinitialise environment" + } else { + // TODO: actually initialise it. + } + + return result; +} \ No newline at end of file diff --git a/src/c/environment/environment.h b/src/c/environment/environment.h new file mode 100644 index 0000000..87a40aa --- /dev/null +++ b/src/c/environment/environment.h @@ -0,0 +1,15 @@ +/** + * environment/environment.h + * + * Initialise a MINIMAL environment. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_environment_environment_h +#define __psse_environment_environment_h + +struct pso_pointer initialise_environment( uint32_t node); + +#endif \ No newline at end of file diff --git a/src/c/io/fopen.h b/src/c/io/fopen.h new file mode 100644 index 0000000..5f87bd2 --- /dev/null +++ b/src/c/io/fopen.h @@ -0,0 +1,83 @@ +/* + * fopen.h + * + * adapted from https://curl.haxx.se/libcurl/c/fopen.html. + * + * + * Modifications to read/write wide character streams by + * Simon Brooke. + * + * NOTE THAT: for my purposes, I'm only interested in wide characters, + * and I always read them one character at a time. + * + * Copyright (c) 2003, 2017 Simtec Electronics + * Some portions (c) 2019 Simon Brooke + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR + * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. + * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT + * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, + * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY + * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT + * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF + * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + * + * This example requires libcurl 7.9.7 or later. + */ + +#ifndef __fopen_h +#define __fopen_h +#include +/* + * wide characters + */ +#include +#include + +#define url_fwprintf(f, ...) ((f->type = CFTYPE_FILE) ? fwprintf( f->handle.file, __VA_ARGS__) : -1) +#define url_fputws(ws, f) ((f->type = CFTYPE_FILE) ? fputws(ws, f->handle.file) : 0) +#define url_fputwc(wc, f) ((f->type = CFTYPE_FILE) ? fputwc(wc, f->handle.file) : 0) + +enum fcurl_type_e { + CFTYPE_NONE = 0, + CFTYPE_FILE = 1, + CFTYPE_CURL = 2 +}; + +struct fcurl_data { + enum fcurl_type_e type; /* type of handle */ + union { + CURL *curl; + FILE *file; + } handle; /* handle */ + + char *buffer; /* buffer to store cached data */ + size_t buffer_len; /* currently allocated buffer's length */ + size_t buffer_pos; /* cursor into in buffer */ + int still_running; /* Is background url fetch still in progress */ +}; + +typedef struct fcurl_data URL_FILE; + +/* exported functions */ +URL_FILE *url_fopen( const char *url, const char *operation ); +int url_fclose( URL_FILE * file ); +int url_feof( URL_FILE * file ); +size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ); +char *url_fgets( char *ptr, size_t size, URL_FILE * file ); +void url_rewind( URL_FILE * file ); + +#endif diff --git a/src/c/memory/header.h b/src/c/memory/header.h index 42fa488..c470074 100644 --- a/src/c/memory/header.h +++ b/src/c/memory/header.h @@ -16,6 +16,8 @@ #define TAGLENGTH 3 +#define MAXREFERENCE 4294967295 + /** * @brief Header for all paged space objects. * diff --git a/src/c/memory/memory.c b/src/c/memory/memory.c index 85754bc..530d3e6 100644 --- a/src/c/memory/memory.c +++ b/src/c/memory/memory.c @@ -7,20 +7,41 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include +#include "memory/memory.h" +#include "memory/node.h" +#include "memory/pointer.h" + /** * @brief Freelists for each size class. - * - * TODO: I don't know if that +1 is needed, my mind gets confused by arrays - * indexed from zero. But it does little harm. */ -struct pso_pointer freelists[MAX_SIZE_CLASS + 1]; +struct pso_pointer freelists[MAX_SIZE_CLASS]; +/** + * @brief Flag to prevent re-initialisation. + */ +bool memory_initialised = false; -int initialise_memory( int node ) { - for (uint8_t i = 0; i <= MAX_SIZE_CLASS; i++) { - freelists[i] = nil; +/** + * @brief Initialise the memory allocation system. + * + * Essentially, just set up the freelists; allocating pages will then happen + * automatically as objects are requested. + * + * @param node the index number of the node we are initialising. + * @return int + */ +struct pso_pointer initialise_memory( uint32_t node ) { + if (memory_initialised) { + // TODO: throw an exception + } else { + for (uint8_t i = 0; i <= MAX_SIZE_CLASS; i++) { + freelists[i] = nil; + } + memory_initialised = true; } - + + return t; } diff --git a/src/c/memory/memory.h b/src/c/memory/memory.h index 33e9d39..5911f2f 100644 --- a/src/c/memory/memory.h +++ b/src/c/memory/memory.h @@ -23,7 +23,7 @@ */ #define MAX_SIZE_CLASS 0xf -int initialise_memory( ); +struct pso_pointer initialise_memory( ); extern struct pso_pointer out_of_memory_exception; extern struct pso_pointer freelists[]; diff --git a/src/c/memory/node.c b/src/c/memory/node.c index 81f6aea..84228c4 100644 --- a/src/c/memory/node.c +++ b/src/c/memory/node.c @@ -12,9 +12,10 @@ #include -#include "ops/equal.h" -#include "memory.h" -#include "pointer.h" +#include "environment/environment.h" +#include "memory/memory.h" +#include "memory/pointer.h" +#include "ops/eq.h" /** * @brief Flag to prevent the node being initialised more than once. @@ -31,17 +32,19 @@ bool node_initialised = false; */ uint32_t node_index = 0; + /** * @brief The canonical `nil` pointer - * + * */ -struct pso_pointer nil = struct pso_pointer { 0, 0, 0 }; +struct pso_pointer nil = (struct pso_pointer) { 0, 0, 0}; /** * @brief the canonical `t` (true) pointer. - * + * */ -struct pso_pointer t = struct pso_pointer { 0, 0, 1 }; +struct pso_pointer t = (struct pso_pointer) { 0, 0, 1 }; + /** * @brief Set up the basic informetion about this node. @@ -51,10 +54,8 @@ struct pso_pointer t = struct pso_pointer { 0, 0, 1 }; */ struct pso_pointer initialise_node( uint32_t index ) { node_index = index; - nil = pso_pointer { index, 0, 0}; - t = pso_pointer( index, 0, 1 ); - pso_pointer result = initialise_memory( index ); + struct pso_pointer result = initialise_memory( index ); if ( eq( result, t ) ) { result = initialise_environment( index ); diff --git a/src/c/memory/node.h b/src/c/memory/node.h index fbc177a..1e94956 100644 --- a/src/c/memory/node.h +++ b/src/c/memory/node.h @@ -34,3 +34,4 @@ extern struct pso_pointer t; struct pso_pointer initialise_node( uint32_t index ); #endif + diff --git a/src/c/memory/page.c b/src/c/memory/page.c index 7e28524..eb424e7 100644 --- a/src/c/memory/page.c +++ b/src/c/memory/page.c @@ -8,10 +8,9 @@ */ #include +#include #include #include -#include - #include "debug.h" #include "memory/memory.h" #include "memory/node.h" @@ -84,12 +83,6 @@ struct pso_pointer initialise_page( union page* page_addr, uint16_t page_index, * @brief Allocate a page for objects of this size class, initialise it, and * link the objects in it into the freelist for this size class. * - * Because we can't return an exception at this low level, and because there - * are multiple possible causes of failure, for the present this function will - * print errors to stderr. We cast the error stream to wide, since we've - * probably (but not certainly) already cast it to wide, and we can't reliably - * cast it back. - * * @param size_class an integer in the range 0...MAX_SIZE_CLASS. * @return t on success, an exception if an error occurred. */ diff --git a/src/c/memory/page.h b/src/c/memory/page.h index b5285f5..ba64d38 100644 --- a/src/c/memory/page.h +++ b/src/c/memory/page.h @@ -72,7 +72,6 @@ union page { struct psof psofs[PAGE_BYTES / 262144]; }; -struct pso_pointer initialise_page( union page * page_addr, uint16_t page_index, - uint8_t size_class, struct pso_pointer freelist); +struct pso_pointer allocate_page( uint8_t size_class ); #endif diff --git a/src/c/memory/pointer.c b/src/c/memory/pointer.c index 8a47439..5c46540 100644 --- a/src/c/memory/pointer.c +++ b/src/c/memory/pointer.c @@ -1,13 +1,16 @@ /** - * memory/pointer.h + * memory/node.h * - * A pointer to a paged space object. + * The node on which this instance resides. * * (c) 2026 Simon Brooke * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include + #include "memory/node.h" +#include "memory/page.h" #include "memory/pointer.h" #include "memory/pso.h" @@ -20,7 +23,7 @@ * @return struct pso_pointer a pointer referencing the specified object. */ struct pso_pointer make_pointer( uint32_t node, uint16_t page, uint16_t offset) { - return struct pso_pointer{ node, page, pointer}; + return (struct pso_pointer){ node, page, offset}; } /** @@ -37,11 +40,12 @@ struct pso2* pointer_to_object( struct pso_pointer pointer) { struct pso2* result = NULL; if ( pointer.node == node_index) { - result = (struct pso2*) &(pages[pointer.node] + (pointer.offset * sizeof( uint64_t))); - } + union page* pg = pages[pointer.page]; + result = (struct pso2*) &pg->words[pointer.offset]; + } // TODO: else if we have a copy of the object in cache, return that; // else request a copy of the object from the node which curates it. return result; } - \ No newline at end of file + diff --git a/src/c/memory/pso.c b/src/c/memory/pso.c index f76890d..c4fc711 100644 --- a/src/c/memory/pso.c +++ b/src/c/memory/pso.c @@ -14,9 +14,17 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ - #include "memory/page.h" - #include "memory/pointer.h" - #include "memory/pso.h" +#include +#include + +#include "debug.h" +#include "memory/header.h" +#include "memory/memory.h" +#include "memory/node.h" +#include "memory/page.h" +#include "memory/pointer.h" +#include "memory/pso.h" +#include "ops/truth.h" /** * @brief Allocate an object of this size_class with this tag. @@ -29,8 +37,8 @@ struct pso_pointer allocate( char* tag, uint8_t size_class) { struct pso_pointer result = nil; if (size_class <= MAX_SIZE_CLASS) { - if (freelists[size_class] == nil) { - result = allocate_page(size_class) + if (nilp( freelists[size_class])) { + result = allocate_page(size_class); } if ( !exceptionp( result) && not( freelists[size_class] ) ) { @@ -38,16 +46,16 @@ struct pso_pointer allocate( char* tag, uint8_t size_class) { struct pso2* object = pointer_to_object( result); freelists[size_class] = object->payload.free.next; - strncpy( (char *)(object->header.tag.mnemonic), tag, TAGLENGTH); + strncpy( (char *)(object->header.tag.bytes.mnemonic), tag, TAGLENGTH); /* the object ought already to have the right size class in its tag * because it was popped off the freelist for that size class. */ - if ( object->header.tag.size_class != size_class) { + if ( object->header.tag.bytes.size_class != size_class) { // TODO: return an exception instead? Or warn, set it, and continue? } /* the objext ought to have a reference count ot zero, because it's * on the freelist, but again we should sanity check. */ - if ( object->header.header.count != 0) { + if ( object->header.count != 0) { // TODO: return an exception instead? Or warn, set it, and continue? } @@ -57,6 +65,28 @@ struct pso_pointer allocate( char* tag, uint8_t size_class) { return result; } +uint32_t payload_size( struct pso2* object) { + // TODO: Unit tests DEFINITELY needed! + return ((1 << object->header.tag.bytes.size_class) - sizeof( struct pso_header)); +} + +void free_cell( struct pso_pointer p) { + struct pso2* p2 = pointer_to_object( p); + uint32_t array_size = payload_size(p2); + uint8_t size_class = p2->header.tag.bytes.size_class; + + strncpy( (char *)(p2->header.tag.bytes.mnemonic), FREETAG, TAGLENGTH); + + /* will C just let me cheerfully walk off the end of the array I've declared? */ + for (int i = 0; i < array_size; i++) { + p2->payload.words[i] = 0; + } + + /* TODO: obtain mutex on freelist */ + p2->payload.free.next = freelists[size_class]; + freelists[size_class] = p; +} + /** * increment the reference count of the object at this cons pointer. * @@ -71,14 +101,14 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) { if ( object->header.count < MAXREFERENCE ) { object->header.count++; #ifdef DEBUG - debug_printf( DEBUG_ALLOC, - L"\nIncremented object of type %4.4s at page %u, offset %u to count %u", - ( ( char * ) object->header.tag.bytes ), pointer.page, + debug_printf( DEBUG_ALLOC, 0, + L"\nIncremented object of type %3.3s at page %u, offset %u to count %u", + ( ( char * ) &object->header.tag.bytes.mnemonic[0] ), pointer.page, pointer.offset, object->header.count ); - if ( strncmp( object->header.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) { - debug_printf( DEBUG_ALLOC, - L"; pointer to vector object of type %4.4s.\n", - ( ( char * ) ( object->header.payload.vectorp.tag.bytes ) ) ); + if ( vectorpointp( pointer) ) { + debug_printf( DEBUG_ALLOC, 0, + L"; pointer to vector object of type %3.3s.\n", + ( ( char * ) &( object->payload.vectorp.tag.bytes[0] ) ) ); } else { debug_println( DEBUG_ALLOC ); } @@ -99,18 +129,17 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) { struct pso_pointer dec_ref( struct pso_pointer pointer ) { struct pso2 *object = pointer_to_object( pointer ); - if ( object->count > 0 && object->count != MAXREFERENCE ) { - object->count--; + if ( object->header.count > 0 && object->header.count != MAXREFERENCE ) { + object->header.count--; #ifdef DEBUG - debug_printf( DEBUG_ALLOC, + debug_printf( DEBUG_ALLOC, 0, L"\nDecremented object of type %4.4s at page %d, offset %d to count %d", - ( ( char * ) object->tag.bytes ), pointer.page, - pointer.offset, object->count ); - if ( strncmp( ( char * ) object->tag.bytes, VECTORPOINTTAG, TAGLENGTH ) - == 0 ) { - debug_printf( DEBUG_ALLOC, - L"; pointer to vector object of type %4.4s.\n", - ( ( char * ) ( object->payload.vectorp.tag.bytes ) ) ); + ( ( char * ) (object->header.tag.bytes.mnemonic )), pointer.page, + pointer.offset, object->header.count ); + if ( vectorpointp( pointer)) { + debug_printf( DEBUG_ALLOC, 0, + L"; pointer to vector object of type %3.3s.\n", + ( ( char * ) &( object->payload.vectorp.tag.bytes ) ) ); } else { debug_println( DEBUG_ALLOC ); } @@ -118,7 +147,7 @@ struct pso_pointer dec_ref( struct pso_pointer pointer ) { if ( object->header.count == 0 ) { free_cell( pointer ); - pointer = NIL; + pointer = nil; } } @@ -133,7 +162,7 @@ struct pso_pointer dec_ref( struct pso_pointer pointer ) { void lock_object( struct pso_pointer pointer) { struct pso2* object = pointer_to_object( pointer ); - object->header.header.count = MAXREFERENCE; + object->header.count = MAXREFERENCE; } @@ -145,9 +174,12 @@ void lock_object( struct pso_pointer pointer) { * @return the tag value of the object indicated. */ uint32_t get_tag_value( struct pso_pointer pointer) { - result = (pointer_to_object( pointer)->tag.value & 0xffffff; + struct pso2* object = pointer_to_object( pointer); + uint32_t result = (object->header.tag.value & 0xffffff); - // TODO: deal with the vector pointer issue + if (vectorpointp( pointer)) { + result = (object->payload.vectorp.tag.value & 0xffffff); + } return result; -} \ No newline at end of file +} diff --git a/src/c/memory/pso.h b/src/c/memory/pso.h index 5f91bca..1ce7bf2 100644 --- a/src/c/memory/pso.h +++ b/src/c/memory/pso.h @@ -251,4 +251,6 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ); void lock_object( struct pso_pointer pointer); -#endif \ No newline at end of file +uint32_t get_tag_value( struct pso_pointer pointer); + +#endif diff --git a/src/c/memory/pso2.h b/src/c/memory/pso2.h index e8305d0..4cbad4a 100644 --- a/src/c/memory/pso2.h +++ b/src/c/memory/pso2.h @@ -12,6 +12,7 @@ #include +#include "../payloads/psse-string.h" #include "memory/header.h" #include "payloads/cons.h" #include "payloads/free.h" @@ -22,7 +23,6 @@ #include "payloads/nlambda.h" #include "payloads/read_stream.h" #include "payloads/special.h" -#include "payloads/string.h" #include "payloads/symbol.h" // #include "payloads/time.h" #include "payloads/vector_pointer.h" diff --git a/src/c/ops/eq.c b/src/c/ops/eq.c index d5f7228..9830b96 100644 --- a/src/c/ops/eq.c +++ b/src/c/ops/eq.c @@ -10,8 +10,10 @@ */ #include "memory/memory.h" +#include "memory/node.h" #include "memory/pointer.h" -#include "memory/stack.h" +#include "payloads/stack.h" +#include "ops/truth.h" /** * @brief Function; do these two pointers point to the same object? @@ -41,14 +43,14 @@ bool eq( struct pso_pointer a, struct pso_pointer b ) { * @param env my environment (ignored). * @return `t` if all args are pointers to the same object, else `nil`; */ -struct pso_pointer lisp_eq( struct stack_frame *frame, +struct pso_pointer lisp_eq( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ) { struct pso_pointer result = t; if ( frame->args > 1 ) { for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) { - result = eq( frame->arg[0], fetch_arg( frame, b ) ) ? t : nil; + result = eq( fetch_arg(frame, 0), fetch_arg( frame, b ) ) ? t : nil; } } diff --git a/src/c/ops/eq.h b/src/c/ops/eq.h index 204c297..ca330f4 100644 --- a/src/c/ops/eq.h +++ b/src/c/ops/eq.h @@ -11,10 +11,14 @@ #ifndef __psse_ops_eq_h #define __psse_ops_eq_h +#include + +#include "memory/pointer.h" +#include "memory/pso4.h" bool eq( struct pso_pointer a, struct pso_pointer b ); -struct pso_pointer lisp_eq( struct stack_frame *frame, +struct pso_pointer lisp_eq( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ); diff --git a/src/c/ops/eval.c b/src/c/ops/eval.c index c5d7a35..5e20b71 100644 --- a/src/c/ops/eval.c +++ b/src/c/ops/eval.c @@ -9,14 +9,16 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ -#include "memory/pointer" -#include "memory/stack.h" +#include "memory/pointer.h" +#include "memory/pso4.h" #include "payloads/cons.h" +#include "payloads/exception.h" #include "payloads/function.h" #include "payloads/keyword.h" #include "payloads/lambda.h" #include "payloads/nlambda.h" #include "payloads/special.h" +#include "payloads/stack.h" /** * @brief Despatch eval based on tag of the form in the first position. @@ -26,10 +28,10 @@ * @param env the evaluation environment. * @return struct pso_pointer */ -struct pso_pointer eval_despatch( struct stack_frame *frame, +struct pso_pointer eval_despatch( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ) { - struct pso_pointer result = frame->arg[0]; + struct pso_pointer result = frame->payload.stack_frame.arg[0]; // switch ( get_tag_value( result)) { // case CONSTV: @@ -53,7 +55,7 @@ struct pso_pointer eval_despatch( struct stack_frame *frame, return result; } -struct pso_pointer lisp_eval( struct stack_frame *frame, +struct pso_pointer lisp_eval( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ) { struct pso_pointer result = eval_despatch( frame, frame_pointer, env ); diff --git a/src/c/ops/truth.c b/src/c/ops/truth.c index 631f38d..8e10dd6 100644 --- a/src/c/ops/truth.c +++ b/src/c/ops/truth.c @@ -58,10 +58,10 @@ bool truep( struct pso_pointer p) { * @param env the evaluation environment. * @return `t` if the first argument in this frame is `nil`, else `t` */ -pso_pointer lisp_nilp( struct stack_frame *frame, +pso_pointer lisp_nilp( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ){ - return (nilp(frame->arg[0]) ? t : nil); + return (nilp(frame->payload.stack_frame.arg[0]) ? t : nil); } /** @@ -72,10 +72,10 @@ pso_pointer lisp_nilp( struct stack_frame *frame, * @param env the evaluation environment. * @return `t` if the first argument in this frame is `t`, else `nil`. */ -pso_pointer lisp_truep( struct stack_frame *frame, +pso_pointer lisp_truep( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ){ - return (truep(frame->arg[0]) ? t : nil); + return (truep(frame->payload.stack_frame.arg[0]) ? t : nil); } /** @@ -87,8 +87,8 @@ pso_pointer lisp_truep( struct stack_frame *frame, * @param env the evaluation environment. * @return `t` if the first argument in this frame is not `nil`, else `t`. */ -pso_pointer lisp_not( struct stack_frame *frame, +pso_pointer lisp_not( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ){ - return (not(frame->arg[0]) ? t : nil); -} \ No newline at end of file + return (not(frame->payload.stack_frame.arg[0]) ? t : nil); +} diff --git a/src/c/ops/truth.h b/src/c/ops/truth.h index c59ced9..50fa6e5 100644 --- a/src/c/ops/truth.h +++ b/src/c/ops/truth.h @@ -12,21 +12,21 @@ #ifndef __psse_ops_truth_h #define __psse_ops_truth_h -bool nilp( struct pso_pointer a, struct pso_pointer b ); +bool nilp( struct pso_pointer p ); -struct pso_pointer lisp_nilp( struct stack_frame *frame, +struct pso_pointer lisp_nilp( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ); -bool not( struct pso_pointer a, struct pso_pointer b ); +bool not( struct pso_pointer p ); -struct pso_pointer lisp_not( struct stack_frame *frame, +struct pso_pointer lisp_not( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ); -bool truep( struct pso_pointer a, struct pso_pointer b ); +bool truep( struct pso_pointer p ); -struct pso_pointer lisp_truep( struct stack_frame *frame, +struct pso_pointer lisp_truep( struct pso4 *frame, struct pso_pointer frame_pointer, struct pso_pointer env ); diff --git a/src/c/payloads/exception.c b/src/c/payloads/exception.c new file mode 100644 index 0000000..ea9a1df --- /dev/null +++ b/src/c/payloads/exception.c @@ -0,0 +1,13 @@ + + +#import "memory/pointer.h" +#import "memory/pso.h" +#import "payloads/exception.h" + +/** + * @param p a pointer to an object. + * @return true if that object is an exception, else false. + */ +bool exceptionp( struct pso_pointer p) { + return (get_tag_value( p) == EXCEPTIONTV); +} diff --git a/src/c/payloads/exception.h b/src/c/payloads/exception.h index d6fdc03..edc95ec 100644 --- a/src/c/payloads/exception.h +++ b/src/c/payloads/exception.h @@ -9,6 +9,7 @@ #ifndef __psse_payloads_exception_h #define __psse_payloads_exception_h +#include #include "memory/pointer.h" @@ -27,5 +28,6 @@ struct exception_payload { struct pso_pointer cause; }; +bool exceptionp( struct pso_pointer p); #endif diff --git a/src/c/payloads/string.h b/src/c/payloads/psse-string.h similarity index 100% rename from src/c/payloads/string.h rename to src/c/payloads/psse-string.h diff --git a/src/c/payloads/stack.h b/src/c/payloads/stack.h index 4225dbc..b8510c1 100644 --- a/src/c/payloads/stack.h +++ b/src/c/payloads/stack.h @@ -13,6 +13,7 @@ #define __psse_payloads_stack_h #include "memory/pointer.h" +#include "memory/pso4.h" #define STACKTAG "STK" #define STACKTV 4936787 @@ -47,4 +48,6 @@ struct stack_frame_payload { uint32_t depth; }; +struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index ); + #endif diff --git a/src/c/payloads/vector_pointer.c b/src/c/payloads/vector_pointer.c new file mode 100644 index 0000000..6a09cd1 --- /dev/null +++ b/src/c/payloads/vector_pointer.c @@ -0,0 +1,18 @@ +/** + * payloads/vector_pointer.c + * + * A pointer to an object in vector space. + * + * (c) 2026 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "memory/pointer.h" +#include "memory/pso.h" +#include "payloads/vector_pointer.h" + +bool vectorpointp( struct pso_pointer p) { + return (get_tag_value( p) == VECTORPOINTTV); +} diff --git a/src/c/payloads/vector_pointer.h b/src/c/payloads/vector_pointer.h index 8fda0f3..31b45f0 100644 --- a/src/c/payloads/vector_pointer.h +++ b/src/c/payloads/vector_pointer.h @@ -10,6 +10,8 @@ #ifndef __psse_payloads_vector_pointer_h #define __psse_payloads_vector_pointer_h +#include + #include "memory/pointer.h" /** @@ -37,4 +39,6 @@ struct vectorp_payload { void *address; }; +bool vectorpointp( struct pso_pointer p); + #endif