Compare commits
No commits in common. "60921be3d499f25d4b0444fa70ef74a328b272f1" and "04bf001652864981a6d7819299ff1d875c8a4fd9" have entirely different histories.
60921be3d4
...
04bf001652
25 changed files with 91 additions and 330 deletions
|
|
@ -1,36 +0,0 @@
|
|||
/**
|
||||
* 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;
|
||||
}
|
||||
|
|
@ -1,15 +0,0 @@
|
|||
/**
|
||||
* 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
|
||||
|
|
@ -1,83 +0,0 @@
|
|||
/*
|
||||
* 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,8 +16,6 @@
|
|||
|
||||
#define TAGLENGTH 3
|
||||
|
||||
#define MAXREFERENCE 4294967295
|
||||
|
||||
/**
|
||||
* @brief Header for all paged space objects.
|
||||
*
|
||||
|
|
|
|||
|
|
@ -7,41 +7,20 @@
|
|||
* 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.
|
||||
*/
|
||||
struct pso_pointer freelists[MAX_SIZE_CLASS];
|
||||
|
||||
/**
|
||||
* @brief Flag to prevent re-initialisation.
|
||||
*/
|
||||
bool memory_initialised = false;
|
||||
|
||||
/**
|
||||
* @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
|
||||
* 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 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;
|
||||
struct pso_pointer freelists[MAX_SIZE_CLASS + 1];
|
||||
|
||||
|
||||
int initialise_memory( int node ) {
|
||||
for (uint8_t i = 0; i <= MAX_SIZE_CLASS; i++) {
|
||||
freelists[i] = nil;
|
||||
}
|
||||
|
||||
return t;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -23,7 +23,7 @@
|
|||
*/
|
||||
#define MAX_SIZE_CLASS 0xf
|
||||
|
||||
struct pso_pointer initialise_memory( );
|
||||
int initialise_memory( );
|
||||
|
||||
extern struct pso_pointer out_of_memory_exception;
|
||||
extern struct pso_pointer freelists[];
|
||||
|
|
|
|||
|
|
@ -12,10 +12,9 @@
|
|||
|
||||
#include <bits/stdint-uintn.h>
|
||||
|
||||
#include "environment/environment.h"
|
||||
#include "memory/memory.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "ops/eq.h"
|
||||
#include "ops/equal.h"
|
||||
#include "memory.h"
|
||||
#include "pointer.h"
|
||||
|
||||
/**
|
||||
* @brief Flag to prevent the node being initialised more than once.
|
||||
|
|
@ -32,19 +31,17 @@ 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.
|
||||
|
|
@ -54,8 +51,10 @@ 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 );
|
||||
|
||||
struct pso_pointer result = initialise_memory( index );
|
||||
pso_pointer result = initialise_memory( index );
|
||||
|
||||
if ( eq( result, t ) ) {
|
||||
result = initialise_environment( index );
|
||||
|
|
|
|||
|
|
@ -34,4 +34,3 @@ extern struct pso_pointer t;
|
|||
struct pso_pointer initialise_node( uint32_t index );
|
||||
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -8,9 +8,10 @@
|
|||
*/
|
||||
|
||||
#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"
|
||||
|
|
@ -70,19 +71,23 @@ struct pso_pointer initialise_page( union page* page_addr, uint16_t page_index,
|
|||
struct pso2* object = (struct pso2 *)(page_addr + (i * obj_bytes));
|
||||
|
||||
object->header.tag.bytes.size_class = size_class;
|
||||
strncpy( &(object->header.tag.bytes.mnemonic[0]), FREETAG, TAGLENGTH);
|
||||
strncpy( (char *)(object->header.tag.bytes.mnemonic), FREETAG, TAGLENGTH);
|
||||
object->payload.free.next = result;
|
||||
|
||||
result = make_pointer( node_index, page_index, (uint16_t)( i * obj_size));
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* @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,6 +72,7 @@ union page {
|
|||
struct psof psofs[PAGE_BYTES / 262144];
|
||||
};
|
||||
|
||||
struct pso_pointer allocate_page( uint8_t size_class );
|
||||
struct pso_pointer initialise_page( union page * page_addr, uint16_t page_index,
|
||||
uint8_t size_class, struct pso_pointer freelist);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,16 +1,13 @@
|
|||
/**
|
||||
* memory/node.h
|
||||
* memory/pointer.h
|
||||
*
|
||||
* The node on which this instance resides.
|
||||
* A pointer to a paged space object.
|
||||
*
|
||||
* (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"
|
||||
|
||||
|
|
@ -23,7 +20,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, offset};
|
||||
return struct pso_pointer{ node, page, pointer};
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -40,8 +37,7 @@ struct pso2* pointer_to_object( struct pso_pointer pointer) {
|
|||
struct pso2* result = NULL;
|
||||
|
||||
if ( pointer.node == node_index) {
|
||||
union page* pg = pages[pointer.page];
|
||||
result = (struct pso2*) &pg->words[pointer.offset];
|
||||
result = (struct pso2*) &(pages[pointer.node] + (pointer.offset * sizeof( uint64_t)));
|
||||
}
|
||||
// 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,17 +14,9 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#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"
|
||||
#include "memory/page.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
|
||||
/**
|
||||
* @brief Allocate an object of this size_class with this tag.
|
||||
|
|
@ -37,8 +29,8 @@ struct pso_pointer allocate( char* tag, uint8_t size_class) {
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if (size_class <= MAX_SIZE_CLASS) {
|
||||
if (nilp( freelists[size_class])) {
|
||||
result = allocate_page(size_class);
|
||||
if (freelists[size_class] == nil) {
|
||||
result = allocate_page(size_class)
|
||||
}
|
||||
|
||||
if ( !exceptionp( result) && not( freelists[size_class] ) ) {
|
||||
|
|
@ -46,16 +38,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.bytes.mnemonic), tag, TAGLENGTH);
|
||||
strncpy( (char *)(object->header.tag.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.bytes.size_class != size_class) {
|
||||
if ( object->header.tag.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.count != 0) {
|
||||
if ( object->header.header.count != 0) {
|
||||
// TODO: return an exception instead? Or warn, set it, and continue?
|
||||
}
|
||||
|
||||
|
|
@ -65,28 +57,6 @@ 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.
|
||||
*
|
||||
|
|
@ -101,14 +71,14 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
|
|||
if ( object->header.count < MAXREFERENCE ) {
|
||||
object->header.count++;
|
||||
#ifdef DEBUG
|
||||
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,
|
||||
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,
|
||||
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[0] ) ) );
|
||||
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 ) ) );
|
||||
} else {
|
||||
debug_println( DEBUG_ALLOC );
|
||||
}
|
||||
|
|
@ -129,17 +99,18 @@ 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->header.count > 0 && object->header.count != MAXREFERENCE ) {
|
||||
object->header.count--;
|
||||
if ( object->count > 0 && object->count != MAXREFERENCE ) {
|
||||
object->count--;
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
debug_printf( DEBUG_ALLOC,
|
||||
L"\nDecremented object of type %4.4s at page %d, offset %d to count %d",
|
||||
( ( 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 ) ) );
|
||||
( ( 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 ) ) );
|
||||
} else {
|
||||
debug_println( DEBUG_ALLOC );
|
||||
}
|
||||
|
|
@ -147,7 +118,7 @@ struct pso_pointer dec_ref( struct pso_pointer pointer ) {
|
|||
|
||||
if ( object->header.count == 0 ) {
|
||||
free_cell( pointer );
|
||||
pointer = nil;
|
||||
pointer = NIL;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -162,7 +133,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.count = MAXREFERENCE;
|
||||
object->header.header.count = MAXREFERENCE;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -174,12 +145,9 @@ void lock_object( struct pso_pointer pointer) {
|
|||
* @return the tag value of the object indicated.
|
||||
*/
|
||||
uint32_t get_tag_value( struct pso_pointer pointer) {
|
||||
struct pso2* object = pointer_to_object( pointer);
|
||||
uint32_t result = (object->header.tag.value & 0xffffff);
|
||||
result = (pointer_to_object( pointer)->tag.value & 0xffffff;
|
||||
|
||||
if (vectorpointp( pointer)) {
|
||||
result = (object->payload.vectorp.tag.value & 0xffffff);
|
||||
}
|
||||
// TODO: deal with the vector pointer issue
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -251,6 +251,4 @@ 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,7 +12,6 @@
|
|||
|
||||
#include <stdint.h>
|
||||
|
||||
#include "../payloads/psse-string.h"
|
||||
#include "memory/header.h"
|
||||
#include "payloads/cons.h"
|
||||
#include "payloads/free.h"
|
||||
|
|
@ -23,6 +22,7 @@
|
|||
#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,10 +10,8 @@
|
|||
*/
|
||||
|
||||
#include "memory/memory.h"
|
||||
#include "memory/node.h"
|
||||
#include "memory/pointer.h"
|
||||
#include "payloads/stack.h"
|
||||
#include "ops/truth.h"
|
||||
#include "memory/stack.h"
|
||||
|
||||
/**
|
||||
* @brief Function; do these two pointers point to the same object?
|
||||
|
|
@ -43,14 +41,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 pso4 *frame,
|
||||
struct pso_pointer lisp_eq( struct stack_frame *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( fetch_arg(frame, 0), fetch_arg( frame, b ) ) ? t : nil;
|
||||
result = eq( frame->arg[0], fetch_arg( frame, b ) ) ? t : nil;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -11,14 +11,10 @@
|
|||
|
||||
#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 pso4 *frame,
|
||||
struct pso_pointer lisp_eq( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
|
|
|
|||
|
|
@ -9,16 +9,14 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/pointer"
|
||||
#include "memory/stack.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.
|
||||
|
|
@ -28,10 +26,10 @@
|
|||
* @param env the evaluation environment.
|
||||
* @return struct pso_pointer
|
||||
*/
|
||||
struct pso_pointer eval_despatch( struct pso4 *frame,
|
||||
struct pso_pointer eval_despatch( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso_pointer result = frame->payload.stack_frame.arg[0];
|
||||
struct pso_pointer result = frame->arg[0];
|
||||
|
||||
// switch ( get_tag_value( result)) {
|
||||
// case CONSTV:
|
||||
|
|
@ -55,7 +53,7 @@ struct pso_pointer eval_despatch( struct pso4 *frame,
|
|||
return result;
|
||||
}
|
||||
|
||||
struct pso_pointer lisp_eval( struct pso4 *frame,
|
||||
struct pso_pointer lisp_eval( struct stack_frame *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 pso4 *frame,
|
||||
pso_pointer lisp_nilp( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ){
|
||||
return (nilp(frame->payload.stack_frame.arg[0]) ? t : nil);
|
||||
return (nilp(frame->arg[0]) ? t : nil);
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -72,10 +72,10 @@ pso_pointer lisp_nilp( struct pso4 *frame,
|
|||
* @param env the evaluation environment.
|
||||
* @return `t` if the first argument in this frame is `t`, else `nil`.
|
||||
*/
|
||||
pso_pointer lisp_truep( struct pso4 *frame,
|
||||
pso_pointer lisp_truep( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ){
|
||||
return (truep(frame->payload.stack_frame.arg[0]) ? t : nil);
|
||||
return (truep(frame->arg[0]) ? t : nil);
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -87,8 +87,8 @@ pso_pointer lisp_truep( struct pso4 *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 pso4 *frame,
|
||||
pso_pointer lisp_not( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ){
|
||||
return (not(frame->payload.stack_frame.arg[0]) ? t : nil);
|
||||
return (not(frame->arg[0]) ? t : nil);
|
||||
}
|
||||
|
|
@ -12,21 +12,21 @@
|
|||
#ifndef __psse_ops_truth_h
|
||||
#define __psse_ops_truth_h
|
||||
|
||||
bool nilp( struct pso_pointer p );
|
||||
bool nilp( struct pso_pointer a, struct pso_pointer b );
|
||||
|
||||
struct pso_pointer lisp_nilp( struct pso4 *frame,
|
||||
struct pso_pointer lisp_nilp( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
bool not( struct pso_pointer p );
|
||||
bool not( struct pso_pointer a, struct pso_pointer b );
|
||||
|
||||
struct pso_pointer lisp_not( struct pso4 *frame,
|
||||
struct pso_pointer lisp_not( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
bool truep( struct pso_pointer p );
|
||||
bool truep( struct pso_pointer a, struct pso_pointer b );
|
||||
|
||||
struct pso_pointer lisp_truep( struct pso4 *frame,
|
||||
struct pso_pointer lisp_truep( struct stack_frame *frame,
|
||||
struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env );
|
||||
|
||||
|
|
|
|||
|
|
@ -1,13 +0,0 @@
|
|||
|
||||
|
||||
#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,7 +9,6 @@
|
|||
|
||||
#ifndef __psse_payloads_exception_h
|
||||
#define __psse_payloads_exception_h
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "memory/pointer.h"
|
||||
|
||||
|
|
@ -28,6 +27,5 @@ struct exception_payload {
|
|||
struct pso_pointer cause;
|
||||
};
|
||||
|
||||
bool exceptionp( struct pso_pointer p);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -13,7 +13,6 @@
|
|||
#define __psse_payloads_stack_h
|
||||
|
||||
#include "memory/pointer.h"
|
||||
#include "memory/pso4.h"
|
||||
|
||||
#define STACKTAG "STK"
|
||||
#define STACKTV 4936787
|
||||
|
|
@ -48,6 +47,4 @@ struct stack_frame_payload {
|
|||
uint32_t depth;
|
||||
};
|
||||
|
||||
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index );
|
||||
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,18 +0,0 @@
|
|||
/**
|
||||
* 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,8 +10,6 @@
|
|||
#ifndef __psse_payloads_vector_pointer_h
|
||||
#define __psse_payloads_vector_pointer_h
|
||||
|
||||
#include <stdbool.h>
|
||||
|
||||
#include "memory/pointer.h"
|
||||
|
||||
/**
|
||||
|
|
@ -39,6 +37,4 @@ struct vectorp_payload {
|
|||
void *address;
|
||||
};
|
||||
|
||||
bool vectorpointp( struct pso_pointer p);
|
||||
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue