My monster, it not only compiles, it now runs!
This commit is contained in:
parent
60921be3d4
commit
a8b4a6e69d
26 changed files with 244 additions and 172 deletions
5
Makefile
5
Makefile
|
|
@ -8,8 +8,9 @@ DEPS := $(OBJS:.o=.d)
|
||||||
|
|
||||||
TESTS := $(shell find unit-tests -name *.sh)
|
TESTS := $(shell find unit-tests -name *.sh)
|
||||||
|
|
||||||
INC_DIRS := $(shell find $(SRC_DIRS) -type d)
|
# INC_DIRS := $(shell find $(SRC_DIRS) -type d)
|
||||||
INC_FLAGS := $(addprefix -I,$(INC_DIRS))
|
# INC_FLAGS := $(addprefix -I,$(INC_DIRS))
|
||||||
|
INC_FLAGS := -I $(SRC_DIRS)
|
||||||
|
|
||||||
TMP_DIR ?= ./tmp
|
TMP_DIR ?= ./tmp
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -56,7 +56,8 @@ uint32_t npages_allocated = 0;
|
||||||
* @return struct pso_pointer the new head for the freelist for this size_class,
|
* @return struct pso_pointer the new head for the freelist for this size_class,
|
||||||
*/
|
*/
|
||||||
struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
|
struct pso_pointer initialise_page( union page *page_addr, uint16_t page_index,
|
||||||
uint8_t size_class, struct pso_pointer freelist) {
|
uint8_t size_class,
|
||||||
|
struct pso_pointer freelist ) {
|
||||||
struct pso_pointer result = freelist;
|
struct pso_pointer result = freelist;
|
||||||
int obj_size = pow( 2, size_class );
|
int obj_size = pow( 2, size_class );
|
||||||
int obj_bytes = obj_size * sizeof( uint64_t );
|
int obj_bytes = obj_size * sizeof( uint64_t );
|
||||||
|
|
@ -67,13 +68,17 @@ struct pso_pointer initialise_page( union page* page_addr, uint16_t page_index,
|
||||||
// `nil` and the next on for `t`.
|
// `nil` and the next on for `t`.
|
||||||
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
for ( int i = objs_in_page - 1; i >= 0; i-- ) {
|
||||||
// it should be safe to cast any pso object to a pso2
|
// it should be safe to cast any pso object to a pso2
|
||||||
struct pso2* object = (struct pso2 *)(page_addr + (i * obj_bytes));
|
struct pso2 *object =
|
||||||
|
( struct pso2 * ) ( page_addr + ( i * obj_bytes ) );
|
||||||
|
|
||||||
object->header.tag.bytes.size_class = size_class;
|
object->header.tag.bytes.size_class = size_class;
|
||||||
strncpy( &(object->header.tag.bytes.mnemonic[0]), FREETAG, TAGLENGTH);
|
strncpy( &( object->header.tag.bytes.mnemonic[0] ), FREETAG,
|
||||||
|
TAGLENGTH );
|
||||||
object->payload.free.next = result;
|
object->payload.free.next = result;
|
||||||
|
|
||||||
result = make_pointer( node_index, page_index, (uint16_t)( i * obj_size));
|
result =
|
||||||
|
make_pointer( node_index, page_index,
|
||||||
|
( uint16_t ) ( i * obj_size ) );
|
||||||
}
|
}
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
|
|
@ -108,12 +113,12 @@ struct pso_pointer allocate_page( uint8_t size_class ) {
|
||||||
npages_allocated, size_class );
|
npages_allocated, size_class );
|
||||||
|
|
||||||
freelists[size_class] =
|
freelists[size_class] =
|
||||||
initialise_page( (union page*)pg, npages_allocated, size_class, freelists[size_class] );
|
initialise_page( ( union page * ) pg, npages_allocated,
|
||||||
|
size_class, freelists[size_class] );
|
||||||
|
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"Initialised page %d; freelist for size class %x updated.\n",
|
L"Initialised page %d; freelist for size class %x updated.\n",
|
||||||
npages_allocated,
|
npages_allocated, size_class );
|
||||||
size_class);
|
|
||||||
|
|
||||||
npages_allocated++;
|
npages_allocated++;
|
||||||
} else {
|
} else {
|
||||||
|
|
|
||||||
|
|
@ -22,7 +22,8 @@
|
||||||
* @param offset The offset, in words, within that page, of the object.
|
* @param offset The offset, in words, within that page, of the object.
|
||||||
* @return struct pso_pointer a pointer referencing the specified object.
|
* @return struct pso_pointer a pointer referencing the specified object.
|
||||||
*/
|
*/
|
||||||
struct pso_pointer make_pointer( uint32_t node, uint16_t page, uint16_t offset) {
|
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, offset };
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -48,4 +49,3 @@ struct pso2* pointer_to_object( struct pso_pointer pointer) {
|
||||||
|
|
||||||
return result;
|
return result;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -46,7 +46,8 @@ struct pso_pointer allocate( char* tag, uint8_t size_class) {
|
||||||
struct pso2 *object = pointer_to_object( result );
|
struct pso2 *object = pointer_to_object( result );
|
||||||
freelists[size_class] = object->payload.free.next;
|
freelists[size_class] = object->payload.free.next;
|
||||||
|
|
||||||
strncpy( (char *)(object->header.tag.bytes.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
|
/* the object ought already to have the right size class in its tag
|
||||||
* because it was popped off the freelist for that size class. */
|
* because it was popped off the freelist for that size class. */
|
||||||
|
|
@ -67,7 +68,8 @@ struct pso_pointer allocate( char* tag, uint8_t size_class) {
|
||||||
|
|
||||||
uint32_t payload_size( struct pso2 *object ) {
|
uint32_t payload_size( struct pso2 *object ) {
|
||||||
// TODO: Unit tests DEFINITELY needed!
|
// TODO: Unit tests DEFINITELY needed!
|
||||||
return ((1 << object->header.tag.bytes.size_class) - sizeof( struct pso_header));
|
return ( ( 1 << object->header.tag.bytes.size_class ) -
|
||||||
|
sizeof( struct pso_header ) );
|
||||||
}
|
}
|
||||||
|
|
||||||
void free_cell( struct pso_pointer p ) {
|
void free_cell( struct pso_pointer p ) {
|
||||||
|
|
@ -75,7 +77,8 @@ void free_cell( struct pso_pointer p) {
|
||||||
uint32_t array_size = payload_size( p2 );
|
uint32_t array_size = payload_size( p2 );
|
||||||
uint8_t size_class = p2->header.tag.bytes.size_class;
|
uint8_t size_class = p2->header.tag.bytes.size_class;
|
||||||
|
|
||||||
strncpy( (char *)(p2->header.tag.bytes.mnemonic), FREETAG, TAGLENGTH);
|
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? */
|
/* will C just let me cheerfully walk off the end of the array I've declared? */
|
||||||
for ( int i = 0; i < array_size; i++ ) {
|
for ( int i = 0; i < array_size; i++ ) {
|
||||||
|
|
@ -103,12 +106,13 @@ struct pso_pointer inc_ref( struct pso_pointer pointer ) {
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"\nIncremented object of type %3.3s at page %u, offset %u to count %u",
|
L"\nIncremented object of type %3.3s at page %u, offset %u to count %u",
|
||||||
( ( char * ) &object->header.tag.bytes.mnemonic[0] ), pointer.page,
|
( ( char * ) &object->header.tag.bytes.mnemonic[0] ),
|
||||||
pointer.offset, object->header.count );
|
pointer.page, pointer.offset, object->header.count );
|
||||||
if ( vectorpointp( pointer ) ) {
|
if ( vectorpointp( pointer ) ) {
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"; pointer to vector object of type %3.3s.\n",
|
L"; pointer to vector object of type %3.3s.\n",
|
||||||
( ( char * ) &( object->payload.vectorp.tag.bytes[0] ) ) );
|
( ( char * )
|
||||||
|
&( object->payload.vectorp.tag.bytes[0] ) ) );
|
||||||
} else {
|
} else {
|
||||||
debug_println( DEBUG_ALLOC );
|
debug_println( DEBUG_ALLOC );
|
||||||
}
|
}
|
||||||
|
|
@ -134,12 +138,13 @@ struct pso_pointer dec_ref( struct pso_pointer pointer ) {
|
||||||
#ifdef DEBUG
|
#ifdef DEBUG
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"\nDecremented object of type %4.4s at page %d, offset %d to count %d",
|
L"\nDecremented object of type %4.4s at page %d, offset %d to count %d",
|
||||||
( ( char * ) (object->header.tag.bytes.mnemonic )), pointer.page,
|
( ( char * ) ( object->header.tag.bytes.mnemonic ) ),
|
||||||
pointer.offset, object->header.count );
|
pointer.page, pointer.offset, object->header.count );
|
||||||
if ( vectorpointp( pointer ) ) {
|
if ( vectorpointp( pointer ) ) {
|
||||||
debug_printf( DEBUG_ALLOC, 0,
|
debug_printf( DEBUG_ALLOC, 0,
|
||||||
L"; pointer to vector object of type %3.3s.\n",
|
L"; pointer to vector object of type %3.3s.\n",
|
||||||
( ( char * ) &( object->payload.vectorp.tag.bytes ) ) );
|
( ( char * )
|
||||||
|
&( object->payload.vectorp.tag.bytes ) ) );
|
||||||
} else {
|
} else {
|
||||||
debug_println( DEBUG_ALLOC );
|
debug_println( DEBUG_ALLOC );
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -13,6 +13,7 @@
|
||||||
#include "memory/node.h"
|
#include "memory/node.h"
|
||||||
#include "memory/pointer.h"
|
#include "memory/pointer.h"
|
||||||
#include "payloads/stack.h"
|
#include "payloads/stack.h"
|
||||||
|
#include "ops/stack_ops.h"
|
||||||
#include "ops/truth.h"
|
#include "ops/truth.h"
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
@ -48,9 +49,12 @@ struct pso_pointer lisp_eq( struct pso4 *frame,
|
||||||
struct pso_pointer env ) {
|
struct pso_pointer env ) {
|
||||||
struct pso_pointer result = t;
|
struct pso_pointer result = t;
|
||||||
|
|
||||||
if ( frame->args > 1 ) {
|
if ( frame->payload.stack_frame.args > 1 ) {
|
||||||
for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) {
|
for ( int b = 1;
|
||||||
result = eq( fetch_arg(frame, 0), fetch_arg( frame, b ) ) ? t : nil;
|
( truep( result ) ) && ( b < frame->payload.stack_frame.args );
|
||||||
|
b++ ) {
|
||||||
|
result =
|
||||||
|
eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,15 @@
|
||||||
|
/**
|
||||||
|
* ops/repl.h
|
||||||
|
*
|
||||||
|
* The read/eval/print loop.
|
||||||
|
*
|
||||||
|
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||||
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef __psse_ops_repl_h
|
||||||
|
#define __psse_ops_repl_h
|
||||||
|
|
||||||
|
// struct pso_pointer repl( struct pso_pointer prompt, struct pso_pointer readtable);
|
||||||
|
|
||||||
|
#endif
|
||||||
30
src/c/ops/stack_ops.h
Normal file
30
src/c/ops/stack_ops.h
Normal file
|
|
@ -0,0 +1,30 @@
|
||||||
|
/**
|
||||||
|
* ops/stack_ops.h
|
||||||
|
*
|
||||||
|
* Operations on a Lisp stack frame.
|
||||||
|
*
|
||||||
|
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||||
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#ifndef __psse_ops_stack_ops_h
|
||||||
|
#define __psse_ops_stack_ops_h
|
||||||
|
|
||||||
|
#include "memory/pointer.h"
|
||||||
|
#include "memory/pso4.h"
|
||||||
|
|
||||||
|
/*
|
||||||
|
* number of arguments stored in a stack frame
|
||||||
|
*/
|
||||||
|
#define args_in_frame 8
|
||||||
|
|
||||||
|
/**
|
||||||
|
* @brief The maximum depth of stack before we throw an exception.
|
||||||
|
*
|
||||||
|
* `0` is interpeted as `unlimited`.
|
||||||
|
*/
|
||||||
|
extern uint32_t stack_limit;
|
||||||
|
|
||||||
|
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index );
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
@ -9,6 +9,12 @@
|
||||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
#include <stdbool.h>
|
||||||
|
|
||||||
|
#include "memory/node.h"
|
||||||
|
#include "memory/pointer.h"
|
||||||
|
#include "ops/stack_ops.h"
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief true if `p` points to `nil`, else false.
|
* @brief true if `p` points to `nil`, else false.
|
||||||
*
|
*
|
||||||
|
|
@ -21,7 +27,7 @@
|
||||||
* @return false otherwise.
|
* @return false otherwise.
|
||||||
*/
|
*/
|
||||||
bool nilp( struct pso_pointer p ) {
|
bool nilp( struct pso_pointer p ) {
|
||||||
return (p.page == 0 && p.offset = 0);
|
return ( p.page == 0 && p.offset == 0 );
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
@ -47,7 +53,7 @@ bool not( struct pso_pointer p) {
|
||||||
* @return false otherwise.
|
* @return false otherwise.
|
||||||
*/
|
*/
|
||||||
bool truep( struct pso_pointer p ) {
|
bool truep( struct pso_pointer p ) {
|
||||||
return (p.page == 0 && p.offset = 1);
|
return ( p.page == 0 && p.offset == 1 );
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
@ -58,10 +64,10 @@ bool truep( struct pso_pointer p) {
|
||||||
* @param env the evaluation environment.
|
* @param env the evaluation environment.
|
||||||
* @return `t` if the first argument in this frame is `nil`, else `t`
|
* @return `t` if the first argument in this frame is `nil`, else `t`
|
||||||
*/
|
*/
|
||||||
pso_pointer lisp_nilp( struct pso4 *frame,
|
struct pso_pointer lisp_nilp( struct pso4 *frame,
|
||||||
struct pso_pointer frame_pointer,
|
struct pso_pointer frame_pointer,
|
||||||
struct pso_pointer env ) {
|
struct pso_pointer env ) {
|
||||||
return (nilp(frame->payload.stack_frame.arg[0]) ? t : nil);
|
return ( nilp( fetch_arg( frame, 0 )) ? t : nil );
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
@ -72,10 +78,10 @@ pso_pointer lisp_nilp( struct pso4 *frame,
|
||||||
* @param env the evaluation environment.
|
* @param env the evaluation environment.
|
||||||
* @return `t` if the first argument in this frame is `t`, else `nil`.
|
* @return `t` if the first argument in this frame is `t`, else `nil`.
|
||||||
*/
|
*/
|
||||||
pso_pointer lisp_truep( struct pso4 *frame,
|
struct pso_pointer lisp_truep( struct pso4 *frame,
|
||||||
struct pso_pointer frame_pointer,
|
struct pso_pointer frame_pointer,
|
||||||
struct pso_pointer env ) {
|
struct pso_pointer env ) {
|
||||||
return (truep(frame->payload.stack_frame.arg[0]) ? t : nil);
|
return ( truep( fetch_arg( frame, 0 ) ) ? t : nil );
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
|
|
@ -87,8 +93,8 @@ pso_pointer lisp_truep( struct pso4 *frame,
|
||||||
* @param env the evaluation environment.
|
* @param env the evaluation environment.
|
||||||
* @return `t` if the first argument in this frame is not `nil`, else `t`.
|
* @return `t` if the first argument in this frame is not `nil`, else `t`.
|
||||||
*/
|
*/
|
||||||
pso_pointer lisp_not( struct pso4 *frame,
|
struct pso_pointer lisp_not( struct pso4 *frame,
|
||||||
struct pso_pointer frame_pointer,
|
struct pso_pointer frame_pointer,
|
||||||
struct pso_pointer env ) {
|
struct pso_pointer env ) {
|
||||||
return (not(frame->payload.stack_frame.arg[0]) ? t : nil);
|
return ( not( fetch_arg( frame, 0 ) ) ? t : nil );
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -11,6 +11,10 @@
|
||||||
|
|
||||||
#ifndef __psse_ops_truth_h
|
#ifndef __psse_ops_truth_h
|
||||||
#define __psse_ops_truth_h
|
#define __psse_ops_truth_h
|
||||||
|
#include <stdbool.h>
|
||||||
|
|
||||||
|
#include "memory/pointer.h"
|
||||||
|
#include "memory/pso4.h"
|
||||||
|
|
||||||
bool nilp( struct pso_pointer p );
|
bool nilp( struct pso_pointer p );
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,8 +1,16 @@
|
||||||
|
/**
|
||||||
|
* payloads/exception.c
|
||||||
|
*
|
||||||
|
* An exception; required three pointers, so use object of size class 3.
|
||||||
|
*
|
||||||
|
* (c) 2026 Simon Brooke <simon@journeyman.cc>
|
||||||
|
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||||
|
*/
|
||||||
|
|
||||||
|
|
||||||
#import "memory/pointer.h"
|
#include "memory/pointer.h"
|
||||||
#import "memory/pso.h"
|
#include "memory/pso.h"
|
||||||
#import "payloads/exception.h"
|
#include "payloads/exception.h"
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @param p a pointer to an object.
|
* @param p a pointer to an object.
|
||||||
|
|
|
||||||
|
|
@ -50,7 +50,8 @@ struct pso_pointer make_mutex();
|
||||||
* @param forms a list of arbitrary Lisp forms.
|
* @param forms a list of arbitrary Lisp forms.
|
||||||
* @return struct pso_pointer the result.
|
* @return struct pso_pointer the result.
|
||||||
*/
|
*/
|
||||||
struct pso_pointer with_lock( struct pso_pointer lock, struct pso_pointer forms);
|
struct pso_pointer with_lock( struct pso_pointer lock,
|
||||||
|
struct pso_pointer forms );
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* @brief as with_lock, q.v. but attempts to obtain a lock and returns an
|
* @brief as with_lock, q.v. but attempts to obtain a lock and returns an
|
||||||
|
|
@ -64,6 +65,7 @@ struct pso_pointer with_lock( struct pso_pointer lock, struct pso_pointer forms)
|
||||||
* @param forms a list of arbitrary Lisp forms.
|
* @param forms a list of arbitrary Lisp forms.
|
||||||
* @return struct pso_pointer the result.
|
* @return struct pso_pointer the result.
|
||||||
*/
|
*/
|
||||||
struct pso_pointer attempt_with_lock( struct pso_pointer lock, struct pso_pointer forms);
|
struct pso_pointer attempt_with_lock( struct pso_pointer lock,
|
||||||
|
struct pso_pointer forms );
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -13,7 +13,7 @@
|
||||||
#define __psse_payloads_stack_h
|
#define __psse_payloads_stack_h
|
||||||
|
|
||||||
#include "memory/pointer.h"
|
#include "memory/pointer.h"
|
||||||
#include "memory/pso4.h"
|
// #include "memory/pso4.h"
|
||||||
|
|
||||||
#define STACKTAG "STK"
|
#define STACKTAG "STK"
|
||||||
#define STACKTV 4936787
|
#define STACKTV 4936787
|
||||||
|
|
@ -23,13 +23,6 @@
|
||||||
*/
|
*/
|
||||||
#define args_in_frame 8
|
#define args_in_frame 8
|
||||||
|
|
||||||
/**
|
|
||||||
* @brief The maximum depth of stack before we throw an exception.
|
|
||||||
*
|
|
||||||
* `0` is interpeted as `unlimited`.
|
|
||||||
*/
|
|
||||||
extern uint32_t stack_limit;
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* A stack frame.
|
* A stack frame.
|
||||||
*/
|
*/
|
||||||
|
|
@ -48,6 +41,4 @@ struct stack_frame_payload {
|
||||||
uint32_t depth;
|
uint32_t depth;
|
||||||
};
|
};
|
||||||
|
|
||||||
struct pso_pointer fetch_arg( struct pso4 *frame, unsigned int index );
|
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
|
||||||
|
|
@ -14,6 +14,7 @@
|
||||||
|
|
||||||
#include "psse.h"
|
#include "psse.h"
|
||||||
#include "memory/node.h"
|
#include "memory/node.h"
|
||||||
|
#include "ops/stack_ops.h"
|
||||||
|
|
||||||
void print_banner( ) {
|
void print_banner( ) {
|
||||||
fwprintf( stdout, L"Post-Scarcity Software Environment version %s\n\n",
|
fwprintf( stdout, L"Post-Scarcity Software Environment version %s\n\n",
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue