msyds/gyehoek-hs
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cps

Browse Source
This commit is contained in:
Madeleine Sydney Slaga
2026-06-30 11:47:51 -06:00
parent 37b97f9eb3
commit 59c96f9ffb
48 changed files with 205 additions and 1677 deletions
Download Patch File Download Diff File Expand all files Collapse all files
runtime/src/capi.rs
-24
View File
@@ -1,24 +0,0 @@
use std::slice;
use crate::scm::scm_bits;
use crate::scm;
#[unsafe(no_mangle)]
pub extern "C" fn scm_from_utf8_string (
ptr : *const u8,
len : usize
) -> scm_bits {
let bytes = unsafe { slice::from_raw_parts (ptr, len) };
scm::make_string (str::from_utf8 (bytes).unwrap ())
}
// #[unsafe(no_mangle)]
// pub extern "C" fn scm_hash (ptr : *const u8, len : usize) -> u64 {
// let bytes = unsafe { slice::from_raw_parts (ptr, len) };
// crate::obarray::hash (str::from_utf8 (bytes).unwrap ())
// }
#[unsafe(no_mangle)]
pub extern "C" fn scm_string_to_symbol (str : scm_bits) -> scm_bits {
crate::scm::string_to_symbol (str)
}
runtime/src/gc.rs
-34
View File
@@ -1,34 +0,0 @@
use libc::{c_void, size_t};
#[link(name = "gc", kind = "static")]
unsafe extern "C" {
// fn GC_allow_register_threads ();
// fn GC_alloc_lock ();
// fn GC_alloc_unlock ();
// fn GC_free (ptr: *mut c_void);
// fn GC_get_stack_base (stack_base: *mut GcStackBase) -> c_int;
// fn GC_init ();
fn GC_malloc (size: size_t) -> *mut c_void;
fn GC_realloc (ptr: *mut c_void, size: size_t) -> *mut c_void;
// fn GC_register_my_thread
// (stack_base: *const GcStackBase) -> c_int;
// fn GC_set_stackbottom
// (thread: *const c_void, stack_bottom: *const GcStackBase);
// fn GC_unregister_my_thread ();
// fn GC_gcollect ();
// fn GC_register_finalizer (
// ptr: *const c_void,
// finalizer: extern "C" fn (*mut c_void, *mut c_void),
// client_data: *const c_void,
// opt_old_finalizer: *const c_void,
// opt_old_client_data: *const c_void,
// ) -> *mut c_void;
}
pub unsafe fn malloc<T> (size: usize) -> *mut T {
unsafe { GC_malloc (size) as *mut T }
}
pub unsafe fn realloc<T> (ptr: *mut T, size: usize) -> *mut T {
unsafe { GC_realloc (ptr as *mut c_void, size) as *mut T }
}
runtime/src/lib.rs
-9
View File
@@ -1,9 +0,0 @@
#![allow(non_upper_case_globals)]
#![allow(non_camel_case_types)]
mod gc;
mod scm;
mod primitives;
// mod obarray;
mod capi;
mod var;
runtime/src/primitives.rs
-31
View File
@@ -1,31 +0,0 @@
use crate::scm;
use crate::scm::{scm_bits, SCM};
use std::io::{stdout, Write};
#[unsafe(no_mangle)]
pub extern "C" fn scm_write (x: scm_bits) -> scm_bits {
match scm::unpack (x) {
SCM::SmallInt (n) => print! ("{n}"),
SCM::Cons (car, cdr) => {
print! ("(");
scm_write (car);
print! (" . ");
scm_write (cdr);
print! (")");
},
SCM::String (s) => print! ("\"{s}\""),
SCM::Nil => print! ("()"),
SCM::False => print! ("#f"),
SCM::True => print! ("#t"),
SCM::Symbol (_s) => print! ("{x:#016x}"),
// SCM::Symbol (s) => print! ("{s}"),
};
let _ = stdout ().flush ();
return 0;
}
#[unsafe(no_mangle)]
pub extern "C" fn scm_newline () -> scm_bits {
print! ("\n");
0
}
runtime/src/scm.rs
-203
View File
@@ -1,203 +0,0 @@
#![allow(non_upper_case_globals)]
#![allow(non_camel_case_types)]
use std::slice;
use internment::Intern;
use crate::gc;
pub type scm_bits = u64;
pub const tc2_int : u64 = 2;
pub const tc3_cons : u64 = 0;
pub const tc7_obarray : u64 = 0x55;
pub const tc7_symbol : u64 = 0x05;
pub const tc7_string : u64 = 0x15;
// pub const scm_false : SCM = pack (0b00100);
// pub const scm_true : SCM = pack (0b01100);
// pub const scm_eol : SCM = pack (0b10100);
pub enum SCM {
SmallInt (i64),
Cons (scm_bits, scm_bits),
String (String),
Symbol (String),
Nil,
False,
True,
}
// #[inline(always)]
// pub fn pack (x : SCM) -> scm_bits {
// }
#[inline(always)]
pub fn unpack_string (x : scm_bits) -> String {
let len = unsafe { cell_word (x, 1) };
let str_beginning = (x as *const scm_bits).wrapping_add (2) as *const u8;
let slice = unsafe {
str::from_utf8 (
slice::from_raw_parts (
str_beginning,
len.try_into ().unwrap ()
)
).unwrap ()
};
String::from (slice)
}
// super duper important for this to inline. we want to eliminate the
// SCM type at runtime as much as possible. the hope is for inlining
// to lead to a case-of-case–esque transformation.
#[inline(always)]
pub fn unpack (x : scm_bits) -> SCM {
if is_small_int (x) {
SCM::SmallInt ((x >> 2) as i64)
} else if is_cons (x) {
// `car` x and `cdr` x are safe iff `is_cons` x.
unsafe { SCM::Cons (car (x), cdr (x)) }
} else if is_string (x) {
SCM::String (unpack_string (x))
} else if is_symbol (x) {
let s = unpack_string (unsafe { cell_word (x, 1) });
SCM::Symbol (s)
} else {
// concat_panic! ("don't know how to unpack: ", x)
panic! ("don't know how to unpack {x:#016x}")
}
}
const fn is_small_int (x: scm_bits) -> bool {
3 & x == tc2_int
}
const fn is_immediate (x: scm_bits) -> bool {
6 & x != 0
}
fn is_string (x: scm_bits) -> bool {
has_tc7 (x, tc7_string)
}
fn is_cons (x: scm_bits) -> bool {
// safety of `cell_type` is mutually exclusive with
// `is_immediate`, so this is okay.
unsafe {
! is_immediate (x) && (1 & cell_type (x)) == 0
}
}
fn is_symbol (x : scm_bits) -> bool {
has_tc7 (x, tc7_symbol)
}
fn has_tc7 (x: scm_bits, tc7: u64) -> bool {
unsafe {
! is_immediate (x) && (0x7f & cell_type (x)) == tc7
}
}
unsafe fn cell_type (x: scm_bits) -> scm_bits {
unsafe { cell_word (x, 0) }
}
unsafe fn cell_word (x: scm_bits, n: usize) -> scm_bits {
let p = x as *mut scm_bits;
unsafe {
*(p.wrapping_add (n))
}
}
unsafe fn car (x: scm_bits) -> scm_bits {
unsafe { cell_word (x, 0) }
}
unsafe fn cdr (x: scm_bits) -> scm_bits {
unsafe { cell_word (x, 1) }
}
pub unsafe fn words (tag : scm_bits, n : usize) -> *mut scm_bits {
let r = unsafe { gc::malloc (n * size_of::<scm_bits> ()) };
unsafe { *r = tag };
return r
}
pub fn pack_ptr (obj : *const scm_bits) -> scm_bits {
obj as scm_bits
}
pub unsafe fn set_word (obj : *mut scm_bits, ix : usize, val : scm_bits) {
let x = obj.wrapping_add (ix);
unsafe { *x = val; }
}
pub fn make_string_from_raw_parts (
ptr : *const u8,
len : usize
) -> scm_bits {
let bytes = unsafe { slice::from_raw_parts (ptr, len) };
make_string (str::from_utf8 (bytes).unwrap ())
}
pub fn make_string (s : &str) -> scm_bits {
let len = s.len ();
let size_of_tag_and_len = 2 * size_of::<scm_bits> ();
let size_of_contents = len;
let r = unsafe { gc::malloc (size_of_tag_and_len + size_of_contents) };
unsafe {
set_word (r, 0, tc7_string);
set_word (r, 1, len as u64);
}
let str_beginning = r.wrapping_add (2) as *mut u8;
for (i, b) in s.as_bytes ().iter ().enumerate () {
unsafe { *(str_beginning.wrapping_add (i)) = *b };
}
return pack_ptr (r)
}
// pub fn make_symbol (name : &str) -> scm_bits {
// let r = unsafe { words (tc7_symbol, 2) };
// let sym = obarray::symbols.intern (name).to_usize ();
// unsafe { set_word (r, 1, sym.try_into ().unwrap ()) };
// pack_ptr (r)
// }
struct Symbol ([scm_bits; 2]);
impl PartialEq for Symbol {
fn eq (&self, other: &Self) -> bool {
if let (SCM::String (s1), SCM::String (s2))
= (unpack (self.0[1]), unpack (other.0[1])) {
s1 == s2
} else {
panic! ("not a symbol")
}
}
}
impl Eq for Symbol {}
impl std::hash::Hash for Symbol {
fn hash <H: std::hash::Hasher> (&self, state: &mut H) {
if let SCM::String (s) = unpack (self.0[1]) {
s.hash (state)
} else {
panic! ("not a symbol")
}
}
}
fn make_symbol_off_heap (name : scm_bits) -> Symbol {
Symbol ([ tc7_symbol, name ])
}
pub fn string_to_symbol (str : scm_bits) -> scm_bits {
let r = Intern::new (make_symbol_off_heap (str));
pack_ptr (r.0.as_ptr ())
}
runtime/src/var.rs
-26
View File
@@ -1,26 +0,0 @@
use std::{collections::HashMap, ops::DerefMut as _, sync::{LazyLock, RwLock}};
use crate::scm::scm_bits;
struct Vars (
LazyLock <RwLock <HashMap <String, scm_bits>>>
);
impl Vars {
pub const fn new () -> Vars {
Vars (LazyLock::new (|| RwLock::new (HashMap::new ())))
}
pub fn lookup (&self, name : String) -> Option <scm_bits> {
// let r = self.0.write ().unwrap ();
// (*r).get (&name).map (|x| *x)
todo! ()
}
pub fn define (&self, name : String, value : scm_bits) {
// let mut r = self.0.write ().unwrap ();
// r.deref_mut ().insert (name, value);
todo! ()
}
}
static vars : Vars = Vars::new ();