Much more progress, still doesn't compile.
This commit is contained in:
parent
1ce9fbda77
commit
60921be3d4
25 changed files with 326 additions and 89 deletions
36
src/c/environment/environment.c
Normal file
36
src/c/environment/environment.c
Normal file
|
|
@ -0,0 +1,36 @@
|
|||
/**
|
||||
* environment/environment.c
|
||||
*
|
||||
* Initialise a MINIMAL environment.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
15
src/c/environment/environment.h
Normal file
15
src/c/environment/environment.h
Normal file
|
|
@ -0,0 +1,15 @@
|
|||
/**
|
||||
* environment/environment.h
|
||||
*
|
||||
* Initialise a MINIMAL environment.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* 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
|
||||
83
src/c/io/fopen.h
Normal file
83
src/c/io/fopen.h
Normal file
|
|
@ -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 <simon@journeyman.cc>
|
||||
*
|
||||
* 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 <curl/curl.h>
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
#include <wchar.h>
|
||||
#include <wctype.h>
|
||||
|
||||
#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
|
||||
|
|
@ -16,6 +16,8 @@
|
|||
|
||||
#define TAGLENGTH 3
|
||||
|
||||
#define MAXREFERENCE 4294967295
|
||||
|
||||
/**
|
||||
* @brief Header for all paged space objects.
|
||||
*
|
||||
|
|
|
|||
|
|
@ -7,20 +7,41 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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[];
|
||||
|
|
|
|||
|
|
@ -12,9 +12,10 @@
|
|||
|
||||
#include <bits/stdint-uintn.h>
|
||||
|
||||
#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 );
|
||||
|
|
|
|||
|
|
@ -34,3 +34,4 @@ extern struct pso_pointer t;
|
|||
struct pso_pointer initialise_node( uint32_t index );
|
||||
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -8,10 +8,9 @@
|
|||
*/
|
||||
|
||||
#include <math.h>
|
||||
#include <string.h>
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#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.
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stddef.h>
|
||||
|
||||
#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,7 +40,8 @@ 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.
|
||||
|
|
|
|||
|
|
@ -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 <stdbool.h>
|
||||
#include <string.h>
|
||||
|
||||
#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;
|
||||
}
|
||||
|
|
@ -251,4 +251,6 @@ struct pso_pointer inc_ref( struct pso_pointer pointer );
|
|||
|
||||
void lock_object( struct pso_pointer pointer);
|
||||
|
||||
uint32_t get_tag_value( struct pso_pointer pointer);
|
||||
|
||||
#endif
|
||||
|
|
@ -12,6 +12,7 @@
|
|||
|
||||
#include <stdint.h>
|
||||
|
||||
#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"
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -11,10 +11,14 @@
|
|||
|
||||
#ifndef __psse_ops_eq_h
|
||||
#define __psse_ops_eq_h
|
||||
#include <stdbool.h>
|
||||
|
||||
#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 );
|
||||
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
return (not(frame->payload.stack_frame.arg[0]) ? t : nil);
|
||||
}
|
||||
|
|
@ -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 );
|
||||
|
||||
|
|
|
|||
13
src/c/payloads/exception.c
Normal file
13
src/c/payloads/exception.c
Normal file
|
|
@ -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);
|
||||
}
|
||||
|
|
@ -9,6 +9,7 @@
|
|||
|
||||
#ifndef __psse_payloads_exception_h
|
||||
#define __psse_payloads_exception_h
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "memory/pointer.h"
|
||||
|
||||
|
|
@ -27,5 +28,6 @@ struct exception_payload {
|
|||
struct pso_pointer cause;
|
||||
};
|
||||
|
||||
bool exceptionp( struct pso_pointer p);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
18
src/c/payloads/vector_pointer.c
Normal file
18
src/c/payloads/vector_pointer.c
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
/**
|
||||
* payloads/vector_pointer.c
|
||||
*
|
||||
* A pointer to an object in vector space.
|
||||
*
|
||||
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#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);
|
||||
}
|
||||
|
|
@ -10,6 +10,8 @@
|
|||
#ifndef __psse_payloads_vector_pointer_h
|
||||
#define __psse_payloads_vector_pointer_h
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "memory/pointer.h"
|
||||
|
||||
/**
|
||||
|
|
@ -37,4 +39,6 @@ struct vectorp_payload {
|
|||
void *address;
|
||||
};
|
||||
|
||||
bool vectorpointp( struct pso_pointer p);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue