feat(rtl): migrate blaise_arc.c → blaise_arc.pas — Step 9c
Port all non-function-pointer ARC functions from C to Pascal: _StringAddRef, _StringRelease, _StringEquals, _StringConcat, TObject_Destroy, _ClassAddRef, _ClassFree Remaining in C (blaise_arc_class.c — renamed from blaise_arc.c): _ClassAlloc and _ClassRelease — store and call a function pointer (the $_FieldCleanup_TypeName hook), which Blaise cannot express yet. Compiler fixes required to support this port: - uCodeGenQBE: EmitFuncDef now exits early for IsExternal declarations; previously it crashed (access violation) when iterating a nil body - uSymbolTable: remove _ClassAddRef and _ClassRelease from RegisterBuiltins; they are internal RTL symbols emitted directly by the codegen, not user-callable builtins, and pre-registering them caused "Duplicate identifier" errors when the unit interface re-declared them RTL Makefile: blaise_arc_class.c replaces blaise_arc.c in C_SRCS; blaise_arc.pas added to PAS_OBJS with its own build driver. All 1035 compiler tests pass.
This commit is contained in:
Graeme Geldenhuys
parent
d60958dc25
commit
584f0378e2
|
|
@ -2548,6 +2548,7 @@ var
|
|||
Prefix: string;
|
||||
SavedExitLbl: string;
|
||||
begin
|
||||
if ADecl.IsExternal then Exit; { no body to emit for external declarations }
|
||||
FuncName := '$' + QBEMangle(ADecl.Name);
|
||||
IsFunc := ADecl.ResolvedReturnType <> nil;
|
||||
if AExported then Prefix := 'export ' else Prefix := '';
|
||||
|
|
|
|||
|
|
@ -996,9 +996,7 @@ begin
|
|||
Sym := TSymbol.Create('Inc', skProcedure, nil); Define(Sym);
|
||||
Sym := TSymbol.Create('Dec', skProcedure, nil); Define(Sym);
|
||||
{ Memory utilities }
|
||||
Sym := TSymbol.Create('ZeroMem', skProcedure, nil); Define(Sym);
|
||||
Sym := TSymbol.Create('_ClassAddRef', skProcedure, nil); Define(Sym);
|
||||
Sym := TSymbol.Create('_ClassRelease',skProcedure, nil); Define(Sym);
|
||||
Sym := TSymbol.Create('ZeroMem', skProcedure, nil); Define(Sym);
|
||||
{ CLI arguments }
|
||||
Sym := TSymbol.Create('ParamCount', skFunction, FTypeInteger); Define(Sym);
|
||||
Sym := TSymbol.Create('ParamStr', skFunction, FTypeString); Define(Sym);
|
||||
|
|
|
|||
19
rtl/Makefile
19
rtl/Makefile
|
|
@ -14,7 +14,7 @@ QBE = ../vendor/qbe/qbe
|
|||
|
||||
# C sources (blaise_str.pas replaces blaise_str.c; blaise_str_fmt.c keeps
|
||||
# the variadic _StringFormat which cannot be expressed in Pascal).
|
||||
C_SRCS = $(SRC_DIR)/blaise_arc.c \
|
||||
C_SRCS = $(SRC_DIR)/blaise_arc_class.c \
|
||||
$(SRC_DIR)/blaise_exc.c \
|
||||
$(SRC_DIR)/blaise_weak.c \
|
||||
$(SRC_DIR)/blaise_str_fmt.c \
|
||||
|
|
@ -25,7 +25,8 @@ C_OBJS = $(patsubst $(SRC_DIR)/%.c,$(OBJ_DIR)/%.o,$(C_SRCS))
|
|||
# Pascal RTL units compiled via the Blaise compiler.
|
||||
# Each unit is compiled by a thin driver program; the program section is
|
||||
# stripped from the IR so only the unit's exported functions are archived.
|
||||
PAS_OBJS = $(OBJ_DIR)/blaise_str.o
|
||||
PAS_OBJS = $(OBJ_DIR)/blaise_str.o \
|
||||
$(OBJ_DIR)/blaise_arc.o
|
||||
|
||||
OBJS = $(C_OBJS) $(PAS_OBJS)
|
||||
|
||||
|
|
@ -58,6 +59,20 @@ $(OBJ_DIR)/blaise_str.s: $(OBJ_DIR)/blaise_str.ssa
|
|||
$(OBJ_DIR)/blaise_str.o: $(OBJ_DIR)/blaise_str.s
|
||||
$(CC) -c -o $@ $<
|
||||
|
||||
$(OBJ_DIR)/blaise_arc.ssa: $(PAS_SRC_DIR)/blaise_arc.pas \
|
||||
$(PAS_SRC_DIR)/blaise_arc_build_driver.pas
|
||||
@mkdir -p $(OBJ_DIR)
|
||||
$(BLAISE) --source $(PAS_SRC_DIR)/blaise_arc_build_driver.pas \
|
||||
--unit-path $(PAS_SRC_DIR) \
|
||||
--emit-ir \
|
||||
| sed '/^# Generated by Blaise/,$$d' > $@
|
||||
|
||||
$(OBJ_DIR)/blaise_arc.s: $(OBJ_DIR)/blaise_arc.ssa
|
||||
$(QBE) -o $@ $<
|
||||
|
||||
$(OBJ_DIR)/blaise_arc.o: $(OBJ_DIR)/blaise_arc.s
|
||||
$(CC) -c -o $@ $<
|
||||
|
||||
install: $(LIB)
|
||||
@mkdir -p $(COMPILER_BIN)
|
||||
cp $(LIB) $(COMPILER_BIN)/blaise_rtl.a
|
||||
|
|
|
|||
|
|
@ -1,169 +0,0 @@
|
|||
/*
|
||||
* Blaise RTL — ARC string management (Phase 2)
|
||||
*
|
||||
* String pointer convention:
|
||||
* A Blaise string value is a pointer to the 12-byte header below.
|
||||
* The character data starts immediately after the header.
|
||||
* nil (0) represents an empty / unassigned string.
|
||||
*
|
||||
* +--[4 bytes]--+--[4 bytes]--+--[4 bytes]--+--[N bytes]--+--[1 byte]--+
|
||||
* | RefCount | Length | Capacity | UTF-8 data | NUL |
|
||||
* +-------------+-------------+-------------+-------------+------------+
|
||||
* ^--- string pointer (header ptr) ^--- chars at ptr+12
|
||||
*
|
||||
* RefCount = -1 marks a statically-allocated string (string literals in the
|
||||
* data section). _StringAddRef and _StringRelease are no-ops for static
|
||||
* strings and nil pointers.
|
||||
*
|
||||
* _StringConcat allocates a new header with RefCount = 0 (unowned). The
|
||||
* compiler inserts a _StringAddRef at every assignment, which brings the
|
||||
* count to 1. A corresponding _StringRelease at scope exit frees it.
|
||||
*/
|
||||
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
|
||||
#define IMMORTAL_REFCNT (-1)
|
||||
|
||||
typedef struct {
|
||||
int32_t refcnt;
|
||||
int32_t length;
|
||||
int32_t capacity;
|
||||
/* char data[]; follows immediately */
|
||||
} BlaiseStrHdr;
|
||||
|
||||
static inline BlaiseStrHdr* hdr(void* ptr) {
|
||||
return (BlaiseStrHdr*)ptr;
|
||||
}
|
||||
|
||||
void _StringAddRef(void* ptr) {
|
||||
if (!ptr) return;
|
||||
BlaiseStrHdr* h = hdr(ptr);
|
||||
if (h->refcnt == IMMORTAL_REFCNT) return;
|
||||
h->refcnt++;
|
||||
}
|
||||
|
||||
void _StringRelease(void* ptr) {
|
||||
if (!ptr) return;
|
||||
BlaiseStrHdr* h = hdr(ptr);
|
||||
if (h->refcnt == IMMORTAL_REFCNT) return;
|
||||
if (--h->refcnt == 0) free(ptr);
|
||||
}
|
||||
|
||||
/*
|
||||
* Content-equality comparison. Returns 1 if the two strings have identical
|
||||
* byte content, 0 otherwise. nil is treated as the empty string.
|
||||
*/
|
||||
int32_t _StringEquals(void* s1, void* s2) {
|
||||
if (s1 == s2) return 1;
|
||||
int32_t len1 = s1 ? hdr(s1)->length : 0;
|
||||
int32_t len2 = s2 ? hdr(s2)->length : 0;
|
||||
if (len1 != len2) return 0;
|
||||
if (len1 == 0) return 1;
|
||||
const char* c1 = (const char*)s1 + sizeof(BlaiseStrHdr);
|
||||
const char* c2 = (const char*)s2 + sizeof(BlaiseStrHdr);
|
||||
return memcmp(c1, c2, len1) == 0 ? 1 : 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Class instance ARC support.
|
||||
*
|
||||
* Every Blaise class instance carries a hidden 16-byte prefix before the user
|
||||
* pointer:
|
||||
*
|
||||
* +--[4 bytes]--+--[4 bytes]--+--[8 bytes]-------------+
|
||||
* | RefCount | (padding) | cleanup fn pointer |
|
||||
* +-------------+-------------+------------------------+
|
||||
* ^--- user pointer
|
||||
*
|
||||
* The cleanup function, emitted by the compiler as $_FieldCleanup_<TypeName>,
|
||||
* releases every ARC-managed field the object holds (string and class fields,
|
||||
* chained up the inheritance tree). It runs before free() when the refcount
|
||||
* reaches zero and may be null for classes that hold no ARC-managed fields.
|
||||
*
|
||||
* RefCount starts at 0; the compiler inserts _ClassAddRef on assignment
|
||||
* (mirroring the string ARC convention).
|
||||
*/
|
||||
|
||||
typedef void (*BlaiseFieldCleanupFn)(void*);
|
||||
|
||||
typedef struct {
|
||||
int32_t refcnt;
|
||||
int32_t _pad;
|
||||
BlaiseFieldCleanupFn cleanup;
|
||||
} BlaiseObjHdr;
|
||||
|
||||
#define CLASS_HDR_SIZE (sizeof(BlaiseObjHdr))
|
||||
|
||||
static inline BlaiseObjHdr* obj_hdr(void* user_ptr) {
|
||||
return (BlaiseObjHdr*)((char*)user_ptr - CLASS_HDR_SIZE);
|
||||
}
|
||||
|
||||
void* _ClassAlloc(size_t size, BlaiseFieldCleanupFn cleanup) {
|
||||
char* base = (char*)calloc(1, size + CLASS_HDR_SIZE);
|
||||
if (!base) return NULL;
|
||||
BlaiseObjHdr* h = (BlaiseObjHdr*)base;
|
||||
h->cleanup = cleanup;
|
||||
/* refcnt starts at 0; first assignment's _ClassAddRef brings it to 1 */
|
||||
return base + CLASS_HDR_SIZE;
|
||||
}
|
||||
|
||||
void _ClassFree(void* user_ptr) {
|
||||
if (!user_ptr) return;
|
||||
free((char*)user_ptr - CLASS_HDR_SIZE);
|
||||
}
|
||||
|
||||
/* Default TObject.Destroy — no-op; ARC cleanup handles memory management. */
|
||||
void TObject_Destroy(void* self) {
|
||||
(void)self;
|
||||
}
|
||||
|
||||
void _ClassAddRef(void* user_ptr) {
|
||||
if (!user_ptr) return;
|
||||
obj_hdr(user_ptr)->refcnt++;
|
||||
}
|
||||
|
||||
/* Forward declaration — implemented in blaise_weak.c. */
|
||||
extern void _WeakZeroSlots(void* target);
|
||||
|
||||
void _ClassRelease(void* user_ptr) {
|
||||
if (!user_ptr) return;
|
||||
BlaiseObjHdr* h = obj_hdr(user_ptr);
|
||||
if (--h->refcnt == 0) {
|
||||
/* Zero every registered weak reference before the object's
|
||||
* storage goes away — otherwise a weak reader would see a
|
||||
* dangling pointer. */
|
||||
_WeakZeroSlots(user_ptr);
|
||||
if (h->cleanup) h->cleanup(user_ptr);
|
||||
free((char*)user_ptr - CLASS_HDR_SIZE);
|
||||
}
|
||||
}
|
||||
|
||||
/*
|
||||
* Concatenate two Blaise strings. Either or both may be nil.
|
||||
* Returns a new header with RefCount = 0 (caller takes ownership via AddRef).
|
||||
* Returns nil if both inputs are nil.
|
||||
*/
|
||||
void* _StringConcat(void* s1, void* s2) {
|
||||
const char* c1 = s1 ? (const char*)s1 + sizeof(BlaiseStrHdr) : "";
|
||||
const char* c2 = s2 ? (const char*)s2 + sizeof(BlaiseStrHdr) : "";
|
||||
int32_t len1 = s1 ? hdr(s1)->length : 0;
|
||||
int32_t len2 = s2 ? hdr(s2)->length : 0;
|
||||
int32_t total = len1 + len2;
|
||||
BlaiseStrHdr* result;
|
||||
|
||||
result = (BlaiseStrHdr*)malloc(sizeof(BlaiseStrHdr) + total + 1);
|
||||
if (!result) return NULL;
|
||||
|
||||
result->refcnt = 0; /* unowned; caller's _StringAddRef brings it to 1 */
|
||||
result->length = total;
|
||||
result->capacity = total;
|
||||
|
||||
char* dest = (char*)result + sizeof(BlaiseStrHdr);
|
||||
if (len1 > 0) memcpy(dest, c1, len1);
|
||||
if (len2 > 0) memcpy(dest + len1, c2, len2);
|
||||
dest[total] = '\0';
|
||||
|
||||
return result;
|
||||
}
|
||||
51
rtl/src/main/c/blaise_arc_class.c
Normal file
51
rtl/src/main/c/blaise_arc_class.c
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
/*
|
||||
* Blaise RTL — class ARC (function-pointer-dependent subset)
|
||||
*
|
||||
* _ClassAlloc and _ClassRelease remain in C because they store and call a
|
||||
* function pointer (the field-cleanup hook emitted by the compiler as
|
||||
* $_FieldCleanup_TypeName). All other ARC functions live in blaise_arc.pas.
|
||||
*
|
||||
* Class instance layout:
|
||||
* +--[4 bytes]--+--[4 bytes]--+--[8 bytes]--+--[user fields...]--+
|
||||
* | RefCount | (padding) | cleanup ptr | ... |
|
||||
* +-------------+-------------+-------------+--------------------+
|
||||
* ^--- user pointer
|
||||
*/
|
||||
|
||||
#include <stdint.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
typedef void (*BlaiseFieldCleanupFn)(void*);
|
||||
|
||||
typedef struct {
|
||||
int32_t refcnt;
|
||||
int32_t _pad;
|
||||
BlaiseFieldCleanupFn cleanup;
|
||||
} BlaiseObjHdr;
|
||||
|
||||
#define CLASS_HDR_SIZE (sizeof(BlaiseObjHdr))
|
||||
|
||||
static inline BlaiseObjHdr* obj_hdr(void* user_ptr) {
|
||||
return (BlaiseObjHdr*)((char*)user_ptr - CLASS_HDR_SIZE);
|
||||
}
|
||||
|
||||
void* _ClassAlloc(size_t size, BlaiseFieldCleanupFn cleanup) {
|
||||
char* base = (char*)calloc(1, size + CLASS_HDR_SIZE);
|
||||
if (!base) return NULL;
|
||||
BlaiseObjHdr* h = (BlaiseObjHdr*)base;
|
||||
h->cleanup = cleanup;
|
||||
return base + CLASS_HDR_SIZE;
|
||||
}
|
||||
|
||||
/* Forward declaration — implemented in blaise_weak.c. */
|
||||
extern void _WeakZeroSlots(void* target);
|
||||
|
||||
void _ClassRelease(void* user_ptr) {
|
||||
if (!user_ptr) return;
|
||||
BlaiseObjHdr* h = obj_hdr(user_ptr);
|
||||
if (--h->refcnt == 0) {
|
||||
_WeakZeroSlots(user_ptr);
|
||||
if (h->cleanup) h->cleanup(user_ptr);
|
||||
free((char*)user_ptr - CLASS_HDR_SIZE);
|
||||
}
|
||||
}
|
||||
186
rtl/src/main/pascal/blaise_arc.pas
Normal file
186
rtl/src/main/pascal/blaise_arc.pas
Normal file
|
|
@ -0,0 +1,186 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: BSD-3-Clause
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{
|
||||
Blaise RTL — ARC management (Pascal port of blaise_arc.c)
|
||||
|
||||
String layout (shared with blaise_str.pas):
|
||||
+--[4 bytes]--+--[4 bytes]--+--[4 bytes]--+--[N bytes]--+--[1 byte]--+
|
||||
| RefCount | Length | Capacity | UTF-8 data | NUL |
|
||||
+-------------+-------------+-------------+-------------+------------+
|
||||
^--- string pointer
|
||||
|
||||
Class instance layout:
|
||||
+--[4 bytes]--+--[4 bytes]--+--[8 bytes]--+--[user fields...]--+
|
||||
| RefCount | (padding) | cleanup ptr | ... |
|
||||
+-------------+-------------+-------------+--------------------+
|
||||
^--- user pointer (what Pascal code sees)
|
||||
|
||||
nil = unassigned. RefCount = -1 = immortal (string literals).
|
||||
|
||||
_ClassAlloc and _ClassRelease remain in blaise_arc.c because they
|
||||
store and call a function pointer — not yet expressible in Blaise.
|
||||
}
|
||||
|
||||
unit blaise_arc;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
procedure _StringAddRef(Ptr: Pointer);
|
||||
procedure _StringRelease(Ptr: Pointer);
|
||||
function _StringEquals(S1, S2: Pointer): Integer;
|
||||
function _StringConcat(S1, S2: Pointer): Pointer;
|
||||
procedure TObject_Destroy(Self: Pointer);
|
||||
procedure _ClassAddRef(UserPtr: Pointer);
|
||||
procedure _ClassFree(UserPtr: Pointer);
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
IMMORTAL = -1;
|
||||
HDR_SIZE = 12; { string header: RefCount + Length + Capacity }
|
||||
CLASS_HDR = 16; { class header: RefCount + pad + cleanup ptr }
|
||||
|
||||
function _libc_malloc(Size: Int64): Pointer; external name 'malloc';
|
||||
procedure _libc_free(Ptr: Pointer); external name 'free';
|
||||
function _libc_memcpy(Dst, Src: Pointer; N: Int64): Pointer; external name 'memcpy';
|
||||
function _libc_memcmp(S1, S2: Pointer; N: Int64): Integer; external name 'memcmp';
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ String ARC }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure _StringAddRef(Ptr: Pointer);
|
||||
var
|
||||
RC: ^Integer;
|
||||
begin
|
||||
if Ptr = nil then Exit;
|
||||
RC := Ptr;
|
||||
if RC^ = IMMORTAL then Exit;
|
||||
RC^ := RC^ + 1;
|
||||
end;
|
||||
|
||||
procedure _StringRelease(Ptr: Pointer);
|
||||
var
|
||||
RC: ^Integer;
|
||||
begin
|
||||
if Ptr = nil then Exit;
|
||||
RC := Ptr;
|
||||
if RC^ = IMMORTAL then Exit;
|
||||
RC^ := RC^ - 1;
|
||||
if RC^ = 0 then _libc_free(Ptr);
|
||||
end;
|
||||
|
||||
function _StringEquals(S1, S2: Pointer): Integer;
|
||||
var
|
||||
Len1, Len2: Integer;
|
||||
LN: ^Integer;
|
||||
C1, C2: PChar;
|
||||
begin
|
||||
if S1 = S2 then
|
||||
begin
|
||||
Result := 1;
|
||||
Exit;
|
||||
end;
|
||||
if S1 = nil then
|
||||
Len1 := 0
|
||||
else
|
||||
begin
|
||||
LN := S1 + 4;
|
||||
Len1 := LN^;
|
||||
end;
|
||||
if S2 = nil then
|
||||
Len2 := 0
|
||||
else
|
||||
begin
|
||||
LN := S2 + 4;
|
||||
Len2 := LN^;
|
||||
end;
|
||||
if Len1 <> Len2 then
|
||||
begin
|
||||
Result := 0;
|
||||
Exit;
|
||||
end;
|
||||
if Len1 = 0 then
|
||||
begin
|
||||
Result := 1;
|
||||
Exit;
|
||||
end;
|
||||
C1 := PChar(S1 + HDR_SIZE);
|
||||
C2 := PChar(S2 + HDR_SIZE);
|
||||
if _libc_memcmp(C1, C2, Int64(Len1)) = 0 then
|
||||
Result := 1
|
||||
else
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
function _StringConcat(S1, S2: Pointer): Pointer;
|
||||
var
|
||||
Len1, Len2, Total: Integer;
|
||||
LN: ^Integer;
|
||||
RC, LenF, CapF: ^Integer;
|
||||
Dst: PChar;
|
||||
begin
|
||||
if S1 = nil then
|
||||
Len1 := 0
|
||||
else
|
||||
begin
|
||||
LN := S1 + 4;
|
||||
Len1 := LN^;
|
||||
end;
|
||||
if S2 = nil then
|
||||
Len2 := 0
|
||||
else
|
||||
begin
|
||||
LN := S2 + 4;
|
||||
Len2 := LN^;
|
||||
end;
|
||||
Total := Len1 + Len2;
|
||||
Result := _libc_malloc(Int64(HDR_SIZE + Total + 1));
|
||||
if Result = nil then Exit;
|
||||
RC := Result;
|
||||
RC^ := 0;
|
||||
LenF := Result + 4;
|
||||
LenF^ := Total;
|
||||
CapF := Result + 8;
|
||||
CapF^ := Total;
|
||||
Dst := PChar(Result + HDR_SIZE);
|
||||
if Len1 > 0 then
|
||||
_libc_memcpy(Dst, S1 + HDR_SIZE, Int64(Len1));
|
||||
if Len2 > 0 then
|
||||
_libc_memcpy(Dst + Len1, S2 + HDR_SIZE, Int64(Len2));
|
||||
Dst[Total] := 0;
|
||||
end;
|
||||
|
||||
{ ------------------------------------------------------------------ }
|
||||
{ Class ARC (no function pointers needed here) }
|
||||
{ ------------------------------------------------------------------ }
|
||||
|
||||
procedure TObject_Destroy(Self: Pointer);
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure _ClassAddRef(UserPtr: Pointer);
|
||||
var
|
||||
Hdr: Pointer;
|
||||
RC: ^Integer;
|
||||
begin
|
||||
if UserPtr = nil then Exit;
|
||||
Hdr := UserPtr - CLASS_HDR;
|
||||
RC := Hdr;
|
||||
RC^ := RC^ + 1;
|
||||
end;
|
||||
|
||||
procedure _ClassFree(UserPtr: Pointer);
|
||||
begin
|
||||
if UserPtr = nil then Exit;
|
||||
_libc_free(UserPtr - CLASS_HDR);
|
||||
end;
|
||||
|
||||
end.
|
||||
16
rtl/src/main/pascal/blaise_arc_build_driver.pas
Normal file
16
rtl/src/main/pascal/blaise_arc_build_driver.pas
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
{
|
||||
Blaise - An Object Pascal Compiler
|
||||
Copyright (c) 2026 Graeme Geldenhuys
|
||||
SPDX-License-Identifier: BSD-3-Clause
|
||||
See LICENSE file in the project root for full license terms.
|
||||
}
|
||||
|
||||
{ Build driver for blaise_arc.pas — used only by the RTL Makefile. }
|
||||
|
||||
program blaise_arc_build_driver;
|
||||
|
||||
uses
|
||||
blaise_arc;
|
||||
|
||||
begin
|
||||
end.
|
||||
Loading…
Reference in a new issue