diff --git a/app/Main.hs b/app/Main.hs index 6e331cb..ca6206e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -101,7 +101,7 @@ callGCC => FilePath -> List String -> Eff es FilePath callGCC f args = do let asm_file = f -<.> "s" - exe = dropExtension f + exe = f -<.> "out" C.StdoutTrimmed (T.words -> flags) <- C.run $ C.cmd "pkg-config" & C.addArgs @String ["--cflags", "--libs", "bdw-gc"] diff --git a/play/.gitignore b/play/.gitignore new file mode 100644 index 0000000..f35d769 --- /dev/null +++ b/play/.gitignore @@ -0,0 +1,4 @@ +*.anf +*.s +*.ssa +*.out \ No newline at end of file diff --git a/play/a.c b/play/a.c deleted file mode 100644 index e72a9b2..0000000 --- a/play/a.c +++ /dev/null @@ -1,21 +0,0 @@ -#include -#include - -#if (-1 >> 2 == -1) && (-4 >> 2 == -1) && (-5 >> 2 == -2) && (-8 >> 2 == -2) -# define SCM_SRS(x, y) ((x) >> (y)) -#else -# define SCM_SRS(x, y) \ - ((x) < 0 \ - ? -1 - (scm_t_signed_bits) (~(scm_t_bits)(x) >> (y)) \ - : ((x) >> (y))) -#endif - -int main () { - unsigned long mask = 0xfffffffffffffffe; - unsigned long x = (4 << 2) + 2; - unsigned long y = (2 << 2) + 2; - unsigned long z = ((x + y) >> 2) + 2; - printf ("BLAH: %d\n", BLAH); - printf ("%ld\n", sizeof(long)); - printf ("%lx\n", (long) z >> 2); -} diff --git a/play/a.out b/play/a.out deleted file mode 100755 index 48b5217..0000000 Binary files a/play/a.out and /dev/null differ diff --git a/play/hash b/play/hash deleted file mode 100755 index b9592f6..0000000 Binary files a/play/hash and /dev/null differ diff --git a/play/hash.c b/play/hash.c deleted file mode 100644 index 9c1d885..0000000 --- a/play/hash.c +++ /dev/null @@ -1,48 +0,0 @@ -#include -#include -#include "../runtime/gyehoek.h" -#include "../runtime/weak-set.h" - -static int -symbol_lookup_predicate_fn (SCM sym1, void *closure) { - const SCM sym2 = *((SCM*)closure); - const int symp1 = SCM_SYMBOLP (sym1); - const int symp2 = SCM_SYMBOLP (sym2); - // both symbols? - if (SCM_SYMBOLP (sym1) && SCM_SYMBOLP (sym2)) { - const SCM str1 = SCM_CELL_OBJECT (sym1, 2); - const SCM str2 = SCM_CELL_OBJECT (sym2, 2); - const size_t len1 = scm_c_string_length (str1); - const size_t len2 = scm_c_string_length (str2); - // same length? - if (len1 == len2) { - // same name? - const char * const s1 = scm_c_string_chars (str1); - const char * const s2 = scm_c_string_chars (str2); - return strncmp (s1, s2, len1); - } - } - return 0; -} - -SCM test (SCM set, const char *sym_name, SCM value) { - SCM str = scm_from_cstring (sym_name); - SCM sym = scm_make_symbol (str, scm_c_hash (str)); - SCM r = scm_c_weak_set_insert (set, scm_c_hash (str), value, - symbol_lookup_predicate_fn, - &sym); - printf ("%ld\n", weak_set_count (set)); - return r; -} - -int main () { - /* const char s[] = "wormy"; */ - /* const SCM str = scm_from_utf8_string (s, sizeof(s)); */ - /* const unsigned long hash = scm_c_hash (str); */ - /* printf ("%ld\n", hash); */ - - SCM set = scm_c_make_weak_set (31); - test (set, "my-symbol", SCM_PACK (SCM_MAKE_SMALL_INT (123))); - test (set, "my-symbol", SCM_PACK (SCM_MAKE_SMALL_INT (123))); - test (set, "my-symbol2", SCM_PACK (SCM_MAKE_SMALL_INT (456))); -} diff --git a/play/string b/play/string deleted file mode 100755 index 092ae8e..0000000 Binary files a/play/string and /dev/null differ diff --git a/play/string.anf b/play/string.anf deleted file mode 100644 index ebed362..0000000 --- a/play/string.anf +++ /dev/null @@ -1,4 +0,0 @@ -;;; -*- mode:scheme -*- - -(let ((x0 (prim:write "abc"))) x0) - diff --git a/play/string.s b/play/string.s deleted file mode 100644 index 4f9f709..0000000 --- a/play/string.s +++ /dev/null @@ -1,23 +0,0 @@ -.data -.balign 8 -.1: - .ascii "abc" -/* end data */ - -.text -.globl main -main: - pushq %rbp - movq %rsp, %rbp - movl $3, %esi - leaq .1(%rip), %rdi - callq scm_from_utf8_string - movq %rax, %rdi - callq scm_write - leave - ret -.type main, @function -.size main, .-main -/* end function main */ - -.section .note.GNU-stack,"",@progbits diff --git a/play/string.ssa b/play/string.ssa deleted file mode 100644 index 21c48d9..0000000 --- a/play/string.ssa +++ /dev/null @@ -1,10 +0,0 @@ - -data $.1 = -{b "abc"} -export -function w $main () { -@start - %.2 =l call $scm_from_utf8_string (l $.1, l 3) - %x0 =l call $scm_write (l %.2) - ret %x0 -} \ No newline at end of file diff --git a/play/t b/play/t deleted file mode 100755 index 5fcccbd..0000000 Binary files a/play/t and /dev/null differ diff --git a/play/t.anf b/play/t.anf deleted file mode 100644 index 8f81c6e..0000000 --- a/play/t.anf +++ /dev/null @@ -1,4 +0,0 @@ -;;; -*- mode:scheme -*- - -(let ((x0 (prim:cons 4 2)) (x1 (prim:write x0))) x1) - diff --git a/play/t.s b/play/t.s deleted file mode 100644 index 7ca6047..0000000 --- a/play/t.s +++ /dev/null @@ -1,18 +0,0 @@ -.text -.globl main -main: - pushq %rbp - movq %rsp, %rbp - movl $16, %edi - callq GC_malloc - movq %rax, %rdi - movq $18, (%rdi) - movq $10, 8(%rdi) - callq scm_write - leave - ret -.type main, @function -.size main, .-main -/* end function main */ - -.section .note.GNU-stack,"",@progbits diff --git a/play/t.ssa b/play/t.ssa deleted file mode 100644 index 3cc3c6c..0000000 --- a/play/t.ssa +++ /dev/null @@ -1,10 +0,0 @@ -export -function w $main () { -@start - %x0 =l call $GC_malloc (l 16) - %.2 =l add %x0, 8 - storel 18, %x0 - storel 10, %.2 - %x1 =l call $scm_write (l %x0) - ret %x1 -} \ No newline at end of file diff --git a/play/t.scm b/play/write-cons.scm similarity index 100% rename from play/t.scm rename to play/write-cons.scm diff --git a/play/wtf.s b/play/wtf.s deleted file mode 100644 index f5c3363..0000000 --- a/play/wtf.s +++ /dev/null @@ -1,31 +0,0 @@ -.data -.balign 8 -fstr: - .ascii "%s" - .byte 0 -/* end data */ - -.data -.balign 8 -str: - .ascii "안녕하세요" - .byte 0 -/* end data */ - -.text -.globl main -main: - pushq %rbp - movq %rsp, %rbp - leaq str(%rip), %rsi - leaq fstr(%rip), %rdi - movl $0, %eax - callq printf - movl $0, %eax - leave - ret -.type main, @function -.size main, .-main -/* end function main */ - -.section .note.GNU-stack,"",@progbits diff --git a/play/wtf.ssa b/play/wtf.ssa deleted file mode 100644 index 44fca0e..0000000 --- a/play/wtf.ssa +++ /dev/null @@ -1,8 +0,0 @@ -data $fstr = { b "%s", b 0 } -data $str = { b "안녕하세요", b 0 } - -export function w $main () { -@start - call $printf (l $fstr, ..., l $str) - ret 0 -} \ No newline at end of file diff --git a/runtime/Cargo.lock b/runtime/Cargo.lock index 6edff79..454c82b 100644 --- a/runtime/Cargo.lock +++ b/runtime/Cargo.lock @@ -30,6 +30,15 @@ dependencies = [ "cc", ] +[[package]] +name = "const_panic" +version = "0.2.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e262cdaac42494e3ae34c43969f9cdeb7da178bdb4b66fa6a1ea2edb4c8ae652" +dependencies = [ + "typewit", +] + [[package]] name = "find-msvc-tools" version = "0.1.9" @@ -41,6 +50,7 @@ name = "gyehoek" version = "0.1.0" dependencies = [ "bdwgc-alloc", + "const_panic", "libc", ] @@ -55,3 +65,9 @@ name = "shlex" version = "1.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" + +[[package]] +name = "typewit" +version = "1.15.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "214ca0b2191785cbc06209b9ca1861e048e39b5ba33574b3cedd58363d5bb5f6" diff --git a/runtime/Cargo.toml b/runtime/Cargo.toml index 930db0d..b87b264 100644 --- a/runtime/Cargo.toml +++ b/runtime/Cargo.toml @@ -12,6 +12,7 @@ crate-type = ["staticlib"] bdwgc-alloc = { version = "0.6.13" , default-features = false , features = ["cmake"] } +const_panic = "0.2.15" libc = "0.2.186" [patch.crates-io] diff --git a/runtime/src/gc.rs b/runtime/src/gc.rs index 6dbe407..d6c90a4 100644 --- a/runtime/src/gc.rs +++ b/runtime/src/gc.rs @@ -1,30 +1,34 @@ -use libc::{c_int, c_void, size_t}; +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_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_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; + // 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 (size: usize) -> *mut T { unsafe { GC_malloc (size) as *mut T } } + +pub unsafe fn realloc (ptr: *mut T, size: usize) -> *mut T { + unsafe { GC_realloc (ptr as *mut c_void, size) as *mut T } +} diff --git a/runtime/src/lib.rs b/runtime/src/lib.rs index a0a222e..656658b 100644 --- a/runtime/src/lib.rs +++ b/runtime/src/lib.rs @@ -3,128 +3,54 @@ use std::{io::{stdout, Write}}; mod gc; +mod scm; +use scm::{scm_bits, SCM}; // use crate::gc; // use bdwgc_alloc:Allocator; -pub const scm_tc2_int : u64 = 2; -pub const scm_tc3_cons : u64 = 0; -pub const scm_tc7_weak_set : u64 = 0x55; -pub const scm_tc7_symbol : u64 = 0x05; -pub const scm_tc7_string : u64 = 0x15; +// pub const scm_false : SCM = scm_pack (0b00100); +// pub const scm_true : SCM = scm_pack (0b01100); +// pub const scm_eol : SCM = scm_pack (0b10100); -pub const scm_false : SCM = scm_pack (0b00100); -pub const scm_true : SCM = scm_pack (0b01100); -pub const scm_eol : SCM = scm_pack (0b10100); +// #[unsafe(no_mangle)] +// pub extern "C" fn scm_write (x: SCM) -> SCM { +// if is_small_int (x) { +// print! ("{:?}", get_small_int (x)); +// } else if is_cons (x) { +// print! ("("); +// scm_write (scm_car (x)); +// print! (" . "); +// scm_write (scm_cdr (x)); +// print! (")"); +// } else { +// let ty = if is_immediate (x) { "immediate" } else { "heap object" }; +// print! ("#<{ty} {:#016x}>", scm_unpack (x)); +// } +// let _ = stdout ().flush (); +// return scm_pack (0); +// } - -pub type scm_bits = u64; - -#[repr(C)] -#[derive(Clone, Copy)] -pub struct SCM { - n : scm_bits -} - -const fn scm_pack (bits : scm_bits) -> SCM { - SCM {n: bits} -} - -fn scm_unpack (x : SCM) -> scm_bits { - x.n -} - -fn scm_unpack_pointer (x : SCM) -> *mut scm_bits { - x.n as *mut scm_bits -} - -fn scm_pack_pointer (x : *const scm_bits) -> SCM { - SCM {n: x as scm_bits} -} - - - -fn scm_words (ty: scm_bits, n: usize) -> SCM { - unsafe { - let r = gc::malloc (n * size_of:: ()) as *mut scm_bits; - *r = ty; - return scm_pack_pointer (r); - } -} - -fn scm_cell_object (x: SCM, n: usize) -> SCM { - let p = scm_unpack_pointer (x) as *mut SCM; - unsafe { - *(p.wrapping_add (n)) - } -} - -fn scm_cell_word (x: SCM, n: usize) -> scm_bits { - scm_unpack (scm_cell_object (x, n)) -} - -fn is_immediate (x: SCM) -> bool { - 6 & scm_unpack (x) != 0 -} - -fn scm_cell_type (x: SCM) -> scm_bits { - scm_cell_word (x, 0) -} - -fn is_cons (x: SCM) -> bool { - ! is_immediate (x) && (1 & scm_cell_type (x)) == 0 -} - -fn is_small_int (x: SCM) -> bool { - 3 & scm_unpack (x) == scm_tc2_int -} - -fn get_small_int (x: SCM) -> scm_bits { - scm_unpack (x) >> 2 -} - -fn scm_car (x: SCM) -> SCM { - scm_cell_object (x, 0) -} - -fn scm_cdr (x: SCM) -> SCM { - scm_cell_object (x, 1) -} +// #[unsafe(no_mangle)] +// pub extern "C" fn scm_from_utf8 (s: *const u8, len: usize) -> SCM { +// let r = scm_words (scm_tc7_string, 3); +// return scm_pack (0); +// } #[unsafe(no_mangle)] -pub extern "C" fn scm_write (x: SCM) -> SCM { - if is_small_int (x) { - print! ("{:?}", get_small_int (x)); - } else if is_cons (x) { - print! ("("); - scm_write (scm_car (x)); - print! (" . "); - scm_write (scm_cdr (x)); - print! (")"); - } else { - let ty = if is_immediate (x) { "immediate" } else { "heap object" }; - print! ("#<{ty} {:#016x}>", scm_unpack (x)); - } +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::Nil => print! ("()"), + SCM::False => print! ("#f"), + SCM::True => print! ("#t"), + }; let _ = stdout ().flush (); - return scm_pack (0); -} - -#[unsafe(no_mangle)] -pub extern "C" fn scm_from_utf8 (s: *const u8, len: usize) -> SCM { - let r = scm_words (scm_tc7_string, 3); - return scm_pack (0); -} - -pub fn add (left: u64, right: u64) -> u64 { - left + right -} - -#[cfg(test)] -mod tests { - use super::*; - - #[test] - fn it_works () { - let result = add (2, 2); - assert_eq! (result, 4); - } + return 0; } diff --git a/runtime/src/scm.rs b/runtime/src/scm.rs new file mode 100644 index 0000000..d188738 --- /dev/null +++ b/runtime/src/scm.rs @@ -0,0 +1,101 @@ +#![allow(non_upper_case_globals)] +#![allow(non_camel_case_types)] + +// use const_panic::concat_panic; + +pub type scm_bits = u64; + +// #[repr(C)] +// #[derive(Clone, Copy)] +// pub struct SCM { +// n : bits +// } + +// const fn pack (bits : scm_bits) -> SCM { +// SCM {n: scm_bits} +// } + +// const fn unpack (x : SCM) -> scm_bits { +// x.n +// } + +// const fn unpack_pointer (x : SCM) -> *mut scm_bits { +// x.n as *mut scm_bits +// } + +// fn pack_pointer (x : *const scm_bits) -> SCM { +// SCM {n: x as scm_bits} +// } + +pub const tc2_int : u64 = 2; +pub const tc3_cons : u64 = 0; +pub const tc7_weak_set : 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), + Nil, + False, + True, +} + +// #[inline(always)] +// pub fn pack (x : SCM) -> scm_bits { +// } + +// 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 { + // 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_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 + } +} + +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) } +}