From e4d00d6dab0850d29462b3e92cab3a2593b38978 Mon Sep 17 00:00:00 2001 From: Blake McBride Date: Wed, 24 Dec 2025 06:27:46 -0600 Subject: [PATCH] Added reentrancy support --- Makefile | 9 +- README.md | 66 ++--- README2.md | 53 ++++ doc/CODEBASE_ANALYSIS.md | 153 ++++++++++++ doc/REENTRANT.md | 259 ++++++++++++++++++++ doc/THREADING_DESIGN.md | 510 +++++++++++++++++++++++++++++++++++++++ doc/api.md | 86 +++++++ include/xlcompat.h | 211 ++++++++++++++++ include/xlcontext.h | 373 ++++++++++++++++++++++++++++ include/xlisp.h | 30 ++- include/xlthread.h | 280 +++++++++++++++++++++ src/CMakeLists.txt | 9 +- src/unstuff.c | 2 + src/xlansi.c | 2 + src/xlapi.c | 2 + src/xlcom.c | 7 + src/xlcontext.c | 432 +++++++++++++++++++++++++++++++++ src/xldmem.c | 15 +- src/xlfasl.c | 2 + src/xlfun1.c | 2 + src/xlfun2.c | 4 + src/xlfun3.c | 4 + src/xlimage.c | 2 + src/xlinit.c | 7 + src/xlint.c | 11 +- src/xlio.c | 2 + src/xlitersq.c | 2 + src/xlmain.c | 22 +- src/xlobj.c | 2 + src/xlosint.c | 73 ++++-- src/xlprint.c | 17 +- src/xlread.c | 36 ++- src/xlsym.c | 7 + xlisp/CMakeLists.txt | 2 +- 34 files changed, 2600 insertions(+), 94 deletions(-) create mode 100644 README2.md create mode 100644 doc/CODEBASE_ANALYSIS.md create mode 100644 doc/REENTRANT.md create mode 100644 doc/THREADING_DESIGN.md create mode 100644 include/xlcompat.h create mode 100644 include/xlcontext.h create mode 100644 include/xlthread.h create mode 100644 src/xlcontext.c diff --git a/Makefile b/Makefile index 3aa3d6d..49a5a41 100755 --- a/Makefile +++ b/Makefile @@ -45,7 +45,12 @@ endif ECHO=echo MKDIR=mkdir -CFLAGS=-Wall -DUNIX -I$(HDRDIR) +CFLAGS=-Wall -DUNIX -I$(HDRDIR) -fPIC + +# Reentrant/threading support: make REENTRANT=1 +ifdef REENTRANT + CFLAGS += -DXLISP_USE_CONTEXT +endif INC=$(HDRDIR)/xlisp.h @@ -67,6 +72,7 @@ clean: rm -f -r $(OBJDIR) rm -f -r $(LIBDIR) rm -f -r $(BINDIR) + rm -f -r build ######### # XLISP # @@ -99,6 +105,7 @@ $(LIBOBJDIR)/xlansi.o \ $(LIBOBJDIR)/xlapi.o \ $(LIBOBJDIR)/xlcobj.o \ $(LIBOBJDIR)/xlcom.o \ +$(LIBOBJDIR)/xlcontext.o \ $(LIBOBJDIR)/xldbg.o \ $(LIBOBJDIR)/xldmem.o \ $(LIBOBJDIR)/xlfasl.o \ diff --git a/README.md b/README.md index fac510a..27f6529 100644 --- a/README.md +++ b/README.md @@ -1,53 +1,39 @@ -# xlisp -## An object-oriented LISP +# XLISP 3 -Version 3.0 +XLISP3 is a fork of David Betz's XLISP3. -February 18, 2006 +The home for this fork is at -## Building with CMake -We've added the ability to build with CMake to simplify building XLisp on your -system. The way that we expect this to work on Linux systems using `make` would -be to first make a build directory. For this walkthrough we'll say that we -start _in_ the xlisp directory: +XLISP3 is better described as Scheme than Lisp since it more closely follows Scheme. -```bash -cd .. -mkdir build -cd build -ccmake ../xlisp -``` -So, now we have made a build directory outside of xlisp, so that the build -products don't get strewn all over our pristine source. The `ccmake` command is -a curses front end to CMake that I like. From there you can pick the type of -build, then type "g" for generate. This drops you out in a shell prompt, where -it has made makefiles for you (on other platforms, you may have other types of -build files generated). After that you can: +It has some really nice features as follows: -```bash -make -# and then, either: -make install -# or -make package -``` +1. It has a byte-code compiler (to FASL files) so code runs reasonably fast. +2. It can load Lisp source files or compiled FASL files. +3. It has an object system with classes, methods, inheritance, and `super` calls. +4. The macro system is traditional Lisp-style (not Scheme's hygienic macros). +5. It can be used as an extension language embedded in C programs. +6. It can save/load workspace images. +7. It correctly handles tail recursion (proper tail call optimization). +8. It has a Common Lisp-style package system. +9. It supports multiple return values. +10. It has first-class continuations (call/cc). -With the CMake file we have in there, it also has a "package" target, which -will most likely result in a gzipped tar file of the build products. It is also -possible to alter the `CMakeLists.txt` file to generate other package types, -such as `*.rpm`, `*.deb`, etc. +## To all of this, I have added: -#### David Michael Betz +A. When used as an extension language, it is now reentrant and can handle multiple simultaneous threads. -18 Garrison Drive -Bedford, US, NH 03110 +To this, I would like to add native thread support at some time. -(603) 472-2389 (home) +## Building -#### Copyright (c) 1984-2006, by David Michael Betz + make # standard build + make REENTRANT=1 # thread-safe build + make clean # remove build artifacts -All Rights Reserved +## The original README file is located at README2.md + +Blake McBride +blake@mcbridemail.com -See the included file LICENSE for the full license. -Updated 11/8/24 to test 2FA. diff --git a/README2.md b/README2.md new file mode 100644 index 0000000..fac510a --- /dev/null +++ b/README2.md @@ -0,0 +1,53 @@ +# xlisp +## An object-oriented LISP + +Version 3.0 + +February 18, 2006 + +## Building with CMake +We've added the ability to build with CMake to simplify building XLisp on your +system. The way that we expect this to work on Linux systems using `make` would +be to first make a build directory. For this walkthrough we'll say that we +start _in_ the xlisp directory: + +```bash +cd .. +mkdir build +cd build +ccmake ../xlisp +``` +So, now we have made a build directory outside of xlisp, so that the build +products don't get strewn all over our pristine source. The `ccmake` command is +a curses front end to CMake that I like. From there you can pick the type of +build, then type "g" for generate. This drops you out in a shell prompt, where +it has made makefiles for you (on other platforms, you may have other types of +build files generated). After that you can: + +```bash +make +# and then, either: +make install +# or +make package +``` + +With the CMake file we have in there, it also has a "package" target, which +will most likely result in a gzipped tar file of the build products. It is also +possible to alter the `CMakeLists.txt` file to generate other package types, +such as `*.rpm`, `*.deb`, etc. + +#### David Michael Betz + +18 Garrison Drive +Bedford, US, NH 03110 + +(603) 472-2389 (home) + +#### Copyright (c) 1984-2006, by David Michael Betz + +All Rights Reserved + +See the included file LICENSE for the full license. + +Updated 11/8/24 to test 2FA. diff --git a/doc/CODEBASE_ANALYSIS.md b/doc/CODEBASE_ANALYSIS.md new file mode 100644 index 0000000..152c618 --- /dev/null +++ b/doc/CODEBASE_ANALYSIS.md @@ -0,0 +1,153 @@ +# XLISP Codebase Analysis + +## Overview + +**XLISP** is an object-oriented LISP interpreter/compiler (v3.3) by David Michael Betz (1983-2017). Licensed under MIT. It compiles Lisp to bytecodes rather than interpreting directly, making it faster than traditional interpreters. + +## Project Structure + +``` +xlisp/ +├── src/ # Core C source (27 files, ~18.8K lines) +├── include/ # Header files +├── xlisp/ # REPL executable source +├── ext/ # Extension module +├── doc/ # Documentation (Markdown) +├── *.lsp # 14 Lisp initialization/library files +├── CMakeLists.txt # Modern build system +└── Makefile # Legacy build +``` + +## Key Components + +| Module | Purpose | +|--------|---------| +| `xlcom.c` | Bytecode compiler | +| `xlint.c` | Bytecode interpreter/VM | +| `xldmem.c` | Memory management & GC | +| `xlobj.c` | Object-oriented system | +| `xlread.c` / `xlprint.c` | Reader/printer | +| `xlapi.c` | C embedding API | +| `xlfun1.c`, `xlfun2.c`, `xlfun3.c` | Built-in functions | +| `xlftab.c` | Function table registry | +| `xlmath.c` | Mathematical functions | +| `xlsym.c` | Symbol and package management | +| `xlimage.c` | Memory image/workspace management | +| `xlfasl.c` | Fast loading (compiled bytecode) | +| `xldbg.c` | Debugging support | +| `msstuff.c` | Windows-specific code | +| `unstuff.c` | Unix-specific code | + +## Lisp Library Files + +| File | Purpose | +|------|---------| +| `xlisp.lsp` | Main initialization | +| `xlinit.lsp` | System initialization | +| `macros.lsp` | Macro system | +| `objects.lsp` | Object system utilities | +| `qquote.lsp` | Quasiquote/unquote support | +| `clisp.lsp` | Common Lisp compatibility | +| `pp.lsp` | Pretty printer | +| `math.lsp` | Math utilities | +| `compile.lsp` | Compilation utilities | +| `fasl.lsp` | Fast loading utilities | +| `crec.lsp` | C records (FFI) | + +## Architecture + +### Execution Flow + +``` +Lisp Source Code + ↓ + Reader (xlread.c) + ↓ + S-Expressions + ↓ + Compiler (xlcom.c) + ↓ + Bytecodes + ↓ + Interpreter (xlint.c) + ↓ + Execution Results +``` + +### Memory Layout + +- **Node Space**: Lisp values with free list and protected pointers +- **Vector Space**: Strings and arrays with automatic expansion +- **Generational garbage collection** + +### VM Registers + +- `xlFun` - current function +- `xlEnv` - environment +- `xlVal` - last value +- `xlSP` - value stack pointer +- `xlCSP` - control stack pointer + +## Notable Features + +- **Bytecode compilation** - not direct interpretation +- **Generational garbage collection** with protected pointers +- **Class-based OOP** with inheritance and method dispatch +- **Scheme influences** - lexical scoping, proper tail recursion +- **Common Lisp elements** - packages, keywords, multiple values +- **Cross-platform** (Windows, Linux, macOS) via ANSI C +- **Extensible** via C API and extension modules +- **FASL support** - fast loading of pre-compiled bytecode + +## Build System + +### CMake (Recommended) + +```bash +mkdir build && cd build +cmake .. +make +make install # or make package +``` + +Requires CMake 3.14+. Supports link-time optimization (IPO). + +### Build Targets + +1. **xlisp** (library) - Core interpreter/compiler +2. **ext** (shared library) - Extension module +3. **xlisp-repl** (executable) - Interactive REPL + +### Legacy Support + +- `Makefile` - Traditional make-based build +- `.dsp/.dsw` - Historical Visual Studio project files + +## Type System + +- `xlValue` - Universal Lisp value pointer (node-based) +- `xlFIXTYPE` - Fixed-point integers (long) +- `xlFLOTYPE` - Floating-point (double) +- `xlCHRTYPE` - Character (int) + +## C API Patterns + +```c +// Argument fetching +xlGetArg() +xlGetArgFixnum() +xlLastArg() // Detects too many args + +// Return values +xlMakeFixnum() +xlCons() + +// Class definition +xlClass() +``` + +## Platform Abstraction + +- `msstuff.c` - Windows-specific implementation +- `unstuff.c` - Unix-specific implementation +- ANSI C for maximum portability diff --git a/doc/REENTRANT.md b/doc/REENTRANT.md new file mode 100644 index 0000000..5b70180 --- /dev/null +++ b/doc/REENTRANT.md @@ -0,0 +1,259 @@ +# XLISP Reentrant/Thread-Safe Mode + +## Overview + +XLISP can be built in a reentrant mode that allows it to be safely called from multiple threads. Each thread gets its own independent interpreter context with completely separate: + +- Value and control stacks +- Heap memory (nodes and vectors) +- Symbol tables and packages +- Garbage collector state +- VM registers + +**Important:** Lisp data cannot be shared between threads. Each context is a fully isolated interpreter instance. + +## Building + +To build XLISP with reentrant support: + +```bash +make clean +make REENTRANT=1 +``` + +This defines `XLISP_USE_CONTEXT` which enables thread-local storage for the interpreter state. + +To verify the build has reentrant support: + +```bash +nm lib/libxlisp.a | grep xlCreateContext +``` + +You should see `T xlCreateContext` in the output. + +## Thread-Local Storage + +The reentrant build uses thread-local storage (TLS) to maintain a per-thread interpreter context pointer. The implementation uses: + +- `__thread` keyword on GCC/Clang (Linux, macOS) +- `__declspec(thread)` on MSVC (Windows) +- pthread keys as a fallback + +## API + +### Headers + +```c +#include "xlisp.h" +#include "xlthread.h" +``` + +### Functions + +#### xlCreateContext + +```c +xlContext *xlCreateContext(void) +``` + +Allocates a new interpreter context. Returns NULL on failure. + +The context is allocated but not initialized. You must call `xlInitContext()` before using it. + +#### xlInitContext + +```c +int xlInitContext(xlContext *ctx, xlCallbacks *callbacks, + int argc, const char *argv[], const char *workspace) +``` + +Initializes a context for use. Returns 0 on success, -1 on failure. + +Parameters: +- `ctx` - Context created by `xlCreateContext()` +- `callbacks` - Callback structure from `xlDefaultCallbacks()` +- `argc`, `argv` - Command line arguments (can be 0, NULL) +- `workspace` - Workspace image file to restore, or NULL for fresh start + +This function: +1. Sets the context as the current thread's active context +2. Initializes memory management (stack, heap) +3. Creates the standard packages and symbols +4. Optionally restores a workspace image + +#### xlSetCurrentContext + +```c +void xlSetCurrentContext(xlContext *ctx) +``` + +Sets the current thread's active context. This is called automatically by `xlInitContext()`, but can be used to switch between multiple contexts in the same thread. + +#### xlGetCurrentContext + +```c +xlContext *xlGetCurrentContext(void) +``` + +Returns the current thread's active context, or NULL if none is set. + +#### xlDestroyContext + +```c +void xlDestroyContext(xlContext *ctx) +``` + +Frees all memory associated with a context: +- Node segments +- Vector segments +- Stack +- Protected pointer blocks +- The context structure itself + +Call this when a thread is finished using the interpreter. + +## Usage Examples + +### Single Thread (Main Program) + +For single-threaded use, the standard `xlInit()` function works as before. In reentrant mode, it automatically creates and initializes a default context: + +```c +#include "xlisp.h" + +int main(int argc, char *argv[]) +{ + xlCallbacks *callbacks = xlDefaultCallbacks(argc, argv); + + if (!xlInit(callbacks, argc, argv, NULL)) { + fprintf(stderr, "Failed to initialize XLISP\n"); + return 1; + } + + xlInfo("%s\n", xlBanner()); + xlCallFunctionByName(NULL, 0, "*TOPLEVEL*", 0); + return 0; +} +``` + +### Multiple Threads + +Each thread must create and initialize its own context: + +```c +#include +#include "xlisp.h" +#include "xlthread.h" + +void *worker_thread(void *arg) +{ + xlContext *ctx; + xlCallbacks *callbacks; + + /* Create a new context for this thread */ + ctx = xlCreateContext(); + if (ctx == NULL) { + fprintf(stderr, "Failed to create context\n"); + return NULL; + } + + /* Initialize the context */ + callbacks = xlDefaultCallbacks(0, NULL); + if (xlInitContext(ctx, callbacks, 0, NULL, NULL) != 0) { + fprintf(stderr, "Failed to initialize context\n"); + xlDestroyContext(ctx); + return NULL; + } + + /* Now use the interpreter */ + xlLoadFile("worker.lsp"); + xlCallFunctionByName(NULL, 0, "DO-WORK", 0); + + /* Clean up */ + xlDestroyContext(ctx); + return NULL; +} + +int main(int argc, char *argv[]) +{ + pthread_t threads[4]; + int i; + + for (i = 0; i < 4; i++) + pthread_create(&threads[i], NULL, worker_thread, NULL); + + for (i = 0; i < 4; i++) + pthread_join(threads[i], NULL); + + return 0; +} +``` + +### Multiple Contexts in One Thread + +A single thread can manage multiple contexts by switching between them: + +```c +#include "xlisp.h" +#include "xlthread.h" + +int main(void) +{ + xlContext *ctx1, *ctx2; + xlCallbacks *callbacks = xlDefaultCallbacks(0, NULL); + + /* Create two contexts */ + ctx1 = xlCreateContext(); + ctx2 = xlCreateContext(); + + /* Initialize first context */ + xlInitContext(ctx1, callbacks, 0, NULL, NULL); + xlLoadFile("program1.lsp"); + + /* Initialize second context */ + xlInitContext(ctx2, callbacks, 0, NULL, NULL); + xlLoadFile("program2.lsp"); + + /* Switch between them */ + xlSetCurrentContext(ctx1); + xlCallFunctionByName(NULL, 0, "FUNC1", 0); + + xlSetCurrentContext(ctx2); + xlCallFunctionByName(NULL, 0, "FUNC2", 0); + + /* Clean up */ + xlDestroyContext(ctx1); + xlDestroyContext(ctx2); + + return 0; +} +``` + +## Limitations + +1. **No data sharing:** Lisp values cannot be passed between contexts. Each context has its own heap, so pointers are not valid across contexts. + +2. **No cross-thread calls:** You cannot call a function in one context from another thread. Each thread must use its own context. + +3. **Callbacks:** The callback structure can be shared between contexts (it contains function pointers, not Lisp data), but be careful with any state in your callback implementations. + +4. **Memory overhead:** Each context has its own complete interpreter state, including separate heaps. Memory usage scales linearly with the number of contexts. + +5. **Initialization time:** Creating and initializing a context takes time (building symbol tables, etc.). For best performance, create contexts once and reuse them. + +## Implementation Details + +The reentrant mode works by: + +1. Moving all global variables into an `xlContext` structure +2. Using a thread-local pointer (`xl_current_context`) to the current context +3. Providing compatibility macros that redirect global variable access through the context pointer + +For example, the global `xlVal` becomes: +```c +#define xlVal (xlCtx()->val) +``` + +Where `xlCtx()` returns the current thread's context pointer. + +The context structure is defined in `include/xlcontext.h` and contains all interpreter state including VM registers, stack pointers, memory management state, symbol caches, and package pointers. diff --git a/doc/THREADING_DESIGN.md b/doc/THREADING_DESIGN.md new file mode 100644 index 0000000..20d4ad7 --- /dev/null +++ b/doc/THREADING_DESIGN.md @@ -0,0 +1,510 @@ +# XLISP Threading Support Design + +## Overview + +This document describes the design for adding multi-threading support to XLISP using **thread-local interpreter instances**. Each thread gets its own complete interpreter state with no sharing of Lisp data between threads. + +## Architecture + +### Current Problem: Global State + +The current implementation uses extensive global variables: + +```c +// VM Registers (xldmem.c) +xlValue xlFun; // current function +xlValue xlEnv; // current environment +xlValue xlVal; // value of most recent instruction +xlValue *xlSP; // value stack pointer +xlValue *xlCSP; // control stack pointer +int xlArgC; // argument count + +// Stack (xldmem.c) +xlValue *xlStkBase; // stack base +xlValue *xlStkTop; // stack top + +// Memory Management (xldmem.c) +xlNodeSegment *xlNSegments; +xlVectorSegment *xlVSegments; +xlValue *xlVFree, *xlVTop; +xlValue xlFNodes; +xlFIXTYPE xlNFree, xlNNodes, xlTotal, xlGCCalls; +xlProtectedPtrBlk *xlPPointers; + +// Interpreter State (xlint.c) +xlErrorTarget *xlerrtarget; +xlValue *xlcatch; +int xlTraceBytecodes; +void (*xlNext)(void); +static unsigned char *base, *pc; // bytecode pointers + +// Important Values +xlValue xlTrue, xlFalse, xlPackages; +xlValue xlUnboundObject, xlDefaultObject, xlEofObject; + +// Symbols (xlinit.c) - ~30+ cached symbols +xlValue s_quote, s_function, s_package, ... + +// I/O +FILE *xlTranscriptFP; +xlCallbacks *callbacks; +``` + +### Solution: Interpreter Context Structure + +All global state is encapsulated into a single context structure: + +```c +/* include/xlcontext.h */ + +#ifndef __XLCONTEXT_H__ +#define __XLCONTEXT_H__ + +#include "xlisp.h" + +/* Interpreter context - contains all per-thread state */ +typedef struct xlContext { + + /* === VM Registers === */ + xlValue fun; /* current function */ + xlValue env; /* current environment */ + xlValue val; /* value of most recent instruction */ + int argc; /* argument count */ + void (*next)(void); /* next function to call */ + + /* === Stacks === */ + xlValue *sp; /* value stack pointer */ + xlValue *csp; /* control stack pointer */ + xlValue *stkBase; /* stack base */ + xlValue *stkTop; /* stack top */ + + /* === Bytecode Interpreter === */ + unsigned char *pc; /* program counter */ + unsigned char *pcBase; /* code base pointer */ + xlErrorTarget *errTarget; + xlValue *catchFrame; + int traceBytecodes; + int sample; /* control char sample counter */ + + /* === Memory: Node Space === */ + xlNodeSegment *nSegments; + xlNodeSegment *nsLast; + xlValue fNodes; /* free node list */ + xlFIXTYPE nsSize; + xlFIXTYPE nNodes; + xlFIXTYPE nFree; + int nsCount; + + /* === Memory: Vector Space === */ + xlVectorSegment *vSegments; + xlVectorSegment *vsCurrent; + xlValue *vFree; + xlValue *vTop; + xlFIXTYPE vsSize; + int vsCount; + + /* === Memory: Protected Pointers === */ + xlProtectedPtrBlk *pPointers; + + /* === Memory: Statistics === */ + xlFIXTYPE total; + xlFIXTYPE gcCalls; + + /* === Important Values === */ + xlValue vTrue; + xlValue vFalse; + xlValue packages; + xlValue unboundObject; + xlValue defaultObject; + xlValue eofObject; + + /* === Cached Symbols === */ + struct { + xlValue quote, function, quasiquote, unquote, unquoteSplicing; + xlValue dot, package, eval, load; + xlValue print, printCase, eql; + xlValue stdin_, stdout_, stderr_; + xlValue stackPointer, error; + xlValue fixfmt, hexfmt, flofmt, freeptr, backtrace; + /* Lambda list keywords */ + xlValue lk_optional, lk_rest, lk_key, lk_aux, lk_allow_other_keys; + xlValue slk_optional, slk_rest; + /* Keyword symbols */ + xlValue k_upcase, k_downcase; + xlValue k_internal, k_external, k_inherited; + xlValue k_key, k_uses, k_test, k_testnot; + xlValue k_start, k_end, k_1start, k_1end, k_2start, k_2end; + xlValue k_count, k_fromend; + } sym; + + /* === Packages === */ + xlValue lispPackage; + xlValue xlispPackage; + xlValue keywordPackage; + + /* === Reader State === */ + xlValue symReadTable; + xlValue symNMacro, symTMacro, symWSpace; + xlValue symConst, symSEscape, symMEscape; + + /* === Printer State === */ + int prBreadth; + int prDepth; + + /* === I/O === */ + FILE *transcriptFP; + + /* === Callbacks === */ + xlCallbacks *callbacks; + + /* === Initialization Flag === */ + int initialized; + + /* === Command Line === */ + int cmdLineArgC; + const char **cmdLineArgV; + + /* === C Classes === */ + xlCClass *cClasses; + +} xlContext; + +/* Thread-local context access */ +#if defined(_WIN32) + #define XLISP_TLS __declspec(thread) +#elif defined(__GNUC__) + #define XLISP_TLS __thread +#else + /* Fall back to pthread_getspecific */ + #define XLISP_USE_PTHREAD_TLS 1 +#endif + +#ifndef XLISP_USE_PTHREAD_TLS + extern XLISP_TLS xlContext *xlCurrentContext; + #define xlCtx() xlCurrentContext +#else + xlContext *xlCtx(void); +#endif + +/* Context management API */ +xlContext *xlCreateContext(void); +void xlDestroyContext(xlContext *ctx); +void xlSetCurrentContext(xlContext *ctx); +xlContext *xlGetCurrentContext(void); + +/* Initialize a context */ +int xlInitContext(xlContext *ctx, xlCallbacks *callbacks, + int argc, const char *argv[], const char *workspace); + +#endif /* __XLCONTEXT_H__ */ +``` + +## Compatibility Macros + +To minimize code changes, provide macros that redirect old globals to context fields: + +```c +/* include/xlcompat.h - Compatibility layer for threading */ + +#ifndef __XLCOMPAT_H__ +#define __XLCOMPAT_H__ + +#include "xlcontext.h" + +/* VM Registers */ +#define xlFun (xlCtx()->fun) +#define xlEnv (xlCtx()->env) +#define xlVal (xlCtx()->val) +#define xlArgC (xlCtx()->argc) +#define xlNext (xlCtx()->next) + +/* Stacks */ +#define xlSP (xlCtx()->sp) +#define xlCSP (xlCtx()->csp) +#define xlStkBase (xlCtx()->stkBase) +#define xlStkTop (xlCtx()->stkTop) + +/* Memory - Node Space */ +#define xlNSegments (xlCtx()->nSegments) +#define xlNSLast (xlCtx()->nsLast) +#define xlFNodes (xlCtx()->fNodes) +#define xlNSSize (xlCtx()->nsSize) +#define xlNNodes (xlCtx()->nNodes) +#define xlNFree (xlCtx()->nFree) +#define xlNSCount (xlCtx()->nsCount) + +/* Memory - Vector Space */ +#define xlVSegments (xlCtx()->vSegments) +#define xlVSCurrent (xlCtx()->vsCurrent) +#define xlVFree (xlCtx()->vFree) +#define xlVTop (xlCtx()->vTop) +#define xlVSSize (xlCtx()->vsSize) +#define xlVSCount (xlCtx()->vsCount) + +/* Memory - Other */ +#define xlPPointers (xlCtx()->pPointers) +#define xlTotal (xlCtx()->total) +#define xlGCCalls (xlCtx()->gcCalls) + +/* Important Values */ +#define xlTrue (xlCtx()->vTrue) +#define xlFalse (xlCtx()->vFalse) +#define xlPackages (xlCtx()->packages) +#define xlUnboundObject (xlCtx()->unboundObject) +#define xlDefaultObject (xlCtx()->defaultObject) +#define xlEofObject (xlCtx()->eofObject) + +/* Packages */ +#define xlLispPackage (xlCtx()->lispPackage) +#define xlXLispPackage (xlCtx()->xlispPackage) +#define xlKeywordPackage (xlCtx()->keywordPackage) + +/* Interpreter State */ +#define xlerrtarget (xlCtx()->errTarget) +#define xlcatch (xlCtx()->catchFrame) +#define xlTraceBytecodes (xlCtx()->traceBytecodes) + +/* I/O */ +#define xlTranscriptFP (xlCtx()->transcriptFP) + +/* Symbols - accessed via xlCtx()->sym.XXX */ +#define s_quote (xlCtx()->sym.quote) +#define s_function (xlCtx()->sym.function) +#define s_package (xlCtx()->sym.package) +/* ... etc for all cached symbols ... */ + +/* Printer */ +#define xlPRBreadth (xlCtx()->prBreadth) +#define xlPRDepth (xlCtx()->prDepth) + +/* Command line */ +#define xlCmdLineArgC (xlCtx()->cmdLineArgC) +#define xlCmdLineArgV (xlCtx()->cmdLineArgV) + +/* Initialization */ +#define xlInitializedP (xlCtx()->initialized) + +#endif /* __XLCOMPAT_H__ */ +``` + +## New Public API + +```c +/* include/xlthread.h - Thread-safe API */ + +#ifndef __XLTHREAD_H__ +#define __XLTHREAD_H__ + +#include "xlcontext.h" + +/* + * Thread-Safe XLISP API + * + * Each thread must: + * 1. Create its own context with xlCreateContext() + * 2. Initialize it with xlInitContext() + * 3. Set it as current with xlSetCurrentContext() + * 4. Use standard xl* functions (they use xlCtx() internally) + * 5. Destroy with xlDestroyContext() when done + */ + +/* Create a new interpreter context */ +xlEXPORT xlContext *xlCreateContext(void); + +/* Destroy an interpreter context */ +xlEXPORT void xlDestroyContext(xlContext *ctx); + +/* Set the current thread's context */ +xlEXPORT void xlSetCurrentContext(xlContext *ctx); + +/* Get the current thread's context */ +xlEXPORT xlContext *xlGetCurrentContext(void); + +/* Initialize a context (replaces xlInit for multi-threaded use) */ +xlEXPORT int xlInitContext( + xlContext *ctx, + xlCallbacks *callbacks, + int argc, + const char *argv[], + const char *workspace +); + +/* Thread-safe versions of key API functions */ +/* (These explicitly take a context parameter) */ + +xlEXPORT int xlCallFunctionCtx( + xlContext *ctx, + xlValue *values, int vmax, + xlValue fun, int argc, ... +); + +xlEXPORT int xlEvaluateCtx( + xlContext *ctx, + xlValue *values, int vmax, + xlValue expr +); + +xlEXPORT int xlEvaluateCStringCtx( + xlContext *ctx, + xlValue *values, int vmax, + const char *str +); + +#endif /* __XLTHREAD_H__ */ +``` + +## Usage Example + +```c +/* example_threaded.c - Multi-threaded XLISP usage */ + +#include +#include "xlthread.h" + +void *worker_thread(void *arg) { + int thread_id = *(int *)arg; + xlContext *ctx; + xlValue result; + char expr[256]; + + /* Create and initialize context for this thread */ + ctx = xlCreateContext(); + if (!ctx) { + fprintf(stderr, "Thread %d: Failed to create context\n", thread_id); + return NULL; + } + + /* Initialize with default callbacks */ + if (xlInitContext(ctx, xlDefaultCallbacks(NULL), 0, NULL, NULL) != 0) { + fprintf(stderr, "Thread %d: Failed to initialize\n", thread_id); + xlDestroyContext(ctx); + return NULL; + } + + /* Set as current context for this thread */ + xlSetCurrentContext(ctx); + + /* Now we can use standard XLISP functions */ + snprintf(expr, sizeof(expr), "(+ %d 100)", thread_id); + + if (xlEvaluateCString(&result, 1, expr) == 1) { + printf("Thread %d: %s = %ld\n", + thread_id, expr, xlGetFixnum(result)); + } + + /* Can also use explicit context version */ + xlEvaluateCStringCtx(ctx, &result, 1, "(* 6 7)"); + + /* Cleanup */ + xlDestroyContext(ctx); + return NULL; +} + +int main(void) { + pthread_t threads[4]; + int ids[4] = {1, 2, 3, 4}; + + /* Launch worker threads */ + for (int i = 0; i < 4; i++) { + pthread_create(&threads[i], NULL, worker_thread, &ids[i]); + } + + /* Wait for completion */ + for (int i = 0; i < 4; i++) { + pthread_join(threads[i], NULL); + } + + return 0; +} +``` + +## Implementation Plan + +### Phase 1: Create Context Structure +1. Define `xlContext` struct in new `include/xlcontext.h` +2. Add thread-local storage for current context pointer +3. Implement `xlCreateContext()`, `xlDestroyContext()`, `xlSetCurrentContext()` + +### Phase 2: Add Compatibility Macros +1. Create `include/xlcompat.h` with macro redirects +2. Include xlcompat.h in xlisp.h (after xlcontext.h) +3. All existing code continues to work via macros + +### Phase 3: Refactor Initialization +1. Create `xlInitContext()` that initializes a specific context +2. Modify `xlInit()` to create a default context and call `xlInitContext()` +3. Move all initialization from static to context-based + +### Phase 4: Refactor Memory Management +1. Move all memory globals into context (`xldmem.c`) +2. GC now operates on context's memory segments +3. Each context has independent heap + +### Phase 5: Refactor Interpreter +1. Move interpreter state into context (`xlint.c`) +2. Move bytecode state (pc, base) into context +3. Error handling uses context's error target + +### Phase 6: Refactor Symbols and Packages +1. Move symbol cache into context +2. Move package list into context +3. Each context has its own symbol table + +### Phase 7: Testing and Validation +1. Single-threaded regression tests +2. Multi-threaded stress tests +3. Memory leak testing with valgrind + +## Files Requiring Modification + +| File | Changes | +|------|---------| +| `include/xlisp.h` | Include xlcontext.h, xlcompat.h | +| `include/xlcontext.h` | **NEW** - Context structure | +| `include/xlcompat.h` | **NEW** - Compatibility macros | +| `include/xlthread.h` | **NEW** - Thread-safe API | +| `src/xldmem.c` | Remove globals, use xlCtx() | +| `src/xlint.c` | Remove globals, use xlCtx() | +| `src/xlinit.c` | Remove globals, use xlCtx() | +| `src/xlsym.c` | Remove globals, use xlCtx() | +| `src/xlmain.c` | Add context creation in xlInit() | +| `src/xlapi.c` | Add xlInitContext(), context API | +| `src/xlcom.c` | Use xlCtx() for compiler state | +| `src/xlread.c` | Use xlCtx() for reader state | +| `src/xlprint.c` | Use xlCtx() for printer state | +| `src/xlio.c` | Use xlCtx() for I/O state | +| `src/xlobj.c` | Use xlCtx() for object symbols | +| `src/xlfun1.c` | No changes (uses macros) | +| `src/xlfun2.c` | No changes (uses macros) | +| `src/xlfun3.c` | No changes (uses macros) | + +## Considerations + +### What This Design Does NOT Support +- Sharing Lisp objects between threads (each thread has isolated heap) +- Concurrent GC (each thread GCs independently) +- Cross-thread message passing at Lisp level + +### If You Need Shared Data +For inter-thread communication, use C-level mechanisms: +- Serialize Lisp data to strings, pass via queue +- Use foreign pointers to shared C structures with your own locking +- Implement a Lisp-level channel/queue using C primitives + +### Performance Notes +- Thread-local storage access is very fast (single instruction on most platforms) +- Independent heaps mean no GC coordination overhead +- Memory usage scales linearly with thread count + +## Estimated Effort + +| Phase | Effort | +|-------|--------| +| Phase 1: Context Structure | 1-2 days | +| Phase 2: Compatibility Macros | 1 day | +| Phase 3: Refactor Init | 2-3 days | +| Phase 4: Refactor Memory | 3-4 days | +| Phase 5: Refactor Interpreter | 2-3 days | +| Phase 6: Refactor Symbols | 2-3 days | +| Phase 7: Testing | 3-5 days | +| **Total** | **~2-3 weeks** | diff --git a/doc/api.md b/doc/api.md index b8b24a1..f5f6c02 100644 --- a/doc/api.md +++ b/doc/api.md @@ -1,6 +1,22 @@ # xlisp ## The API +### Building + +Standard build: +```bash +make +``` + +Reentrant/thread-safe build: +```bash +make REENTRANT=1 +``` + +The reentrant build enables thread-local interpreter contexts, allowing XLISP to be safely called from multiple threads. + +### Basic Usage + Here is the basic form of a C program that uses `xlisp.dll`. ```cpp @@ -29,6 +45,76 @@ void main(int argc,char *argv[]) xlCallFunctionByName(NULL,0,"*TOPLEVEL*",0); } ``` + +### Multi-threaded Usage + +When built with `REENTRANT=1`, each thread must create and initialize its own interpreter context. Contexts are completely independent - no Lisp data is shared between threads. + +```cpp +#include "xlisp.h" +#include "xlthread.h" + +void *thread_func(void *arg) +{ + xlCallbacks *callbacks; + xlContext *ctx; + + /* create a new interpreter context for this thread */ + ctx = xlCreateContext(); + if (ctx == NULL) + return NULL; + + /* get default callbacks and initialize the context */ + callbacks = xlDefaultCallbacks(0, NULL); + if (xlInitContext(ctx, callbacks, 0, NULL, NULL) != 0) { + xlDestroyContext(ctx); + return NULL; + } + + /* use the interpreter */ + xlLoadFile("mycode.lsp"); + xlCallFunctionByName(NULL, 0, "MY-FUNCTION", 0); + + /* clean up when done */ + xlDestroyContext(ctx); + return NULL; +} +``` + +#### Context API Functions + +```cpp +xlContext *xlCreateContext(void) +``` +Allocates a new interpreter context. Returns NULL on failure. + +```cpp +int xlInitContext(xlContext *ctx, xlCallbacks *callbacks, + int argc, const char *argv[], const char *workspace) +``` +Initializes a context for use. Returns 0 on success, -1 on failure. +- `ctx` - context created by `xlCreateContext()` +- `callbacks` - callback structure (use `xlDefaultCallbacks()`) +- `argc`, `argv` - command line arguments (can be 0, NULL) +- `workspace` - workspace image file to restore (or NULL) + +```cpp +void xlSetCurrentContext(xlContext *ctx) +``` +Sets the current thread's active context. Called automatically by `xlInitContext()`. + +```cpp +void xlDestroyContext(xlContext *ctx) +``` +Frees all memory associated with a context. Call when the thread is done with the interpreter. + +```cpp +xlContext *xlGetCurrentContext(void) +``` +Returns the current thread's active context. + +### Defining External Functions + External functions should be declared as functions taking no arguments and returning an xlValue which is the result. Arguments should be fetched by using the routines below. For functions that take optional arguments, call the predicate `xlMoreArgsP()` to determine if more arguments are present before diff --git a/include/xlcompat.h b/include/xlcompat.h new file mode 100644 index 0000000..7038267 --- /dev/null +++ b/include/xlcompat.h @@ -0,0 +1,211 @@ +/* xlcompat.h - compatibility macros for multi-threading support */ +/* Copyright (c) 1984-2002, by David Michael Betz + All Rights Reserved + See the included file 'license.txt' for the full license. +*/ + +#ifndef __XLCOMPAT_H__ +#define __XLCOMPAT_H__ + +#include "xlcontext.h" + +/* + * Compatibility Layer for XLISP Threading + * + * These macros redirect all global variable accesses to the current + * thread's context. This allows existing code to work unchanged while + * supporting multiple interpreter instances. + * + * IMPORTANT: Do not use these macros in xlcontext.c where the actual + * context management is implemented. Define XLISP_CONTEXT_IMPL before + * including this header to disable the macros. + */ + +#ifndef XLISP_CONTEXT_IMPL + +/* ==================================================================== + * VM Registers + * ==================================================================== */ +#define xlFun (xlCtx()->fun) +#define xlEnv (xlCtx()->env) +#define xlVal (xlCtx()->val) +#define xlArgC (xlCtx()->argc) +#define xlNext (xlCtx()->next) + +/* ==================================================================== + * Stacks + * ==================================================================== */ +#define xlSP (xlCtx()->sp) +#define xlCSP (xlCtx()->csp) +#define xlStkBase (xlCtx()->stkBase) +#define xlStkTop (xlCtx()->stkTop) + +/* ==================================================================== + * Bytecode Interpreter State + * ==================================================================== */ +#define xlerrtarget (xlCtx()->errTarget) +#define xlcatch (xlCtx()->catchFrame) +#define xlTraceBytecodes (xlCtx()->traceBytecodes) + +/* Note: pc and pcBase are static in xlint.c, handled separately */ + +/* ==================================================================== + * Memory Management - Node Space + * ==================================================================== */ +#define xlNSegments (xlCtx()->nSegments) +#define xlNSLast (xlCtx()->nsLast) +#define xlFNodes (xlCtx()->fNodes) +#define xlNSSize (xlCtx()->nsSize) +#define xlNNodes (xlCtx()->nNodes) +#define xlNFree (xlCtx()->nFree) +#define xlNSCount (xlCtx()->nsCount) + +/* ==================================================================== + * Memory Management - Vector Space + * ==================================================================== */ +#define xlVSegments (xlCtx()->vSegments) +#define xlVSCurrent (xlCtx()->vsCurrent) +#define xlVFree (xlCtx()->vFree) +#define xlVTop (xlCtx()->vTop) +#define xlVSSize (xlCtx()->vsSize) +#define xlVSCount (xlCtx()->vsCount) + +/* ==================================================================== + * Memory Management - Other + * ==================================================================== */ +#define xlPPointers (xlCtx()->pPointers) +#define xlTotal (xlCtx()->total) +#define xlGCCalls (xlCtx()->gcCalls) + +/* ==================================================================== + * Important Singleton Values + * ==================================================================== */ +#define xlTrue (xlCtx()->vTrue) +#define xlFalse (xlCtx()->vFalse) +#define xlUnboundObject (xlCtx()->unboundObject) +#define xlDefaultObject (xlCtx()->defaultObject) +#define xlEofObject (xlCtx()->eofObject) + +/* ==================================================================== + * Package System + * ==================================================================== */ +#define xlPackages (xlCtx()->packages) +#define xlLispPackage (xlCtx()->lispPackage) +#define xlXLispPackage (xlCtx()->xlispPackage) +#define xlKeywordPackage (xlCtx()->keywordPackage) + +/* ==================================================================== + * Cached Symbols - Special Forms + * ==================================================================== */ +#define s_quote (xlCtx()->sym.quote) +#define s_function (xlCtx()->sym.function) +#define s_quasiquote (xlCtx()->sym.quasiquote) +#define s_unquote (xlCtx()->sym.unquote) +#define s_unquotesplicing (xlCtx()->sym.unquoteSplicing) +#define s_dot (xlCtx()->sym.dot) + +/* ==================================================================== + * Cached Symbols - System + * ==================================================================== */ +#define s_package (xlCtx()->sym.package) +#define s_eval (xlCtx()->sym.eval) +#define s_load (xlCtx()->sym.load) +#define s_print (xlCtx()->sym.print) +#define s_printcase (xlCtx()->sym.printCase) +#define s_eql (xlCtx()->sym.eql) +#define s_error (xlCtx()->sym.error) +#define s_stackpointer (xlCtx()->sym.stackPointer) +#define s_backtrace (xlCtx()->sym.backtrace) +#define s_unassigned (xlCtx()->sym.unassigned) + +/* ==================================================================== + * Cached Symbols - Standard Streams + * ==================================================================== */ +#define s_stdin (xlCtx()->sym.stdin_) +#define s_stdout (xlCtx()->sym.stdout_) +#define s_stderr (xlCtx()->sym.stderr_) + +/* ==================================================================== + * Cached Symbols - Format Strings + * ==================================================================== */ +#define s_fixfmt (xlCtx()->sym.fixfmt) +#define s_hexfmt (xlCtx()->sym.hexfmt) +#define s_flofmt (xlCtx()->sym.flofmt) +#define s_freeptr (xlCtx()->sym.freeptr) + +/* ==================================================================== + * Cached Symbols - Lambda List Keywords + * ==================================================================== */ +#define lk_optional (xlCtx()->sym.lk_optional) +#define lk_rest (xlCtx()->sym.lk_rest) +#define lk_key (xlCtx()->sym.lk_key) +#define lk_aux (xlCtx()->sym.lk_aux) +#define lk_allow_other_keys (xlCtx()->sym.lk_allow_other_keys) +#define slk_optional (xlCtx()->sym.slk_optional) +#define slk_rest (xlCtx()->sym.slk_rest) + +/* ==================================================================== + * Cached Symbols - Keywords + * ==================================================================== */ +#define k_upcase (xlCtx()->sym.k_upcase) +#define k_downcase (xlCtx()->sym.k_downcase) +#define k_internal (xlCtx()->sym.k_internal) +#define k_external (xlCtx()->sym.k_external) +#define k_inherited (xlCtx()->sym.k_inherited) +#define k_key (xlCtx()->sym.k_key) +#define k_uses (xlCtx()->sym.k_uses) +#define k_test (xlCtx()->sym.k_test) +#define k_testnot (xlCtx()->sym.k_testnot) +#define k_start (xlCtx()->sym.k_start) +#define k_end (xlCtx()->sym.k_end) +#define k_1start (xlCtx()->sym.k_1start) +#define k_1end (xlCtx()->sym.k_1end) +#define k_2start (xlCtx()->sym.k_2start) +#define k_2end (xlCtx()->sym.k_2end) +#define k_count (xlCtx()->sym.k_count) +#define k_fromend (xlCtx()->sym.k_fromend) + +/* ==================================================================== + * Reader State + * ==================================================================== */ +#define xlSymReadTable (xlCtx()->symReadTable) +#define xlSymNMacro (xlCtx()->symNMacro) +#define xlSymTMacro (xlCtx()->symTMacro) +#define xlSymWSpace (xlCtx()->symWSpace) +#define xlSymConst (xlCtx()->symConst) +#define xlSymSEscape (xlCtx()->symSEscape) +#define xlSymMEscape (xlCtx()->symMEscape) + +/* ==================================================================== + * Printer State + * ==================================================================== */ +#define xlPRBreadth (xlCtx()->prBreadth) +#define xlPRDepth (xlCtx()->prDepth) + +/* ==================================================================== + * I/O State + * ==================================================================== */ +#define xlTranscriptFP (xlCtx()->transcriptFP) + +/* ==================================================================== + * Initialization and Command Line + * ==================================================================== */ +#define xlInitializedP (xlCtx()->initialized) +#define xlCmdLineArgC (xlCtx()->cmdLineArgC) +#define xlCmdLineArgV (xlCtx()->cmdLineArgV) + +/* ==================================================================== + * Compiler State + * ==================================================================== */ +#define xlDebugModeP (xlCtx()->debugModeP) + +/* ==================================================================== + * Object System + * ==================================================================== */ +#define c_class (xlCtx()->c_class) +#define c_object (xlCtx()->c_object) +#define k_initialize (xlCtx()->k_initialize) + +#endif /* XLISP_CONTEXT_IMPL */ + +#endif /* __XLCOMPAT_H__ */ diff --git a/include/xlcontext.h b/include/xlcontext.h new file mode 100644 index 0000000..ce593b0 --- /dev/null +++ b/include/xlcontext.h @@ -0,0 +1,373 @@ +/* xlcontext.h - xlisp interpreter context for multi-threading support */ +/* Copyright (c) 1984-2002, by David Michael Betz + All Rights Reserved + See the included file 'license.txt' for the full license. +*/ + +#ifndef __XLCONTEXT_H__ +#define __XLCONTEXT_H__ + +#include /* for FILE* */ + +/* + * Forward declarations - only if xlisp.h hasn't been included yet. + * If xlisp.h is included first, these types are already defined. + */ +#ifndef __XLISP_H__ +typedef struct xlNode xlNode, *xlValue; +typedef struct xlNodeSegment xlNodeSegment; +typedef struct xlVectorSegment xlVectorSegment; +typedef struct xlProtectedPtrBlk xlProtectedPtrBlk; +typedef struct xlErrorTarget xlErrorTarget; +typedef struct xlCClass xlCClass; +typedef struct xlCallbacks xlCallbacks; +#endif + +/* Type definitions matching xlisp.h defaults */ +#ifndef xlFIXTYPE +#define xlFIXTYPE long +#endif + +#ifndef xlOFFTYPE +#define xlOFFTYPE long +#endif + +/* + * xlContext - Per-thread interpreter state + * + * This structure contains all state that was previously stored in global + * variables. Each thread that uses XLISP must have its own context. + * + * Usage: + * xlContext *ctx = xlCreateContext(); + * xlInitContext(ctx, callbacks, argc, argv, workspace); + * xlSetCurrentContext(ctx); + * // ... use XLISP API ... + * xlDestroyContext(ctx); + */ +typedef struct xlContext { + + /* ================================================================ + * VM Registers + * ================================================================ */ + xlValue fun; /* current function being executed */ + xlValue env; /* current lexical environment */ + xlValue val; /* value of most recent instruction */ + int argc; /* argument count for current call */ + void (*next)(void); /* next function to call (xlApply or NULL) */ + + /* ================================================================ + * Value and Control Stacks + * ================================================================ */ + xlValue *sp; /* value stack pointer (grows down) */ + xlValue *csp; /* control stack pointer (grows up) */ + xlValue *stkBase; /* base of stack allocation */ + xlValue *stkTop; /* top of stack allocation */ + + /* ================================================================ + * Bytecode Interpreter State + * ================================================================ */ + unsigned char *pc; /* program counter */ + unsigned char *pcBase; /* base of current code object */ + xlErrorTarget *errTarget; /* error/abort target chain */ + xlValue *catchFrame; /* current catch frame pointer */ + int traceBytecodes; /* bytecode tracing enabled */ + int sample; /* control character sample counter */ + + /* ================================================================ + * Memory Management - Node Space + * ================================================================ */ + xlNodeSegment *nSegments; /* list of node segments */ + xlNodeSegment *nsLast; /* last node segment (for appending) */ + xlValue fNodes; /* head of free node list */ + xlFIXTYPE nsSize; /* default nodes per segment */ + xlFIXTYPE nNodes; /* total number of nodes allocated */ + xlFIXTYPE nFree; /* number of nodes in free list */ + int nsCount; /* number of node segments */ + + /* ================================================================ + * Memory Management - Vector Space + * ================================================================ */ + xlVectorSegment *vSegments; /* list of vector segments */ + xlVectorSegment *vsCurrent; /* current vector segment */ + xlValue *vFree; /* next free location in vector space */ + xlValue *vTop; /* top of current vector segment */ + xlFIXTYPE vsSize; /* default size of vector segments */ + int vsCount; /* number of vector segments */ + + /* ================================================================ + * Memory Management - Protected Pointers + * ================================================================ */ + xlProtectedPtrBlk *pPointers; /* protected pointer blocks */ + + /* ================================================================ + * Memory Management - Statistics + * ================================================================ */ + xlFIXTYPE total; /* total bytes of memory in use */ + xlFIXTYPE gcCalls; /* number of GC invocations */ + + /* ================================================================ + * Important Singleton Values + * ================================================================ */ + xlValue vTrue; /* #t */ + xlValue vFalse; /* #f */ + xlValue unboundObject; /* marker for unbound variables */ + xlValue defaultObject; /* default object for methods */ + xlValue eofObject; /* end-of-file object */ + + /* ================================================================ + * Package System + * ================================================================ */ + xlValue packages; /* list of all packages */ + xlValue lispPackage; /* the LISP package */ + xlValue xlispPackage; /* the XLISP package */ + xlValue keywordPackage; /* the KEYWORD package */ + + /* ================================================================ + * Cached Symbols - Frequently Used + * ================================================================ */ + struct { + /* Special forms and core */ + xlValue quote; + xlValue function; + xlValue quasiquote; + xlValue unquote; + xlValue unquoteSplicing; + xlValue dot; + + /* System symbols */ + xlValue package; + xlValue eval; + xlValue load; + xlValue print; + xlValue printCase; + xlValue eql; + xlValue error; + xlValue stackPointer; + xlValue backtrace; + xlValue unassigned; + + /* Standard streams */ + xlValue stdin_; + xlValue stdout_; + xlValue stderr_; + + /* Format strings */ + xlValue fixfmt; + xlValue hexfmt; + xlValue flofmt; + xlValue freeptr; + + /* Lambda list keywords */ + xlValue lk_optional; + xlValue lk_rest; + xlValue lk_key; + xlValue lk_aux; + xlValue lk_allow_other_keys; + + /* Scheme-style lambda keywords */ + xlValue slk_optional; + xlValue slk_rest; + + /* Keyword symbols for functions */ + xlValue k_upcase; + xlValue k_downcase; + xlValue k_internal; + xlValue k_external; + xlValue k_inherited; + xlValue k_key; + xlValue k_uses; + xlValue k_test; + xlValue k_testnot; + xlValue k_start; + xlValue k_end; + xlValue k_1start; + xlValue k_1end; + xlValue k_2start; + xlValue k_2end; + xlValue k_count; + xlValue k_fromend; + + } sym; + + /* ================================================================ + * Reader State + * ================================================================ */ + xlValue symReadTable; /* read table symbol */ + xlValue symNMacro; /* non-terminating macro */ + xlValue symTMacro; /* terminating macro */ + xlValue symWSpace; /* whitespace */ + xlValue symConst; /* constituent */ + xlValue symSEscape; /* single escape */ + xlValue symMEscape; /* multiple escape */ + + /* ================================================================ + * Printer State + * ================================================================ */ + int prBreadth; /* print breadth limit (-1 = unlimited) */ + int prDepth; /* print depth limit (-1 = unlimited) */ + + /* ================================================================ + * I/O State + * ================================================================ */ + FILE *transcriptFP; /* transcript file pointer */ + + /* ================================================================ + * Callbacks + * ================================================================ */ + xlCallbacks *callbacks; /* host application callbacks */ + + /* ================================================================ + * Compiler State + * ================================================================ */ + int debugModeP; /* true to turn off tail recursion */ + + /* ================================================================ + * Initialization State + * ================================================================ */ + int initialized; /* non-zero if fully initialized */ + + /* ================================================================ + * Command Line + * ================================================================ */ + int cmdLineArgC; /* argument count */ + const char **cmdLineArgV; /* argument vector */ + + /* ================================================================ + * C Class Registry + * ================================================================ */ + xlCClass *cClasses; /* linked list of C classes */ + + /* ================================================================ + * Object System + * ================================================================ */ + xlValue c_class; /* the Class class */ + xlValue c_object; /* the Object class */ + xlValue k_initialize; /* :initialize keyword */ + +} xlContext; + + +/* ==================================================================== + * Thread-Local Storage Configuration + * ==================================================================== */ + +#if defined(_WIN32) || defined(_WIN64) + /* Windows: use __declspec(thread) */ + #define XLISP_TLS __declspec(thread) + #define XLISP_TLS_NATIVE 1 +#elif defined(__GNUC__) || defined(__clang__) + /* GCC/Clang: use __thread */ + #define XLISP_TLS __thread + #define XLISP_TLS_NATIVE 1 +#else + /* Fallback: use pthread_getspecific */ + #define XLISP_TLS + #define XLISP_TLS_PTHREAD 1 +#endif + + +/* ==================================================================== + * Context Access + * ==================================================================== */ + +#ifdef XLISP_TLS_NATIVE + /* Fast path: native thread-local storage */ + extern XLISP_TLS xlContext *xl_current_context; + #define xlCtx() xl_current_context +#else + /* Slow path: pthread TLS */ + xlContext *xlGetCurrentContext(void); + #define xlCtx() xlGetCurrentContext() +#endif + + +/* ==================================================================== + * Context Management API + * ==================================================================== */ + +#ifndef xlEXPORT +#define xlEXPORT +#endif + +/* + * xlCreateContext - Allocate a new interpreter context + * + * Returns a newly allocated context structure, or NULL on failure. + * The context is not initialized; call xlInitContext() before use. + */ +xlEXPORT xlContext *xlCreateContext(void); + +/* + * xlDestroyContext - Free an interpreter context + * + * Releases all memory associated with the context, including: + * - Node segments + * - Vector segments + * - Stack space + * - Protected pointer blocks + * + * The context must not be in use by any thread when destroyed. + */ +xlEXPORT void xlDestroyContext(xlContext *ctx); + +/* + * xlSetCurrentContext - Set the current thread's context + * + * This must be called before using any XLISP functions. + * Each thread should have its own context. + */ +xlEXPORT void xlSetCurrentContext(xlContext *ctx); + +/* + * xlGetCurrentContext - Get the current thread's context + * + * Returns the context set by xlSetCurrentContext(), or NULL if none. + */ +#ifndef XLISP_TLS_NATIVE +xlEXPORT xlContext *xlGetCurrentContext(void); +#else +#define xlGetCurrentContext() xl_current_context +#endif + +/* + * xlInitContext - Initialize an interpreter context + * + * This performs the same initialization as xlInit(), but for a + * specific context. The context must have been created with + * xlCreateContext(). + * + * Parameters: + * ctx - Context to initialize + * callbacks - Host application callbacks (or NULL for defaults) + * argc - Command line argument count + * argv - Command line argument vector + * workspace - Workspace file to load (or NULL) + * + * Returns 0 on success, non-zero on failure. + */ +xlEXPORT int xlInitContext( + xlContext *ctx, + xlCallbacks *callbacks, + int argc, + const char *argv[], + const char *workspace +); + +/* + * xlContextInitMemory - Initialize memory management for a context + * + * Called internally by xlInitContext(). Allocates the initial + * stack space and prepares the memory allocator. + */ +void xlContextInitMemory(xlContext *ctx, xlFIXTYPE stackSize); + +/* + * xlContextInitSymbols - Initialize symbols for a context + * + * Called internally by xlInitContext(). Creates the initial + * packages and interns the standard symbols. + */ +void xlContextInitSymbols(xlContext *ctx); + +#endif /* __XLCONTEXT_H__ */ diff --git a/include/xlisp.h b/include/xlisp.h index 63100cd..bb821e0 100755 --- a/include/xlisp.h +++ b/include/xlisp.h @@ -499,6 +499,12 @@ struct xlVectorSegment { xlValue vs_data[1]; /* segment data */ }; +/* + * When XLISP_USE_CONTEXT is defined, these are macros in xlcompat.h. + * Otherwise, they are extern declarations for traditional globals. + */ +#ifndef XLISP_USE_CONTEXT + /* node space */ extern xlFIXTYPE xlNSSize; /* node segment size */ extern xlNodeSegment *xlNSegments; /* list of node segments */ @@ -521,6 +527,8 @@ extern xlFIXTYPE xlGCCalls; /* number of calls to the garbage collec extern const char **xlCmdLineArgV; extern int xlCmdLineArgC; +#endif /* !XLISP_USE_CONTEXT */ + /* subr definition structure */ typedef struct { const char *name; @@ -622,7 +630,8 @@ typedef struct { void (*exit)(int sts); } xlCallbacks; -/* external variables */ +/* external variables - wrapped for context mode */ +#ifndef XLISP_USE_CONTEXT xlEXPORT extern int xlInitializedP; /* true if initialization is done */ xlEXPORT extern FILE *xlTranscriptFP; /* transcript file pointer */ xlEXPORT extern xlValue *xlStkBase; /* base of value stack */ @@ -650,6 +659,7 @@ xlEXPORT extern xlValue xlSymWSpace; xlEXPORT extern xlValue xlSymConst; xlEXPORT extern xlValue xlSymSEscape; xlEXPORT extern xlValue xlSymMEscape; +#endif /* !XLISP_USE_CONTEXT */ /* API status codes */ #define xlsSuccess 0 @@ -1313,5 +1323,23 @@ void xlosEnter(void); /* setup default callbacks */ xlEXPORT xlCallbacks *xlDefaultCallbacks(const char *programPath); +/* ==================================================================== + * Threading Support + * + * When XLISP_USE_CONTEXT is defined, all global variables are replaced + * with macros that access the current thread's context. This allows + * multiple interpreter instances in different threads. + * + * To enable threading: + * #define XLISP_USE_CONTEXT + * #include "xlisp.h" + * + * Or compile with -DXLISP_USE_CONTEXT + * ==================================================================== */ +#ifdef XLISP_USE_CONTEXT +#include "xlcompat.h" +#include "xlthread.h" +#endif + #endif diff --git a/include/xlthread.h b/include/xlthread.h new file mode 100644 index 0000000..3d0476d --- /dev/null +++ b/include/xlthread.h @@ -0,0 +1,280 @@ +/* xlthread.h - thread-safe XLISP API */ +/* Copyright (c) 1984-2002, by David Michael Betz + All Rights Reserved + See the included file 'license.txt' for the full license. +*/ + +#ifndef __XLTHREAD_H__ +#define __XLTHREAD_H__ + +#include "xlcontext.h" + +/* + * Thread-Safe XLISP API + * + * This header provides the public API for using XLISP in a multi-threaded + * application. Each thread that needs to use XLISP must have its own + * interpreter context. + * + * Basic usage pattern: + * + * void *worker_thread(void *arg) { + * xlContext *ctx; + * xlValue result; + * + * // Create and initialize context for this thread + * ctx = xlCreateContext(); + * if (!ctx) return NULL; + * + * if (xlInitContext(ctx, xlDefaultCallbacks(NULL), 0, NULL, NULL)) { + * xlDestroyContext(ctx); + * return NULL; + * } + * + * // Set as current context for this thread + * xlSetCurrentContext(ctx); + * + * // Now standard XLISP API can be used + * xlEvaluateCString(&result, 1, "(+ 1 2)"); + * + * // Or use explicit context versions + * xlEvaluateCStringCtx(ctx, &result, 1, "(* 6 7)"); + * + * // Cleanup when done + * xlDestroyContext(ctx); + * return NULL; + * } + * + * IMPORTANT NOTES: + * + * 1. Each thread MUST have its own context. Contexts are NOT thread-safe + * and must not be shared between threads. + * + * 2. Lisp objects (xlValue) belong to their context's heap. Do NOT pass + * xlValue objects between threads - they will become invalid or cause + * memory corruption. + * + * 3. For inter-thread communication, serialize Lisp data to strings or + * use C-level data structures with your own synchronization. + * + * 4. Each context has its own garbage collector. GC in one thread does + * not affect other threads. + */ + + +/* ==================================================================== + * Context Management (re-exported from xlcontext.h) + * ==================================================================== */ + +/* These are declared in xlcontext.h but re-listed here for convenience */ + +/* + * xlCreateContext - Create a new interpreter context + * + * Allocates and returns a new context structure. The context is not + * initialized; you must call xlInitContext() before use. + * + * Returns NULL on allocation failure. + */ +/* xlEXPORT xlContext *xlCreateContext(void); */ + +/* + * xlDestroyContext - Destroy an interpreter context + * + * Frees all memory associated with the context. The context must not + * be in use when destroyed. If this is the current context, you should + * call xlSetCurrentContext(NULL) first. + */ +/* xlEXPORT void xlDestroyContext(xlContext *ctx); */ + +/* + * xlSetCurrentContext - Set the current thread's context + * + * Sets the context that will be used by all standard XLISP API calls + * in the current thread. Pass NULL to clear the current context. + */ +/* xlEXPORT void xlSetCurrentContext(xlContext *ctx); */ + +/* + * xlGetCurrentContext - Get the current thread's context + * + * Returns the context set by xlSetCurrentContext(), or NULL if none. + */ +/* xlEXPORT xlContext *xlGetCurrentContext(void); */ + +/* + * xlInitContext - Initialize an interpreter context + * + * Initializes a context for use. This sets up memory management, + * creates the initial packages and symbols, and optionally loads + * a workspace image. + * + * Parameters: + * ctx - Context created by xlCreateContext() + * callbacks - Application callbacks, or NULL for defaults + * argc - Command line argument count + * argv - Command line arguments + * workspace - Workspace file to load, or NULL + * + * Returns 0 on success, non-zero on failure. + */ +/* xlEXPORT int xlInitContext(xlContext *ctx, xlCallbacks *callbacks, + int argc, const char *argv[], + const char *workspace); */ + + +/* ==================================================================== + * Thread-Safe API Functions (Explicit Context Parameter) + * + * These functions take an explicit context parameter instead of using + * the thread-local current context. They are useful when you need to + * operate on a context that is not the current thread's context. + * ==================================================================== */ + +/* Forward declaration of xlValue - full definition in xlisp.h */ +#ifndef __XLISP_H__ +typedef struct xlNode *xlValue; +#endif + +/* + * xlCallFunctionCtx - Call a Lisp function with explicit context + * + * Same as xlCallFunction() but uses the specified context. + */ +xlEXPORT int xlCallFunctionCtx( + xlContext *ctx, + xlValue *values, + int vmax, + xlValue fun, + int argc, + ... +); + +/* + * xlCallFunctionByNameCtx - Call a named function with explicit context + * + * Same as xlCallFunctionByName() but uses the specified context. + */ +xlEXPORT int xlCallFunctionByNameCtx( + xlContext *ctx, + xlValue *values, + int vmax, + const char *fname, + int argc, + ... +); + +/* + * xlEvaluateCtx - Evaluate an expression with explicit context + * + * Same as xlEvaluate() but uses the specified context. + */ +xlEXPORT int xlEvaluateCtx( + xlContext *ctx, + xlValue *values, + int vmax, + xlValue expr +); + +/* + * xlEvaluateCStringCtx - Evaluate a C string with explicit context + * + * Same as xlEvaluateCString() but uses the specified context. + */ +xlEXPORT int xlEvaluateCStringCtx( + xlContext *ctx, + xlValue *values, + int vmax, + const char *str +); + +/* + * xlEvaluateStringCtx - Evaluate a string with explicit context + * + * Same as xlEvaluateString() but uses the specified context. + */ +xlEXPORT int xlEvaluateStringCtx( + xlContext *ctx, + xlValue *values, + int vmax, + const char *str, + xlFIXTYPE len +); + +/* + * xlLoadFileCtx - Load a file with explicit context + * + * Same as xlLoadFile() but uses the specified context. + */ +xlEXPORT int xlLoadFileCtx( + xlContext *ctx, + const char *fname +); + +/* + * xlReadFromCStringCtx - Read from a C string with explicit context + * + * Same as xlReadFromCString() but uses the specified context. + */ +xlEXPORT int xlReadFromCStringCtx( + xlContext *ctx, + const char *str, + xlValue *pval +); + +/* + * xlGCCtx - Force garbage collection with explicit context + * + * Triggers garbage collection for the specified context. + */ +xlEXPORT void xlGCCtx(xlContext *ctx); + + +/* ==================================================================== + * Utility Functions + * ==================================================================== */ + +/* + * xlContextIsInitialized - Check if a context is initialized + * + * Returns non-zero if the context has been successfully initialized. + */ +#define xlContextIsInitialized(ctx) ((ctx)->initialized) + +/* + * xlContextMemoryUsage - Get memory usage for a context + * + * Returns the total bytes of memory allocated by the context. + */ +#define xlContextMemoryUsage(ctx) ((ctx)->total) + +/* + * xlContextGCCount - Get GC count for a context + * + * Returns the number of garbage collections performed by the context. + */ +#define xlContextGCCount(ctx) ((ctx)->gcCalls) + + +/* ==================================================================== + * Thread Safety Utilities + * ==================================================================== */ + +/* + * xlWithContext - Execute code with a specific context + * + * This macro temporarily sets a context as current, executes the + * given code block, and restores the previous context. + * + * Usage: + * xlWithContext(ctx) { + * // code using ctx as current context + * } + */ +#define xlWithContext(ctx) \ + for (xlContext *_xl_saved_ctx = xlGetCurrentContext(), \ + *_xl_once = (xlSetCurrentContext(ctx), (xlContext*)1); \ + _xl_once; \ + xlSetCurrentContext(_xl_saved_ctx), _xl_once = NULL) + +#endif /* __XLTHREAD_H__ */ diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index d2869e3..56e4cf7 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -4,6 +4,7 @@ set(xlisp_sources xlbcode.h xlcobj.c xlcom.c + xlcontext.c xldbg.c xldmem.c xlfasl.c @@ -23,7 +24,10 @@ set(xlisp_sources xlprint.c xlread.c xlsym.c - "${CMAKE_CURRENT_SOURCE_DIR}/../include/xlisp.h") + "${CMAKE_CURRENT_SOURCE_DIR}/../include/xlisp.h" + "${CMAKE_CURRENT_SOURCE_DIR}/../include/xlcontext.h" + "${CMAKE_CURRENT_SOURCE_DIR}/../include/xlcompat.h" + "${CMAKE_CURRENT_SOURCE_DIR}/../include/xlthread.h") if(${CMAKE_SYSTEM} STREQUAL Windows) list(APPEND xlisp_sources msstuff.c) @@ -33,3 +37,6 @@ endif() target_sources(xlisp PRIVATE ${xlisp_sources}) target_include_directories(xlisp PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../include) + +# Enable position-independent code for TLS compatibility with shared libraries +set_target_properties(xlisp PROPERTIES POSITION_INDEPENDENT_CODE ON) diff --git a/src/unstuff.c b/src/unstuff.c index 0642078..9f89638 100755 --- a/src/unstuff.c +++ b/src/unstuff.c @@ -11,8 +11,10 @@ #endif #include "xlisp.h" +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue s_unbound; +#endif /* local variables */ #define LBSIZE 100 diff --git a/src/xlansi.c b/src/xlansi.c index 8b08fb5..4270639 100755 --- a/src/xlansi.c +++ b/src/xlansi.c @@ -104,7 +104,9 @@ xlEXPORT void xlosCheck(void) /* xlosInfo - show information on control-t */ xlEXPORT void xlosInfo(void) { +#ifndef XLISP_USE_CONTEXT extern xlFIXTYPE xlNFree,xlGCCalls,xlTotal; +#endif char buf[80]; sprintf(buf,"\n[ Free: %ld, GC calls: %ld, Total: %ld ]",xlNFree,xlGCCalls,xlTotal); xlErrPutStr(buf); diff --git a/src/xlapi.c b/src/xlapi.c index c35354c..86156a1 100755 --- a/src/xlapi.c +++ b/src/xlapi.c @@ -10,8 +10,10 @@ static void (*idleHandler)(void *data) = NULL; static void *idleData; +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue *xlcatch,s_eval,s_load,xlUnboundObject,xlEofObject; +#endif /* prototypes */ static const char *PrintToString(xlValue expr,char *buf,xlFIXTYPE len,int escFlag); diff --git a/src/xlcom.c b/src/xlcom.c index 43ca7a2..df0f100 100755 --- a/src/xlcom.c +++ b/src/xlcom.c @@ -26,12 +26,14 @@ #define slambdakey(x) ((x) == slk_optional \ || (x) == slk_rest) +#ifndef XLISP_USE_CONTEXT /* global variables */ xlEXPORT int xlDebugModeP = FALSE; /* external variables */ extern xlValue lk_optional,lk_rest,lk_key,lk_allow_other_keys,lk_aux; extern xlValue slk_optional,slk_rest; +#endif /* local variables */ static xlValue info; /* compiler info */ @@ -393,6 +395,7 @@ static void do_method(xlValue form,int cont) selector = xlCar(xlCdr(form)); fargs = xlCar(xlCdr(xlCdr(form))); body = xlCdr(xlCdr(xlCdr(form))); + (void)object; (void)selector; (void)fargs; (void)body; cd_fundefinition(xlCar(form),xlCar(xlCdr(form)),xlCdr(xlCdr(form))); @@ -717,7 +720,9 @@ static void add_extra_arguments(xlValue fargs) /* parse_optional_arguments - parse the &optional arguments */ static void parse_optional_arguments(xlValue key,xlValue *pfargs,int base) { +#ifndef XLISP_USE_CONTEXT extern xlValue xlDefaultObject; +#endif int patch,patch2,chain,off,oargc=0; xlValue fargs,arg,def,svar; @@ -871,7 +876,9 @@ static void parse_key_arguments(xlValue *pfargs,int base) /* parse_key_argument - parse a single &key argument */ static void parse_key_argument(xlValue form,xlValue *parg,xlValue *pkey,xlValue *pdef,xlValue *psvar) { +#ifndef XLISP_USE_CONTEXT extern xlValue xlKeywordPackage; +#endif xlValue key; *pkey = *pdef = *psvar = xlNil; if (xlConsP(form)) { diff --git a/src/xlcontext.c b/src/xlcontext.c new file mode 100644 index 0000000..4b0a626 --- /dev/null +++ b/src/xlcontext.c @@ -0,0 +1,432 @@ +/* xlcontext.c - xlisp interpreter context management */ +/* Copyright (c) 1984-2002, by David Michael Betz + All Rights Reserved + See the included file 'license.txt' for the full license. +*/ + +/* + * This file must be compiled WITHOUT the compatibility macros, + * since it implements the actual context management. + */ +#define XLISP_CONTEXT_IMPL 1 + +#include "xlisp.h" +#include "xlcontext.h" + +#include +#include + +/* ==================================================================== + * Thread-Local Storage + * ==================================================================== */ + +#ifdef XLISP_TLS_NATIVE +/* Native thread-local storage */ +XLISP_TLS xlContext *xl_current_context = NULL; + +#else +/* Pthread-based thread-local storage */ +#include + +static pthread_key_t xl_context_key; +static pthread_once_t xl_context_key_once = PTHREAD_ONCE_INIT; + +static void xl_create_key(void) { + pthread_key_create(&xl_context_key, NULL); +} + +xlEXPORT xlContext *xlGetCurrentContext(void) { + pthread_once(&xl_context_key_once, xl_create_key); + return (xlContext *)pthread_getspecific(xl_context_key); +} + +static void xl_set_context_pthread(xlContext *ctx) { + pthread_once(&xl_context_key_once, xl_create_key); + pthread_setspecific(xl_context_key, ctx); +} +#endif + + +/* ==================================================================== + * Context Creation and Destruction + * ==================================================================== */ + +/* + * xlCreateContext - Allocate a new interpreter context + */ +xlEXPORT xlContext *xlCreateContext(void) { + xlContext *ctx; + + /* Allocate the context structure */ + ctx = (xlContext *)malloc(sizeof(xlContext)); + if (ctx == NULL) + return NULL; + + /* Zero-initialize the entire structure */ + memset(ctx, 0, sizeof(xlContext)); + + /* Set default sizes */ + ctx->nsSize = xlNSSIZE; + ctx->vsSize = xlVSSIZE; + + /* Initialize printer limits */ + ctx->prBreadth = -1; + ctx->prDepth = -1; + + return ctx; +} + +/* + * xlDestroyContext - Free an interpreter context + */ +xlEXPORT void xlDestroyContext(xlContext *ctx) { + xlNodeSegment *nseg, *next_nseg; + xlVectorSegment *vseg, *next_vseg; + xlProtectedPtrBlk *ppb, *next_ppb; + + if (ctx == NULL) + return; + + /* Free node segments */ + for (nseg = ctx->nSegments; nseg != NULL; nseg = next_nseg) { + next_nseg = nseg->ns_next; + free(nseg); + } + + /* Free vector segments */ + for (vseg = ctx->vSegments; vseg != NULL; vseg = next_vseg) { + next_vseg = vseg->vs_next; + free(vseg); + } + + /* Free protected pointer blocks */ + for (ppb = ctx->pPointers; ppb != NULL; ppb = next_ppb) { + next_ppb = ppb->next; + free(ppb); + } + + /* Free the stack */ + if (ctx->stkBase != NULL) + free(ctx->stkBase); + + /* Free the context structure itself */ + free(ctx); +} + + +/* ==================================================================== + * Context Selection + * ==================================================================== */ + +/* + * xlSetCurrentContext - Set the current thread's context + */ +xlEXPORT void xlSetCurrentContext(xlContext *ctx) { +#ifdef XLISP_TLS_NATIVE + xl_current_context = ctx; +#else + xl_set_context_pthread(ctx); +#endif +} + + +/* ==================================================================== + * Context Initialization + * ==================================================================== */ + +/* + * xlContextInitMemory - Initialize memory management for a context + * + * This allocates the stack and prepares the memory allocator. + * It does NOT allocate node/vector segments yet - that happens on demand. + */ +void xlContextInitMemory(xlContext *ctx, xlFIXTYPE stackSize) { + xlFIXTYPE n; + + /* Initialize basic values */ + ctx->vTrue = NULL; + ctx->vFalse = NULL; + ctx->unboundObject = NULL; + ctx->defaultObject = NULL; + ctx->eofObject = NULL; + ctx->packages = NULL; + + /* Initialize VM registers */ + ctx->fun = NULL; + ctx->env = NULL; + ctx->val = NULL; + ctx->argc = 0; + ctx->next = NULL; + + /* Initialize statistics */ + ctx->gcCalls = 0; + ctx->total = 0; + + /* Initialize node space */ + ctx->nSegments = NULL; + ctx->nsLast = NULL; + ctx->nsCount = 0; + ctx->nNodes = 0; + ctx->nFree = 0; + ctx->fNodes = NULL; + + /* Initialize vector space */ + ctx->vSegments = NULL; + ctx->vsCurrent = NULL; + ctx->vsCount = 0; + ctx->vFree = NULL; + ctx->vTop = NULL; + + /* Initialize protected pointers */ + ctx->pPointers = NULL; + + /* Allocate the stack */ + n = stackSize * sizeof(xlValue); + ctx->stkBase = (xlValue *)malloc(n); + if (ctx->stkBase == NULL) { + /* Caller should check for initialization failure */ + return; + } + ctx->total += n; + + /* Initialize stack pointers */ + ctx->stkTop = ctx->stkBase + stackSize; + ctx->sp = ctx->stkTop; /* value stack starts at top, grows down */ + ctx->csp = ctx->stkBase; /* control stack starts at base, grows up */ +} + +/* + * xlInitContext - Initialize an interpreter context + * + * This is the main initialization function that sets up a context + * for use. It must be called after xlCreateContext() and before + * using the context. + * + * This performs the same initialization as xlInit(), including: + * - Setting up callbacks + * - Initializing memory management + * - Creating packages and symbols (via xlInitWorkspace) + * - Optionally restoring a workspace image + */ +xlEXPORT int xlInitContext( + xlContext *ctx, + xlCallbacks *callbacks, + int argc, + const char *argv[], + const char *workspace +) { + xlContext *saved_ctx; + xlErrorTarget target; + + if (ctx == NULL) + return -1; + + /* Save current context and set this one as active */ + saved_ctx = xlGetCurrentContext(); + xlSetCurrentContext(ctx); + + /* Store callbacks and set them via xlSetCallbacks */ + ctx->callbacks = callbacks; + xlSetCallbacks(callbacks); + + /* Store command line */ + ctx->cmdLineArgC = argc; + ctx->cmdLineArgV = argv; + + /* Set default segment sizes */ + ctx->nsSize = xlNSSIZE; + ctx->vsSize = xlVSSIZE; + + /* Setup an initialization error handler */ + xlPushTarget(&target); + if (setjmp(target.target)) { + xlPopTarget(); + xlSetCurrentContext(saved_ctx); + return -1; + } + + /* + * Initialize the workspace. This calls xlInitMemory() which + * sets up the stack, then creates packages and symbols. + * Since the context is now current, all the macros (xlSP, xlEnv, etc.) + * will access this context's fields. + */ + if (!workspace || !xlRestoreImage(workspace)) + xlInitWorkspace(xlSTACKSIZE); + + /* Done with initialization */ + xlPopTarget(); + + /* Mark as initialized */ + ctx->initialized = 1; + + /* Keep this context as current (don't restore saved) */ + /* xlSetCurrentContext(saved_ctx); */ + + return 0; +} + + +/* ==================================================================== + * Explicit Context API Functions + * + * These functions operate on an explicit context parameter. + * They temporarily set the context as current, perform the operation, + * and restore the previous context. + * + * NOTE: Full implementation requires the rest of the XLISP system + * to be integrated with the context system. For Phase 1, these + * are stub implementations. + * ==================================================================== */ + +/* + * Helper macro to wrap operations with context switching + */ +#define WITH_CONTEXT(ctx, code) do { \ + xlContext *_saved = xlGetCurrentContext(); \ + xlSetCurrentContext(ctx); \ + code; \ + xlSetCurrentContext(_saved); \ +} while (0) + +/* + * xlGCCtx - Force garbage collection for a specific context + */ +xlEXPORT void xlGCCtx(xlContext *ctx) { + WITH_CONTEXT(ctx, { + /* xlGC() will be called here once integrated */ + /* For now, this is a placeholder */ + }); +} + +/* + * The remaining *Ctx functions are stubs for Phase 1. + * They will be fully implemented when the interpreter + * is integrated with the context system. + * + * xlCallFunctionCtx + * xlCallFunctionByNameCtx + * xlEvaluateCtx + * xlEvaluateCStringCtx + * xlEvaluateStringCtx + * xlLoadFileCtx + * xlReadFromCStringCtx + */ + +/* Stub implementations - to be completed in later phases */ + +xlEXPORT int xlEvaluateCStringCtx( + xlContext *ctx, + xlValue *values, + int vmax, + const char *str +) { + int result = -1; + WITH_CONTEXT(ctx, { + /* result = xlEvaluateCString(values, vmax, str); */ + /* Stub: not yet integrated */ + (void)values; + (void)vmax; + (void)str; + }); + return result; +} + +xlEXPORT int xlEvaluateStringCtx( + xlContext *ctx, + xlValue *values, + int vmax, + const char *str, + xlFIXTYPE len +) { + int result = -1; + WITH_CONTEXT(ctx, { + /* result = xlEvaluateString(values, vmax, str, len); */ + (void)values; + (void)vmax; + (void)str; + (void)len; + }); + return result; +} + +xlEXPORT int xlEvaluateCtx( + xlContext *ctx, + xlValue *values, + int vmax, + xlValue expr +) { + int result = -1; + WITH_CONTEXT(ctx, { + /* result = xlEvaluate(values, vmax, expr); */ + (void)values; + (void)vmax; + (void)expr; + }); + return result; +} + +xlEXPORT int xlLoadFileCtx( + xlContext *ctx, + const char *fname +) { + int result = -1; + WITH_CONTEXT(ctx, { + /* result = xlLoadFile(fname); */ + (void)fname; + }); + return result; +} + +xlEXPORT int xlReadFromCStringCtx( + xlContext *ctx, + const char *str, + xlValue *pval +) { + int result = -1; + WITH_CONTEXT(ctx, { + /* result = xlReadFromCString(str, pval); */ + (void)str; + (void)pval; + }); + return result; +} + +/* + * Variadic functions require special handling. + * These will be implemented using va_list versions in later phases. + */ + +xlEXPORT int xlCallFunctionCtx( + xlContext *ctx, + xlValue *values, + int vmax, + xlValue fun, + int argc, + ... +) { + (void)ctx; + (void)values; + (void)vmax; + (void)fun; + (void)argc; + /* Stub - requires va_list integration */ + return -1; +} + +xlEXPORT int xlCallFunctionByNameCtx( + xlContext *ctx, + xlValue *values, + int vmax, + const char *fname, + int argc, + ... +) { + (void)ctx; + (void)values; + (void)vmax; + (void)fname; + (void)argc; + /* Stub - requires va_list integration */ + return -1; +} diff --git a/src/xldmem.c b/src/xldmem.c index 0112738..ff1e170 100755 --- a/src/xldmem.c +++ b/src/xldmem.c @@ -8,6 +8,17 @@ #undef DEBUG_GC +/* + * When XLISP_USE_CONTEXT is defined, all these "globals" become macros + * that access xlCtx()->field. The actual storage is in the xlContext + * structure, managed by xlcontext.c. + * + * When not defined, we use traditional global variables for backward + * compatibility with single-threaded use. + */ + +#ifndef XLISP_USE_CONTEXT + /* virtual machine registers */ xlEXPORT xlValue xlFun; /* current function */ xlEXPORT xlValue xlEnv; /* current environment */ @@ -48,12 +59,14 @@ int xlVSCount; /* number of vector segments */ xlValue *xlVFree; /* next free location in vector space */ xlValue *xlVTop; /* top of vector space */ -/* external variables */ +/* external variables - only needed in legacy mode */ extern xlValue xlPackages; /* list of packages */ extern xlValue xlUnboundObject; /* unbound indicator */ extern xlValue xlDefaultObject; /* default object */ extern xlValue xlEofObject; /* eof object */ +#endif /* !XLISP_USE_CONTEXT */ + /* forward declarations */ static xlValue allocnode(int); static void findmemory(void); diff --git a/src/xlfasl.c b/src/xlfasl.c index 856a54d..96a9aa3 100755 --- a/src/xlfasl.c +++ b/src/xlfasl.c @@ -6,8 +6,10 @@ #include "xlisp.h" +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue xlEofObject; +#endif /* prototypes */ static int faslwritecode(xlValue fptr,xlValue code); diff --git a/src/xlfun1.c b/src/xlfun1.c index d7e4478..715b30d 100755 --- a/src/xlfun1.c +++ b/src/xlfun1.c @@ -10,10 +10,12 @@ static char gsprefix[xlSTRMAX+1] = { 'G',0 }; /* gensym prefix string */ static xlFIXTYPE gsnumber = 1; /* gensym number */ +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue xlEnv,xlVal,xlDefaultObject; extern xlValue xlUnboundObject,s_package,s_eql,k_uses,k_test,k_testnot,k_key; extern xlValue xlPackages,xlLispPackage,xlLispPackage,xlLispPackage; +#endif /* forward declarations */ static xlValue cxr(const char *adstr); diff --git a/src/xlfun2.c b/src/xlfun2.c index f73bc8d..8d04154 100755 --- a/src/xlfun2.c +++ b/src/xlfun2.c @@ -11,11 +11,13 @@ #define TLEFT 1 #define TRIGHT 2 +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue xlEofObject,s_hexfmt; extern xlValue s_stdin,s_stdout,s_stderr,s_error; extern xlValue k_start,k_end,k_1start,k_1end,k_2start,k_2end,k_fromend; extern int xlPRBreadth,xlPRDepth; +#endif /* forward declarations */ static xlValue setit(int *pvar); @@ -44,7 +46,9 @@ xlValue xsymstr(void) /* xstrsym - built-in function 'string->symbol' */ xlValue xstrsym(void) { +#ifndef XLISP_USE_CONTEXT extern xlValue s_package; +#endif xlValue key; xlVal = xlGetArgString(); xlLastArg(); diff --git a/src/xlfun3.c b/src/xlfun3.c index 20d5e4b..3df6cd6 100755 --- a/src/xlfun3.c +++ b/src/xlfun3.c @@ -6,8 +6,10 @@ #include "xlisp.h" +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue s_package; +#endif /* forward declarations */ static const char *showstring(const char *str,int bch); @@ -298,7 +300,9 @@ xlCContinuation load_cc = { load_continuation,load_unwind,4,"Load:package,env,fi /* do_loadloop - read the next expression and setup to evaluate it */ static void do_loadloop(xlValue print,xlValue oldpack) { +#ifndef XLISP_USE_CONTEXT extern xlValue s_eval; +#endif xlValue expr; /* try to read the next expression from the file */ diff --git a/src/xlimage.c b/src/xlimage.c index bcbd533..7fed342 100755 --- a/src/xlimage.c +++ b/src/xlimage.c @@ -6,9 +6,11 @@ #include "xlisp.h" +#ifndef XLISP_USE_CONTEXT /* global variables */ extern xlValue xlLispPackage,xlLispPackage,xlKeywordPackage,xlLispPackage; extern xlValue xlPackages,xlEofObject,xlDefaultObject; +#endif /* local variables */ static xlOFFTYPE off,foff; diff --git a/src/xlinit.c b/src/xlinit.c index 616dd32..40b1eab 100755 --- a/src/xlinit.c +++ b/src/xlinit.c @@ -13,6 +13,11 @@ /* shorthand for xlFIRSTENV */ #define FE xlFIRSTENV +/* + * When XLISP_USE_CONTEXT is defined, globals become macros to xlCtx(). + */ +#ifndef XLISP_USE_CONTEXT + /* global variables */ xlEXPORT xlValue xlSymConst,xlSymMEscape,xlSymSEscape,xlSymWSpace; xlEXPORT xlValue xlSymTMacro,xlSymNMacro,xlSymReadTable; @@ -29,6 +34,8 @@ xlValue s_fixfmt,s_hexfmt,s_flofmt,s_freeptr,s_backtrace; /* external variables */ extern xlValue xlLispPackage; +#endif /* !XLISP_USE_CONTEXT */ + /* local functions */ static xlValue getloadpath(void); diff --git a/src/xlint.c b/src/xlint.c index 8bb0d80..3baacf6 100755 --- a/src/xlint.c +++ b/src/xlint.c @@ -10,6 +10,11 @@ /* macro to call a xlSUBR */ #define callsubr(x,c) (xlArgC = (c), (x)()) +/* + * When XLISP_USE_CONTEXT is defined, globals become macros to xlCtx(). + */ +#ifndef XLISP_USE_CONTEXT + /* globals */ xlErrorTarget *xlerrtarget = NULL; /* error target */ xlValue *xlcatch = NULL; /* catch frame pointer */ @@ -17,11 +22,13 @@ int xlTraceBytecodes = FALSE; /* trace enable */ xlEXPORT int xlArgC; /* number of arguments remaining */ xlEXPORT void (*xlNext)(void); /* next function to call (xlApply or NULL) */ -/* external variables */ +/* external variables - only in legacy mode */ extern xlValue s_package,s_stdin,s_stdout,xlUnboundObject; extern xlValue s_unassigned,xlDefaultObject,s_error; extern xlValue s_stackpointer; +#endif /* !XLISP_USE_CONTEXT */ + /* error target (and bytecode dispatch target) */ #define BCD_START 0 /* must be zero */ #define BCD_RETURN 1 @@ -593,7 +600,9 @@ static void opLIT(void) /* opGREF - handler for opcode GREF */ static void opGREF(void) { +#ifndef XLISP_USE_CONTEXT extern xlValue s_package; +#endif register xlValue tmp; xlValue key; tmp = xlGetElement(xlFun,*pc++); diff --git a/src/xlio.c b/src/xlio.c index 7221ce4..36d9410 100755 --- a/src/xlio.c +++ b/src/xlio.c @@ -9,8 +9,10 @@ /* global variables */ xlFIXTYPE xlfsize; +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue s_stdin,s_stdout,s_stderr,xlUnboundObject; +#endif /* forward declarations */ static int fstream_getc(xlValue fptr); diff --git a/src/xlitersq.c b/src/xlitersq.c index b85c2ca..22adb8a 100755 --- a/src/xlitersq.c +++ b/src/xlitersq.c @@ -34,8 +34,10 @@ typedef xlValue (*MACTION)(xlValue val,xlValue *d); #define IS_FETCH 1 #define IS_UPDATE 2 +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue xlVal,k_key,k_count,k_start,k_end; +#endif static void iterseq1(xlValue ivalue,xlValue tresult,ACTION action); static void iterlist1(xlValue ivalue,xlValue tresult,ACTION action); diff --git a/src/xlmain.c b/src/xlmain.c index 907edc5..1469814 100755 --- a/src/xlmain.c +++ b/src/xlmain.c @@ -11,9 +11,14 @@ #define BANNER "\ XLISP 3.3, September 6, 2002 Copyright (c) 1984-2002, by David Betz" +/* + * When XLISP_USE_CONTEXT is defined, globals become macros to xlCtx(). + */ +#ifndef XLISP_USE_CONTEXT + /* global variables */ int xlCmdLineArgC = 0; /* command line argument count */ -const char **xlCmdLineArgV = NULL; /* array of command line arguments */ +const char **xlCmdLineArgV = NULL; /* array of command line arguments */ xlEXPORT int xlInitializedP = FALSE; /* true if initialization is done */ xlEXPORT FILE *xlTranscriptFP = NULL; /* trace file pointer */ @@ -22,6 +27,8 @@ extern xlValue s_package,xlUnboundObject,s_stderr,s_error,s_backtrace; extern xlFIXTYPE xlNSSize,xlVSSize; extern int xlTraceBytecodes; +#endif /* !XLISP_USE_CONTEXT */ + /* local prototypes */ static void fmterror(const char *tag,const char *fmt,va_list ap); @@ -30,7 +37,18 @@ xlEXPORT int xlInit(xlCallbacks *callbacks,int argc,const char *argv[],const cha { xlErrorTarget target; int src,dst; - + +#ifdef XLISP_USE_CONTEXT + /* In threaded mode, create and set up the default context */ + { + xlContext *ctx = xlCreateContext(); + if (ctx == NULL) + return FALSE; + xlSetCurrentContext(ctx); + ctx->callbacks = callbacks; + } +#endif + /* store the callback structure pointer */ xlSetCallbacks(callbacks); diff --git a/src/xlobj.c b/src/xlobj.c index 8a17c3e..3be057c 100755 --- a/src/xlobj.c +++ b/src/xlobj.c @@ -6,12 +6,14 @@ #include "xlisp.h" +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue s_stdout; /* local variables */ static xlValue k_initialize; static xlValue c_class,c_object; +#endif /* local prototypes */ static int FindIVarOffset(xlValue cls,xlValue sym,int *pOffset); diff --git a/src/xlosint.c b/src/xlosint.c index 0b71b85..6d578d8 100755 --- a/src/xlosint.c +++ b/src/xlosint.c @@ -6,32 +6,52 @@ #include "xlisp.h" -/* global variables */ +#ifndef XLISP_USE_CONTEXT +/* global variables - only in legacy mode */ static xlCallbacks *callbacks = NULL; +#endif /* xlSetCallbacks - initialize xlisp */ void xlSetCallbacks(xlCallbacks *cb) { +#ifdef XLISP_USE_CONTEXT + /* In context mode, store in the current context */ + xlCtx()->callbacks = cb; +#else /* save the pointer to the callbacks */ callbacks = cb; +#endif +} + +/* Helper to get callbacks pointer */ +static xlCallbacks *getCallbacks(void) +{ +#ifdef XLISP_USE_CONTEXT + return xlCtx()->callbacks; +#else + return callbacks; +#endif } /* xlosLoadPath - return the load path */ xlEXPORT const char *xlosLoadPath(void) { - return callbacks->loadPath ? (*callbacks->loadPath)() : NULL; + xlCallbacks *cb = getCallbacks(); + return cb && cb->loadPath ? (*cb->loadPath)() : NULL; } /* xlosParsePath - return the load path */ xlEXPORT const char *xlosParsePath(const char **pp) { - return callbacks->parsePath ? (*callbacks->parsePath)(pp) : NULL; + xlCallbacks *cb = getCallbacks(); + return cb && cb->parsePath ? (*cb->parsePath)(pp) : NULL; } /* xlosDirectorySeparator - return the directory separator character */ xlEXPORT int xlosDirectorySeparator(void) { - return callbacks->directorySeparator ? (*callbacks->directorySeparator)() : '\\'; + xlCallbacks *cb = getCallbacks(); + return cb && cb->directorySeparator ? (*cb->directorySeparator)() : '\\'; } /* xlosEnter - enter o/s specific functions */ @@ -60,29 +80,33 @@ xlEXPORT xlValue (*xlosFindSubr(const char *name))(void) return (xlValue (*)(void))xsdp->subr; /* call the user handler */ - return callbacks->findSubr ? (*callbacks->findSubr)(name) : NULL; + xlCallbacks *cb = getCallbacks(); + return cb && cb->findSubr ? (*cb->findSubr)(name) : NULL; } /* xlosError - print an error message */ xlEXPORT void xlosError(const char *msg) { - if (callbacks->error) - (*callbacks->error)(msg); + xlCallbacks *cb = getCallbacks(); + if (cb && cb->error) + (*cb->error)(msg); } /* xlosFileModTime - return the modification time of a file */ xlEXPORT int xlosFileModTime(const char *fname,xlFIXTYPE *pModTime) -{ - return callbacks->fileModTime ? (*callbacks->fileModTime)(fname,pModTime) : FALSE; +{ + xlCallbacks *cb = getCallbacks(); + return cb && cb->fileModTime ? (*cb->fileModTime)(fname,pModTime) : FALSE; } /* xlosConsoleGetC - get a character from the terminal */ xlEXPORT int xlosConsoleGetC(void) { + xlCallbacks *cb = getCallbacks(); int ch; - + /* get the next character */ - ch = callbacks->consoleGetC ? (*callbacks->consoleGetC)() : EOF; + ch = cb && cb->consoleGetC ? (*cb->consoleGetC)() : EOF; /* output the character to the transcript file */ if (xlTranscriptFP && ch != EOF) @@ -95,12 +119,14 @@ xlEXPORT int xlosConsoleGetC(void) /* xlosConsolePutC - put a character to the terminal */ xlEXPORT void xlosConsolePutC(int ch) { + xlCallbacks *cb = getCallbacks(); + /* check for control characters */ xlosCheck(); /* output the character */ - if (callbacks->consolePutC) - (*callbacks->consolePutC)(ch); + if (cb && cb->consolePutC) + (*cb->consolePutC)(ch); /* output the character to the transcript file */ if (xlTranscriptFP) @@ -117,32 +143,37 @@ xlEXPORT void xlosConsolePutS(const char *str) /* xlosConsoleAtBOLP - are we at the beginning of a line? */ xlEXPORT int xlosConsoleAtBOLP(void) { - return callbacks->consoleAtBOLP ? (*callbacks->consoleAtBOLP)() : FALSE; + xlCallbacks *cb = getCallbacks(); + return cb && cb->consoleAtBOLP ? (*cb->consoleAtBOLP)() : FALSE; } /* xlosConsoleFlush - flush the terminal input buffer */ xlEXPORT void xlosConsoleFlush(void) { - if (callbacks->consoleFlushInput) - (*callbacks->consoleFlushInput)(); + xlCallbacks *cb = getCallbacks(); + if (cb && cb->consoleFlushInput) + (*cb->consoleFlushInput)(); } /* xlosConsoleCheck - check for control characters during execution */ xlEXPORT int xlosConsoleCheck(void) { - return callbacks->consoleCheck ? (*callbacks->consoleCheck)() : 0; + xlCallbacks *cb = getCallbacks(); + return cb && cb->consoleCheck ? (*cb->consoleCheck)() : 0; } /* xlosFlushOutput - flush the output buffer */ xlEXPORT void xlosFlushOutput(void) { - if (callbacks->consoleFlushOutput) - (*callbacks->consoleFlushOutput)(); + xlCallbacks *cb = getCallbacks(); + if (cb && cb->consoleFlushOutput) + (*cb->consoleFlushOutput)(); } /* xlosExit - exit from XLISP */ xlEXPORT void xlosExit(int sts) { - if (callbacks->exit) - (*callbacks->exit)(sts); + xlCallbacks *cb = getCallbacks(); + if (cb && cb->exit) + (*cb->exit)(sts); } diff --git a/src/xlprint.c b/src/xlprint.c index 6b1b1e5..48d9354 100755 --- a/src/xlprint.c +++ b/src/xlprint.c @@ -6,17 +6,24 @@ #include "xlisp.h" +/* + * When XLISP_USE_CONTEXT is defined, globals become macros to xlCtx(). + */ +#ifndef XLISP_USE_CONTEXT + /* global variables */ int xlPRBreadth = -1; int xlPRDepth = -1; -/* local variables */ -static char buf[200]; - /* external variables */ extern xlValue s_printcase,k_downcase; extern xlValue s_fixfmt,s_flofmt,xlUnboundObject; +#endif /* !XLISP_USE_CONTEXT */ + +/* local variables */ +static char buf[200]; + static void print(xlValue fptr,xlValue vptr,int escflag,int depth); static void putatm(xlValue fptr,const char *tag,xlValue val); static void putfstream(xlValue fptr,xlValue val); @@ -312,7 +319,9 @@ static void putqstring(xlValue fptr,xlValue str) /* putsymbol - output a symbol */ static void putsymbol(xlValue fptr,xlValue sym) { +#ifndef XLISP_USE_CONTEXT extern xlValue s_package,xlKeywordPackage,k_internal; +#endif xlValue package,key; if ((package = xlGetPackage(sym)) == xlNil) xlPutStr(fptr,"#:"); @@ -430,7 +439,9 @@ static void putcharacter(xlValue fptr,int ch) /* putobject - output an object value */ static void putobject(xlValue fptr,xlValue obj) { +#ifndef XLISP_USE_CONTEXT extern xlValue s_print; +#endif xlInternalCall(&obj,1,obj,2,s_print,fptr); } diff --git a/src/xlread.c b/src/xlread.c index 8c4ddd4..365a390 100755 --- a/src/xlread.c +++ b/src/xlread.c @@ -17,9 +17,11 @@ #define RO_COMMENT 2 #define RO_EOF 3 +#ifndef XLISP_USE_CONTEXT /* external variables */ extern xlValue s_package,s_quote,s_function,s_quasiquote,s_unquote,s_unquotesplicing,s_dot; extern xlValue xlEofObject; +#endif /* forward declarations */ static int readone(xlValue fptr,xlValue *pval); @@ -192,11 +194,9 @@ void xrmhash(void) /* xrmquote - read macro %RM-QUOTE */ void xrmquote(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* return the result */ @@ -207,11 +207,9 @@ void xrmquote(void) /* xrmdquote - read macro %RM-DOUBLE-QUOTE */ void xrmdquote(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* return the result */ @@ -222,11 +220,9 @@ void xrmdquote(void) /* xrmbquote - read macro %RM-BACKQUOTE */ void xrmbquote(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* return the result */ @@ -237,11 +233,9 @@ void xrmbquote(void) /* xrmcomma - read macro %RM-COMMA */ void xrmcomma(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* return the result */ @@ -252,11 +246,9 @@ void xrmcomma(void) /* xrmlparen - read macro %RM-LEFT-PAREN */ void xrmlparen(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* return the result */ @@ -267,11 +259,9 @@ void xrmlparen(void) /* xrmrparen - read macro %RM-RIGHT-PAREN */ void xrmrparen(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* illegal in this context */ @@ -281,11 +271,9 @@ void xrmrparen(void) /* xrmsemi - read macro %RM-SEMICOLON */ void xrmsemi(void) { - xlValue mch; - /* parse the argument list */ xlVal = xlGetInputPort(); - mch = xlGetArgChar(); + (void)xlGetArgChar(); xlLastArg(); /* skip over the comment */ @@ -407,7 +395,9 @@ static xlValue read_quote(xlValue fptr,xlValue sym) /* read_symbol - parse a symbol (or a number) */ static xlValue read_symbol(xlValue fptr) { +#ifndef XLISP_USE_CONTEXT extern xlValue xlKeywordPackage,k_external; +#endif char buf[xlSTRMAX+1],*sname; xlValue package,val,key; @@ -518,7 +508,7 @@ static xlValue read_string(xlValue fptr) } /* return the new string */ - return xlTop() == xlNil ? xlPop(), xlMakeString(buf,len) : xlGetStrOutput(xlPop()); + return xlTop() == xlNil ? (void)xlPop(), xlMakeString(buf,len) : xlGetStrOutput(xlPop()); } /* read_special - parse an atom starting with '#' */ @@ -790,7 +780,9 @@ xlEXPORT xlValue xlCharType(int ch) /* tentry - get readtable entry for a character */ static xlValue tentry(int ch) { +#ifndef XLISP_USE_CONTEXT extern xlValue xlSymReadTable; +#endif xlValue rtable = xlGetValue(xlSymReadTable); if (xlVectorP(rtable) && ch >= 0 && ch < xlGetSize(rtable)) return xlGetElement(rtable,ch); diff --git a/src/xlsym.c b/src/xlsym.c index c8547e5..cc35f86 100755 --- a/src/xlsym.c +++ b/src/xlsym.c @@ -6,12 +6,19 @@ #include "xlisp.h" +/* + * When XLISP_USE_CONTEXT is defined, globals become macros to xlCtx(). + */ +#ifndef XLISP_USE_CONTEXT + /* global variables */ xlValue xlPackages,xlLispPackage,xlXLispPackage,xlKeywordPackage; /* external variables */ extern xlValue xlPackages,s_package,k_internal,k_external,k_inherited; +#endif /* !XLISP_USE_CONTEXT */ + /* forward declarations */ static xlValue addtolist(xlValue list,xlValue val); static xlValue removefromlist(xlValue list,xlValue val); diff --git a/xlisp/CMakeLists.txt b/xlisp/CMakeLists.txt index a67ef0b..24a0ed5 100644 --- a/xlisp/CMakeLists.txt +++ b/xlisp/CMakeLists.txt @@ -3,6 +3,6 @@ target_sources(xlisp-repl PRIVATE "${CMAKE_CURRENT_SOURCE_DIR}/../include/xlisp.h") target_include_directories(xlisp-repl PUBLIC ${CMAKE_CURRENT_SOURCE_DIR}/../include) -target_link_libraries(xlisp-repl xlisp) +target_link_libraries(xlisp-repl xlisp m) set_target_properties(xlisp-repl PROPERTIES PUBLIC_HEADER ${CMAKE_CURRENT_SOURCE_DIR}/../include/xlisp.h)