refactor(runtime): replace blaise_exc.c with Pascal + x86_64 assembly
Port all exception frame management, type identity, and runtime check functions from C to pure Pascal (blaise_exc.pas). Replace libc setjmp/longjmp with a minimal custom implementation in x86_64 assembly (blaise_setjmp_x86_64.s, ~40 lines) that saves only the 8 callee-saved registers (64-byte jmp_buf vs libc's 200-byte one). This eliminates the last C source file from the runtime build. The only non-Pascal code in the runtime is now the assembly setjmp stub. Changes: - runtime/src/main/asm/blaise_setjmp_x86_64.s: _blaise_setjmp/_blaise_longjmp - runtime/src/main/pascal/blaise_exc.pas: _PushExcFrame, _PopExcFrame, _Raise, _Reraise, _CurrentException, _CurrentExceptionMessage, _IsInstance, _ImplementsInterface, _GetItab, _Raise_InvalidCast, _CheckNil — all ported from blaise_exc.c - uCodeGenQBE.pas: emit call $_blaise_setjmp instead of call $setjmp - cp.test.exceptions.pas: IR assertion updated for new symbol name - runtime/Makefile: assembly rule, Pascal blaise_exc build, C rules removed - .gitignore: whitelist runtime/src/main/asm/*.s - runtime/src/main/c/blaise_exc.c: deleted 2083 tests pass, fixpoint verified (stage-3/stage-4).
This commit is contained in:
Graeme Geldenhuys
parent
127bc35490
commit
4969b74810
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -9,6 +9,7 @@ releases/
|
|||
*.res
|
||||
*.rst
|
||||
*.s
|
||||
!runtime/src/main/asm/*.s
|
||||
|
||||
# Shared / dynamic libraries
|
||||
*.so
|
||||
|
|
|
|||
|
|
@ -18,9 +18,8 @@ interface
|
|||
uses
|
||||
SysUtils, StrUtils, Classes, uAST, uSymbolTable, uStrCompat;
|
||||
|
||||
// Raw byte copy used by TIRBuffer — maps to libc memcpy under both compilers.
|
||||
// FPC: {$linklib c} ensures libc is linked; Blaise links blaise_rtl.a which
|
||||
// already pulls in libc.
|
||||
// Raw byte copy used by TIRBuffer — maps to libc memcpy.
|
||||
// Blaise links blaise_rtl.a which already pulls in libc.
|
||||
procedure _ir_memcpy(Dst, Src: Pointer; N: Int64); external name 'memcpy';
|
||||
|
||||
type
|
||||
|
|
@ -2030,7 +2029,7 @@ begin
|
|||
Inc(FExcDepth);
|
||||
|
||||
SjrTemp := AllocTemp;
|
||||
EmitLine(Format(' %s =w call $setjmp(l %s)', [SjrTemp, FrameTemp]));
|
||||
EmitLine(Format(' %s =w call $_blaise_setjmp(l %s)', [SjrTemp, FrameTemp]));
|
||||
EmitLine(Format(' jnz %s, @%s, @%s', [SjrTemp, LblFinExc, LblTry]));
|
||||
|
||||
{ Normal path: run try body, pop frame, run finally body }
|
||||
|
|
@ -2078,15 +2077,15 @@ begin
|
|||
LblEnd := AllocLabel('except_end');
|
||||
|
||||
{ Use a pre-allocated exception frame slot from @start (see EmitExcFrameAllocs).
|
||||
Matches the size contract in blaise_exc.c — must hold jmp_buf (200 B on
|
||||
Linux x86_64, ~312 B on macOS ARM64) plus two pointer fields. }
|
||||
Matches the size contract in blaise_exc.pas — must hold jmp_buf (64 B on
|
||||
x86_64, larger on ARM64) plus two pointer fields. }
|
||||
FrameTemp := Format('%%_exc_frame_%d', [FExcFrameNext]);
|
||||
FExcFrameNext := FExcFrameNext + 1;
|
||||
EmitLine(Format(' call $_PushExcFrame(l %s)', [FrameTemp]));
|
||||
Inc(FExcDepth);
|
||||
|
||||
SjrTemp := AllocTemp;
|
||||
EmitLine(Format(' %s =w call $setjmp(l %s)', [SjrTemp, FrameTemp]));
|
||||
EmitLine(Format(' %s =w call $_blaise_setjmp(l %s)', [SjrTemp, FrameTemp]));
|
||||
EmitLine(Format(' jnz %s, @%s, @%s', [SjrTemp, LblExcept, LblTry]));
|
||||
|
||||
{ Normal path: run try body, pop frame on clean exit }
|
||||
|
|
|
|||
|
|
@ -581,7 +581,7 @@ procedure TExceptionTests.TestCodegen_TryExcept_CallsSetjmp;
|
|||
var IR: string;
|
||||
begin
|
||||
IR := GenIR(SrcTryExcept);
|
||||
AssertTrue('try/except calls setjmp', Pos('call $setjmp', IR) > 0);
|
||||
AssertTrue('try/except calls _blaise_setjmp', Pos('call $_blaise_setjmp', IR) > 0);
|
||||
end;
|
||||
|
||||
procedure TExceptionTests.TestCodegen_TryExcept_PopsFrame;
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ CFLAGS = -O2 -Wall -Wextra -std=c11
|
|||
|
||||
SRC_DIR = src/main/c
|
||||
PAS_SRC_DIR = src/main/pascal
|
||||
ASM_DIR = src/main/asm
|
||||
OBJ_DIR = target
|
||||
LIB = $(OBJ_DIR)/blaise_rtl.a
|
||||
|
||||
|
|
@ -19,10 +20,8 @@ COMPILER_BIN = ../compiler/target
|
|||
BLAISE = $(COMPILER_BIN)/blaise
|
||||
QBE = ../vendor/qbe/qbe
|
||||
|
||||
# C sources — only those that cannot be expressed in Pascal remain.
|
||||
# blaise_exc.c: setjmp/longjmp, type identity, nil-check (QBE cannot express these).
|
||||
C_SRCS = $(SRC_DIR)/blaise_exc.c
|
||||
C_OBJS = $(patsubst $(SRC_DIR)/%.c,$(OBJ_DIR)/%.o,$(C_SRCS))
|
||||
# Assembly sources — platform-specific, no C compiler needed.
|
||||
ASM_OBJS = $(OBJ_DIR)/blaise_setjmp_x86_64.o
|
||||
|
||||
# Pascal RTL units compiled via the Blaise compiler.
|
||||
# Each unit is compiled by a thin driver program; the program section is
|
||||
|
|
@ -33,9 +32,10 @@ PAS_OBJS = $(OBJ_DIR)/blaise_mem.o \
|
|||
$(OBJ_DIR)/blaise_weak.o \
|
||||
$(OBJ_DIR)/blaise_float.o \
|
||||
$(OBJ_DIR)/blaise_thread.o \
|
||||
$(OBJ_DIR)/blaise_exc.o \
|
||||
$(OBJ_DIR)/rtl_platform_posix.o
|
||||
|
||||
OBJS = $(C_OBJS) $(PAS_OBJS)
|
||||
OBJS = $(ASM_OBJS) $(PAS_OBJS)
|
||||
|
||||
.PHONY: all install clean
|
||||
|
||||
|
|
@ -44,10 +44,10 @@ all: $(LIB)
|
|||
$(LIB): $(OBJS)
|
||||
ar rcs $@ $^
|
||||
|
||||
# --- C rules ---
|
||||
$(OBJ_DIR)/%.o: $(SRC_DIR)/%.c
|
||||
# --- Assembly rules ---
|
||||
$(OBJ_DIR)/%.o: $(ASM_DIR)/%.s
|
||||
@mkdir -p $(OBJ_DIR)
|
||||
$(CC) $(CFLAGS) -c -o $@ $<
|
||||
$(CC) -c -o $@ $<
|
||||
|
||||
# --- Pascal unit rules ---
|
||||
# Compile via a build driver, strip everything from '# Generated by Blaise'
|
||||
|
|
@ -151,6 +151,20 @@ $(OBJ_DIR)/blaise_thread.s: $(OBJ_DIR)/blaise_thread.ssa
|
|||
$(OBJ_DIR)/blaise_thread.o: $(OBJ_DIR)/blaise_thread.s
|
||||
$(CC) -c -o $@ $<
|
||||
|
||||
$(OBJ_DIR)/blaise_exc.ssa: $(PAS_SRC_DIR)/blaise_exc.pas \
|
||||
$(PAS_SRC_DIR)/blaise_exc_build_driver.pas
|
||||
@mkdir -p $(OBJ_DIR)
|
||||
$(BLAISE) --source $(PAS_SRC_DIR)/blaise_exc_build_driver.pas \
|
||||
--unit-path $(PAS_SRC_DIR) \
|
||||
--emit-ir \
|
||||
| sed '/^# Generated by Blaise/,$$d' > $@
|
||||
|
||||
$(OBJ_DIR)/blaise_exc.s: $(OBJ_DIR)/blaise_exc.ssa
|
||||
$(QBE) -o $@ $<
|
||||
|
||||
$(OBJ_DIR)/blaise_exc.o: $(OBJ_DIR)/blaise_exc.s
|
||||
$(CC) -c -o $@ $<
|
||||
|
||||
install: $(LIB)
|
||||
@mkdir -p $(COMPILER_BIN)
|
||||
cp $(LIB) $(COMPILER_BIN)/blaise_rtl.a
|
||||
|
|
|
|||
72
runtime/src/main/asm/blaise_setjmp_x86_64.s
Normal file
72
runtime/src/main/asm/blaise_setjmp_x86_64.s
Normal file
|
|
@ -0,0 +1,72 @@
|
|||
#
|
||||
# Blaise — An Object Pascal Compiler
|
||||
# Copyright (c) 2026 Graeme Geldenhuys
|
||||
# SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
# Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
# See LICENSE file in the project root for full license terms.
|
||||
#
|
||||
# Minimal setjmp/longjmp for Blaise exception handling (x86_64, System V ABI).
|
||||
#
|
||||
# These replace libc setjmp/longjmp so the runtime has zero C dependencies
|
||||
# for exception dispatch. Only callee-saved registers are stored — this is
|
||||
# sufficient because the compiler never promotes locals across setjmp (all
|
||||
# locals in try-bearing functions remain as stack slots).
|
||||
#
|
||||
# jmp_buf layout (64 bytes at offset 0 of BlaiseExcFrame):
|
||||
# [0] RBX
|
||||
# [8] RBP
|
||||
# [16] R12
|
||||
# [24] R13
|
||||
# [32] R14
|
||||
# [40] R15
|
||||
# [48] RSP (caller's stack pointer, after return address)
|
||||
# [56] RIP (return address)
|
||||
#
|
||||
|
||||
.text
|
||||
|
||||
# int _blaise_setjmp(void *buf)
|
||||
# %rdi = pointer to jmp_buf (first 64 bytes of BlaiseExcFrame)
|
||||
# Returns 0 on direct call, non-zero when restored by _blaise_longjmp.
|
||||
.globl _blaise_setjmp
|
||||
.type _blaise_setjmp, @function
|
||||
_blaise_setjmp:
|
||||
mov %rbx, (%rdi)
|
||||
mov %rbp, 8(%rdi)
|
||||
mov %r12, 16(%rdi)
|
||||
mov %r13, 24(%rdi)
|
||||
mov %r14, 32(%rdi)
|
||||
mov %r15, 40(%rdi)
|
||||
lea 8(%rsp), %rax # caller's RSP (skip the return address)
|
||||
mov %rax, 48(%rdi)
|
||||
mov (%rsp), %rax # return address
|
||||
mov %rax, 56(%rdi)
|
||||
xor %eax, %eax # return 0
|
||||
ret
|
||||
.size _blaise_setjmp, .-_blaise_setjmp
|
||||
|
||||
|
||||
# void _blaise_longjmp(void *buf, int val)
|
||||
# %rdi = pointer to jmp_buf
|
||||
# %esi = return value (passed back through setjmp's return)
|
||||
# Does not return to caller — jumps to the setjmp call site.
|
||||
.globl _blaise_longjmp
|
||||
.type _blaise_longjmp, @function
|
||||
_blaise_longjmp:
|
||||
mov %esi, %eax # return value
|
||||
test %eax, %eax
|
||||
jnz 1f
|
||||
inc %eax # longjmp(buf, 0) must return 1
|
||||
1:
|
||||
mov (%rdi), %rbx
|
||||
mov 8(%rdi), %rbp
|
||||
mov 16(%rdi), %r12
|
||||
mov 24(%rdi), %r13
|
||||
mov 32(%rdi), %r14
|
||||
mov 40(%rdi), %r15
|
||||
mov 48(%rdi), %rsp
|
||||
jmp *56(%rdi) # jump to saved return address
|
||||
.size _blaise_longjmp, .-_blaise_longjmp
|
||||
|
||||
|
||||
.section .note.GNU-stack,"",@progbits
|
||||
|
|
@ -1,228 +0,0 @@
|
|||
/*
|
||||
* Blaise — An Object Pascal Compiler
|
||||
* Copyright (c) 2026 Graeme Geldenhuys
|
||||
* SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
* Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
* See LICENSE file in the project root for full license terms.
|
||||
*
|
||||
* Blaise RTL — Exception frame management (Phase 2)
|
||||
*
|
||||
* Uses setjmp/longjmp for exception dispatch. Each try block allocates a
|
||||
* BlaiseExcFrame on the Pascal stack. jbuf MUST be at offset 0 so the
|
||||
* compiler can pass the frame pointer directly to setjmp.
|
||||
*
|
||||
* Frame size contract: the compiler allocates BLAISE_EXC_FRAME_ALLOC16 * 16
|
||||
* bytes (currently 512) for each try block via QBE alloc16. This must be >=
|
||||
* sizeof(BlaiseExcFrame) on every supported target.
|
||||
*
|
||||
* Linux x86_64: sizeof(jmp_buf) = 200 → frame = 216 bytes < 512 ✓
|
||||
* macOS ARM64: sizeof(jmp_buf) ≈ 312 → frame = 328 bytes < 512 ✓
|
||||
*/
|
||||
|
||||
#include <setjmp.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdint.h>
|
||||
#include <string.h>
|
||||
|
||||
/* Forward declaration — implemented in blaise_mem.pas. Blaise strings
|
||||
must be allocated through _BlaiseGetMem so that _StringRelease can
|
||||
free them via _BlaiseFreeMem without a heap mismatch. */
|
||||
extern void* _BlaiseGetMem(int32_t size);
|
||||
|
||||
/* Forward-declared string helper to build a Blaise string from a C string. */
|
||||
static void* exc_str_from_cstr(const char* s) {
|
||||
typedef struct { int32_t refcnt; int32_t length; int32_t capacity; } StrHdr;
|
||||
int32_t len = s ? (int32_t)strlen(s) : 0;
|
||||
StrHdr* h = (StrHdr*)_BlaiseGetMem((int32_t)(sizeof(StrHdr) + len + 1));
|
||||
if (!h) return NULL;
|
||||
h->refcnt = 0; h->length = len; h->capacity = len;
|
||||
if (len > 0) memcpy((char*)(h + 1), s, (size_t)len);
|
||||
((char*)(h + 1))[len] = '\0';
|
||||
return (void*)h;
|
||||
}
|
||||
|
||||
typedef struct BlaiseExcFrame {
|
||||
jmp_buf jbuf; /* offset 0 — frame ptr passed directly to setjmp */
|
||||
void* exception; /* live exception object; NULL on normal path */
|
||||
void* prev; /* previous BlaiseExcFrame* in the thread-local chain */
|
||||
} BlaiseExcFrame;
|
||||
|
||||
#ifdef _WIN32
|
||||
static __declspec(thread) BlaiseExcFrame* g_exc_top = NULL;
|
||||
static __declspec(thread) void* g_current_exception = NULL;
|
||||
#else
|
||||
static __thread BlaiseExcFrame* g_exc_top = NULL;
|
||||
static __thread void* g_current_exception = NULL;
|
||||
#endif
|
||||
|
||||
/*
|
||||
* _PushExcFrame — link a new exception frame into the thread-local chain.
|
||||
* Called by the compiler BEFORE setjmp at the start of every try block.
|
||||
*/
|
||||
void _PushExcFrame(void* frame) {
|
||||
BlaiseExcFrame* f = (BlaiseExcFrame*)frame;
|
||||
f->exception = NULL;
|
||||
f->prev = (void*)g_exc_top;
|
||||
g_exc_top = f;
|
||||
}
|
||||
|
||||
/*
|
||||
* _PopExcFrame — unlink the top frame.
|
||||
* Called on normal exit from a try scope or at the start of an except/finally
|
||||
* handler before running handler body.
|
||||
*/
|
||||
void _PopExcFrame(void) {
|
||||
if (g_exc_top)
|
||||
g_exc_top = (BlaiseExcFrame*)g_exc_top->prev;
|
||||
}
|
||||
|
||||
/*
|
||||
* _Raise — raise an exception. Sets obj on the current frame and longjmps.
|
||||
* Aborts if no active handler exists (unhandled exception).
|
||||
*/
|
||||
void _Raise(void* obj) {
|
||||
if (!g_exc_top)
|
||||
abort();
|
||||
g_current_exception = obj;
|
||||
g_exc_top->exception = obj;
|
||||
longjmp(*(jmp_buf*)g_exc_top, 1);
|
||||
}
|
||||
|
||||
/*
|
||||
* _CurrentException — return the live exception object.
|
||||
* Called from an except handler to capture the exception pointer.
|
||||
* Uses g_current_exception (set by _Raise) rather than g_exc_top->exception
|
||||
* so that bare re-raise inside a typed handler continues to work after
|
||||
* _PopExcFrame has already unwound the handler's own frame.
|
||||
*/
|
||||
void* _CurrentException(void) {
|
||||
return g_current_exception;
|
||||
}
|
||||
|
||||
/*
|
||||
* _CurrentExceptionMessage — return the Message string of the current exception.
|
||||
* Class layout: offset 0 = vptr (8 bytes), offset 8 = FMessage (string pointer).
|
||||
* Returns an empty string if no exception is active.
|
||||
*/
|
||||
void* _CurrentExceptionMessage(void) {
|
||||
/* Use g_current_exception rather than g_exc_top->exception: the codegen
|
||||
calls _PopExcFrame() before running the except body, so g_exc_top has
|
||||
already been unwound by the time CurrentExceptionMessage is called. */
|
||||
void* exc = g_current_exception;
|
||||
if (!exc) return exc_str_from_cstr("");
|
||||
/* FMessage is the first user field, after the 8-byte vptr */
|
||||
void* msg = *((void**)((char*)exc + 8));
|
||||
return msg ? msg : exc_str_from_cstr("");
|
||||
}
|
||||
|
||||
/*
|
||||
* _Reraise — re-raise the given exception to the enclosing handler.
|
||||
* Called by the compiler on the exception path of try/finally, after
|
||||
* _PopExcFrame has already unlinked the try block's own frame.
|
||||
*/
|
||||
void _Reraise(void* exc) {
|
||||
_Raise(exc);
|
||||
}
|
||||
|
||||
/* -----------------------------------------------------------------------
|
||||
* Type identity — is / as operators
|
||||
* ----------------------------------------------------------------------- */
|
||||
|
||||
/*
|
||||
* BlaiseTypeInfo — one per class/interface, stored as vtable slot 0.
|
||||
* parent = pointer to parent class TypeInfo, or NULL for root classes.
|
||||
* impllist = NULL-terminated array of {typeinfo_intf*, itab*} pairs, or NULL
|
||||
* if the class implements no interfaces.
|
||||
*/
|
||||
typedef struct BlaiseTypeInfo {
|
||||
const struct BlaiseTypeInfo* parent;
|
||||
const void** impllist;
|
||||
} BlaiseTypeInfo;
|
||||
|
||||
/*
|
||||
* _IsInstance — runtime 'is' check for class inheritance.
|
||||
* Walks the TypeInfo parent chain from the object's own TypeInfo upward.
|
||||
* Returns 1 if the object is an instance of target (or a subclass), else 0.
|
||||
* obj must be non-nil and point to an instance whose first field is the vptr.
|
||||
*/
|
||||
int _IsInstance(void* obj, const BlaiseTypeInfo* target) {
|
||||
const BlaiseTypeInfo* ti;
|
||||
void** vtable;
|
||||
if (!obj || !target) return 0;
|
||||
vtable = *(void***)obj; /* obj[0] = vptr */
|
||||
ti = (const BlaiseTypeInfo*)vtable[0]; /* vtable[0] = typeinfo */
|
||||
while (ti) {
|
||||
if (ti == target) return 1;
|
||||
ti = ti->parent;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* _ImplementsInterface — runtime 'is' check for interface membership.
|
||||
* Walks the class TypeInfo chain; at each level searches the impllist for
|
||||
* a matching interface TypeInfo pointer.
|
||||
* Returns 1 if the object's class (or any ancestor) implements the interface.
|
||||
*/
|
||||
int _ImplementsInterface(void* obj, const BlaiseTypeInfo* intf_ti) {
|
||||
const BlaiseTypeInfo* ti;
|
||||
const void** impl;
|
||||
void** vtable;
|
||||
if (!obj || !intf_ti) return 0;
|
||||
vtable = *(void***)obj;
|
||||
ti = (const BlaiseTypeInfo*)vtable[0];
|
||||
while (ti) {
|
||||
impl = ti->impllist;
|
||||
while (impl && *impl) {
|
||||
if ((const BlaiseTypeInfo*)(*impl) == intf_ti) return 1;
|
||||
impl += 2; /* each entry is {typeinfo*, itab*} — skip both */
|
||||
}
|
||||
ti = ti->parent;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* _GetItab — return the itab pointer for the given object/interface pair.
|
||||
* Walks the class TypeInfo chain searching the impllist for a matching
|
||||
* interface TypeInfo pointer; returns the associated itab on match.
|
||||
* Returns NULL if the object's class does not implement the interface.
|
||||
*/
|
||||
const void* _GetItab(void* obj, const BlaiseTypeInfo* intf_ti) {
|
||||
const BlaiseTypeInfo* ti;
|
||||
const void** impl;
|
||||
void** vtable;
|
||||
if (!obj || !intf_ti) return 0;
|
||||
vtable = *(void***)obj;
|
||||
ti = (const BlaiseTypeInfo*)vtable[0];
|
||||
while (ti) {
|
||||
impl = ti->impllist;
|
||||
while (impl && *impl) {
|
||||
if ((const BlaiseTypeInfo*)(*impl) == intf_ti) return *(impl + 1);
|
||||
impl += 2;
|
||||
}
|
||||
ti = ti->parent;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* _Raise_InvalidCast — raised by the 'as' operator when the type check fails.
|
||||
*/
|
||||
void _Raise_InvalidCast(void) {
|
||||
abort();
|
||||
}
|
||||
|
||||
/*
|
||||
* _CheckNil — abort with a clear message if the object pointer is nil.
|
||||
* Emitted by codegen before every method dispatch on a class variable so
|
||||
* that calling a method on an uninitialised (nil) object produces a
|
||||
* meaningful error instead of silently succeeding or crashing randomly.
|
||||
*/
|
||||
void _CheckNil(void* obj) {
|
||||
if (!obj) {
|
||||
fprintf(stderr, "Runtime error: method call on nil object\n");
|
||||
abort();
|
||||
}
|
||||
}
|
||||
268
runtime/src/main/pascal/blaise_exc.pas
Normal file
268
runtime/src/main/pascal/blaise_exc.pas
Normal file
|
|
@ -0,0 +1,268 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{
|
||||
Blaise RTL — Exception frame management and type identity (pure Pascal)
|
||||
|
||||
Replaces the former blaise_exc.c. setjmp/longjmp are provided by a
|
||||
platform-specific assembly stub (blaise_setjmp_x86_64.s for x86_64)
|
||||
so the exception subsystem has zero C dependencies.
|
||||
|
||||
Exception frame layout (BlaiseExcFrame):
|
||||
offset 0: jmp_buf (64 bytes on x86_64 — 8 callee-saved registers)
|
||||
offset 64: exception (Pointer — live exception object, nil on normal path)
|
||||
offset 72: prev (Pointer — previous frame in thread-local chain)
|
||||
|
||||
Frame size contract: the compiler allocates 512 bytes via QBE alloc16 for
|
||||
each try block. This must be >= 80 bytes (64 jmp_buf + 2 pointers) on
|
||||
all supported targets. The generous allocation leaves room for future
|
||||
ARM64 jmp_buf growth without a compiler change.
|
||||
|
||||
Thread safety: g_exc_top and g_current_exception are plain globals.
|
||||
When threadvar support is added to the language, they should become
|
||||
thread-local.
|
||||
}
|
||||
|
||||
unit blaise_exc;
|
||||
|
||||
interface
|
||||
|
||||
procedure _PushExcFrame(Frame: Pointer);
|
||||
procedure _PopExcFrame;
|
||||
procedure _Raise(Obj: Pointer);
|
||||
procedure _Reraise(Exc: Pointer);
|
||||
function _CurrentException: Pointer;
|
||||
function _CurrentExceptionMessage: Pointer;
|
||||
function _IsInstance(Obj: Pointer; Target: Pointer): Integer;
|
||||
function _ImplementsInterface(Obj: Pointer; IntfTI: Pointer): Integer;
|
||||
function _GetItab(Obj: Pointer; IntfTI: Pointer): Pointer;
|
||||
procedure _Raise_InvalidCast;
|
||||
procedure _CheckNil(Obj: Pointer);
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
OFS_EXCEPTION = 64;
|
||||
OFS_PREV = 72;
|
||||
|
||||
type
|
||||
PPointer = ^Pointer;
|
||||
|
||||
procedure _blaise_longjmp(Buf: Pointer; Val: Integer); external name '_blaise_longjmp';
|
||||
|
||||
function _BlaiseGetMem(Size: Integer): Pointer; external name '_BlaiseGetMem';
|
||||
function _libc_write(Fd: Integer; Buf: Pointer; Count: Int64): Int64; external name 'write';
|
||||
procedure _libc_abort; external name 'abort';
|
||||
|
||||
var
|
||||
g_exc_top: Pointer;
|
||||
g_current_exception: Pointer;
|
||||
|
||||
function ExcStrEmpty: Pointer;
|
||||
var
|
||||
Base: Pointer;
|
||||
RC, LN, CP: ^Integer;
|
||||
Data: PChar;
|
||||
begin
|
||||
Base := _BlaiseGetMem(13);
|
||||
if Base = nil then
|
||||
begin
|
||||
Result := nil;
|
||||
Exit;
|
||||
end;
|
||||
RC := Base;
|
||||
RC^ := 0;
|
||||
LN := Base + 4;
|
||||
LN^ := 0;
|
||||
CP := Base + 8;
|
||||
CP^ := 0;
|
||||
Data := PChar(Base + 12);
|
||||
Data[0] := #0;
|
||||
Result := Base + 12;
|
||||
end;
|
||||
|
||||
procedure _PushExcFrame(Frame: Pointer);
|
||||
var
|
||||
ExcSlot: PPointer;
|
||||
PrevSlot: PPointer;
|
||||
begin
|
||||
ExcSlot := Frame + OFS_EXCEPTION;
|
||||
ExcSlot^ := nil;
|
||||
PrevSlot := Frame + OFS_PREV;
|
||||
PrevSlot^ := g_exc_top;
|
||||
g_exc_top := Frame;
|
||||
end;
|
||||
|
||||
procedure _PopExcFrame;
|
||||
var
|
||||
PrevSlot: PPointer;
|
||||
begin
|
||||
if g_exc_top <> nil then
|
||||
begin
|
||||
PrevSlot := g_exc_top + OFS_PREV;
|
||||
g_exc_top := PrevSlot^;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure _Raise(Obj: Pointer);
|
||||
var
|
||||
ExcSlot: PPointer;
|
||||
begin
|
||||
if g_exc_top = nil then
|
||||
_libc_abort;
|
||||
g_current_exception := Obj;
|
||||
ExcSlot := g_exc_top + OFS_EXCEPTION;
|
||||
ExcSlot^ := Obj;
|
||||
_blaise_longjmp(g_exc_top, 1);
|
||||
end;
|
||||
|
||||
procedure _Reraise(Exc: Pointer);
|
||||
begin
|
||||
_Raise(Exc);
|
||||
end;
|
||||
|
||||
function _CurrentException: Pointer;
|
||||
begin
|
||||
Result := g_current_exception;
|
||||
end;
|
||||
|
||||
function _CurrentExceptionMessage: Pointer;
|
||||
var
|
||||
Exc: Pointer;
|
||||
MsgSlot: PPointer;
|
||||
Msg: Pointer;
|
||||
begin
|
||||
Exc := g_current_exception;
|
||||
if Exc = nil then
|
||||
begin
|
||||
Result := ExcStrEmpty;
|
||||
Exit;
|
||||
end;
|
||||
MsgSlot := Exc + 8;
|
||||
Msg := MsgSlot^;
|
||||
if Msg = nil then
|
||||
Result := ExcStrEmpty
|
||||
else
|
||||
Result := Msg;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------
|
||||
Type identity — is / as operators
|
||||
------------------------------------------------------------------
|
||||
|
||||
BlaiseTypeInfo layout (matches the codegen-emitted typeinfo_ data):
|
||||
offset 0: parent (Pointer — parent class TypeInfo, or nil for root)
|
||||
offset 8: impllist (Pointer — nil-terminated array of (typeinfo*, itab*) pairs)
|
||||
------------------------------------------------------------------ }
|
||||
|
||||
function _IsInstance(Obj: Pointer; Target: Pointer): Integer;
|
||||
var
|
||||
VTable: PPointer;
|
||||
TI: Pointer;
|
||||
ParentSlot: PPointer;
|
||||
begin
|
||||
Result := 0;
|
||||
if (Obj = nil) or (Target = nil) then Exit;
|
||||
VTable := PPointer(Obj)^;
|
||||
TI := VTable^;
|
||||
while TI <> nil do
|
||||
begin
|
||||
if TI = Target then
|
||||
begin
|
||||
Result := 1;
|
||||
Exit;
|
||||
end;
|
||||
ParentSlot := TI;
|
||||
TI := ParentSlot^;
|
||||
end;
|
||||
end;
|
||||
|
||||
function _ImplementsInterface(Obj: Pointer; IntfTI: Pointer): Integer;
|
||||
var
|
||||
VTable: PPointer;
|
||||
TI: Pointer;
|
||||
ParentSlot: PPointer;
|
||||
ImplSlot: PPointer;
|
||||
Impl: PPointer;
|
||||
begin
|
||||
Result := 0;
|
||||
if (Obj = nil) or (IntfTI = nil) then Exit;
|
||||
VTable := PPointer(Obj)^;
|
||||
TI := VTable^;
|
||||
while TI <> nil do
|
||||
begin
|
||||
ImplSlot := TI + 8;
|
||||
Impl := ImplSlot^;
|
||||
while (Impl <> nil) and (Impl^ <> nil) do
|
||||
begin
|
||||
if Impl^ = IntfTI then
|
||||
begin
|
||||
Result := 1;
|
||||
Exit;
|
||||
end;
|
||||
Impl := Pointer(Impl) + 16;
|
||||
end;
|
||||
ParentSlot := TI;
|
||||
TI := ParentSlot^;
|
||||
end;
|
||||
end;
|
||||
|
||||
function _GetItab(Obj: Pointer; IntfTI: Pointer): Pointer;
|
||||
var
|
||||
VTable: PPointer;
|
||||
TI: Pointer;
|
||||
ParentSlot: PPointer;
|
||||
ImplSlot: PPointer;
|
||||
Impl: PPointer;
|
||||
ItabSlot: PPointer;
|
||||
begin
|
||||
Result := nil;
|
||||
if (Obj = nil) or (IntfTI = nil) then Exit;
|
||||
VTable := PPointer(Obj)^;
|
||||
TI := VTable^;
|
||||
while TI <> nil do
|
||||
begin
|
||||
ImplSlot := TI + 8;
|
||||
Impl := ImplSlot^;
|
||||
while (Impl <> nil) and (Impl^ <> nil) do
|
||||
begin
|
||||
if Impl^ = IntfTI then
|
||||
begin
|
||||
ItabSlot := Pointer(Impl) + 8;
|
||||
Result := ItabSlot^;
|
||||
Exit;
|
||||
end;
|
||||
Impl := Pointer(Impl) + 16;
|
||||
end;
|
||||
ParentSlot := TI;
|
||||
TI := ParentSlot^;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DiagAbort(Msg: Pointer; Len: Integer);
|
||||
var
|
||||
NL: Byte;
|
||||
begin
|
||||
_libc_write(2, Msg, Int64(Len));
|
||||
NL := 10;
|
||||
_libc_write(2, @NL, 1);
|
||||
_libc_abort;
|
||||
end;
|
||||
|
||||
procedure _Raise_InvalidCast;
|
||||
begin
|
||||
DiagAbort('Runtime error: invalid typecast', 31);
|
||||
end;
|
||||
|
||||
procedure _CheckNil(Obj: Pointer);
|
||||
begin
|
||||
if Obj = nil then
|
||||
DiagAbort('Runtime error: method call on nil object', 41);
|
||||
end;
|
||||
|
||||
end.
|
||||
17
runtime/src/main/pascal/blaise_exc_build_driver.pas
Normal file
17
runtime/src/main/pascal/blaise_exc_build_driver.pas
Normal file
|
|
@ -0,0 +1,17 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
|
||||
Licensed under the Apache License v2.0 with Runtime Library Exception.
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{ Build driver for blaise_exc.pas — used only by the RTL Makefile. }
|
||||
|
||||
program blaise_exc_build_driver;
|
||||
|
||||
uses
|
||||
blaise_exc;
|
||||
|
||||
begin
|
||||
end.
|
||||
Loading…
Reference in a new issue