File size: 5,834 Bytes
ffc07fb | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | ! Layer 0 — Sovereign IDE Runtime
! Arena allocator + string intern + panic
! Maps to: snap-os SoulVM, errant QTT, sov-kernel-monster bare-metal
MODULE sovereign_runtime
USE iso_c_binding
IMPLICIT NONE
PRIVATE
! ── Arena allocator ───────────────────────────────────────────────────────
INTEGER, PARAMETER :: ARENA_SIZE = 64 * 1024 * 1024 ! 64 MiB default slab
INTEGER, PARAMETER :: MAX_STRINGS = 65536
TYPE :: arena_t
INTEGER(C_INTPTR_T) :: base = 0
INTEGER(C_INTPTR_T) :: cursor = 0
INTEGER(C_INTPTR_T) :: limit = 0
LOGICAL :: sealed = .FALSE.
END TYPE arena_t
! ── String intern table ───────────────────────────────────────────────────
TYPE :: intern_entry_t
CHARACTER(LEN=256) :: str = ''
INTEGER(C_INT32_T) :: id = 0
INTEGER(C_INT32_T) :: hash = 0
END TYPE intern_entry_t
TYPE :: intern_table_t
TYPE(intern_entry_t) :: entries(MAX_STRINGS)
INTEGER :: count = 0
LOGICAL :: worm_sealed = .FALSE.
END TYPE intern_table_t
! ── Global singletons (one per process) ──────────────────────────────────
TYPE(arena_t), SAVE :: g_arena
TYPE(intern_table_t), SAVE :: g_intern
PUBLIC :: runtime_init
PUBLIC :: runtime_teardown
PUBLIC :: arena_alloc
PUBLIC :: arena_reset
PUBLIC :: str_intern
PUBLIC :: str_lookup
PUBLIC :: runtime_panic
CONTAINS
! ---------------------------------------------------------------------------
SUBROUTINE runtime_init(arena_bytes)
INTEGER, INTENT(IN), OPTIONAL :: arena_bytes
INTEGER :: slab
slab = ARENA_SIZE
IF (PRESENT(arena_bytes)) slab = arena_bytes
! TODO: call bifrost_worm_open() from snap-os before first alloc
CALL arena_init_internal(g_arena, slab)
g_intern%count = 0
g_intern%worm_sealed = .FALSE.
WRITE(*,'(A,I0,A)') '[runtime] arena init: ', slab, ' bytes'
END SUBROUTINE runtime_init
! ---------------------------------------------------------------------------
SUBROUTINE runtime_teardown()
! Seal the WORM log (bifrost pattern, snap-os)
! TODO: call bifrost_worm_seal(g_worm_handle)
CALL arena_free_internal(g_arena)
WRITE(*,'(A)') '[runtime] teardown complete'
END SUBROUTINE runtime_teardown
! ---------------------------------------------------------------------------
! Arena allocate n bytes; returns pointer or calls panic on OOM
FUNCTION arena_alloc(n) RESULT(ptr)
INTEGER, INTENT(IN) :: n
INTEGER(C_INTPTR_T) :: ptr
IF (g_arena%sealed) CALL runtime_panic('arena_alloc: arena is sealed')
IF (g_arena%cursor + n > g_arena%limit) &
CALL runtime_panic('arena_alloc: out of memory')
ptr = g_arena%cursor
g_arena%cursor = g_arena%cursor + n
END FUNCTION arena_alloc
! ---------------------------------------------------------------------------
SUBROUTINE arena_reset()
IF (g_arena%sealed) RETURN
g_arena%cursor = g_arena%base
END SUBROUTINE arena_reset
! ---------------------------------------------------------------------------
! Intern a string; return stable u32 ID (QTT tag, errant pattern)
FUNCTION str_intern(s) RESULT(id)
CHARACTER(LEN=*), INTENT(IN) :: s
INTEGER(C_INT32_T) :: id
INTEGER :: i, h
h = djb2_hash(s)
DO i = 1, g_intern%count
IF (g_intern%entries(i)%hash == h .AND. &
g_intern%entries(i)%str == s) THEN
id = g_intern%entries(i)%id
RETURN
END IF
END DO
! New entry
IF (g_intern%count >= MAX_STRINGS) &
CALL runtime_panic('str_intern: table full')
g_intern%count = g_intern%count + 1
g_intern%entries(g_intern%count)%str = s
g_intern%entries(g_intern%count)%id = INT(g_intern%count, C_INT32_T)
g_intern%entries(g_intern%count)%hash = h
id = INT(g_intern%count, C_INT32_T)
END FUNCTION str_intern
! ---------------------------------------------------------------------------
FUNCTION str_lookup(id) RESULT(s)
INTEGER(C_INT32_T), INTENT(IN) :: id
CHARACTER(LEN=256) :: s
IF (id < 1 .OR. id > g_intern%count) THEN
CALL runtime_panic('str_lookup: invalid id')
END IF
s = g_intern%entries(id)%str
END FUNCTION str_lookup
! ---------------------------------------------------------------------------
SUBROUTINE runtime_panic(msg)
CHARACTER(LEN=*), INTENT(IN) :: msg
! TODO: write WORM record via bifrost before abort
WRITE(*,'(A,A)') '[SOVEREIGN PANIC] ', TRIM(msg)
STOP 1
END SUBROUTINE runtime_panic
! ── Internal helpers ──────────────────────────────────────────────────────
SUBROUTINE arena_init_internal(a, slab)
TYPE(arena_t), INTENT(INOUT) :: a
INTEGER, INTENT(IN) :: slab
! Stub: real impl calls mmap/VirtualAlloc via C binding
a%base = 0
a%cursor = 0
a%limit = INT(slab, C_INTPTR_T)
a%sealed = .FALSE.
END SUBROUTINE arena_init_internal
SUBROUTINE arena_free_internal(a)
TYPE(arena_t), INTENT(INOUT) :: a
a%sealed = .TRUE.
END SUBROUTINE arena_free_internal
PURE FUNCTION djb2_hash(s) RESULT(h)
CHARACTER(LEN=*), INTENT(IN) :: s
INTEGER :: h, i
h = 5381
DO i = 1, LEN_TRIM(s)
h = h * 33 + ICHAR(s(i:i))
END DO
END FUNCTION djb2_hash
END MODULE sovereign_runtime
|