layer-0-runtime/runtime.f90

! 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