Careful debugging of the memory leak problem. At this stage,
stack frames for interpreted (but not primitive) functions appear not to be being reclaimed, and the oblist doesn't seem to be being fully reclaimed.
This commit is contained in:
parent
8629e33f92
commit
70376c6529
14 changed files with 156 additions and 50 deletions
|
|
@ -1,3 +1,5 @@
|
|||
# Implementing Post Scarcity Hardware
|
||||
|
||||
The address space hinted at by using 64 bit cons-space and a 64 bit vector space containing objects each of whose length may be up to 1.4e20 bytes (2^64 of 64 bit words) is so large that a completely populated post-scarcity hardware machine can probably never be built. But that doesn't mean I'm wrong to specify such an address space: if we can make this architecture work for machines that can't (yet, anyway) be built, it will work for machines that can; and, changing the size of the pointers, which one might wish to do for storage economy, can be done with a few edits to consspaceobject.h.
|
||||
|
||||
But, for the moment, let's discuss a potential 32 bit psh machine, and how it might be built.
|
||||
|
|
@ -5,53 +7,53 @@ But, for the moment, let's discuss a potential 32 bit psh machine, and how it mi
|
|||
## Pass one: a literal implementation
|
||||
|
||||
Let's say a processing node comprises a two core 32 bit processor, such as an ARM, 4GB of RAM, and a custom router chip. On each node, core zero is the actual processing node, and core one handles communications. We arrange these on a printed circuit board that is 4 nodes by 4 nodes. Each node is connected to the nodes in front, behind, left and right by tracks on the board, and by pins to the nodes on the boards above and below. On the edges of the board, the tracks which have no 'next neighbour' lead to some sort of reasonably high speed bidirectional serial connection — I'm imagining optical fibre (or possibly pairs of optical fibre, one for each direction). These boards are assembled in stacks of four, and the 'up' pins on the top board and the 'down' pins (or sockets) on the bottom board connect to similar high speed serial connectors.
|
||||
|
||||
|
||||
This unit of 4 boards — 64 compute nodes — now forms both a logical and a physical cube. Let's call this cube module a crystal. Connect left to right, top to bottom and back to front, and you have a hypercube. But take another identical crystal, place it along side, connect the right of crystal A to the left of crystal B and the right of B to the left of A, leaving the tops and bottoms and fronts and backs of those crystals still connected to themselves, and you have a larger cuboid with more compute power and address space but slightly lower path efficiency. Continue in this manner until you have four layers of four crystals, and you have a compute unit of 4096 nodes. So the basic 4x4x4 building block — the 'crystal' — is a good place to start, and it is in some measure affordable to build — low numbers of thousands of pounds, even for a prototype.
|
||||
|
||||
|
||||
I imagine you could get away with a two layer board — you might need more, I'm no expert in these things, but the data tracks between nodes can all go on one layer, and then you can have a raster bus on the other layer which carries power, backup data, and common signals (if needed).
|
||||
|
||||
|
||||
So, each node has 4Gb of memory (or more, or less — 4Gb here is just illustrative). How is that memory organised? It could be treated as a heap, or it could be treated as four separate pages, but it must store four logical blocks of data: its own curated conspage, from which other nodes can request copies of objects; its own private housekeeping data (which can also be a conspage, but from which other nodes can't request copies); its cache of copies of data copied from other nodes; and its heap.
|
||||
|
||||
|
||||
Note that a crystal of 64 nodes each with 4Gb or RAM has a total memory of 256Gb, which easily fits onto a single current generation hard disk or SSD module. So I'm envisaging that either the nodes take turns to back up their memory to backing store all the time during normal operation. They (obviously) don't need to backup their cache, since they don't curate it.
|
||||
|
||||
|
||||
What does this cost? About £15 per processor chip, plus £30 for memory, plus the router, which is custom but probably still in tens of pounds, plus a share of the cost of the board; probably under £100 per node, or £6500 for the 'crystal'.
|
||||
|
||||
|
||||
## Pass two: a virtual implementation
|
||||
|
||||
OK, OK, this crystal cube is a pretty concept, but let's get real. Using one core of each of 64 chips makes the architecture very concrete, but it's not necessarily efficient, either computationally or financially.
|
||||
|
||||
|
||||
64 core ARM chips already exist:
|
||||
|
||||
|
||||
1. [Qualcom Hydra](https://eltechs.com/hydra-is-the-name-of-qualcomms-64-core-arm-server-processor/) - 64 of 64 bit cores;
|
||||
2. [Macom X-Gene](https://www.apm.com/products/data-center/x-gene-family/x-gene/) - 64 of 64 bit cores;
|
||||
2. [Phytium Mars](https://www.nextplatform.com/2016/09/01/details-emerge-chinas-64-core-arm-chip/) - 64 cores, but frustratingly this does not say whether cores are 32 or 64 bit
|
||||
|
||||
|
||||
There are other interesting chips which aren't strictly 64 core:
|
||||
|
||||
|
||||
1. [Cavium ThunderX](https://www.servethehome.com/exclusive-first-cavium-thunderx-dual-48-core-96-core-total-arm-benchmarks) - ARM; 96 cores, each 64 bit, in pairs of two, shipping now;
|
||||
2. [Sparc M8](https://www.servethehome.com/oracle-sparc-m8-released-32-cores-256-threads-5-0ghz/) - 32 of 64 bit cores each capable of 8 concurrent threads; shipping now.
|
||||
|
||||
|
||||
## Implementing the virtual hypercube
|
||||
|
||||
Of course, these chips are not designed as hypercubes. We can't route our own network of physical connections into the chips, so our communications channels have to be virtual. But we can implement a communications channel as a pair of buffers, an 'upstream' buffer writable by the lower-numbered processor and readable by the higher, and a 'downstream' buffer writable by the higher numbered processor and readable by the lower. Each buffer should be at least big enough to write a whole cons page object into, optionally including a cryptographic signature if that is implemented. Each pair of buffers also needs at least four bits of flags, in order to be able, for each direction, to be able to signal
|
||||
|
||||
|
||||
0. Idle — the processor at the receiving end is idle and can accept work;
|
||||
1. Busy writing — the processor at the sending end is writing data to the buffer, which is not yet complete;
|
||||
2. Ready to read — the processor at the sending end has written data to the buffer, and it is complete;
|
||||
3. Read — the processor at the receiving end has read the current contents of the buffer.
|
||||
|
||||
|
||||
Thus I think it takes at least six clock ticks to write the buffer (set busy-writing, copy four 64 bit words into the buffer, set ready-to-read) and five to read it out — again, more if the messages are cryptographically signed — for an eleven clock tick transfer (the buffers may be allocated in main memory, but in practice they will always live in L2 cache). That's probably cheaper than making a stack frame. All communications channels within the 'crystal' cost exactly the same.
|
||||
|
||||
|
||||
But note! As in the virtual design, a single thread cannot at the same time execute user program and listen to communications from neighbours. So a node has to be able to run two threads. Whether that's two threads on a single core, or two cores per node, is a detail. But it makes the ThunderX and Spark M8 designs look particularly interesting.
|
||||
|
||||
|
||||
But note that there's one huge advantage that this single-chip virtual crystal has over the literal design: all cores access the same memory pool. Consequently, vector space objects never have to be passed hop, hop, hop across the communications network, all can be accessed directly; and to pass a list, all you have to pass is its first cons cell. So any S-Expression can be passed from any node to any of its 6 proximal neighbours in one hop.
|
||||
|
||||
|
||||
There are downsides to this, too. While communication inside the crystal is easier and quicker, communication between crystals becomes a lot more complex and I don't yet even have an idea how it might work. Also, contention on the main address bus, with 64 processors all trying to write to and read from the same memory at the same time, is likely to be horrendous, leading to much lower speed than the solution where each node has its own memory.
|
||||
|
||||
|
||||
On a cost side, you probably fit this all onto one printed circuit board as against the 4 of the 'literal' design; the single processor chip is likely to cost around £400; and the memory will probably be a little cheaper than on the literal design; and you don't need the custom routers, or the connection hardware, or the optical transceivers. So the cost probably looks more like £5,000. Note also that this virtual crystal has 64 bit processors (although address bus contention will almost certainly burn all that advantage and more).
|
||||
|
||||
|
||||
An experimental post-scarcity machine can be built now — and I can almost afford to build it. I don't have the skills, of course; but I can learn.
|
||||
|
||||
|
||||
|
||||
|
||||
## Size of a fully populated machine
|
||||
|
|
|
|||
|
|
@ -1,5 +1,57 @@
|
|||
# State of Play
|
||||
|
||||
## 20260220
|
||||
|
||||
### State of the build
|
||||
|
||||
The only unit tests that are failing now are the bignum tests, which I have
|
||||
consciously parked as a future problem, and the memory leak, similarly. The
|
||||
leak is a lot less bad than it was, but I'm worried that stack frames
|
||||
are not being freed.
|
||||
|
||||
If you run
|
||||
|
||||
```
|
||||
cat lisp/fact.lisp | target/psse -d 2>&1 |\
|
||||
grep 'Vector space object of type' | sort | uniq -c | sort -rn
|
||||
```
|
||||
|
||||
you get a huge number (currently 394) of stack frames in the memory dump; they
|
||||
should all have been reclaimed. There's other stuff in the memory dump as well,
|
||||
|
||||
```
|
||||
422 CONS ;; cons cells, obviously
|
||||
394 VECP ;; pointers to vector space objects -- specifically, the stack frames
|
||||
335 SYMB ;; symbols
|
||||
149 INTR ;; integers
|
||||
83 STRG ;; strings
|
||||
46 FUNC ;; primitive (i.e. written in C) functions
|
||||
25 KEYW ;; keywords
|
||||
10 SPFM ;; primitive special forms
|
||||
3 WRIT ;; write streams: `*out*`, `*log*`, `*sink*`
|
||||
1 TRUE ;; t
|
||||
1 READ ;; read stream: `*in*`
|
||||
1 NIL ;; nil
|
||||
1 LMDA ;; lambda function, specifically `fact`
|
||||
```
|
||||
|
||||
Generally, for each character in a string, symbol or keyword there will be one
|
||||
cell (`STRG`, `SYMB`, or `KEYW`) cell, so the high number of STRG cells is not
|
||||
especially surprising. It looks as though none of the symbols bound in the
|
||||
oblist are being recovered on exit, which is undesirable but not catastrophic,
|
||||
since it's a fixed burden of memory which isn't expanding.
|
||||
|
||||
But the fact that stack frames aren't being reclaimed is serious.
|
||||
|
||||
### Update, 19:31
|
||||
|
||||
Right, investigating this more deeply, I found that `make_empty_frame` was doing
|
||||
an `inc_ref` it should not have been, Having fixed that I'm down to 27 frames
|
||||
left in the dump. That's very close to the number which will be generated by
|
||||
running `(fact 25)`, so I expect it is now only stack frames for interpreted
|
||||
functions which are not being reclaimed. This give me something to work on!
|
||||
|
||||
|
||||
## 20260215
|
||||
|
||||
Both of yesterday's regressions are fixed. Memory problem still in much the
|
||||
|
|
@ -14,8 +66,8 @@ It burned through 74 cons pages each of 1,024 cons cells, total 76,800 cells,
|
|||
and 19,153 stack frames. before it got there; and then threw the exception back
|
||||
up through each of those 19,153 stack frames. But the actual exception message
|
||||
was `Unrecognised tag value 0 ( )`, which is not enormously helpful.
|
||||
|
||||
However, once I had recognised what the problem was, it was quickly fixed, with
|
||||
S
|
||||
However, once I had recognised what the problem was, it was quickly fSixed, with
|
||||
the added bonus that the new solution will automatically work for bignum
|
||||
fractions once bignums are working.
|
||||
|
||||
|
|
|
|||
|
|
@ -1,9 +1,9 @@
|
|||
(set! symbolp (lambda (x) (equal (type x) "SYMB")))
|
||||
(set! symbol? (lambda (x) (equal (type x) "SYMB")))
|
||||
|
||||
(set! defun!
|
||||
(nlambda
|
||||
form
|
||||
(cond ((symbolp (car form))
|
||||
(cond ((symbol? (car form))
|
||||
(set (car form) (apply 'lambda (cdr form))))
|
||||
(t nil))))
|
||||
|
||||
|
|
@ -17,7 +17,7 @@
|
|||
(set! defsp!
|
||||
(nlambda
|
||||
form
|
||||
(cond (symbolp (car form))
|
||||
(cond (symbol? (car form))
|
||||
(set! (car form) (apply nlambda (cdr form))))))
|
||||
|
||||
(defsp! cube (x) ((* x x x)))
|
||||
|
|
|
|||
|
|
@ -4,6 +4,6 @@
|
|||
(cond ((= n 1) 1)
|
||||
(t (* n (fact (- n 1)))))))
|
||||
|
||||
; (fact 1000)
|
||||
(fact 25)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -138,7 +138,7 @@ struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
|
|||
if ( !small_int_cache_initialised ) {
|
||||
for ( int64_t i = 0; i < SMALL_INT_LIMIT; i++ ) {
|
||||
small_int_cache[i] = make_integer( i, NIL );
|
||||
pointer2cell( small_int_cache[i] ).count = UINT32_MAX; // lock it in so it can't be GC'd
|
||||
pointer2cell( small_int_cache[i] ).count = MAXREFERENCE; // lock it in so it can't be GC'd
|
||||
}
|
||||
small_int_cache_initialised = true;
|
||||
debug_print( L"small_int_cache initialised.\n", DEBUG_ALLOC );
|
||||
|
|
|
|||
15
src/init.c
15
src/init.c
|
|
@ -185,6 +185,7 @@ void print_options( FILE *stream ) {
|
|||
L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
|
||||
fwprintf( stream, L"\t-h\tPrint this message and exit;\n" );
|
||||
fwprintf( stream, L"\t-p\tShow a prompt (default is no prompt);\n" );
|
||||
#ifdef DEBUG
|
||||
fwprintf( stream,
|
||||
L"\t-v LEVEL\n\t\tSet verbosity to the specified level (0...512)\n" );
|
||||
fwprintf( stream, L"\t\tWhere bits are interpreted as follows:\n" );
|
||||
|
|
@ -197,6 +198,7 @@ void print_options( FILE *stream ) {
|
|||
fwprintf( stream, L"\t\t64\tLAMBDA;\n" );
|
||||
fwprintf( stream, L"\t\t128\tREPL;\n" );
|
||||
fwprintf( stream, L"\t\t256\tSTACK.\n" );
|
||||
#endif
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -384,14 +386,19 @@ int main( int argc, char *argv[] ) {
|
|||
repl( show_prompt );
|
||||
|
||||
debug_dump_object( oblist, DEBUG_BOOTSTRAP );
|
||||
|
||||
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
|
||||
while ( (pointer2cell(oblist)).count > 0) {
|
||||
fprintf( stderr, "Dangling refs on oblist: %d\n", (pointer2cell(oblist)).count );
|
||||
dec_ref( oblist );
|
||||
}
|
||||
|
||||
free_init_symbols( );
|
||||
|
||||
if ( dump_at_end ) {
|
||||
dump_pages( file_to_url_file( stdout ) );
|
||||
}
|
||||
|
||||
debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
|
||||
dec_ref( oblist );
|
||||
free_init_symbols( );
|
||||
|
||||
summarise_allocation( );
|
||||
curl_global_cleanup( );
|
||||
return ( 0 );
|
||||
|
|
|
|||
|
|
@ -116,6 +116,9 @@ void print_vso( URL_FILE *output, struct cons_pointer pointer ) {
|
|||
case HASHTV:
|
||||
print_map( output, pointer );
|
||||
break;
|
||||
case STACKFRAMETV:
|
||||
dump_stack_trace( output, pointer);
|
||||
break;
|
||||
// \todo: others.
|
||||
default:
|
||||
fwprintf( stderr, L"Unrecognised vector-space type '%d'\n",
|
||||
|
|
|
|||
|
|
@ -126,9 +126,12 @@ void dump_pages( URL_FILE *output ) {
|
|||
url_fwprintf( output, L"\nDUMPING PAGE %d\n", i );
|
||||
|
||||
for ( int j = 0; j < CONSPAGESIZE; j++ ) {
|
||||
dump_object( output, ( struct cons_pointer ) {
|
||||
i, j
|
||||
} );
|
||||
struct cons_pointer pointer = ( struct cons_pointer ) { i, j};
|
||||
if (!freep( pointer)) {
|
||||
dump_object( output, ( struct cons_pointer ) {
|
||||
i, j
|
||||
} );
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -64,6 +64,14 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
|
|||
|
||||
if ( cell->count < MAXREFERENCE ) {
|
||||
cell->count++;
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, L"\nIncremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
|
||||
if ( strncmp( cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
|
||||
debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
|
||||
} else {
|
||||
debug_println( DEBUG_ALLOC);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
return pointer;
|
||||
|
|
@ -82,6 +90,14 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
|
|||
|
||||
if ( cell->count > 0 && cell->count != UINT32_MAX ) {
|
||||
cell->count--;
|
||||
#ifdef DEBUG
|
||||
debug_printf( DEBUG_ALLOC, L"\nDecremented cell of type %4.4s at page %d, offset %d to count %d", ((char *)cell->tag.bytes), pointer.page, pointer.offset, cell->count);
|
||||
if ( strncmp( (char *)cell->tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
|
||||
debug_printf( DEBUG_ALLOC, L"; pointer to vector object of type %4.4s.\n", ((char *)(cell->payload.vectorp.tag.bytes)));
|
||||
} else {
|
||||
debug_println( DEBUG_ALLOC);
|
||||
}
|
||||
#endif
|
||||
|
||||
if ( cell->count == 0 ) {
|
||||
free_cell( pointer );
|
||||
|
|
@ -320,7 +336,7 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
|
|||
} else {
|
||||
// \todo should throw an exception!
|
||||
debug_printf( DEBUG_ALLOC,
|
||||
L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
|
||||
L"Warning: only %4.4s can be prepended to %4.4s\n",
|
||||
tag, tag );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -312,6 +312,11 @@
|
|||
*/
|
||||
#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to an unassigned cell, else false
|
||||
*/
|
||||
#define freep(conspoint) (check_tag(conspoint,FREETV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a function cell, else false
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -13,6 +13,8 @@
|
|||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <stdio.h>
|
||||
|
||||
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
|
|
@ -22,6 +24,7 @@
|
|||
#include "memory/conspage.h"
|
||||
#include "memory/consspaceobject.h"
|
||||
#include "debug.h"
|
||||
#include "io/io.h"
|
||||
#include "memory/hashmap.h"
|
||||
#include "memory/stack.h"
|
||||
#include "memory/vectorspace.h"
|
||||
|
|
@ -123,7 +126,8 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
|
|||
void free_vso( struct cons_pointer pointer ) {
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
|
||||
debug_printf( DEBUG_ALLOC, L"About to free vector-space object at 0x%lx\n",
|
||||
debug_printf( DEBUG_ALLOC, L"About to free vector-space object of type %s at 0x%lx\n",
|
||||
(char *) cell.payload.vectorp.tag.bytes,
|
||||
cell.payload.vectorp.address );
|
||||
struct vector_space_object *vso = cell.payload.vectorp.address;
|
||||
|
||||
|
|
|
|||
|
|
@ -214,9 +214,9 @@ bool equal_number_number( struct cons_pointer a, struct cons_pointer b ) {
|
|||
case RATIOTV:
|
||||
switch ( cell_b->tag.value ) {
|
||||
case INTEGERTV:
|
||||
/* as all ratios are simplified by make_ratio, any
|
||||
/* as ratios are simplified by make_ratio, any
|
||||
* ratio that would simplify to an integer is an
|
||||
* integer, */
|
||||
* integer, TODO: no longer always true. */
|
||||
result = false;
|
||||
break;
|
||||
case REALTV:
|
||||
|
|
@ -278,6 +278,12 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
|
|||
/* TODO: it is not OK to do this on the stack since list-like
|
||||
* structures can be of indefinite extent. It *must* be done by
|
||||
* iteration (and even that is problematic) */
|
||||
#ifdef DEBUG
|
||||
debug_print( L"Comparing '", DEBUG_ARITH);
|
||||
debug_print_object( a, DEBUG_ARITH);
|
||||
debug_print( L"' to '", DEBUG_ARITH);
|
||||
debug_print_object( b, DEBUG_ARITH);
|
||||
#endif
|
||||
result =
|
||||
cell_a->payload.string.hash == cell_b->payload.string.hash
|
||||
&& cell_a->payload.string.character ==
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@
|
|||
*/
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <string.h>
|
||||
/*
|
||||
* wide characters
|
||||
*/
|
||||
|
|
@ -309,7 +310,7 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
|
|||
debug_print( L"`", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` is a ", DEBUG_BIND );
|
||||
debug_print_object( c_type( key ), DEBUG_BIND );
|
||||
debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
|
||||
debug_print( L", not a KEYW or SYMB", DEBUG_BIND );
|
||||
}
|
||||
|
||||
|
|
@ -361,7 +362,7 @@ struct cons_pointer c_assoc( struct cons_pointer key,
|
|||
result = hashmap_get( store, key );
|
||||
} else if ( !nilp( store ) ) {
|
||||
debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
|
||||
debug_print_object( c_type( store ), DEBUG_BIND );
|
||||
debug_printf( DEBUG_BIND, L"%4.4s", (char *)pointer2cell(key).tag.bytes);
|
||||
debug_print( L"`\n", DEBUG_BIND );
|
||||
result =
|
||||
throw_exception( c_append
|
||||
|
|
@ -398,8 +399,8 @@ struct cons_pointer hashmap_put( struct cons_pointer mapp,
|
|||
// hashmap to a bigger number of buckets, and return that.
|
||||
|
||||
map->payload.hashmap.buckets[bucket_no] =
|
||||
inc_ref( make_cons( make_cons( key, val ),
|
||||
map->payload.hashmap.buckets[bucket_no] ) );
|
||||
make_cons( make_cons( key, val ),
|
||||
map->payload.hashmap.buckets[bucket_no] );
|
||||
}
|
||||
|
||||
return mapp;
|
||||
|
|
@ -413,6 +414,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
|
|||
struct cons_pointer store ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
#ifdef DEBUG
|
||||
debug_print( L"set: binding `", DEBUG_BIND );
|
||||
debug_print_object( key, DEBUG_BIND );
|
||||
debug_print( L"` to `", DEBUG_BIND );
|
||||
|
|
@ -421,8 +423,15 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
|
|||
debug_dump_object( store, DEBUG_BIND );
|
||||
debug_println( DEBUG_BIND );
|
||||
|
||||
debug_printf( DEBUG_BIND, L"set: store is %s\n`",
|
||||
lisp_string_to_c_string( c_type( store ) ) );
|
||||
debug_printf( DEBUG_BIND, L"set: store is %4.4s",
|
||||
pointer2cell(store).tag.bytes );
|
||||
if (strncmp(pointer2cell(store).tag.bytes, VECTORPOINTTAG, TAGLENGTH) == 0) {
|
||||
debug_printf( DEBUG_BIND, L" -> %4.4s\n",
|
||||
pointer2cell(store).payload.vectorp.tag.bytes );
|
||||
} else {
|
||||
debug_println( DEBUG_BIND);
|
||||
}
|
||||
#endif
|
||||
if ( nilp( value ) ) {
|
||||
result = store;
|
||||
} else if ( nilp( store ) || consp( store ) ) {
|
||||
|
|
@ -440,8 +449,7 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
|
|||
}
|
||||
|
||||
/**
|
||||
* @brief Binds this key to this value in the global oblist.
|
||||
|
||||
* @brief Binds this `key` to this `value` in the global oblist, and returns the `key`.
|
||||
*/
|
||||
struct cons_pointer
|
||||
deep_bind( struct cons_pointer key, struct cons_pointer value ) {
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@ struct cons_pointer eval_form( struct stack_frame *parent,
|
|||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_empty_frame( parent_pointer );
|
||||
inc_ref( next_pointer );
|
||||
// inc_ref( next_pointer );
|
||||
|
||||
struct stack_frame *next = get_stack_frame( next_pointer );
|
||||
set_reg( next, 0, form );
|
||||
|
|
@ -362,7 +362,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
// inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
|
|
@ -391,7 +391,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
struct cons_pointer exep = NIL;
|
||||
struct cons_pointer next_pointer =
|
||||
make_stack_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
// inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
|
|
@ -424,7 +424,7 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
|
|||
{
|
||||
struct cons_pointer next_pointer =
|
||||
make_special_frame( frame_pointer, args, env );
|
||||
inc_ref( next_pointer );
|
||||
// inc_ref( next_pointer );
|
||||
if ( exceptionp( next_pointer ) ) {
|
||||
result = next_pointer;
|
||||
} else {
|
||||
|
|
@ -1269,7 +1269,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
|
|||
|
||||
struct cons_pointer input = get_default_stream( true, env );
|
||||
struct cons_pointer output = get_default_stream( false, env );
|
||||
// struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
|
||||
struct cons_pointer old_oblist = oblist;
|
||||
struct cons_pointer new_env = env;
|
||||
|
||||
|
|
@ -1342,6 +1341,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
|
|||
if ( exceptionp( expr )
|
||||
&& url_feof( pointer2cell( input ).payload.stream.stream ) ) {
|
||||
/* suppress printing end of stream exception */
|
||||
dec_ref( expr);
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue