archive/c/ops/equal.c

@@ -272,7 +272,7 @@ bool equal_map_map( struct cons_pointer a, struct cons_pointer b ) {
 
         for ( struct cons_pointer i = keys_a; !nilp( i ); i = c_cdr( i ) ) {
             struct cons_pointer key = c_car( i );
-            if ( !c_equal
+            if ( !equal
                  ( hashmap_get( a, key, false ),
                    hashmap_get( b, key, false ) ) ) {
                 result = false;
@@ -331,7 +331,7 @@ bool equal_vector_vector( struct cons_pointer a, struct cons_pointer b ) {
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
  */
-bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
+bool equal( struct cons_pointer a, struct cons_pointer b ) {
     debug_print( L"\nequal: ", DEBUG_EQUAL );
     debug_print_object( a, DEBUG_EQUAL );
     debug_print( L" = ", DEBUG_EQUAL );
@@ -353,8 +353,8 @@ bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
                  * structures can be of indefinite extent. It *must* be done by 
                  * iteration (and even that is problematic) */
                 result =
-                    c_equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
+                    equal( cell_a->payload.cons.car, cell_b->payload.cons.car )
-                    && c_equal( cell_a->payload.cons.cdr,
+                    && equal( cell_a->payload.cons.cdr,
                               cell_b->payload.cons.cdr );
                 break;
             case KEYTV:
@@ -401,7 +401,7 @@ bool c_equal( struct cons_pointer a, struct cons_pointer b ) {
                      * isn't sufficient. So we recurse at least once. */
 
                     result = ( wcsncmp( a_buff, b_buff, i ) == 0 )
-                        && c_equal( c_cdr( a ), c_cdr( b ) );
+                        && equal( c_cdr( a ), c_cdr( b ) );
                 }
                 break;
             case VECTORPOINTTV:

archive/c/ops/equal.h

@@ -31,6 +31,6 @@ bool eq( struct cons_pointer a, struct cons_pointer b );
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
  */
-bool c_equal( struct cons_pointer a, struct cons_pointer b );
+bool equal( struct cons_pointer a, struct cons_pointer b );
 
 #endif

archive/c/ops/intern.c

@@ -334,7 +334,7 @@ struct cons_pointer search_store( struct cons_pointer key,
 
                                 switch ( get_tag_value( entry_ptr ) ) {
                                     case CONSTV:
-                                        if ( c_equal( key, c_car( entry_ptr ) ) ) {
+                                        if ( equal( key, c_car( entry_ptr ) ) ) {
                                             result =
                                                 return_key ? c_car( entry_ptr )
                                                 : c_cdr( entry_ptr );
@@ -441,7 +441,7 @@ struct cons_pointer internedp( struct cons_pointer key,
         for ( struct cons_pointer pair = c_car( store );
               eq( result, NIL ) && !nilp( pair ); pair = c_car( store ) ) {
             if ( consp( pair ) ) {
-                if ( c_equal( c_car( pair ), key ) ) {
+                if ( equal( c_car( pair ), key ) ) {
                     // yes, this should be `eq`, but if symbols are correctly 
                     // interned this will work efficiently, and if not it will
                     // still work.

archive/c/ops/lispops.c

@@ -987,7 +987,7 @@ lisp_equal( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( frame->args > 1 ) {
         for ( int b = 1; ( truep( result ) ) && ( b < frame->args ); b++ ) {
             result =
-                c_equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
+                equal( frame->arg[0], fetch_arg( frame, b ) ) ? TRUE : NIL;
         }
     }
 

src/c/io/io.c

@@ -114,7 +114,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
     if ( stringp( s ) || symbolp( s ) ) {
         int len = 0;
 
-        for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) {
+        for ( struct pso_pointer c = s; !nilp( c );
+              c = cdr(c)) {
             len++;
         }
 
@@ -123,7 +124,8 @@ char *lisp_string_to_c_string( struct pso_pointer s ) {
         result = calloc( ( len * 4 ) + 1, sizeof( char ) );
 
         int i = 0;
-        for ( struct pso_pointer c = s; !nilp( c ); c = cdr( c ) ) {
+        for ( struct pso_pointer c = s; !nilp( c );
+              c = cdr(c)) {
             buffer[i++] = pointer_to_object( c )->payload.string.character;
         }
 
@@ -263,10 +265,7 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
 	struct pso_pointer result = nil;
 
 	if (readp( read_stream)) {
-        result =
+		result = make_character( url_fgetwc( pointer_to_object_of_size_class(read_stream, 2)->payload.stream.stream));
-            make_character( url_fgetwc
-                            ( pointer_to_object_of_size_class
-                              ( read_stream, 2 )->payload.stream.stream ) );
 	}
 
 	return result;
@@ -280,16 +279,12 @@ struct pso_pointer get_character( struct pso_pointer read_stream ) {
  *
  * @return `t` on success, else `nil`.
  */
-struct pso_pointer push_back_character( struct pso_pointer c,
+struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r) {
-                                        struct pso_pointer r ) {
 	struct pso_pointer result = nil;
 
 	if (characterp(c) && readp(r)) {
-        if ( url_ungetwc( ( wint_t )
+		if (url_ungetwc( (wint_t)(pointer_to_object(c)->payload.character.character),
-                          ( pointer_to_object( c )->payload.character.
+				pointer_to_object(r)->payload.stream.stream) >= 0) {
-                            character ),
-                          pointer_to_object( r )->payload.stream.stream ) >=
-             0 ) {
 			result = t;
 		}
 	}
@@ -309,14 +304,12 @@ struct pso_pointer push_back_character( struct pso_pointer c,
  * @return T if the stream was successfully closed, else nil.
  */
 struct pso_pointer
-lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env ) {
+lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
+            struct pso_pointer env ) {
     struct pso_pointer result = nil;
 
     if ( readp( fetch_arg( frame, 0) ) || writep( fetch_arg( frame, 0) ) ) {
-        if ( url_fclose
+        if ( url_fclose( pointer_to_object( fetch_arg( frame, 0) )->payload.stream.stream )
-             ( pointer_to_object( fetch_arg( frame, 0 ) )->payload.
-               stream.stream )
              == 0 ) {
             result = t;
         }
@@ -496,8 +489,8 @@ struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
  * on my stream, if any, else nil.
  */
 struct pso_pointer
-lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
+lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
+           struct pso_pointer env ) {
     struct pso_pointer result = nil;
 
     // if ( stringp( fetch_arg( frame, 0) ) ) {
@@ -563,8 +556,8 @@ lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env ) {
  * on my stream, if any, else nil.
  */
 struct pso_pointer
-lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
+lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
+                struct pso_pointer env ) {
     struct pso_pointer result = nil;
 
     if ( readp( fetch_arg( frame, 0) ) ) {
@@ -592,13 +585,12 @@ lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env ) {
  * on my stream, if any, else nil.
  */
 struct pso_pointer
-lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env ) {
+lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
+            struct pso_pointer env ) {
     struct pso_pointer result = nil;
 
     if ( readp( fetch_arg( frame, 0) ) ) {
-        URL_FILE *stream =
+        URL_FILE *stream = pointer_to_object( fetch_arg( frame, 0) )->payload.stream.stream;
-            pointer_to_object( fetch_arg( frame, 0 ) )->payload.stream.stream;
         struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil );
         result = cursor;
 

src/c/io/io.h

@@ -8,8 +8,8 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-#ifndef __psse_io_io_h
+#ifndef __psse_io_h
-#define __psse_io_io_h
+#define __psse_io_h
 #include <curl/curl.h>
 
 #include "memory/pointer.h"
@@ -32,19 +32,22 @@ wint_t url_ungetwc( wint_t wc, URL_FILE * input );
 
 struct pso_pointer get_character( struct pso_pointer read_stream );
 
-struct pso_pointer push_back_character( struct pso_pointer c,
+struct pso_pointer push_back_character( struct pso_pointer c, struct pso_pointer r);
-                                        struct pso_pointer r );
 
 struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env );
 
 struct pso_pointer
-lisp_close( struct pso_pointer frame_pointer, struct pso_pointer env );
+lisp_close( struct pso4 *frame, struct pso_pointer frame_pointer,
+            struct pso_pointer env );
 struct pso_pointer
-lisp_open( struct pso_pointer frame_pointer, struct pso_pointer env );
+lisp_open( struct pso4 *frame, struct pso_pointer frame_pointer,
+           struct pso_pointer env );
 struct pso_pointer
-lisp_read_char( struct pso_pointer frame_pointer, struct pso_pointer env );
+lisp_read_char( struct pso4 *frame, struct pso_pointer frame_pointer,
+                struct pso_pointer env );
 struct pso_pointer
-lisp_slurp( struct pso_pointer frame_pointer, struct pso_pointer env );
+lisp_slurp( struct pso4 *frame, struct pso_pointer frame_pointer,
+            struct pso_pointer env );
 
 char *lisp_string_to_c_string( struct pso_pointer s );
 #endif

src/c/io/print.c

@@ -47,8 +47,7 @@ struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output )
  
             result = in_print( object->payload.cons.car, output);
 
-            if ( exceptionp( result ) )
+            if (exceptionp(result)) break;
-                break;
 
             switch (get_tag_value(object->payload.cons.cdr)) {
                 case NILTV :
@@ -84,8 +83,7 @@ struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
                 url_fputwc( L')', output );
                 break;
             case INTEGERTV :
-                url_fwprintf( output, L"%d",
+                url_fwprintf( output, L"%d", (int64_t)(object->payload.integer.value));
-                              ( int64_t ) ( object->payload.integer.value ) );
                 break;
             case TRUETV :
                 url_fputwc( L't', output );
@@ -114,15 +112,11 @@ struct pso_pointer print( struct pso_pointer p, struct pso_pointer stream ) {
         pointer_to_object( stream )->payload.stream.stream : 
         file_to_url_file(stdout);
 
-    if ( writep( stream ) ) {
+    if ( writep( stream)) { inc_ref( stream); }
-        inc_ref( stream );
-    }
 
     struct pso_pointer result = in_print(p, output);
 
-    if ( writep( stream ) ) {
+    if ( writep( stream)) { dec_ref( stream); }
-        dec_ref( stream );
-    }
 
     return result;
 }

src/c/io/read.c

@@ -28,7 +28,6 @@
 #include "io/read.h"
 #include "memory/node.h"
 #include "memory/pointer.h"
-#include "memory/pso.h"
 #include "memory/pso2.h"
 #include "memory/tags.h"
 
@@ -113,7 +112,8 @@ struct pso_pointer read_number( struct pso_pointer frame_pointer,
 				pointer_to_object( character)->payload.character.character;
 
 		URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
-        for ( ; iswdigit( c ); c = url_fgetwc( input ) ) {
+		for ( ; iswdigit( c );
+				  c = url_fgetwc( input ) ){
 			value = (value * base) + ((int)c - (int)L'0');
 		}
 
@@ -141,7 +141,8 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
 				pointer_to_object( character)->payload.character.character;
 
 		URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
-        for ( ; iswalnum( c ); c = url_fgetwc( input ) ) {
+		for ( ; iswalnum( c );
+				  c = url_fgetwc( input ) ){
 			result = make_string_like_thing(c, result, SYMBOLTAG);
 		}
 
@@ -190,8 +191,7 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
 	if (!nilp( readmacro)) {
 		// invoke the read macro on the stream
 	} else if (readp( stream) && characterp(character)) {
-        wchar_t c =
+		wchar_t c = pointer_to_object( character)->payload.character.character;
-            pointer_to_object( character )->payload.character.character;
 		URL_FILE * input = pointer_to_object(stream)->payload.stream.stream;
 
         switch ( c ) {
@@ -207,12 +207,10 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
 //                                          frame_pointer );
                 break;
             default:
-                struct pso_pointer next =
+               struct pso_pointer next = make_frame( frame_pointer, stream, readtable, make_character(c));
-                    make_frame( frame_pointer, stream, readtable,
-                                make_character( c ) );
-                inc_ref( next );
                if ( iswdigit( c ) ) {
-                    result = read_number( next, env );
+                    result =
+                        read_number( next, env );
                 } else if ( iswalpha( c ) ) {
                     result = read_symbol( next, env );
                 } else {
@@ -223,7 +221,6 @@ struct pso_pointer read( struct pso_pointer frame_pointer,
 //                                                    make_string( c, NIL ) ),
 //                                         frame_pointer );
                 }
-                dec_ref( next );
                 break;
         }
 	}

src/c/io/read.h

@@ -1,25 +0,0 @@
-/**
- *  read.h
- *
- *  Read basic Lisp objects..This is :bootstrap layer print; it needs to be
- *  able to read characters, symbols, integers, lists and dotted pairs. I
- *  don't think it needs to be able to read anything else. It must, however,
- *  take a readtable as argument and expand reader macros.
- *
- *
- * (c) 2017 Simon Brooke <simon@journeyman.cc>
- * Licensed under GPL version 2.0, or, at your option, any later version.
- */
-
-#ifndef __psse_io_read_h
-#define __psse_io_read_h
-struct pso_pointer read_number( struct pso_pointer frame_pointer,
-                                struct pso_pointer env );
-
-struct pso_pointer read_symbol( struct pso_pointer frame_pointer,
-                                struct pso_pointer env );
-
-struct pso_pointer read( struct pso_pointer frame_pointer,
-                         struct pso_pointer env );
-
-#endif

src/c/memory/destroy.c

@@ -43,23 +43,16 @@ struct pso_pointer destroy( struct pso_pointer p ) {
 	inc_ref( f);
 
 	switch (get_tag_value(p)) {
-        case CONSTV:
+	case CONSTV: destroy_cons(f, nil); break;
-            destroy_cons( f, nil );
+	case EXCEPTIONTV: destroy_exception(f, nil); break;
-            break;
-        case EXCEPTIONTV:
-            destroy_exception( f, nil );
-            break;
 	case KEYTV :
 	case STRINGTV:
-        case SYMBOLTV:
+	case SYMBOLTV: destroy_string(f, nil); break;
-            destroy_string( f, nil );
+	case STACKTV: destroy_stack_frame(f, nil); break;
-            break;
-        case STACKTV:
-            destroy_stack_frame( f, nil );
-            break;
 	// TODO: others.
 	}
 
 	dec_ref(f);
 	return result;
 }
+

src/c/memory/node.c

@@ -57,7 +57,7 @@ struct pso_pointer initialise_node( uint32_t index ) {
 
     struct pso_pointer result = initialise_memory( index );
 
-    if ( c_eq( result, t ) ) {
+    if ( eq( result, t ) ) {
         result = initialise_environment( index );
     }
 

src/c/memory/node.h

@@ -34,3 +34,4 @@ extern struct pso_pointer t;
 struct pso_pointer initialise_node( uint32_t index );
 
 #endif
+

src/c/memory/pointer.c

@@ -54,8 +54,7 @@ struct pso2 *pointer_to_object( struct pso_pointer p ) {
     struct pso2 *result = NULL;
 
     if ( p.node == node_index ) {
-        if ( p.page < get_pages_allocated(  )
+    	if (p.page < get_pages_allocated() && p.offset < (PAGE_BYTES / 8)) {
-             && p.offset < ( PAGE_BYTES / 8 ) ) {
     		// TODO: that's not really a safe test of whether this is a valid pointer.
 			union page *pg = pages[p.page];
 			result = ( struct pso2 * ) &pg->words[p.offset];
@@ -86,8 +85,7 @@ struct pso2 *pointer_to_object( struct pso_pointer p ) {
  * @return the memory address of the object, provided it is a valid object and
  * 		of the specified size class, else NULL.
  */
-struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
+struct pso2 * pointer_to_object_of_size_class( struct pso_pointer p, uint8_t size_class) {
-                                              uint8_t size_class ) {
 	struct pso2 * result = pointer_to_object( p);
 
 	if (result->header.tag.bytes.size_class != size_class) {
@@ -105,8 +103,7 @@ struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
  * exception back from this function. Consequently, if anything goes wrong
  * we return NULL. The caller *should* check for that and throw an exception.
  */
-struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p,
+struct pso2 * pointer_to_object_with_tag_value( struct pso_pointer p, uint32_t tag_value) {
-                                               uint32_t tag_value ) {
 	struct pso2 * result = pointer_to_object( p);
 
 	if ((result->header.tag.value & 0xffffff) != tag_value) {
@@ -115,3 +112,4 @@ struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p,
 
 	return result;
 }
+

src/c/memory/pointer.h

@@ -39,15 +39,12 @@ struct pso_pointer {
 };
 
 
-struct pso_pointer make_pointer( uint32_t node, uint16_t page,
+struct pso_pointer make_pointer( uint32_t node, uint16_t page, uint16_t offset);
-                                 uint16_t offset );
 
 struct pso2* pointer_to_object( struct pso_pointer pointer);
 
-struct pso2 *pointer_to_object_of_size_class( struct pso_pointer p,
+struct pso2 * pointer_to_object_of_size_class( struct pso_pointer p, uint8_t size_class);
-                                              uint8_t size_class );
 
-struct pso2 *pointer_to_object_with_tag_value( struct pso_pointer p,
+struct pso2 * pointer_to_object_with_tag_value( struct pso_pointer p, uint32_t tag_value);
-                                               uint32_t tag_value );
 
 #endif

src/c/memory/pso.c

@@ -181,8 +181,7 @@ struct pso_pointer free_object( struct pso_pointer p ) {
     strncpy( ( char * ) ( obj->header.tag.bytes.mnemonic ), FREETAG,
              TAGLENGTH );
 #ifdef DEBUG
-    debug_printf( DEBUG_ALLOC, 0,
+    debug_printf( DEBUG_ALLOC, 0, L"Freeing object of size class %d at {%d, %d, %d}",
-                  L"Freeing object of size class %d at {%d, %d, %d}",
     		size_class, p.node, p.page, p.offset);
 #endif
 

src/c/memory/pso4.c

@@ -13,6 +13,5 @@
 #include "memory/pso4.h"
 
 struct pso4* pointer_to_pso4( struct pso_pointer p) {
-    struct pso4 *result =
+	struct pso4* result = (struct pso4*)pointer_to_object_of_size_class( p, 4);
-        ( struct pso4 * ) pointer_to_object_of_size_class( p, 4 );
 }

src/c/memory/tags.c

@@ -47,8 +47,7 @@ bool check_tag( struct pso_pointer p, uint32_t v ) {
  * @return false otherwise.
  */
 bool check_type( struct pso_pointer p, char* s) {
-    return ( strncmp
+	return (strncmp( 
-             ( &( pointer_to_object( p )->header.tag.bytes.mnemonic[0] ), s,
+		&(pointer_to_object(p)->header.tag.bytes.mnemonic[0]), s, TAGLENGTH)
-               TAGLENGTH )
 		 == 0);
 }

src/c/ops/assoc.c

@@ -34,16 +34,18 @@
  * 			return the binding.
  */
 struct pso_pointer search( struct pso_pointer key,
-                           struct pso_pointer store, bool return_key ) {
+                                  struct pso_pointer store,
+                                  bool return_key ) {
 	struct pso_pointer result = nil;
 	bool found = false;
 
 	if (consp( store)) {
 		for ( struct pso_pointer cursor = store;
-              consp( store ) && found == false; cursor = cdr( cursor ) ) {
+				consp( store) && found == false;
+				cursor = cdr( cursor)) {
 			struct pso_pointer pair = car( cursor);
 
-            if ( consp( pair ) && c_equal( car( pair ), key ) ) {
+			if (consp(pair) && equal(car(pair), key)) {
 				found = true;
 				result = return_key ? car(pair) : cdr( pair);
 			}

src/c/ops/assoc.h

@@ -17,12 +17,12 @@
 #include "memory/pointer.h"
 
 struct cons_pointer search( struct pso_pointer key,
-                            struct pso_pointer store, bool return_key );
+                                  struct pso_pointer store,
+                                  bool return_key );
 
 struct pso_pointer assoc( struct pso_pointer key, struct pso_pointer store);
 
-struct pso_pointer interned( struct pso_pointer key,
+struct pso_pointer interned(struct pso_pointer key, struct pso_pointer store);
-                             struct pso_pointer store );
 
 bool internedp(struct pso_pointer key, struct pso_pointer store);
 #endif

src/c/ops/bind.c

@@ -1,44 +0,0 @@
-/**
- *  ops/bind.c
- *
- *  Post Scarcity Software Environment: bind.
- *
- *  Add a binding for a key/value pair to a store -- at this stage, just an
- *  association list.
- *
- *  (c) 2026 Simon Brooke <simon@journeyman.cc>
- *  Licensed under GPL version 2.0, or, at your option, any later version.
- */
-
-#include "memory/node.h"
-#include "memory/pointer.h"
-#include "memory/pso.h"
-#include "memory/pso4.h"
-#include "memory/tags.h"
-
-#include "ops/stack_ops.h"
-
-#include "payloads/cons.h"
-#include "payloads/stack.h"
-
-struct pso_pointer bind( struct pso_pointer frame_pointer,
-                         struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
-    struct pso_pointer key = fetch_arg( frame, 0 );
-    struct pso_pointer value = fetch_arg( frame, 1 );
-    struct pso_pointer store = fetch_arg( frame, 2 );
-
-    return cons( cons( key, value ), store );
-}
-
-struct pso_pointer c_bind( struct pso_pointer key,
-                           struct pso_pointer value,
-                           struct pso_pointer store ) {
-    struct pso_pointer result = nil;
-    struct pso_pointer next = make_frame( nil, key, value, store );
-    inc_ref( next );
-    result = bind( next, nil );
-    dec_ref( next );
-
-    return result;
-}

src/c/ops/bind.h

@@ -1,25 +0,0 @@
-/**
- *  ops/bind.h
- *
- *  Post Scarcity Software Environment: bind.
- *
- *  Test for pointer binduality.
- *
- *  (c) 2026 Simon Brooke <simon@journeyman.cc>
- *  Licensed under GPL version 2.0, or, at your option, any later version.
- */
-
-#ifndef __psse_ops_bind_h
-#define __psse_ops_bind_h
-#include <stdbool.h>
-
-#include "memory/pointer.h"
-
-struct pso_pointer bind( struct pso_pointer frame_pointer,
-                         struct pso_pointer env );
-
-struct pso_pointer c_bind( struct pso_pointer key,
-                           struct pso_pointer value,
-                           struct pso_pointer store );
-
-#endif

src/c/ops/eq.c

@@ -33,14 +33,14 @@
  * @param b another pointer;
  * @return `true` if they are the same, else `false`
  */
-bool c_eq( struct pso_pointer a, struct pso_pointer b ) {
+bool eq( struct pso_pointer a, struct pso_pointer b ) {
     return ( a.node == b.node && a.page == b.page && a.offset == b.offset );
 }
 
-bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
+bool equal( struct pso_pointer a, struct pso_pointer b) {
 	bool result = false;
 
-    if ( c_eq( a, b ) ) {
+	if ( eq( a, b)) {
 		result = true;
 	} else if ( get_tag_value(a) == get_tag_value(b)) {
 		struct pso2 *oa = pointer_to_object(a);
@@ -48,17 +48,15 @@ bool c_equal( struct pso_pointer a, struct pso_pointer b ) {
 
 		switch ( get_tag_value(a)) {
 		case CHARACTERTV :
-                result =
+			result = (oa->payload.character.character == ob->payload.character.character);
-                    ( oa->payload.character.character ==
-                      ob->payload.character.character );
 			break;
 		case CONSTV :
-                result = ( c_equal( car( a ), car( b ) )
+			result = (equal( car(a), car(b)) && equal( cdr(a), cdr(b)));
-                           && c_equal( cdr( a ), cdr( b ) ) );
 			break;
 		case INTEGERTV :
 			result = (oa->payload.integer.value
-                           == ob->payload.integer.value );
+					==
+					ob->payload.integer.value);
 			break;
 		case KEYTV:
 		case STRINGTV :
@@ -91,10 +89,9 @@ bool c_equal( 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 eq( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_eq( struct pso4 *frame,
+                            struct pso_pointer frame_pointer,
                             struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
-
     struct pso_pointer result = t;
 
     if ( frame->payload.stack_frame.args > 1 ) {
@@ -102,9 +99,11 @@ struct pso_pointer eq( struct pso_pointer frame_pointer,
               ( truep( result ) ) && ( b < frame->payload.stack_frame.args );
               b++ ) {
             result =
-                c_eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;
+                eq( fetch_arg( frame, 0 ), fetch_arg( frame, b ) ) ? t : nil;
         }
     }
 
     return result;
 }
+
+

src/c/ops/eq.h

@@ -16,10 +16,11 @@
 #include "memory/pointer.h"
 #include "memory/pso4.h"
 
-bool c_eq( struct pso_pointer a, struct pso_pointer b );
+bool eq( struct pso_pointer a, struct pso_pointer b );
 
-struct pso_pointer eq( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_eq( struct pso4 *frame,
+                            struct pso_pointer frame_pointer,
                             struct pso_pointer env );
 
-bool c_equal( struct pso_pointer a, struct pso_pointer b );
+bool equal( struct pso_pointer a, struct pso_pointer b);
 #endif

src/c/ops/eval.c

@@ -10,9 +10,7 @@
  */
 
 #include "memory/pointer.h"
-#include "memory/pso.h"
 #include "memory/pso2.h"
-#include "memory/pso3.h"
 #include "memory/pso4.h"
 #include "memory/tags.h"
 
@@ -25,8 +23,6 @@
 #include "payloads/special.h"
 #include "payloads/stack.h"
 
-#include "ops/truth.h"
-
 /**
  * @brief Despatch eval based on tag of the form in the first position.
  * 
@@ -35,9 +31,9 @@
  * @param env the evaluation environment.
  * @return struct pso_pointer 
  */
-struct pso_pointer lisp_eval( struct pso_pointer frame_pointer,
+struct pso_pointer eval_despatch( struct pso4 *frame,
+                                  struct pso_pointer frame_pointer,
                                   struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
     struct pso_pointer result = frame->payload.stack_frame.arg[0];
 
     // switch ( get_tag_value( result)) {
@@ -59,17 +55,17 @@ struct pso_pointer lisp_eval( struct pso_pointer frame_pointer,
     //         break;        
     // }
 
-    if ( exceptionp( result ) ) {
+    return result;
-        struct pso3 *x =
-            ( struct pso3 * ) pointer_to_object_with_tag_value( result,
-                                                                EXCEPTIONTV );
-
-        if ( nilp( x->payload.exception.stack ) ) {
-            inc_ref( result );
-            result =
-                make_exception( x->payload.exception.message, frame_pointer,
-                                result );
 }
+
+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 );
+
+    if ( exceptionp( result ) ) {
+        // todo: if result doesn't have a stack frame, create a new exception wrapping
+        // result with this stack frame.
     }
 
     return result;

src/c/ops/reverse.c

@@ -38,33 +38,23 @@
 struct pso_pointer reverse( struct pso_pointer sequence) {
 	struct pso_pointer result = nil;
 
-    for ( struct pso_pointer cursor = sequence; !nilp( sequence );
+	for (struct pso_pointer cursor = sequence; !nilp( sequence); cursor = cdr(cursor)) {
-          cursor = cdr( cursor ) ) {
 		struct pso2* object = pointer_to_object( cursor);
 		switch (get_tag_value(cursor)) {
 		case CONSTV :
 				result = cons( car(cursor), result);
 				break;
 		case KEYTV :
-                result =
+			result = make_string_like_thing( object->payload.string.character, result, KEYTAG);
-                    make_string_like_thing( object->payload.string.character,
-                                            result, KEYTAG );
 			break;
 		case STRINGTV :
-                result =
+			result = make_string_like_thing( object->payload.string.character, result, STRINGTAG);
-                    make_string_like_thing( object->payload.string.character,
-                                            result, STRINGTAG );
 			break;
 		case SYMBOLTV :
-                result =
+			result = make_string_like_thing( object->payload.string.character, result, SYMBOLTAG);
-                    make_string_like_thing( object->payload.string.character,
-                                            result, SYMBOLTAG );
 			break;
 		default :
-                result =
+			result = make_exception( c_string_to_lisp_string(L"Invalid object in sequence"), nil, nil);
-                    make_exception( c_string_to_lisp_string
-                                    ( L"Invalid object in sequence" ), nil,
-                                    nil );
 			goto exit;
 			break;
 		}

src/c/ops/truth.c

@@ -13,7 +13,6 @@
 
 #include "memory/node.h"
 #include "memory/pointer.h"
-#include "memory/pso4.h"
 #include "ops/stack_ops.h"
 
 /**
@@ -65,10 +64,9 @@ bool truep( struct pso_pointer p ) {
  * @param env the evaluation environment.
  * @return `t` if the first argument in this frame is `nil`, else `t`
  */
-struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_nilp( struct pso4 *frame,
+                       struct pso_pointer frame_pointer,
                        struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
-
 return ( nilp( fetch_arg( frame, 0 )) ? t : nil );
 }
 
@@ -80,10 +78,9 @@ struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
  * @param env the evaluation environment.
  * @return `t` if the first argument in this frame is `t`, else `nil`.
  */
-struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_truep( struct pso4 *frame,
+                                 struct pso_pointer frame_pointer,
                                  struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
-
          return ( truep( fetch_arg( frame, 0 ) ) ? t : nil );
 }
 
@@ -96,9 +93,8 @@ struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
  * @param env the evaluation environment.
  * @return `t` if the first argument in this frame is not `nil`, else `t`.
  */
-struct pso_pointer lisp_not( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_not( struct pso4 *frame,
+                               struct pso_pointer frame_pointer,
                                struct pso_pointer env ) {
-    struct pso4 *frame = pointer_to_pso4( frame_pointer );
-
          return ( not( fetch_arg( frame, 0 ) ) ? t : nil );
 }

src/c/ops/truth.h

@@ -18,17 +18,20 @@
 
 bool nilp( struct pso_pointer p );
 
-struct pso_pointer lisp_nilp( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_nilp( struct pso4 *frame,
+                            struct pso_pointer frame_pointer,
                             struct pso_pointer env );
 
 bool not( struct pso_pointer p );
 
-struct pso_pointer lisp_not( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_not( struct pso4 *frame,
+                            struct pso_pointer frame_pointer,
                             struct pso_pointer env );
 
 bool truep( struct pso_pointer p );
 
-struct pso_pointer lisp_truep( struct pso_pointer frame_pointer,
+struct pso_pointer lisp_truep( struct pso4 *frame,
+                            struct pso_pointer frame_pointer,
                             struct pso_pointer env );
 
 #endif

src/c/payloads/character.c

@@ -27,8 +27,7 @@ struct pso_pointer make_character( wint_t c ) {
 	struct pso_pointer result = allocate( CHARACTERTAG, 2 );
 
 	if (!nilp(result)) {
-        pointer_to_object( result )->payload.character.character =
+		pointer_to_object(result)->payload.character.character = (wchar_t) c;
-            ( wchar_t ) c;
 	}
 
 	return result;

src/c/payloads/cons.c

@@ -33,8 +33,11 @@ struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr ) {
     struct pso_pointer result = allocate( CONSTAG, 2 );
 
     struct pso2 *object = pointer_to_object( result );
-    object->payload.cons.car = inc_ref( car );
+    object->payload.cons.car = car;
-    object->payload.cons.cdr = inc_ref( cdr );
+    object->payload.cons.cdr = cdr;
+
+    inc_ref( car );
+    inc_ref( cdr );
 
     return result;
 }
@@ -71,19 +74,15 @@ struct pso_pointer cdr( struct pso_pointer p ) {
     struct pso2 *object = pointer_to_object( result );
 
     switch (get_tag_value( p)) {
-        case CONSTV:
+    case CONSTV : result = object->payload.cons.cdr; break;
-            result = object->payload.cons.cdr;
-            break;
     case KEYTV :
     case STRINGTV :
     case SYMBOLTV :
-            result = object->payload.string.cdr;
+    	result = object->payload.string.cdr; break;
-            break;
     default :
-            result =
+    	result = make_exception(
-                make_exception( cons
+    			cons(c_string_to_lisp_string(L"Invalid type for cdr"), p),
-                                ( c_string_to_lisp_string
+				nil, nil);
-                                  ( L"Invalid type for cdr" ), p ), nil, nil );
     	break;
     }
 
@@ -99,8 +98,7 @@ struct pso_pointer cdr( struct pso_pointer p ) {
  * Lisp calling conventions; one expected arg, the pointer to the cell to
  * be destroyed.
  */
-struct pso_pointer destroy_cons( struct pso_pointer fp,
+struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer env) {
-                                 struct pso_pointer env ) {
 	if (stackp(fp)) {
 		struct pso4 *frame = pointer_to_pso4( fp);
 		struct pso_pointer p = frame->payload.stack_frame.arg[0];

src/c/payloads/cons.h

@@ -32,7 +32,6 @@ struct pso_pointer cdr( struct pso_pointer cons );
 
 struct pso_pointer cons( struct pso_pointer car, struct pso_pointer cdr );
 
-struct pso_pointer destroy_cons( struct pso_pointer fp,
+struct pso_pointer destroy_cons( struct pso_pointer fp, struct pso_pointer env);
-                                 struct pso_pointer env );
 
 #endif

src/c/payloads/exception.c

@@ -17,8 +17,7 @@
 #include "payloads/exception.h"
 
 struct pso_pointer make_exception( struct pso_pointer message,
-                                   struct pso_pointer frame_pointer,
+		struct pso_pointer frame_pointer, struct pso_pointer cause) {
-                                   struct pso_pointer cause ) {
     // TODO: not yet implemented
     return nil;
 }

src/c/payloads/exception.h

@@ -25,8 +25,7 @@ struct exception_payload {
 };
 
 struct pso_pointer make_exception( struct pso_pointer message,
-                                   struct pso_pointer frame_pointer,
+		struct pso_pointer frame_pointer, struct pso_pointer cause);
-                                   struct pso_pointer cause );
 
 struct pso_pointer destroy_exception( struct pso_pointer fp,
 		struct pso_pointer env);

src/c/psse.c

@@ -105,6 +105,7 @@ int main( int argc, char *argv[] ) {
         fputs( "Failed to initialise node\n", stderr );
         exit( 1 );
     }
+
     // repl(  );
 
     exit( 0 );