diff --git a/.vs/launch.vs.json b/.vs/launch.vs.json index af32f0bed6..deec64e337 100644 --- a/.vs/launch.vs.json +++ b/.vs/launch.vs.json @@ -9,11 +9,7 @@ "name": "Run Tests - Summary", "args": [ "--gtest_brief=1" - ], - "env": { - "NEXT_DIR": "${projectDir}", - "FAKE_ISO_PATH": "/game/fake_iso.txt" - } + ] }, { "type": "default", @@ -22,17 +18,28 @@ "name": "Run Tests - Verbose", "args": [ "--gtest_brief=0" - ], - "env": { - "NEXT_DIR": "${projectDir}", - "FAKE_ISO_PATH": "/game/fake_iso.txt" - } + ] }, { "type": "default", "project": "CMakeLists.txt", "projectTarget": "gk.exe (bin\\gk.exe)", - "name": "Run Game" + "name": "Run Runtime (no kernel)", + "args": [ + "-fakeiso", + "-debug", + "-nokernel" + ] + }, + { + "type": "default", + "project": "CMakeLists.txt", + "projectTarget": "gk.exe (bin\\gk.exe)", + "name": "Run Runtime (with kernel)", + "args": [ + "-fakeiso", + "-debug" + ] }, { "type": "default", diff --git a/boot_kernel.sh b/boot_kernel.sh new file mode 100755 index 0000000000..7cd250cb20 --- /dev/null +++ b/boot_kernel.sh @@ -0,0 +1,6 @@ +#!/bin/bash + +# Directory of this script +DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )" + +$DIR/build/game/gk -fakeiso -debug diff --git a/common/goos/CMakeLists.txt b/common/goos/CMakeLists.txt index 170c8df0d8..4347c0d3a1 100644 --- a/common/goos/CMakeLists.txt +++ b/common/goos/CMakeLists.txt @@ -1,2 +1,2 @@ add_library(goos SHARED Object.cpp TextDB.cpp Reader.cpp Interpreter.cpp InterpreterEval.cpp) -target_link_libraries(goos common_util) \ No newline at end of file +target_link_libraries(goos common_util fmt) \ No newline at end of file diff --git a/common/goos/Interpreter.cpp b/common/goos/Interpreter.cpp index 3c3eb8569e..8833619530 100644 --- a/common/goos/Interpreter.cpp +++ b/common/goos/Interpreter.cpp @@ -38,36 +38,36 @@ Interpreter::Interpreter() { {"while", &Interpreter::eval_while}, }; - builtin_forms = { - {"top-level", &Interpreter::eval_begin}, - {"begin", &Interpreter::eval_begin}, - {"exit", &Interpreter::eval_exit}, - {"read", &Interpreter::eval_read}, - {"read-file", &Interpreter::eval_read_file}, - {"print", &Interpreter::eval_print}, - {"inspect", &Interpreter::eval_inspect}, - {"load-file", &Interpreter::eval_load_file}, - {"eq?", &Interpreter::eval_equals}, - {"gensym", &Interpreter::eval_gensym}, - {"eval", &Interpreter::eval_eval}, - {"cons", &Interpreter::eval_cons}, - {"car", &Interpreter::eval_car}, - {"cdr", &Interpreter::eval_cdr}, - {"set-car!", &Interpreter::eval_set_car}, - {"set-cdr!", &Interpreter::eval_set_cdr}, - {"+", &Interpreter::eval_plus}, - {"-", &Interpreter::eval_minus}, - {"*", &Interpreter::eval_times}, - {"/", &Interpreter::eval_divide}, - {"=", &Interpreter::eval_numequals}, - {"<", &Interpreter::eval_lt}, - {">", &Interpreter::eval_gt}, - {"<=", &Interpreter::eval_leq}, - {">=", &Interpreter::eval_geq}, - {"null?", &Interpreter::eval_null}, - {"type?", &Interpreter::eval_type}, - {"current-method-type", &Interpreter::eval_current_method_type}, - }; + builtin_forms = {{"top-level", &Interpreter::eval_begin}, + {"begin", &Interpreter::eval_begin}, + {"exit", &Interpreter::eval_exit}, + {"read", &Interpreter::eval_read}, + {"read-file", &Interpreter::eval_read_file}, + {"print", &Interpreter::eval_print}, + {"inspect", &Interpreter::eval_inspect}, + {"load-file", &Interpreter::eval_load_file}, + {"eq?", &Interpreter::eval_equals}, + {"gensym", &Interpreter::eval_gensym}, + {"eval", &Interpreter::eval_eval}, + {"cons", &Interpreter::eval_cons}, + {"car", &Interpreter::eval_car}, + {"cdr", &Interpreter::eval_cdr}, + {"set-car!", &Interpreter::eval_set_car}, + {"set-cdr!", &Interpreter::eval_set_cdr}, + {"+", &Interpreter::eval_plus}, + {"-", &Interpreter::eval_minus}, + {"*", &Interpreter::eval_times}, + {"/", &Interpreter::eval_divide}, + {"=", &Interpreter::eval_numequals}, + {"<", &Interpreter::eval_lt}, + {">", &Interpreter::eval_gt}, + {"<=", &Interpreter::eval_leq}, + {">=", &Interpreter::eval_geq}, + {"null?", &Interpreter::eval_null}, + {"type?", &Interpreter::eval_type}, + {"current-method-type", &Interpreter::eval_current_method_type}, + {"fmt", &Interpreter::eval_format}, + {"error", &Interpreter::eval_error}}; string_to_type = {{"empty-list", ObjectType::EMPTY_LIST}, {"integer", ObjectType::INTEGER}, diff --git a/common/goos/Interpreter.h b/common/goos/Interpreter.h index 6a643ce584..52eed89c23 100644 --- a/common/goos/Interpreter.h +++ b/common/goos/Interpreter.h @@ -180,6 +180,12 @@ class Interpreter { Object eval_current_method_type(const Object& form, Arguments& args, const std::shared_ptr& env); + Object eval_format(const Object& form, + Arguments& args, + const std::shared_ptr& env); + Object eval_error(const Object& form, + Arguments& args, + const std::shared_ptr& env); // specials Object eval_define(const Object& form, diff --git a/common/goos/InterpreterEval.cpp b/common/goos/InterpreterEval.cpp index bd3e8eac47..226bda29a5 100644 --- a/common/goos/InterpreterEval.cpp +++ b/common/goos/InterpreterEval.cpp @@ -3,6 +3,7 @@ * Implementation of built-in GOOS functions. */ +#include #include "Interpreter.h" namespace goos { @@ -586,4 +587,54 @@ Object Interpreter::eval_current_method_type(const Object& form, vararg_check(form, args, {}, {}); return SymbolObject::make_new(reader.symbolTable, goal_to_goos.enclosing_method_type); } + +Object Interpreter::eval_format(const Object& form, + Arguments& args, + const std::shared_ptr& env) { + (void)env; + if (args.unnamed.size() < 2) { + throw_eval_error(form, "format must get at least two arguments"); + } + + auto dest = args.unnamed.at(0); + auto format_str = args.unnamed.at(1); + if (!format_str.is_string()) { + throw_eval_error(form, "format string must be a string"); + } + + // Note: this might be relying on internal implementation details of libfmt to work properly + // and isn't a great solution. + std::vector> args2; + std::vector strings; + for (size_t i = 2; i < args.unnamed.size(); i++) { + if (args.unnamed.at(i).is_string()) { + strings.push_back(args.unnamed.at(i).as_string()->data); + } else { + strings.push_back(args.unnamed.at(i).print()); + } + } + + for (auto& x : strings) { + args2.push_back(fmt::detail::make_arg(x)); + } + + auto formatted = + fmt::vformat(format_str.as_string()->data, + fmt::format_args(args2.data(), static_cast(args2.size()))); + + if (truthy(dest)) { + printf("%s", formatted.c_str()); + } + + return StringObject::make_new(formatted); +} + +Object Interpreter::eval_error(const Object& form, + Arguments& args, + const std::shared_ptr& env) { + (void)env; + vararg_check(form, args, {ObjectType::STRING}, {}); + throw_eval_error(form, "Error: " + args.unnamed.at(0).as_string()->data); + return EmptyListObject::make_new(); +} } // namespace goos \ No newline at end of file diff --git a/common/type_system/TypeSystem.cpp b/common/type_system/TypeSystem.cpp index 9daa0eea52..0d1f4a93a1 100644 --- a/common/type_system/TypeSystem.cpp +++ b/common/type_system/TypeSystem.cpp @@ -577,7 +577,7 @@ void TypeSystem::add_builtin_types() { // Methods and Fields // OBJECT - add_method(obj_type, "new", make_function_typespec({"symbol", "type", "int32"}, "_type_")); + add_method(obj_type, "new", make_function_typespec({"symbol", "type", "int"}, "_type_")); add_method(obj_type, "delete", make_function_typespec({"_type_"}, "none")); add_method(obj_type, "print", make_function_typespec({"_type_"}, "_type_")); add_method(obj_type, "inspect", make_function_typespec({"_type_"}, "_type_")); diff --git a/common/versions.h b/common/versions.h index a3098572a9..5534a7d15e 100644 --- a/common/versions.h +++ b/common/versions.h @@ -12,8 +12,8 @@ namespace versions { // language version -constexpr s32 GOAL_VERSION_MAJOR = 2; -constexpr s32 GOAL_VERSION_MINOR = 6; +constexpr s32 GOAL_VERSION_MAJOR = 0; +constexpr s32 GOAL_VERSION_MINOR = 1; } // namespace versions // GOAL kernel version diff --git a/doc/changelog.md b/doc/changelog.md new file mode 100644 index 0000000000..d48f86c0a0 --- /dev/null +++ b/doc/changelog.md @@ -0,0 +1,21 @@ +# Language Changes + +## V0.1 +- The GOAL language version has been set to 0.1 +- Calling a function with unknown argument/return types is now an error instead of a warning +- Getting a method of an object or type with `method` returns the correct type for methods using the `_type_` feature +- The `object-new` macro will now type check arguments +- The size argument to `(method object new)` is now an `int` instead of `int32` +- Using `set!` incorrectly, like `(set! 1 2)` will now create an error instead of having no effect +- GOOS now has a `fmt` form which wraps `libfmt` for doing string formatting. +- GOOS now has an `error` form for throwing an error with a string to describe it +- GOAL `if` now throws errors on extra arguments instead of silently ignoring them +- The first 1 MB of GOAL memory now cannot be read/written/executed so dereferencing a GOAL null pointer will now segfault +- The runtime now accepts command line boot arguments +- The runtime now defaults to loading `KERNEL.CGO` and using its `kernel-dispatcher` function. +- The runtime now accepts a `-nokernel` parameter for running without `KERNEL.CGO`. +- The runtime will now refuse to load object files from another major GOAL version +- Using `&+` and `&+!` now produces a pointer with the same type as the original. +- There is a `&-` which returns a `uint` and works with basically any input types +- The `&` operator works on fields and elements in arrays +- The `&->` operator has been added \ No newline at end of file diff --git a/game/kernel/kboot.cpp b/game/kernel/kboot.cpp index da41b01289..ace3785582 100644 --- a/game/kernel/kboot.cpp +++ b/game/kernel/kboot.cpp @@ -47,12 +47,15 @@ u32 DebugSegment; // Set to 1 to load game engine after boot automatically u32 DiskBoot; +u32 MasterUseKernel; + void kboot_init_globals() { strcpy(DebugBootLevel, "#f"); // no specified level strcpy(DebugBootMessage, "play"); // play mode, the default retail mode MasterExit = 0; MasterDebug = 1; + MasterUseKernel = 1; DebugSegment = 1; DiskBoot = 0; memset(&masterConfig, 0, sizeof(MasterConfig)); @@ -117,6 +120,9 @@ s32 goal_main(int argc, const char* const* argv) { if (InitMachine() >= 0) { // init kernel KernelCheckAndDispatch(); // run kernel ShutdownMachine(); // kernel died, we should too. + } else { + fprintf(stderr, "InitMachine failed\n"); + exit(1); } return 0; diff --git a/game/kernel/kboot.h b/game/kernel/kboot.h index e9ac165d55..8b08905246 100644 --- a/game/kernel/kboot.h +++ b/game/kernel/kboot.h @@ -75,6 +75,6 @@ void KernelCheckAndDispatch(); */ void KernelShutdown(); -constexpr bool MasterUseKernel = false; +extern u32 MasterUseKernel; #endif // RUNTIME_KBOOT_H diff --git a/game/kernel/klink.cpp b/game/kernel/klink.cpp index 5978131404..1014f7ed3d 100644 --- a/game/kernel/klink.cpp +++ b/game/kernel/klink.cpp @@ -8,6 +8,7 @@ #include #include +#include #include "klink.h" #include "fileio.h" #include "kscheme.h" @@ -67,6 +68,14 @@ void link_control::begin(Ptr object_file, m_segment_process = 0; ObjectFileHeader* ofh = m_link_block_ptr.cast().c(); + if (ofh->goal_version_major != versions::GOAL_VERSION_MAJOR) { + fprintf( + stderr, + "VERSION ERROR: C Kernel built from GOAL %d.%d, but object file %s is from GOAL %d.%d\n", + versions::GOAL_VERSION_MAJOR, versions::GOAL_VERSION_MINOR, name, ofh->goal_version_major, + ofh->goal_version_minor); + exit(0); + } if (link_debug_printfs) { printf("Object file header:\n"); printf(" GOAL ver %d.%d obj %d len %d\n", ofh->goal_version_major, ofh->goal_version_minor, diff --git a/game/kernel/kmachine.cpp b/game/kernel/kmachine.cpp index f5b611b364..20161fd686 100644 --- a/game/kernel/kmachine.cpp +++ b/game/kernel/kmachine.cpp @@ -94,6 +94,12 @@ void InitParms(int argc, const char* const* argv) { reboot = 0; } + // an added mode to allow booting without a KERNEL.CGO for testing + if (arg == "-nokernel") { + Msg(6, "dkernel: no kernel mode\n"); + MasterUseKernel = false; + } + // GOAL Settings // ---------------------------- diff --git a/game/runtime.cpp b/game/runtime.cpp index bb0c7b84dc..a86cb0c134 100644 --- a/game/runtime.cpp +++ b/game/runtime.cpp @@ -49,6 +49,9 @@ u8* g_ee_main_mem = nullptr; namespace { +int g_argc = 0; +char** g_argv = nullptr; + /*! * SystemThread function for running the DECI2 communication with the GOAL compiler. */ @@ -98,10 +101,6 @@ constexpr u64 EE_MAIN_MEM_MAP = 0x2000000000; // intentionally > 32-bit to // so this should be used only for debugging. constexpr bool EE_MEM_LOW_MAP = false; -// GOAL Boot arguments -constexpr const char* GOAL_ARGV[] = {"", "-fakeiso", "-boot", "-debug"}; -constexpr int GOAL_ARGC = 4; - /*! * SystemThread Function for the EE (PS2 Main CPU) */ @@ -132,6 +131,11 @@ void ee_runner(SystemThreadInterface& iface) { printf("[EE] Run!\n"); memset((void*)g_ee_main_mem, 0, EE_MAIN_MEM_SIZE); + + // prevent access to the first 1 MB of memory. + // On the PS2 this is the kernel and can't be accessed either. + // this may not work well on systems with a page size > 1 MB. + mprotect((void*)g_ee_main_mem, 1024 * 1024, PROT_NONE); fileio_init_globals(); kboot_init_globals(); kdgo_init_globals(); @@ -146,7 +150,7 @@ void ee_runner(SystemThreadInterface& iface) { kmemcard_init_globals(); kprint_init_globals(); - goal_main(GOAL_ARGC, GOAL_ARGV); + goal_main(g_argc, g_argv); printf("[EE] Done!\n"); // // kill the IOP todo @@ -224,8 +228,8 @@ void iop_runner(SystemThreadInterface& iface) { * Arguments are currently ignored. */ u32 exec_runtime(int argc, char** argv) { - (void)argc; - (void)argv; + g_argc = argc; + g_argv = argv; // step 1: sce library prep iop::LIBRARY_INIT(); diff --git a/gk.sh b/gk.sh index d103729b8f..e80d3fb5f4 100755 --- a/gk.sh +++ b/gk.sh @@ -3,4 +3,4 @@ # Directory of this script DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" >/dev/null 2>&1 && pwd )" -$DIR/build/game/gk "$@" +$DIR/build/game/gk -fakeiso -debug -nokernel diff --git a/goal_src/goal-lib.gc b/goal_src/goal-lib.gc index db170bc6bc..9003837d4a 100644 --- a/goal_src/goal-lib.gc +++ b/goal_src/goal-lib.gc @@ -191,8 +191,11 @@ `(set! ,place (+ ,place ,amount)) ) -;; todo, handle too many arguments correct (defmacro if (condition true-case &rest others) + (if (> (length others) 1) + (error "got too many arguments to if") + #f + ) (if (null? others) `(cond (,condition ,true-case)) `(cond (,condition ,true-case) @@ -289,6 +292,18 @@ `(eq? ,thing 0) ) +(defmacro &+! (val amount) + `(set! ,val (&+ ,val ,amount)) + ) + +(defmacro &- (a b) + `(- (the-as uint ,a) (the-as uint ,b)) + ) + +(defmacro &-> (&rest args) + `(& (-> ,@args)) + ) + ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Bit Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -296,21 +311,6 @@ `(logand #xfffffff0 (+ (the-as integer ,value) 15)) ) -(defmacro &+ (v1 &rest args) - (if (null? args) - `(the pointer ,v1) - `(&+ (+ (the-as int ,v1) (the-as int ,(first args))) ,@(cdr args)) - ) - ) - -(defmacro &- (v1 v2) - `(the pointer (- (the-as int ,v1) (the-as int ,v2))) - ) - -(defmacro &+! (v1 v2) - `(set! ,v1 (&+ ,v1 ,v2)) - ) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; TYPE STUFF @@ -368,8 +368,8 @@ (defmacro object-new (&rest sz) (if (null? sz) - `(the ,(current-method-type) ((-> object method-table 0) allocation type-to-make (-> type-to-make asize))) - `(the ,(current-method-type) ((-> object method-table 0) allocation type-to-make ,@sz)) + `(the ,(current-method-type) ((method object new) allocation type-to-make (the int (-> type-to-make size)))) + `(the ,(current-method-type)((method object new) allocation type-to-make ,@sz)) ) ) diff --git a/goal_src/kernel-defs.gc b/goal_src/kernel-defs.gc index bcf2b123fb..9a182a9a9b 100644 --- a/goal_src/kernel-defs.gc +++ b/goal_src/kernel-defs.gc @@ -101,7 +101,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; *listener-link-block* -;; *listener-function* +(define-extern *listener-function* (function object)) ;; kernel-dispatcher ;; kernel-packages ;; *print-column* diff --git a/goal_src/kernel/gcommon.gc b/goal_src/kernel/gcommon.gc index 8a8fdf6226..5a3e90117e 100644 --- a/goal_src/kernel/gcommon.gc +++ b/goal_src/kernel/gcommon.gc @@ -582,7 +582,7 @@ "Create a new inline-array. Sets the length, allocated-length to cnt. Uses the mysterious heap-base field of the type-to-make to determine the element size" (let* ((sz (+ (-> type-to-make size) (* (-> type-to-make heap-base) cnt))) - (new-object (object-new sz))) + (new-object (object-new (the int sz)))) ;;(format 0 "create sz ~d at #x~X~%" sz new-object) (unless (zero? new-object) (set! (-> new-object length) cnt) diff --git a/goal_src/kernel/gkernel-h.gc b/goal_src/kernel/gkernel-h.gc index f6be879969..65050e91ea 100644 --- a/goal_src/kernel/gkernel-h.gc +++ b/goal_src/kernel/gkernel-h.gc @@ -5,3 +5,5 @@ ;; name in dgo: gkernel-h ;; dgos: KERNEL +(defglobalconstant *kernel-major-version* 2) +(defglobalconstant *kernel-minor-version* 0) \ No newline at end of file diff --git a/goal_src/kernel/gkernel.gc b/goal_src/kernel/gkernel.gc index b65c8a9bc6..f3aa580851 100644 --- a/goal_src/kernel/gkernel.gc +++ b/goal_src/kernel/gkernel.gc @@ -5,3 +5,23 @@ ;; name in dgo: gkernel ;; dgos: KERNEL +(define *kernel-version* (the binteger (logior (ash *kernel-major-version* 16) *kernel-minor-version*))) + +(defun kernel-dispatcher () + "Kernel Dispatcher Function. This gets called from the main loop in kboot.cpp's KernelCheckAndDispatch" + + ;; check if we have a new listener function to run + (when *listener-function* + ;; we do! enable method-set for debug purposes + (+! *enable-method-set* 1) + + ;; execute and print result + (let ((result (*listener-function*))) + (format #t "~D~%" result) + ) + (+! *enable-method-set* -1) + + ;; clear the pending function. + (set! *listener-function* (the (function object) #f)) + ) + ) \ No newline at end of file diff --git a/goal_src/kernel/gstring.gc b/goal_src/kernel/gstring.gc index d79a95dbf3..2c2f0a8e44 100644 --- a/goal_src/kernel/gstring.gc +++ b/goal_src/kernel/gstring.gc @@ -5,3 +5,56 @@ ;; name in dgo: gstring ;; dgos: KERNEL +;; Note on strings: +;; the allocated length does not include an extra byte on the end for the null terminator! + +(defmethod length string ((obj string)) + ; Get the length of a string. Like strlen + (let ((str-ptr (-> obj data))) + (while (!= 0 (-> str-ptr 0)) + (set! str-ptr (the (pointer uint8) (&+ str-ptr 1))) + ) + (- (the int str-ptr) (the int (-> obj data))) + ) + ) + +(defmethod asize-of string ((obj string)) + ;; get the size in bytes of a string. + ;; BUG - string should probably be (-> obj type), not that it matters, I don't think + ;; anybody makes a subclass of string. + (+ (-> obj allocated-length) 1 (-> string size)) + ) + +(defun copy-string<-string ((dst string) (src string)) + "Copy data from one string to another, like strcpy" + (let ((dst-ptr (-> dst data)) + (src-ptr (-> src data)) + ) + (while (!= 0 (-> src-ptr)) + (set! (-> dst-ptr) (-> src-ptr)) + (&+! dst-ptr 1) + (&+! src-ptr 1) + ) + ) + ) + +(defmethod new string ((allocation symbol) (type-to-make type) (size int) (other string)) + "Create a new string of the given size. If other is not #f, copy data from it." + (cond + (other + (let* ((desired-size (max (length other) size)) + (new-obj (object-new (+ desired-size 1 (-> type-to-make size)))) + ) + (set! (-> new-obj allocated-length) size) + (copy-string<-string new-obj other) + new-obj + ) + ) + (else + (let ((new-obj (object-new (+ 1 size (-> type-to-make size))))) + (set! (-> new-obj allocated-length) size) + new-obj + ) + ) + ) + ) \ No newline at end of file diff --git a/goal_src/test/test-access-inline-array.gc b/goal_src/test/test-access-inline-array.gc index 156fd3c06c..16cc8641b9 100644 --- a/goal_src/test/test-access-inline-array.gc +++ b/goal_src/test/test-access-inline-array.gc @@ -1,6 +1,5 @@ -(let* ((new-method (-> bfloat method-table 0)) - (print-method (-> bfloat method-table 2)) - (my-float (the bfloat (new-method 'global bfloat))) +(let* ((print-method (method bfloat print)) + (my-float (new 'global 'bfloat)) ) (set! (-> my-float data) 1.23456) (print-method my-float) diff --git a/goal_src/test/test-addr-of.gc b/goal_src/test/test-addr-of.gc new file mode 100644 index 0000000000..a26ffa4b45 --- /dev/null +++ b/goal_src/test/test-addr-of.gc @@ -0,0 +1,15 @@ + +(start-test "addr-of") +(deftype addr-of-test-type (basic) + ((v1 int32 :offset-assert 4) + (arr int32 12 :offset-assert 8) + (end uint8 :offset-assert 56) + ) + ) + +(let ((temp (new 'global 'addr-of-test-type))) + (expect-true (= 8 (&- (&-> temp arr 1) temp))) + (expect-true (= 0 (&- (&-> temp v1) temp))) + ) + +(finish-test) \ No newline at end of file diff --git a/goal_src/test/test-basic-type-check.gc b/goal_src/test/test-basic-type-check.gc index 91e5e23af8..9c06f84de6 100644 --- a/goal_src/test/test-basic-type-check.gc +++ b/goal_src/test/test-basic-type-check.gc @@ -1,6 +1,4 @@ -(define-extern hack-bfloat integer) -(define hack-bfloat (+ #x6000000 4)) -(define-extern hack-bfloat bfloat) +(define hack-bfloat (new 'global 'bfloat)) (format #t "~A~A~A~A" diff --git a/goal_src/test/test-bfloat.gc b/goal_src/test/test-bfloat.gc index 1ed4da74a1..5ba4f8c02f 100644 --- a/goal_src/test/test-bfloat.gc +++ b/goal_src/test/test-bfloat.gc @@ -1,7 +1,4 @@ -;; awful hack to create a bfloat -(define-extern hack-bfloat integer) -(define hack-bfloat (+ #x6000000 4)) -(define-extern hack-bfloat bfloat) +(define hack-bfloat (new 'global 'bfloat)) (set! (-> hack-bfloat type) bfloat) (set! (-> hack-bfloat data) 1.233) diff --git a/goal_src/test/test-dynamic-type.gc b/goal_src/test/test-dynamic-type.gc index 1a12d52439..f0a13aa1c5 100644 --- a/goal_src/test/test-dynamic-type.gc +++ b/goal_src/test/test-dynamic-type.gc @@ -15,7 +15,7 @@ ;"Create a new inline-array. Sets the length, allocated-length to cnt. Uses the mysterious heap-base field ;of the type-to-make to determine the element size" (let* ((sz (+ (-> type-to-make size) (* 4 cnt))) - (new-object (object-new sz))) + (new-object (object-new (the int sz)))) ;;(format 0 "create sz ~d at #x~X~%" sz new-object) (unless (zero? new-object) (set! (-> new-object allocated-length) cnt) @@ -39,7 +39,7 @@ ) (define test-dynamic-obj - (the test-dynamic-type ((-> test-dynamic-type method-table 0) 'global test-dynamic-type 40))) + (the test-dynamic-type (new 'global 'test-dynamic-type 40))) ; ;(define test-dynamic-obj (new 'global 'test-dynamic-type 40)) diff --git a/goal_src/test/test-new-string.gc b/goal_src/test/test-new-string.gc new file mode 100644 index 0000000000..fc0e3bed9a --- /dev/null +++ b/goal_src/test/test-new-string.gc @@ -0,0 +1,12 @@ +(start-test "new-string") + +(let ((new-string (new 'global 'string 17 "alligator"))) + (expect-true (= 17 (-> new-string allocated-length))) + (expect-true (= 9 (length new-string))) + + (expect-true (= #x61 (-> new-string data 0))) ;; a + (expect-true (= #x72 (-> new-string data 8))) ;; r + (expect-true (= #x00 (-> new-string data 9))) ;; \0 + ) + +(finish-test) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-set-self.gc b/goal_src/test/test-set-self.gc similarity index 69% rename from test/old_goal_tests/tests/test-set-self.gc rename to goal_src/test/test-set-self.gc index 708e4b3b11..f5d64b690a 100644 --- a/test/old_goal_tests/tests/test-set-self.gc +++ b/goal_src/test/test-set-self.gc @@ -1,20 +1,17 @@ -(test-setup 12 #f) - (deftype self-test-type (basic) - ((self self-test-type)) + ((self basic)) ) (defmethod new self-test-type ((allocation symbol) (type-to-make type)) (let ((obj (object-new))) ;; here the register of obj is used both as a "real" pointer and a GOAL pointer in the same instruction. - ;; this is a special case in the emitter. + ;; this was a tricky thing to get right in the old compiler, so its worth testing. (set! (-> obj self) obj) obj ) ) (let ((temp (new 'global 'self-test-type))) - (expect-true (eq? temp (-> temp self))) + (format #t "~A~%" (eq? temp (-> temp self))) ) - -12 \ No newline at end of file +0 \ No newline at end of file diff --git a/goal_src/test/test-string-type.gc b/goal_src/test/test-string-type.gc new file mode 100644 index 0000000000..3161186a23 --- /dev/null +++ b/goal_src/test/test-string-type.gc @@ -0,0 +1,17 @@ +(start-test "string-type") +; (db) +(expect-true (= 101 (-> "test" data 1))) +(expect-true (= 4 (-> "test" allocated-length))) +(expect-true (= 13 (asize-of "test"))) +(let ((temp "test")) + ; (format #t "before: ~D ~D~%" (-> temp data 1) (-> temp data 2)) + (set! (-> temp data 1) 102) + ;(format #t "after: ~D ~D~%" (-> temp data 1) (-> temp data 2)) + ; (print-type (-> temp data 1)) + (set! (-> temp data 3) 0) + ; (format #t "length is ~D~%" (length temp)) + ; (inspect temp) + (expect-true (= 3 (length temp))) + ) + +(finish-test) \ No newline at end of file diff --git a/goal_src/test/test-type-arrays.gc b/goal_src/test/test-type-arrays.gc index 51513fc1de..f2ba05b7e9 100644 --- a/goal_src/test/test-type-arrays.gc +++ b/goal_src/test/test-type-arrays.gc @@ -1,10 +1,5 @@ (start-test "test-type-arrays") - -(defmacro new-type-hack (type-name) - `(the ,type-name ((-> ,type-name method-table 0) 'global ,type-name)) - ) - (deftype basic-type (basic) ( (flt float) @@ -21,7 +16,7 @@ ) ) -(let ((obj-test (new-type-hack struct-type))) +(let ((obj-test (new 'global 'struct-type))) ;(inspect obj-test) (set! (-> obj-test dec) #x00f0f0f0) (set! (-> obj-test flt) 123.456) @@ -41,8 +36,8 @@ ) -(let ((obj000 (new-type-hack type000)) - (bo (new-type-hack basic-type)) +(let ((obj000 (new 'global 'type000)) + (bo (new 'global 'basic-type)) ) (set! (-> obj000 x) bo) (expect-eq (-> obj000 x type) basic-type) @@ -58,8 +53,8 @@ ) -(let ((obj001 (new-type-hack type001)) - (sub-obj (new-type-hack struct-type))) +(let ((obj001 (new 'global 'type001)) + (sub-obj (new 'global 'struct-type))) ;;(inspect obj001) (set! (-> obj001 x) sub-obj) (set! (-> obj001 x dec) 12) diff --git a/goalc/compiler/Compiler.h b/goalc/compiler/Compiler.h index 8c1561ecd6..56d4b46281 100644 --- a/goalc/compiler/Compiler.h +++ b/goalc/compiler/Compiler.h @@ -166,6 +166,7 @@ class Compiler { Val* compile_lognot(const goos::Object& form, const goos::Object& rest, Env* env); Val* compile_logand(const goos::Object& form, const goos::Object& rest, Env* env); Val* compile_logior(const goos::Object& form, const goos::Object& rest, Env* env); + Val* compile_pointer_add(const goos::Object& form, const goos::Object& rest, Env* env); // Function Val* compile_lambda(const goos::Object& form, const goos::Object& rest, Env* env); @@ -183,6 +184,7 @@ class Compiler { Val* compile_car(const goos::Object& form, const goos::Object& rest, Env* env); Val* compile_cdr(const goos::Object& form, const goos::Object& rest, Env* env); Val* compile_method(const goos::Object& form, const goos::Object& rest, Env* env); + Val* compile_addr_of(const goos::Object& form, const goos::Object& rest, Env* env); }; #endif // JAK_COMPILER_H diff --git a/goalc/compiler/StaticObject.cpp b/goalc/compiler/StaticObject.cpp index dd0ef92add..cdd6be0641 100644 --- a/goalc/compiler/StaticObject.cpp +++ b/goalc/compiler/StaticObject.cpp @@ -40,7 +40,7 @@ void StaticString::generate(emitter::ObjectGenerator* gen) { } // add allocated size - push_data_to_byte_vector(text.size() + 1, d); + push_data_to_byte_vector(text.size(), d); // add chars for (auto c : text) { diff --git a/goalc/compiler/Val.h b/goalc/compiler/Val.h index 8076084fc4..67fe8874eb 100644 --- a/goalc/compiler/Val.h +++ b/goalc/compiler/Val.h @@ -85,7 +85,9 @@ class RegVal : public Val { */ class SymbolVal : public Val { public: - SymbolVal(std::string name, TypeSpec ts) : Val(std::move(ts)), m_name(std::move(name)) {} + SymbolVal(std::string name, TypeSpec ts) : Val(std::move(ts)), m_name(std::move(name)) { + mark_as_settable(); + } const std::string& name() const { return m_name; } std::string print() const override { return "<" + m_name + ">"; } RegVal* to_reg(Env* fe) override; diff --git a/goalc/compiler/compilation/Atoms.cpp b/goalc/compiler/compilation/Atoms.cpp index 03688d6f91..b47d0c12d9 100644 --- a/goalc/compiler/compilation/Atoms.cpp +++ b/goalc/compiler/compilation/Atoms.cpp @@ -57,7 +57,7 @@ static const std::unordered_map< {"defmethod", &Compiler::compile_defmethod}, // {"defenum", &Compiler::compile_defenum}, {"->", &Compiler::compile_deref}, - // {"&", &Compiler::compile_addr_of}, + {"&", &Compiler::compile_addr_of}, {"the-as", &Compiler::compile_the_as}, {"the", &Compiler::compile_the}, {"print-type", &Compiler::compile_print_type}, @@ -106,6 +106,7 @@ static const std::unordered_map< {">=", &Compiler::compile_condition_as_bool}, {"<", &Compiler::compile_condition_as_bool}, {">", &Compiler::compile_condition_as_bool}, + {"&+", &Compiler::compile_pointer_add}, // BUILDER (build-dgo/build-cgo?) {"build-dgos", &Compiler::compile_build_dgo}, @@ -306,4 +307,17 @@ Val* Compiler::compile_float(float value, Env* env, int seg) { auto fie = get_parent_env_of_type(env); fie->add_static(std::move(obj)); return result; +} + +Val* Compiler::compile_pointer_add(const goos::Object& form, const goos::Object& rest, Env* env) { + auto args = get_va(form, rest); + va_check(form, args, {{}, {}}, {}); + auto first = compile_error_guard(args.unnamed.at(0), env)->to_gpr(env); + typecheck(form, m_ts.make_typespec("pointer"), first->type(), "&+ first argument"); + auto second = compile_error_guard(args.unnamed.at(1), env)->to_gpr(env); + typecheck(form, m_ts.make_typespec("integer"), second->type(), "&+ second argument"); + auto result = env->make_gpr(first->type()); + env->emit(std::make_unique(result, first)); + env->emit(std::make_unique(IntegerMathKind::ADD_64, result, second)); + return result; } \ No newline at end of file diff --git a/goalc/compiler/compilation/Define.cpp b/goalc/compiler/compilation/Define.cpp index 69f51212ef..72b4888b30 100644 --- a/goalc/compiler/compilation/Define.cpp +++ b/goalc/compiler/compilation/Define.cpp @@ -46,6 +46,10 @@ Val* Compiler::compile_define(const goos::Object& form, const goos::Object& rest typecheck(form, existing_type->second, in_gpr->type(), "define on existing symbol"); } + if (!sym_val->settable()) { + throw_compile_error( + form, "Tried to use define on something that wasn't settable: " + sym_val->print()); + } fe->emit(std::make_unique(sym_val, in_gpr)); return in_gpr; } @@ -111,6 +115,10 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E auto sym_val = fe->alloc_val(symbol_string(destination), m_ts.make_typespec("symbol")); auto result_in_gpr = source->to_gpr(env); + if (!sym_val->settable()) { + throw_compile_error( + form, "Tried to use set! on something that wasn't settable: " + sym_val->print()); + } env->emit(std::make_unique(sym_val, result_in_gpr)); return result_in_gpr; } @@ -118,6 +126,10 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E } else { // destination is some complex expression, so compile it and hopefully get something settable. auto dest = compile_error_guard(destination, env); + if (!dest->settable()) { + throw_compile_error(form, + "Tried to use set! on something that wasn't settable: " + dest->print()); + } auto as_mem_deref = dynamic_cast(dest); auto as_pair = dynamic_cast(dest); if (as_mem_deref) { @@ -126,13 +138,13 @@ Val* Compiler::compile_set(const goos::Object& form, const goos::Object& rest, E auto base_as_mco = dynamic_cast(base); if (base_as_mco) { // if it is a constant offset, we can use a fancy x86-64 addressing mode to simplify - auto ti = m_ts.lookup_type(base->type()); + auto ti = m_ts.lookup_type(as_mem_deref->type()); env->emit(std::make_unique( source, base_as_mco->offset, base_as_mco->base->to_gpr(env), ti->get_load_size())); return source; } else { // nope, the pointer to dereference is some compliated thing. - auto ti = m_ts.lookup_type(base->type()); + auto ti = m_ts.lookup_type(as_mem_deref->type()); env->emit(std::make_unique(source, 0, base->to_gpr(env), ti->get_load_size())); return source; diff --git a/goalc/compiler/compilation/Function.cpp b/goalc/compiler/compilation/Function.cpp index 5caad54968..480ad161c1 100644 --- a/goalc/compiler/compilation/Function.cpp +++ b/goalc/compiler/compilation/Function.cpp @@ -417,12 +417,9 @@ Val* Compiler::compile_real_function_call(const goos::Object& form, fe->require_aligned_stack(); TypeSpec return_ts; if (function->type().arg_count() == 0) { - // if the type system doesn't know what the function will return, just make it object. - // the user is responsible for getting this right. - return_ts = m_ts.make_typespec("object"); - gLogger.log(MSG_WARN, "[Warning] Function call could not determine return type: %s, %s, %s\n", - form.print().c_str(), function->print().c_str(), function->type().print().c_str()); - // todo, consider making this an error once object-new works better. + // if the type system doesn't know what the function will return, don't allow it to be called + throw_compile_error( + form, "This function call has unknown argument and return types and cannot be called"); } else { return_ts = function->type().last_arg(); } diff --git a/goalc/compiler/compilation/Type.cpp b/goalc/compiler/compilation/Type.cpp index 86a55ea539..5426811667 100644 --- a/goalc/compiler/compilation/Type.cpp +++ b/goalc/compiler/compilation/Type.cpp @@ -13,6 +13,7 @@ RegVal* Compiler::compile_get_method_of_type(const TypeSpec& type, const std::string& method_name, Env* env) { auto info = m_ts.lookup_method(type.base_type(), method_name); + info.type = info.type.substitute_for_method_call(type.base_type()); auto offset_of_method = get_offset_of_method(info.id); auto fe = get_parent_env_of_type(env); @@ -38,6 +39,7 @@ RegVal* Compiler::compile_get_method_of_object(RegVal* object, Env* env) { auto& compile_time_type = object->type(); auto method_info = m_ts.lookup_method(compile_time_type.base_type(), method_name); + method_info.type = method_info.type.substitute_for_method_call(compile_time_type.base_type()); auto fe = get_parent_env_of_type(env); RegVal* runtime_type = nullptr; @@ -230,6 +232,7 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest if (deref_info.mem_deref) { result = fe->alloc_val(deref_info.result_type, result, MemLoadInfo(deref_info)); + result->mark_as_settable(); } else { assert(false); } @@ -258,9 +261,11 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest assert(di.can_deref); assert(di.mem_deref); result = fe->alloc_val(di.result_type, loc, MemLoadInfo(di)); + result->mark_as_settable(); } else { result = fe->alloc_val(field.type, result, field.field.offset() + offset); + result->mark_as_settable(); // assert(false); } continue; @@ -282,9 +287,11 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest assert(di.mem_deref); assert(di.can_deref); auto offset = compile_integer(di.stride, env)->to_gpr(env); + // todo, check for integer and avoid runtime multiply env->emit(std::make_unique(IntegerMathKind::IMUL_32, offset, index_value)); auto loc = fe->alloc_val(result->type(), result, offset); result = fe->alloc_val(di.result_type, loc, MemLoadInfo(di)); + result->mark_as_settable(); } else { throw_compile_error(form, "can't access array of type " + result->type().print()); } @@ -292,12 +299,27 @@ Val* Compiler::compile_deref(const goos::Object& form, const goos::Object& _rest return result; } +Val* Compiler::compile_addr_of(const goos::Object& form, const goos::Object& rest, Env* env) { + auto args = get_va(form, rest); + va_check(form, args, {{}}, {}); + auto loc = compile_error_guard(args.unnamed.at(0), env); + auto as_mem_deref = dynamic_cast(loc); + if (!as_mem_deref) { + throw_compile_error(form, "Cannot take the address of this"); + } + return as_mem_deref->base; +} + Val* Compiler::compile_the_as(const goos::Object& form, const goos::Object& rest, Env* env) { auto args = get_va(form, rest); va_check(form, args, {{}, {}}, {}); auto desired_ts = parse_typespec(args.unnamed.at(0)); auto base = compile_error_guard(args.unnamed.at(1), env); - return get_parent_env_of_type(env)->alloc_val(desired_ts, base); + auto result = get_parent_env_of_type(env)->alloc_val(desired_ts, base); + if (base->settable()) { + result->mark_as_settable(); + } + return result; } Val* Compiler::compile_the(const goos::Object& form, const goos::Object& rest, Env* env) { @@ -322,7 +344,11 @@ Val* Compiler::compile_the(const goos::Object& form, const goos::Object& rest, E } } - return get_parent_env_of_type(env)->alloc_val(desired_ts, base); + auto result = get_parent_env_of_type(env)->alloc_val(desired_ts, base); + if (base->settable()) { + result->mark_as_settable(); + } + return result; } Val* Compiler::compile_print_type(const goos::Object& form, const goos::Object& rest, Env* env) { @@ -379,7 +405,9 @@ Val* Compiler::compile_car(const goos::Object& form, const goos::Object& rest, E if (pair->type() != m_ts.make_typespec("object")) { typecheck(form, m_ts.make_typespec("pair"), pair->type(), "Type of argument to car"); } - return fe->alloc_val(m_ts.make_typespec("object"), pair, true); + auto result = fe->alloc_val(m_ts.make_typespec("object"), pair, true); + result->mark_as_settable(); + return result; } Val* Compiler::compile_cdr(const goos::Object& form, const goos::Object& rest, Env* env) { @@ -390,7 +418,9 @@ Val* Compiler::compile_cdr(const goos::Object& form, const goos::Object& rest, E if (pair->type() != m_ts.make_typespec("object")) { typecheck(form, m_ts.make_typespec("pair"), pair->type(), "Type of argument to cdr"); } - return fe->alloc_val(m_ts.make_typespec("object"), pair, false); + auto result = fe->alloc_val(m_ts.make_typespec("object"), pair, false); + result->mark_as_settable(); + return result; } // todo, consider splitting into method-of-object and method-of-type? diff --git a/goalc/gs/goos-lib.gs b/goalc/gs/goos-lib.gs index dd6a9c8228..cc1daaf6e8 100644 --- a/goalc/gs/goos-lib.gs +++ b/goalc/gs/goos-lib.gs @@ -122,6 +122,10 @@ (defsmacro string? (x) `(type? 'string ,x)) +(defsmacro ferror (&rest args) + `(error (fmt #f ,@args)) + ) + ;; Bootstrap GOAL macro system diff --git a/goalc/main.cpp b/goalc/main.cpp index a01b20a3a0..bf9c4f563e 100644 --- a/goalc/main.cpp +++ b/goalc/main.cpp @@ -1,10 +1,11 @@ #include #include "goalc/compiler/Compiler.h" +#include "common/versions.h" int main(int argc, char** argv) { (void)argc; (void)argv; - printf("GOAL Compiler\n"); + printf("OpenGOAL Compiler %d.%d\n", versions::GOAL_VERSION_MAJOR, versions::GOAL_VERSION_MINOR); Compiler compiler; compiler.execute_repl(); diff --git a/test/CMakeLists.txt b/test/CMakeLists.txt index cf38f56bf7..f2766d9bef 100644 --- a/test/CMakeLists.txt +++ b/test/CMakeLists.txt @@ -34,5 +34,5 @@ if(CMAKE_COMPILER_IS_GNUCXX AND CODE_COVERAGE) setup_target_for_coverage_lcov(NAME goalc-test_coverage EXECUTABLE goalc-test --gtest_color=yes DEPENDENCIES goalc-test - EXCLUDE "third-party/*" "/usr/include/*") + EXCLUDE "third-party/*" "/usr/include/*" "decompiler/*") endif() diff --git a/test/old_goal_tests/goal-compiler-control.gc b/test/old_goal_tests/goal-compiler-control.gc deleted file mode 100644 index dde63ac4ff..0000000000 --- a/test/old_goal_tests/goal-compiler-control.gc +++ /dev/null @@ -1,44 +0,0 @@ -;-*-Scheme-*- - -;; This file is loaded as part of goal-lib.gc. -;; It should generate no code. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; COMPILER CONTROL -;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; TODO change me!!! -(defglobalconstant *compiler-output-path* "obj/") - -;; a macro to compile the test file -(defmacro :t () - `(asm-file "game/test.gc" :color) - ) - -;; a macro to compile and load the test file -(defmacro :tl () - `(asm-file "game/test.gc" :color :load) - ) - -;; compile the gcommon code. -(defmacro :g () - ;`(asm-file "game/kernel/gcommon.gc" :color :write) - `(asm-file "game/kernel/gcommon.gc" :color) - ) - -;; compile and load the gcommon code. -(defmacro :gl () - `(begin - (asm-file "game/kernel/gcommon.gc" :color :load) - ) - ) - -;; compile, color, and save a file -(defmacro m (file) - `(asm-file ,file :color :write) - ) - -;; compile, color, load and save a file -(defmacro ml (file) - `(asm-file ,file :color :load :write) - ) \ No newline at end of file diff --git a/test/old_goal_tests/goal-constants.gc b/test/old_goal_tests/goal-constants.gc deleted file mode 100644 index 5f1688bfd1..0000000000 --- a/test/old_goal_tests/goal-constants.gc +++ /dev/null @@ -1,7 +0,0 @@ -;-*-Scheme-*- - -;; This file is loaded as part of goal-lib.gc. -;; It should generate no code. - -(defglobalconstant M_PI 3.1415926589932) -(defglobalconstant *gtype-basic-offset* 4) \ No newline at end of file diff --git a/test/old_goal_tests/goal-externs.gc b/test/old_goal_tests/goal-externs.gc deleted file mode 100644 index d3c84d54fe..0000000000 --- a/test/old_goal_tests/goal-externs.gc +++ /dev/null @@ -1,96 +0,0 @@ -;-*-Scheme-*- - -;; This file is loaded as part of goal-lib.gc. -;; It should generate no code. - -;; This is used to extern define all C Kernel functions and types. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Forward declare C Kernel Fixed Syms -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; '() - -;; booleans -(define-extern #f boolean) -(define-extern #t boolean) - -;; types -(define-extern function type) -(define-extern symbol type) -(define-extern basic type) -(define-extern string type) -(define-extern type type) -(define-extern object type) -(define-extern link-block type) -(define-extern integer type) -(define-extern sinteger type) -(define-extern uinteger type) -(define-extern binteger type) -(define-extern int8 type) -(define-extern int16 type) -(define-extern int32 type) -(define-extern int64 type) -(define-extern int128 type) -(define-extern uint8 type) -(define-extern uint16 type) -(define-extern uint32 type) -(define-extern uint64 type) -(define-extern uint128 type) -(define-extern float type) -(define-extern process-tree type) -(define-extern process type) -(define-extern thread type) -(define-extern structure type) -(define-extern pair type) -(define-extern pointer type) -(define-extern number type) -(define-extern array type) -(define-extern vu-function type) -(define-extern connectable type) -(define-extern stack-frame type) -(define-extern file-stream type) -(define-extern kheap type) - -;; functions -(defun-extern nothing () none) -;; del basic -(define-extern static symbol) -(define-extern global object) -;;(define-extern debug kheap) -(define-extern loading-level symbol) -(define-extern loading-package symbol) -(define-extern process-level-heap symbol) -(define-extern stack symbol) -(define-extern scratch symbol) - -;;(define-extern *scratch-top* pointer) -(defun-extern zero-func () int32) -(defun-extern method-set! ((x type) (y integer) (z function)) object) -;; todo - change allocation to a kheap -(defun-extern dgo-load ((name string) (allocation object) (flag integer) (buffer-size integer)) none) - -(defun-extern *listener-function* () object) -(define-extern *enable-method-set* int32) -;; asizeo-of-bsic -;; copy-basic -;; level -;; art group -;; tx page dir -;; tx page -;; sound -;; dgo -;; top level - -(defun-extern string->symbol ((x string)) symbol) -(defun-extern print ((x object)) object) -(defun-extern inspect ((x object)) object) -(define-extern test-function function) -(define-extern _format function) -;; for the compiler -(define-extern format function) -;; TODO - some others... -(define-extern *kernel-boot-message* symbol) -(define-extern *debug-segment* boolean) - -;; for use by the compiler. -(defun-extern malloc ((allocation symbol) (size integer)) pointer) \ No newline at end of file diff --git a/test/old_goal_tests/goal-lib.gc b/test/old_goal_tests/goal-lib.gc deleted file mode 100644 index 5f794c3aff..0000000000 --- a/test/old_goal_tests/goal-lib.gc +++ /dev/null @@ -1,100 +0,0 @@ -;-*-Scheme-*- - -;; THE GOAL COMMON LIBRARY -;; before this is loaded into the compiler, GOOS needs to have loaded -;; goos-lib.gs. The goos-lib will insert some macros into GOAL's macro space -;; required for this to work. - -;; WARNING - this file should generate NO CODE! -;; Any code which would be generated by this file is thrown out without warning! -;; Any "common" code should go in gcommon instead. - -(asm-file "goal/gc/goal-test-defs.gc") -(asm-file "goal/gc/goal-target-control.gc") -(asm-file "goal/gc/goal-compiler-control.gc") -(asm-file "goal/gc/goal-syntax.gc") -(asm-file "goal/gc/goal-test-utils.gc") -(asm-file "goal/gc/goal-externs.gc") -(asm-file "goal/gc/goal-constants.gc") -(asm-file "goal/gc/goal-macros.gc") -(asm-file "builder/gc/builder.gc") - -;; Ideally this file only contains the above asm-file statements -;; but below is a good spot for temporary hacks: - - -;; HACKS! - -;; temp hack, this gets you the wrong type, and doesn't do good typechecking on the inputs -; (defmacro &+ (v1 v2) -; `(the pointer (+ (the integer ,v1) (the integer ,v2))) -; ) - -(defmacro &+ (v1 &rest args) - (if (null? args) - `(the pointer ,v1) - `(&+ (+ (the integer ,v1) (the integer ,(first args))) ,@(cdr args)) - ) - ) - -(defmacro &- (v1 v2) - `(the pointer (- (the integer ,v1) (the integer ,v2))) - ) - -(defmacro &+! (v1 v2) - `(set! ,v1 (&+ ,v1 ,v2)) - ) - -;; macro to print a float. -(defmacro pf (flt) - `(format #t "~f~%" ,flt) - ) - -(defmacro ct () - ;; compiler test - `(begin - (build-game) - (set! fancy-listener-print #f) - (test) - (set! fancy-listener-print #t) - ) - ) - -(defmacro tt () - `(begin - (lt) - (asm-file "game/test.gc" :color :load) - ) - ) - -(defmacro tn () - `(begin - (asm-file "game/test.gc" :color) - ) - ) - - -(defmacro lm () - `(begin - (build-game) - (asm-file "game/engine/math/math.gc" :color :load) - (set! fancy-listener-print #t) - ) - ) - -(defmacro lg () - `(begin - (dgo-load "game" global #xf #x200000) - )) - -(defmacro e () - `(:exit) - ) - -;(test) -;; uncomment to run tests automatically on startup. -;; Useful for running the compiler in GDB where you can't easily type stuff. -;;:(:t) -;(build-game) - -; (set-config! debug-print-obj #t) \ No newline at end of file diff --git a/test/old_goal_tests/goal-macros.gc b/test/old_goal_tests/goal-macros.gc deleted file mode 100644 index 084e350bbc..0000000000 --- a/test/old_goal_tests/goal-macros.gc +++ /dev/null @@ -1,23 +0,0 @@ -;-*-Scheme-*- - -;; This file is loaded as part of goal-lib.gc. -;; It should generate no code. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; BIT STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defmacro align16 (value) - `(logand #xfffffff0 (+ (the integer ,value) 15)) - ) - -(defmacro &-> (&rest args) - `(& (-> ,@args)) - ) - -(defmacro new-with-method (alloc type &rest args) - `(the ,type ((-> ,type methods 0) ,alloc ,type ,@args)) - ) - -(defmacro symbol? (basic-obj) - `(eq? (-> ,basic-obj type) symbol) - ) diff --git a/test/old_goal_tests/goal-syntax.gc b/test/old_goal_tests/goal-syntax.gc deleted file mode 100644 index 3f92a86b63..0000000000 --- a/test/old_goal_tests/goal-syntax.gc +++ /dev/null @@ -1,355 +0,0 @@ -;-*-Scheme-*- - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; LEXICAL STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Bind vars in body -(defmacro let (bindings &rest body) - `((lambda :inline-only #t ,(apply first bindings) ,@body) - ,@(apply second bindings))) - -;; Let, but recursive, allowing you to define variables in terms of others. -(defmacro let* (bindings &rest body) - (if (null? bindings) - `(begin ,@body) - `((lambda :inline-only #t (,(caar bindings)) - (let* ,(cdr bindings) ,@body)) - ,(car (cdar bindings)) - ) - ) - ) - -;; Backup some values, and restore after executing body. -;; Non-dynamic (nonlocal jumps out of body will skip restore) -(defmacro protect (defs &rest body) - (if (null? defs) - ;; nothing to backup, just insert body (base case) - `(begin ,@body) - - ;; a unique name for the thing we are backing up - (with-gensyms (backup) - ;; store the original value of the first def in backup - `(let ((,backup ,(first defs))) - ;; backup any other things which need backing up - (protect ,(cdr defs) - ;; execute the body - ,@body - ) - ;; restore the first thing - (set! ,(first defs) ,backup) - ) - ) - ) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; DEFINE STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Define a new function -(defmacro defun (name bindings &rest body) - (if (and - (> (length body) 1) ;; more than one thing in function - (string? (first body)) ;; first thing is a string - ) - ;; then it's a docstring and we ignore it. - `(define ,name (lambda :name ,name ,bindings ,@(cdr body))) - ;; otherwise don't ignore it. - `(define ,name (lambda :name ,name ,bindings ,@body)) - ) - ) - -;; Define a new function, but only if we're debugging. -;; TODO - should place the function in the debug segment! -(defmacro defun-debug (name &rest args) - `(if *debug-segment* - (defun ,name ,@args) ;; debug data is loaded, define function in symbol table - (define ,name nothing) ;; function not loaded, set function to the nothing function. - ) - ) - -;; By default, recursive functions don't work because the compiler doesn't -;; know the return type of a function until after the function is fully defined. -;; To get around this, this macro allows you to define a function + give a return type. -;; it simply forward declares the function with the given return, then defines the function as normal -;; if you got the return type wrong, the function definition conflicts with the forward dec -;; and throws an error. -(defmacro defun-recursive (name bindings return-type &rest body) - `(begin - (defun-extern ,name ,bindings ,return-type) - (define ,name (lambda :name ,name ,bindings - ;; omit the doc-string if needed - ,@(if (and (> (length body) 1) (string? (first body))) - (cdr body) - body - ) - ) - ) - ) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; CONDITIONAL COMPILATION -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro #when (clause &rest body) - `(#cond (,clause ,@body)) - ) - -(defmacro #unless (clause &rest body) - `(#cond ((not ,clause) ,@body)) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; MATH STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro +1 (var) - `(+ ,var 1) - ) - -(defmacro +! (place amount) - `(set! ,place (+ ,place ,amount)) - ) - -(defmacro +1! (place) - `(set! ,place (+ 1 ,place)) - ) - -(defmacro -! (place amount) - `(set! ,place (- ,place ,amount)) - ) - -(defmacro *! (place amount) - `(set! ,place (* ,place ,amount)) - ) - -(defmacro 1- (var) - `(- ,var 1) - ) - -(defmacro fabs (x) - `(if (> 0.0 ,x) (- ,x) ,x) - ) - -(defmacro fmin (a b) - `(if (> ,a ,b) ,b ,a) - ) - -(defmacro fmax (a b) - `(if (> ,a ,b) ,a ,b) - ) - - -(defmacro true! (place) - `(set! ,place #t) - ) - -(defmacro false! (place) - `(set! ,place #f) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; CONTROL FLOW STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro if (condition true-case &rest others) - (if (null? others) - `(cond (,condition ,true-case)) - `(cond (,condition ,true-case) - (else ,(first others)) - ) - ) - ) - -(defmacro when (condition &rest body) - `(if ,condition - (begin ,@body) - ) - ) - -(defmacro unless (condition &rest body) - `(if (not ,condition) - (begin ,@body) - ) - ) - - -; (defmacro while (test &rest body) -; (with-gensyms (reloop test-exit) -; `(begin -; (goto ,test-exit) -; (label ,reloop) -; ,@body -; (label ,test-exit) -; (when ,test -; (goto ,reloop) -; ) -; ) -; ) -; ) - -(defmacro while (test &rest body) - (with-gensyms (reloop test-exit) - `(begin - (goto ,test-exit) - (label ,reloop) - ,@body - (label ,test-exit) - (when-goto ,test ,reloop) - #f - ) - ) - ) - - -(defmacro and (&rest args) - (with-gensyms (result end) - `(begin - (let ((,result (the object #f))) - ,@(apply (lambda (x) - `(begin - (set! ,result ,x) - (if (eq? ,result #f) - (goto ,end) - ) - ) - ) - args - ) - (label ,end) - ,result - ) - ) - ) - ) - -(defmacro or (&rest args) - (with-gensyms (result end) - `(begin - (let ((,result (the object #f))) - ,@(apply (lambda (x) - `(begin - (set! ,result ,x) - (if (not (eq? ,result #f)) - (goto ,end) - ) - ) - ) - args - ) - (label ,end) - ,result - ) - ) - ) - ) - -(defmacro zero? (thing) - `(eq? ,thing 0) - ) - -(defmacro until (test &rest body) - (with-gensyms (reloop) - `(begin - (label ,reloop) - ,@body - (when-goto (not ,test) ,reloop) - ; (when (not ,test) - ; (goto ,reloop) - ; ) - ) - ) - ) - -(defmacro dotimes (var &rest body) - `(let (( ,(first var) 0)) - (while (< ,(first var) ,(second var)) - ,@body - (+1! ,(first var)) - ) - ,@(cddr var) - ) - ) - -(defmacro countdown (var &rest body) - `(let ((,(first var) ,(second var))) - (while (!= ,(first var) 0) - (set! ,(first var) (- ,(first var) 1)) - ,@body - ) - ) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TYPE STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro basic? (obj) - ;; todo, make this more efficient - `(= 4 (logand (the integer ,obj) #b111)) - ) - -(defmacro pair? (obj) - ;; todo, make this more efficient - `(= 2 (logand (the integer ,obj) #b111)) - ) - -(defmacro binteger? (obj) - `(zero? (logand (the integer ,obj) #b111)) - ) - -(defmacro rtype-of (obj) - `(cond ((binteger? ,obj) binteger) - ((pair? ,obj) pair) - (else (-> (the basic ,obj) type)) - ) - ) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; PAIR STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defmacro cons (a b) - `(new 'global 'pair ,a ,b) - ) - - -(defmacro list (&rest args) - (if (null? args) - (quote '()) - `(cons ,(car args) (list ,@(cdr args))) - ) - ) - -(defmacro null? (arg) - ;; todo, make this better - `(if (eq? ,arg '()) - #t - #f - ) - ) - -(defmacro caar (arg) - `(car (car ,arg)) - ) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; METHOD STUFF -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - - -(defmacro object-new (&rest sz) - (if (null? sz) - `(the ,(current-method-type) ((-> object methods 0) allocation type-to-make (-> type-to-make asize))) - `(the ,(current-method-type) ((-> object methods 0) allocation type-to-make ,@sz)) - ) - ) - diff --git a/test/old_goal_tests/goal-target-control.gc b/test/old_goal_tests/goal-target-control.gc deleted file mode 100644 index c6deb56ff2..0000000000 --- a/test/old_goal_tests/goal-target-control.gc +++ /dev/null @@ -1,30 +0,0 @@ -;-*-Scheme-*- - -;; GOAL Macros for interfacing with the target. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TARGET CONTROL -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro lt (&rest args) - ;; shortcut for listen-to-target. also sends a :status command to make sure - ;; all buffers on the target are flushed. - `(begin - (listen-to-target ,@args) - (:status) - ) - ) - -(defmacro :r (&rest args) - ;; shortcut to completely reset the target and connect, regardless of current state - `(begin - ;; connect, so we can send reset. if we're already connected, does nothing - (listen-to-target ,@args) - ;; send a reset message, disconnecting us - (reset-target) - ;; establish connection again - (listen-to-target ,@args) - ;; flush buffers - (:status) - ) - ) \ No newline at end of file diff --git a/test/old_goal_tests/goal-test-defs.gc b/test/old_goal_tests/goal-test-defs.gc deleted file mode 100644 index 61802d0c46..0000000000 --- a/test/old_goal_tests/goal-test-defs.gc +++ /dev/null @@ -1,134 +0,0 @@ -;; Definition of all GOAL tests - -(defglobalconstant *goal-test-prefix* "goal/gc/tests/") -(defglobalconstant *goal-test-files* - ( - "test-return-integer.gc" - "test-return-integer1.gc" - "test-return-integer2.gc" - "test-return-integer3.gc" - "test-return-integer4.gc" - "test-return-integer5.gc" - "test-return-integer6.gc" - "test-return-negative-integer.gc" - "test-conditional-compilation.gc" - "test-conditional-compilation-2.gc" - "test-define-1.gc" - "test-nested-blocks-1.gc" - ;; up to here has been hand-checked for good code. - - "test-nested-blocks-2.gc" - "test-nested-blocks-3.gc" - "test-goto-1.gc" - "test-defglobalconstant-1.gc" - "test-defglobalconstant-2.gc" - "test-simple-function-call.gc" - "test-application-lambda-1.gc" - "test-let-1.gc" - "test-let-star-1.gc" - "test-string-constant-1.gc" - "test-string-constant-2.gc" - "test-defun-return-constant.gc" - "test-defun-return-symbol.gc" - "test-function-return-arg-1.gc" - "test-nested-function-call.gc" - "test-add-int-constants.gc" - "test-add-int-vars.gc" - "test-add-int-multiple.gc" - "test-add-int-multiple-2.gc" - "test-add-function-returns.gc" - "test-sub-1.gc" - "test-sub-2.gc" - "test-mul-1.gc" - "test-declare-inline.gc" - "test-inline-call.gc" - "test-with-inline.gc" - "test-three-reg-add.gc" - "test-three-reg-sub.gc" - "test-three-reg-mult.gc" - "test-mlet.gc" - "test-set-symbol.gc" - "test-defun-extern.gc" - "test-defsmacro-defgmacro.gc" - "test-desfun.gc" - "test-factorial-recursive.gc" - "test-factorial-iterative.gc" - "test-div-1.gc" - "test-div-2.gc" - "test-protect.gc" - "test-shiftvs.gc" - "test-ash.gc" - "test-negative-integer-symbol.gc" - "test-mod.gc" - "test-nested-function-call-2.gc" - "test-load-gcommon.gc" - "test-quote-symbol.gc" - "test-min-max.gc" - "test-format-1.gc" - "test-float-product.gc" - "test-float-in-symbol.gc" - "test-function-return-constant-float.gc" - "test-float-function.gc" - "test-float-pow-function.gc" - "test-bfloat-1.gc" - "test-align16-1.gc" - "test-align16-2.gc" - "test-basic-type-check.gc" - "test-return-from-f.gc" - "test-return-from-f-tricky-color.gc" - "test-signed-int-compare.gc" - "test-condition-boolean.gc" - "test-return-value-of-if.gc" - "test-inline-array-field.gc" - "test-access-inline-array.gc" - "test-find-parent-method.gc" - "test-empty-pair.gc" - "test-pairp.gc" - "test-cons.gc" - "test-list.gc" - "test-car-cdr-get.gc" - "test-car-cdr-set.gc" - "test-nested-car-cdr-set.gc" - "test-dotimes.gc" - "test-ref.gc" - "test-pair-asize.gc" - "test-last.gc" - "test-pair-length.gc" - "test-member-1.gc" - "test-member-2.gc" - "test-assoc-1.gc" - "test-assoc-2.gc" - "test-assoce-1.gc" - "test-assoce-2.gc" - "test-append.gc" - "test-delete-list.gc" - "test-delete-car.gc" - "test-insert-cons.gc" - "test-sort.gc" - "test-new-inline-array-class.gc" - "test-pointer-as-array-numbers.gc" - "test-memcpy.gc" - "test-qmemcpy-down.gc" - "test-qmemcpy-up.gc" - "test-memset.gc" - "test-print-binteger.gc" - "test-type-arrays.gc" - "test-number-comparison.gc" - "test-approx-pi.gc" - "test-dynamic-type.gc" - "test-string-type.gc" - "test-new-string.gc" - "test-static-new-integer-field.gc" - "test-addr-of.gc" - "test-set-self.gc" - "test-asm-func.gc" - "test-methods.gc" - "test-bitfield-enums.gc" - "test-packed-inline-array.gc" - "test-fixed-shifts.gc" - "test-add-binteger.gc" - "test-bitfield-access.gc" - "test-bitfield-set1.gc" - ) - ) - diff --git a/test/old_goal_tests/goal-test-utils.gc b/test/old_goal_tests/goal-test-utils.gc deleted file mode 100644 index 3e97ab8e13..0000000000 --- a/test/old_goal_tests/goal-test-utils.gc +++ /dev/null @@ -1,39 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; COMPILER TEST -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; macro to set up the target and compiler for a test -(defmacro test-setup (expected-value reset-required) - `(begin - ;; first, reboot and connect - ;; this uses a "compile time" conditional, as (:r) does the reset when it is _compiled_. - ;; so we want to compile the (:r) only if the reset is wanted. - (#when ,reset-required (:r)) - ;; set expected value in GOOS - (seval (define *test-expected* ,expected-value)) - ;; make sure that *test-result* is an object to avoid typing errors with future tests. - (define-extern *test-result* object) - ) - ) - -(defmacro test-result (value) - value) - -(defmacro expect (v1 v2) - `(if (not (eq? ,v1 ,v2)) - (format #t "TEST FAILURE!~%") - ) - ) - -(defmacro expect-true (value) - `(if (not (eq? ,value #t)) - (format #t "TEST FAILTURE!~%") - ) - ) - - -(defmacro expect-false (value) - `(if (not (eq? ,value #f)) - (format #t "TEST FAILTURE!~%") - ) - ) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-access-inline-array.gc b/test/old_goal_tests/tests/test-access-inline-array.gc deleted file mode 100644 index ff22645301..0000000000 --- a/test/old_goal_tests/tests/test-access-inline-array.gc +++ /dev/null @@ -1,19 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 1.2345 #f) - -(let* ((new-method (-> bfloat methods 0)) - (print-method (-> bfloat methods 2)) - (my-float (the bfloat (new-method 'global bfloat))) - ) - (set! (-> my-float data) 1.23456) - (print-method my-float) - (format #t "~%") - ) - -(let ((x 0)) - (while (< x 9) - (format #t "method ~d of ~A is ~A~%" x bfloat (-> bfloat methods x)) - (+1! x) - ) - ) diff --git a/test/old_goal_tests/tests/test-add-binteger.gc b/test/old_goal_tests/tests/test-add-binteger.gc deleted file mode 100644 index eda56a9418..0000000000 --- a/test/old_goal_tests/tests/test-add-binteger.gc +++ /dev/null @@ -1,3 +0,0 @@ -(test-setup -13 #f) - -(printl (+ (the binteger -3) -10)) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-add-function-returns.gc b/test/old_goal_tests/tests/test-add-function-returns.gc deleted file mode 100644 index d9122573c0..0000000000 --- a/test/old_goal_tests/tests/test-add-function-returns.gc +++ /dev/null @@ -1,23 +0,0 @@ - ;-*-Scheme-*- - -;; various functions which add numbers, called in a big sum. -(test-setup 21 #f) - -(defun return-one () - 1) - -(defun return-sum ((a integer) (b integer)) - (+ a b) - ) - -(defun return-plus-two ((in integer)) - (+ in 2) - ) - -(defun return-plus-three ((in integer)) - (+ 3 in) - ) - -(+ 2 (return-one) (return-plus-three 2) (return-plus-two 3) (return-sum 1 2) (return-plus-two 3)) - - diff --git a/test/old_goal_tests/tests/test-add-int-constants.gc b/test/old_goal_tests/tests/test-add-int-constants.gc deleted file mode 100644 index edfab6a487..0000000000 --- a/test/old_goal_tests/tests/test-add-int-constants.gc +++ /dev/null @@ -1,8 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup 13 #f) - -(+ 15 -2) - - diff --git a/test/old_goal_tests/tests/test-add-int-multiple-2.gc b/test/old_goal_tests/tests/test-add-int-multiple-2.gc deleted file mode 100644 index 62fa5e54fb..0000000000 --- a/test/old_goal_tests/tests/test-add-int-multiple-2.gc +++ /dev/null @@ -1,19 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 15 #f) - -;; add a bunch of numbers together in a single function, in a strange order. - -(defun add-five-v2 ((a int32) (b int32) (c int32) (d int32) (e int32)) - (let* ((total-1 a) - (also-d d) - (total-2 (+ total-1 b)) - (total-3 (+ c total-2)) - ) - (+ total-3 e also-d) - ) - ) - -(add-five 1 2 3 4 5) - - diff --git a/test/old_goal_tests/tests/test-add-int-multiple.gc b/test/old_goal_tests/tests/test-add-int-multiple.gc deleted file mode 100644 index 59c2c87fe9..0000000000 --- a/test/old_goal_tests/tests/test-add-int-multiple.gc +++ /dev/null @@ -1,13 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 15 #f) - -;; add a bunch of numbers together in a single function. - -(defun add-five ((a integer) (b integer) (c integer) (d integer) (e integer)) - (+ c d (+ e a) b) - ) - -(add-five 1 2 3 4 5) - - diff --git a/test/old_goal_tests/tests/test-add-int-vars.gc b/test/old_goal_tests/tests/test-add-int-vars.gc deleted file mode 100644 index 5ed9660c1e..0000000000 --- a/test/old_goal_tests/tests/test-add-int-vars.gc +++ /dev/null @@ -1,13 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 7 #f) - -;; add two numbers in a function - -(defun add-two ((x integer) (y integer)) - (+ x y) - ) - -(add-two 3 4) - - diff --git a/test/old_goal_tests/tests/test-addr-of.gc b/test/old_goal_tests/tests/test-addr-of.gc deleted file mode 100644 index 8653a8f55b..0000000000 --- a/test/old_goal_tests/tests/test-addr-of.gc +++ /dev/null @@ -1,13 +0,0 @@ -(test-setup 4 #f) - -(deftype addr-of-test-type (basic) - ((v1 int32 :offset 4) - (arr int32 12 :offset 8) - ) - ) - -(let ((temp (new 'global 'addr-of-test-type))) - (expect-true (= 12 (- (the integer (&-> temp arr 1)) (the integer temp)))) - (- (the integer (&-> temp v1)) (the integer temp)) - ) - diff --git a/test/old_goal_tests/tests/test-align16-1.gc b/test/old_goal_tests/tests/test-align16-1.gc deleted file mode 100644 index d1c9fb6ebc..0000000000 --- a/test/old_goal_tests/tests/test-align16-1.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 80 #f) - -(+ (align16 1) (align16 (* 3 5)) (align16 (/ 32 2)) (align16 (- -17))) diff --git a/test/old_goal_tests/tests/test-align16-2.gc b/test/old_goal_tests/tests/test-align16-2.gc deleted file mode 100644 index 51fe37a536..0000000000 --- a/test/old_goal_tests/tests/test-align16-2.gc +++ /dev/null @@ -1,10 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 64 #f) - -(defun type-method-check ((obj type)) - (align16 (+ 28 (* 4 (-> obj num-methods)))) - ) - -(type-method-check integer) diff --git a/test/old_goal_tests/tests/test-append.gc b/test/old_goal_tests/tests/test-append.gc deleted file mode 100644 index d2df72e9b7..0000000000 --- a/test/old_goal_tests/tests/test-append.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup '(a b c d e) #f) - -(format #t "~A~%" - (append! (list 'a 'b) (list 'c 'd 'e))) diff --git a/test/old_goal_tests/tests/test-application-lambda-1.gc b/test/old_goal_tests/tests/test-application-lambda-1.gc deleted file mode 100644 index d0afd51618..0000000000 --- a/test/old_goal_tests/tests/test-application-lambda-1.gc +++ /dev/null @@ -1,9 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 2 #f) - -;; test an immediate lambda which does not generate code. - -(define *test-result* - ((lambda :inline-only #t (x y z) y) 1 2 3)) -(test-result *test-result*) diff --git a/test/old_goal_tests/tests/test-approx-pi.gc b/test/old_goal_tests/tests/test-approx-pi.gc deleted file mode 100644 index efb818a4e2..0000000000 --- a/test/old_goal_tests/tests/test-approx-pi.gc +++ /dev/null @@ -1,52 +0,0 @@ - - -(test-setup 1 #f) - -(defun test-approx-pi ((res integer)) - (let ((rad (* res res)) - (count 0)) - (dotimes (x res) - (dotimes (y res) - (if (> rad (+ (* x x) (* y y))) - (+! count 1) - ) - ) - ) - (* 4.0 (/ (the float count) (the float rad))) - ) - ) - -(let ((approx-pi (test-approx-pi 1000))) - (expect-true (> approx-pi 3.14)) - (expect-true (< approx-pi 3.15)) - ) - - -(defun test-approx-pi-float ((res float)) - (let* ((rad (the float (* res res))) - (count (the float 0)) - (x (the float 0)) - (y (the float 0)) - (scale (/ 1.0 rad))) - (while (< x res) - (set! y 0.0) - (while (< y res) - ; (format #t "tapf ~f ~f ~f~%" x y res) - (if (> rad (+ (* x x) (* y y))) - (+! count scale) - ) - (+! y 1.0) - ) - (+! x 1.0) - ) - (* 4.0 count) - ) - ) - -(let ((approx-pi (test-approx-pi-float 500.0))) - (expect-true (> approx-pi 3.14)) - (expect-true (< approx-pi 3.15)) - ) - -;(format #t "~f~%" (test-approx-pi 1000)) -1 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-ash.gc b/test/old_goal_tests/tests/test-ash.gc deleted file mode 100644 index bbe09f373e..0000000000 --- a/test/old_goal_tests/tests/test-ash.gc +++ /dev/null @@ -1,13 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 18 #f) - -(defun ash ((value integer) (shift-amount integer)) - (if (> shift-amount 0) - (shlv value shift-amount) - (sarv value (- shift-amount)) - ) - ) - -(+ (ash (+ 1 2) (/ 6 2)) (ash (- 12) (- 1))) - diff --git a/test/old_goal_tests/tests/test-asm-func.gc b/test/old_goal_tests/tests/test-asm-func.gc deleted file mode 100644 index cc6f0fc9f4..0000000000 --- a/test/old_goal_tests/tests/test-asm-func.gc +++ /dev/null @@ -1,19 +0,0 @@ -(test-setup 1234567 #f) - -(defun test-asm-function () - ;; enable asm-func mode (DANGER) - (declare (asm-func)) - ;; now we have no prologue/epilogue. - ;; most operations involving variables are unsafe. - - ;; create a "safe" variable which is the rax register - (rlet ((ret :reg rax :type integer)) - ;; set to a numeric constant - (set! ret 1234567) - ) - - ;; and do a return manually - (.ret) - ) - -(test-asm-function) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-assoc-1.gc b/test/old_goal_tests/tests/test-assoc-1.gc deleted file mode 100644 index 0b2e1fa17f..0000000000 --- a/test/old_goal_tests/tests/test-assoc-1.gc +++ /dev/null @@ -1,7 +0,0 @@ -(test-setup 'w #f) - -(format #t "~A~%" - (cdr (assoc 'e (list (cons 'a 'b) (cons 'e 'w) (cons 'x 'x))))) - - -(print-type (assoc 'a '())) diff --git a/test/old_goal_tests/tests/test-assoc-2.gc b/test/old_goal_tests/tests/test-assoc-2.gc deleted file mode 100644 index 78467fe506..0000000000 --- a/test/old_goal_tests/tests/test-assoc-2.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup #f #f) - -(format #t "~A~%" - (assoc 'r (list (cons 'a 'b) (cons 'e 'w) (cons 'x 'x)))) diff --git a/test/old_goal_tests/tests/test-assoce-1.gc b/test/old_goal_tests/tests/test-assoce-1.gc deleted file mode 100644 index abac90cb8d..0000000000 --- a/test/old_goal_tests/tests/test-assoce-1.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup 'x #f) - -(format #t "~A~%" - (cdr (assoce 'r (list (cons 'a 'b) (cons 'e 'w) (cons 'else 'x))))) diff --git a/test/old_goal_tests/tests/test-assoce-2.gc b/test/old_goal_tests/tests/test-assoce-2.gc deleted file mode 100644 index 17343d3cef..0000000000 --- a/test/old_goal_tests/tests/test-assoce-2.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup 'x #f) - -(format #t "~A~%" - (cdr (assoce 'r (list (cons 'a 'b) (cons 'r 'x) (cons 'else 'w))))) diff --git a/test/old_goal_tests/tests/test-basic-type-check.gc b/test/old_goal_tests/tests/test-basic-type-check.gc deleted file mode 100644 index e4670fed79..0000000000 --- a/test/old_goal_tests/tests/test-basic-type-check.gc +++ /dev/null @@ -1,24 +0,0 @@ - ;-*-Scheme-*- - -(test-setup '#f#t#t#f#t#f#t#t #f) - -;; awful hack to create a bfloat at #x6000000 -(define-extern hack-bfloat integer) -(define hack-bfloat (+ #x6000000 *gtype-basic-offset*)) -(define-extern hack-bfloat bfloat) - - -(format #t "~A~A~A~A" - (basic-type? hack-bfloat integer) ;; #f - (basic-type? hack-bfloat structure) ;; #t - (basic-type? integer type) ;; #t - (basic-type? hack-bfloat object) ;; #t - ) - -(format #t "~A~A~A~A~%" - (basic-type? integer basic) ;; t - (basic-type? integer integer) ;; #f - (basic-type? #f basic) ;; #t - (basic-type? inspect function) ;; #t - ) - diff --git a/test/old_goal_tests/tests/test-bfloat-1.gc b/test/old_goal_tests/tests/test-bfloat-1.gc deleted file mode 100644 index 7ec25e845e..0000000000 --- a/test/old_goal_tests/tests/test-bfloat-1.gc +++ /dev/null @@ -1,35 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 1.2339 #f) - -;; awful hack to create a bfloat at #x6000000 -(define-extern hack-bfloat integer) -(define hack-bfloat (+ #x6000000 *gtype-basic-offset*)) -(define-extern hack-bfloat bfloat) - -;; we have to manually set the type field. -(set! (-> hack-bfloat type) bfloat) - -;; set the data field -(set! (-> hack-bfloat data) 1.234) - -(defun test-print-bfloat ((obj bfloat)) - (format #t "~f~%" (-> obj data)) - ) - -;; to make test pass -;;(format #t "~f~%" (-> hack-bfloat data)) -(test-print-bfloat hack-bfloat) - -;; try printing it as a basic (should use default basic printer) -(format #t "Here's a bfloat ~A~%" hack-bfloat) - -;; or access the field directly and print as float -(format #t "Here's (-> flt data) ~f~%" (-> hack-bfloat data)) - -;; or inspect it (compiler should generate this method -(format #t "Here's its inspect~%~I~%" hack-bfloat) - -(format #t "It's type is `~A`~%" (-> hack-bfloat type)) - - diff --git a/test/old_goal_tests/tests/test-bitfield-access.gc b/test/old_goal_tests/tests/test-bitfield-access.gc deleted file mode 100644 index 7b63adab8a..0000000000 --- a/test/old_goal_tests/tests/test-bitfield-access.gc +++ /dev/null @@ -1,24 +0,0 @@ -(test-setup 'fffffffffffff344f213ffffffffffffffff #f) - -(deftype test-bf-type (int32) - ((f1 int16) - (f2 uint8) - (f3 int8 :size 3) - (f4 uint8 :size 2) - (f5 int8 :size 2) - ) - ) - -(deftype test-bf-type2 (int64) - ((f1 int16) - (f2 uint8) - (f3 float) - ) - ) - -(let ((temp (the test-bf-type #xf9f2f344)) - (temp2 (the test-bf-type2 #x133f456789012345))) - (expect-true (< (fabs (- 1.7711 (+ 1.0 (-> temp2 f3)))) 0.002)) - ; (format #t "diff is ~f~%" (fabs (- 1.711 (+ 1.0 (-> temp2 f3))))) - (format #t "~X~X~X~X~X~%" (-> temp f1) (-> temp f2) (-> temp f3) (-> temp f4) (-> temp f5)) - ) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-bitfield-enums.gc b/test/old_goal_tests/tests/test-bitfield-enums.gc deleted file mode 100644 index 535c2f98ee..0000000000 --- a/test/old_goal_tests/tests/test-bitfield-enums.gc +++ /dev/null @@ -1,9 +0,0 @@ -(test-setup 5 #f) - -(defenum test-bitfield :bitfield #t - (one 0) - (two 1) - (four 2) - ) - -(test-bitfield one four) diff --git a/test/old_goal_tests/tests/test-bitfield-set1.gc b/test/old_goal_tests/tests/test-bitfield-set1.gc deleted file mode 100644 index 80cfae8aca..0000000000 --- a/test/old_goal_tests/tests/test-bitfield-set1.gc +++ /dev/null @@ -1,20 +0,0 @@ -(test-setup 50.3432 #f) - -(deftype test-bf-type3 (int64) - ((f1 uint16 :offset-assert 0) - (f2 uint8 :size 7 :offset-assert 16) - (f3 float :offset-assert 23) - (f4 uint8 :size 1 :offset-assert 55) - (f5 uint8 :offset-assert 56) - ) - ) - -(let ((temp (the test-bf-type3 #x0))) - (set! (-> temp f1) #x12) - (set! (-> temp f2) #x13) - (set! (-> temp f3) 12.3433) - (set! (-> temp f4) #xffffffff) ; will get truncated. - (expect-true (eq? 0 (-> temp f5))) ; check it gets truncated - (format #t "~f~%" (+ (-> temp f3) (-> temp f2) (-> temp f1) (-> temp f4))) - ) - diff --git a/test/old_goal_tests/tests/test-car-cdr-get.gc b/test/old_goal_tests/tests/test-car-cdr-get.gc deleted file mode 100644 index a93ac57088..0000000000 --- a/test/old_goal_tests/tests/test-car-cdr-get.gc +++ /dev/null @@ -1,8 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 'ab #f) - -(let ((my-pair (cons 'a 'b))) - (format #t "~A~A~%" (car my-pair) (cdr my-pair)) - ) diff --git a/test/old_goal_tests/tests/test-car-cdr-set.gc b/test/old_goal_tests/tests/test-car-cdr-set.gc deleted file mode 100644 index d909aa22bf..0000000000 --- a/test/old_goal_tests/tests/test-car-cdr-set.gc +++ /dev/null @@ -1,10 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 'cd #f) - -(let ((my-pair (cons 'a 'b))) - (set! (car my-pair) 'c) - (set! (cdr my-pair) 'd) - (format #t "~A~A~%" (car my-pair) (cdr my-pair)) - ) diff --git a/test/old_goal_tests/tests/test-condition-boolean.gc b/test/old_goal_tests/tests/test-condition-boolean.gc deleted file mode 100644 index 78882baf30..0000000000 --- a/test/old_goal_tests/tests/test-condition-boolean.gc +++ /dev/null @@ -1,27 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 4 #f) - -(let ((total 0)) - (if (true-func) - (+! total 1) - (+! total 999) - ) - - (if (false-func) - (+! total 999) - (+! total 1) - ) - - (if (not (true-func)) - (+! total 999) - (+! total 1) - ) - - (if (not (false-func)) - (+! total 1) - (+! total 999) - ) - total - ) - diff --git a/test/old_goal_tests/tests/test-conditional-compilation-2.gc b/test/old_goal_tests/tests/test-conditional-compilation-2.gc deleted file mode 100644 index 0e2fb675ff..0000000000 --- a/test/old_goal_tests/tests/test-conditional-compilation-2.gc +++ /dev/null @@ -1,9 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 5 #f) - -;; test the #when and #unless macros - - -(#unless (< 1 2) (/ 0 0)) -(#when (< 1 2) 5) diff --git a/test/old_goal_tests/tests/test-conditional-compilation.gc b/test/old_goal_tests/tests/test-conditional-compilation.gc deleted file mode 100644 index bc540bdfe9..0000000000 --- a/test/old_goal_tests/tests/test-conditional-compilation.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 3 #f) - -;; test the use of #cond to evaluate goos expressions. - -(#cond - ((> 2 (+ 2 1)) - 1 - ) - - ((< 2 (+ 1 2)) - 3 - ) - ) diff --git a/test/old_goal_tests/tests/test-cons.gc b/test/old_goal_tests/tests/test-cons.gc deleted file mode 100644 index 0564d6f1b7..0000000000 --- a/test/old_goal_tests/tests/test-cons.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup '(a) #f) - -(printl (cons 'a '())) - diff --git a/test/old_goal_tests/tests/test-declare-inline.gc b/test/old_goal_tests/tests/test-declare-inline.gc deleted file mode 100644 index bdda018731..0000000000 --- a/test/old_goal_tests/tests/test-declare-inline.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 32 #f) - -;; test calling an inline function. doesn't actually verify the call is inline. - -(defun inline-test-function-1 ((x integer)) - ;; inline this function by default. - (declare (inline)) - (* 4 x) - ) - -(inline-test-function-1 8) diff --git a/test/old_goal_tests/tests/test-defglobalconstant-1.gc b/test/old_goal_tests/tests/test-defglobalconstant-1.gc deleted file mode 100644 index 76698c449e..0000000000 --- a/test/old_goal_tests/tests/test-defglobalconstant-1.gc +++ /dev/null @@ -1,12 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 17 #f) - -;; test defglobalconstant to define a goal constant - -(defglobalconstant my-constant 12) -(defglobalconstant my-constant 17) -(defglobalconstant not-my-consant 13) - -my-constant diff --git a/test/old_goal_tests/tests/test-defglobalconstant-2.gc b/test/old_goal_tests/tests/test-defglobalconstant-2.gc deleted file mode 100644 index 9e5d01abe3..0000000000 --- a/test/old_goal_tests/tests/test-defglobalconstant-2.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 18 #f) - -;; test defglobalconstant to get a goos constant - -(defmacro get-goos-by-name (name) - ;; do the lookup in the goos global environment - (eval name) - ) - -(defglobalconstant my-constant 18) - -(get-goos-by-name my-constant) diff --git a/test/old_goal_tests/tests/test-define-1.gc b/test/old_goal_tests/tests/test-define-1.gc deleted file mode 100644 index 8fff7f7aac..0000000000 --- a/test/old_goal_tests/tests/test-define-1.gc +++ /dev/null @@ -1,17 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 17 #f) - -;; test the use of define. - -(define first-var 1) -(define second-var 2) -(define first-var 12) - -(begin - (define first-var 13) - (define second-var 12) - (define first-var 17) - second-var - first-var) diff --git a/test/old_goal_tests/tests/test-defsmacro-defgmacro.gc b/test/old_goal_tests/tests/test-defsmacro-defgmacro.gc deleted file mode 100644 index 2124eeff15..0000000000 --- a/test/old_goal_tests/tests/test-defsmacro-defgmacro.gc +++ /dev/null @@ -1,19 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 20 #f) - -(defsmacro test-macro (x) - ;; goos macro - `(+ ,x 2) - ) - -(defmacro test-macro (x) - ;; goal macro which calls a goos macro of the same name - (let ((goos-expansion (test-macro x))) - `(+ ,goos-expansion 3) - ) - ) - -(test-macro 15) - - diff --git a/test/old_goal_tests/tests/test-defun-extern.gc b/test/old_goal_tests/tests/test-defun-extern.gc deleted file mode 100644 index 1d30cdf3e1..0000000000 --- a/test/old_goal_tests/tests/test-defun-extern.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 12345 #f) - -;; this should be defun-extern'd in goal-lib.gc -;; and the function is a C Kernel function. -(+ (zero-func) 12345) diff --git a/test/old_goal_tests/tests/test-defun-return-constant.gc b/test/old_goal_tests/tests/test-defun-return-constant.gc deleted file mode 100644 index 14215deef2..0000000000 --- a/test/old_goal_tests/tests/test-defun-return-constant.gc +++ /dev/null @@ -1,16 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 12 #f) - -(defun return-13 () - 13) - -(defun return-12 () - 12) - -(defun return-11 () - 11) - -(return-12) - - diff --git a/test/old_goal_tests/tests/test-defun-return-symbol.gc b/test/old_goal_tests/tests/test-defun-return-symbol.gc deleted file mode 100644 index 0174ef2eab..0000000000 --- a/test/old_goal_tests/tests/test-defun-return-symbol.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 42 #f) - - - -(define my-number 36) - -(defun return-my-number () - my-number) - -(define my-number 42) - -(return-my-number) diff --git a/test/old_goal_tests/tests/test-delete-car.gc b/test/old_goal_tests/tests/test-delete-car.gc deleted file mode 100644 index 90a6c9275d..0000000000 --- a/test/old_goal_tests/tests/test-delete-car.gc +++ /dev/null @@ -1,11 +0,0 @@ -(test-setup '((a . b) (e . f)) #f) - -(let ((my-list (list (cons 'a 'b) - (cons 'c 'd) - (cons 'e 'f) - ) - )) - (delete-car! 'c my-list) - (format #t "~A~%" my-list) - (format #t "~A~%" (assoc 'c my-list)) - ) diff --git a/test/old_goal_tests/tests/test-delete-list.gc b/test/old_goal_tests/tests/test-delete-list.gc deleted file mode 100644 index 9e5b3d8877..0000000000 --- a/test/old_goal_tests/tests/test-delete-list.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup '(a b d e) #f) - -(format #t "~A~%" - (delete! 'c (list 'a 'b 'c 'd 'e))) diff --git a/test/old_goal_tests/tests/test-desfun.gc b/test/old_goal_tests/tests/test-desfun.gc deleted file mode 100644 index 951552746a..0000000000 --- a/test/old_goal_tests/tests/test-desfun.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 4 #f) - -(desfun square (x) - (* x x) - ) - - -(defmacro call-square (x) - (square x) - ) - -(call-square 2) diff --git a/test/old_goal_tests/tests/test-div-1.gc b/test/old_goal_tests/tests/test-div-1.gc deleted file mode 100644 index cf3c9c32c1..0000000000 --- a/test/old_goal_tests/tests/test-div-1.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 6 #f) - -(+ 1 2 (/ (* 2 5) (+ 1 2))) - diff --git a/test/old_goal_tests/tests/test-div-2.gc b/test/old_goal_tests/tests/test-div-2.gc deleted file mode 100644 index 603bef96c0..0000000000 --- a/test/old_goal_tests/tests/test-div-2.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 7 #f) - -;; this computes nothing that we can check, but verifies that the coloring -;; doesn't do something crazy when constrained a little strangely -(rlet ((x :reg rsp :type int64)) - (/ x 2) - (/ 2 x) - ) - -(let ((x 30)) - (+ (/ x 10) 4) - ) diff --git a/test/old_goal_tests/tests/test-dotimes.gc b/test/old_goal_tests/tests/test-dotimes.gc deleted file mode 100644 index b3a8365400..0000000000 --- a/test/old_goal_tests/tests/test-dotimes.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 4950 #f) - -(let ((sum 0)) - (dotimes (i 100 7 8 9 sum) - (+! sum i) - ;;(format #t "iter ~D sum ~D~%" i sum) - ) - ) diff --git a/test/old_goal_tests/tests/test-dynamic-type.gc b/test/old_goal_tests/tests/test-dynamic-type.gc deleted file mode 100644 index 5e29d5b682..0000000000 --- a/test/old_goal_tests/tests/test-dynamic-type.gc +++ /dev/null @@ -1,58 +0,0 @@ - -(test-setup 1 #f) - -(deftype test-dynamic-type (basic) - ( - (pad0 int16 :offset 0) - (allocated-length int32 :offset 4) - (data int32 :dynamic :offset 8) - (over1 int32 :offset 8) - (over2 int32 :offset 12) - ) - ) - - -(defmethod new test-dynamic-type ((allocation symbol) (type-to-make type) (cnt integer)) - ;"Create a new inline-array. Sets the length, allocated-length to cnt. Uses the mysterious heap-base field - ;of the type-to-make to determine the element size" - (let* ((sz (+ (-> type-to-make asize) (* 4 cnt))) - (new-object (object-new sz))) - ;;(format 0 "create sz ~d at #x~X~%" sz new-object) - (unless (zero? new-object) - (set! (-> new-object allocated-length) cnt) - ) - new-object - ) - ) - -(defmethod length test-dynamic-type ((obj test-dynamic-type)) - ;"Get the length of it" - (-> obj allocated-length) - ) - -(defmethod asize-of test-dynamic-type ((obj test-dynamic-type)) - ;"Get the size in memory of it" - (+ (-> obj type asize) - (* (-> obj allocated-length) 4) - ) - ) - -(define test-dynamic-obj - (the test-dynamic-type ((-> test-dynamic-type methods 0) 'global test-dynamic-type 40))) - -;(inspect test-dynamic-obj) - -(set! (-> test-dynamic-obj data 0) 12) -(set! (-> test-dynamic-obj data 1) 20) -;(inspect test-dynamic-obj) - -; (format #t "should be same (~d ~d) (~d ~d)~%" (-> test-dynamic-obj data 0) (-> test-dynamic-obj over1) -; (-> test-dynamic-obj data 1) (-> test-dynamic-obj over2)) - -(expect-true (= (-> test-dynamic-obj data 0) (-> test-dynamic-obj over1))) -(expect-true (= (-> test-dynamic-obj data 1) (-> test-dynamic-obj over2))) - -(set! (-> test-dynamic-obj pad0) 0) -(expect-true (= (-> test-dynamic-obj type) test-dynamic-type)) -(expect-true (= (asize-of test-dynamic-obj) 180)) -1 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-empty-pair.gc b/test/old_goal_tests/tests/test-empty-pair.gc deleted file mode 100644 index 01fa363089..0000000000 --- a/test/old_goal_tests/tests/test-empty-pair.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - -(test-setup '() #f) - -(print '()) -(format #t "~%") diff --git a/test/old_goal_tests/tests/test-factorial-iterative.gc b/test/old_goal_tests/tests/test-factorial-iterative.gc deleted file mode 100644 index c8fb3f43d2..0000000000 --- a/test/old_goal_tests/tests/test-factorial-iterative.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 3628800 #f) - -(defun factorial-iterative ((x integer)) - (let ((result 1)) - (while (!= x 1) - (set! result (* result x)) - (set! x (- x 1)) - ) - result - ) - ) - -(factorial-iterative 10) diff --git a/test/old_goal_tests/tests/test-factorial-recursive.gc b/test/old_goal_tests/tests/test-factorial-recursive.gc deleted file mode 100644 index 559eb7cfed..0000000000 --- a/test/old_goal_tests/tests/test-factorial-recursive.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 3628800 #f) - -;; for now, recursive functions need to forward declare so they have their -;; return type. -(defun-extern factorial-recursive ((x integer)) integer) - -(defun factorial-recursive ((x integer)) - (cond ((= x 1) x) - (else (* x (factorial-recursive (- x 1)))) - ) - ) - -(factorial-recursive 10) diff --git a/test/old_goal_tests/tests/test-find-parent-method.gc b/test/old_goal_tests/tests/test-find-parent-method.gc deleted file mode 100644 index e4c9dca5fc..0000000000 --- a/test/old_goal_tests/tests/test-find-parent-method.gc +++ /dev/null @@ -1,27 +0,0 @@ - ;-*-Scheme-*- - -(test-setup "test pass!" #f) - -(let ((test-result "test fail!")) - - ;; first, do one where we get something - (if (eq? - (-> structure methods 1) - (find-parent-method bfloat 1) - ) - (set! test-result "test pass!") - ) - - ;; nothing - (if (not (eq? - (find-parent-method structure 5) - nothing - ) - ) - (format #t "TEST FAIL~%~%") - ) - - (print test-result) - ) - - diff --git a/test/old_goal_tests/tests/test-fixed-shifts.gc b/test/old_goal_tests/tests/test-fixed-shifts.gc deleted file mode 100644 index e84d3cd666..0000000000 --- a/test/old_goal_tests/tests/test-fixed-shifts.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup 4611686018427387914 #f) - -(+ (shl 2 3) (shl 1 0) (shl 0 4) (shr 2 3) (shr 10 2) (shl -2 1) (sar -16 2) (shr -1 2)) -;; 16 1 0 0 2 -4 -4 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-float-function.gc b/test/old_goal_tests/tests/test-float-function.gc deleted file mode 100644 index 596ccee968..0000000000 --- a/test/old_goal_tests/tests/test-float-function.gc +++ /dev/null @@ -1,12 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 10.152 #f) - - -(defun float-testing-function ((x float) (y float)) - (* x y (* x x)) - ) - -(let ((x (float-testing-function (* 1.2 1.2) 3.4))) - (format #t "~,,3f~%" x) - ) diff --git a/test/old_goal_tests/tests/test-float-in-symbol.gc b/test/old_goal_tests/tests/test-float-in-symbol.gc deleted file mode 100644 index 4df1895272..0000000000 --- a/test/old_goal_tests/tests/test-float-in-symbol.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 2345.0 #f) -(define float-symbol 2345.0) -(format #t "~,,0f~%" float-symbol) - diff --git a/test/old_goal_tests/tests/test-float-pow-function.gc b/test/old_goal_tests/tests/test-float-pow-function.gc deleted file mode 100644 index 433b1c0168..0000000000 --- a/test/old_goal_tests/tests/test-float-pow-function.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 256 #f) - -(defun pow-test ((base float) (exponent integer)) - (let ((result base)) - (while (> exponent 1) - (*! result base) - (-! exponent 1) - ) - result - ) - ) - -(format #t "~,,0f~%" (pow-test 2.0 8)) diff --git a/test/old_goal_tests/tests/test-float-product.gc b/test/old_goal_tests/tests/test-float-product.gc deleted file mode 100644 index 502d6506e9..0000000000 --- a/test/old_goal_tests/tests/test-float-product.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 120.000 #f) - -(format #t "~,,0f~%" (* 1.2 25.0 4.0)) - diff --git a/test/old_goal_tests/tests/test-format-1.gc b/test/old_goal_tests/tests/test-format-1.gc deleted file mode 100644 index 95fbc6ff48..0000000000 --- a/test/old_goal_tests/tests/test-format-1.gc +++ /dev/null @@ -1,61 +0,0 @@ -;-*-Scheme-*- - - - -(test-setup 'automatic-pass #f) - -(format #t "test newline~%newline~%") -(format #t "test tilde ~~ ~%") - -;; test g, G - -(format #t "test A print boxed-string: ~a~%" "boxed string!") -(format #t "test A print symbol: ~A~%" 'a-symbol) -(format #t "test A make boxed object longer: ~17A!~%" "srt") -(format #t "test A non-default pad: ~12,'za~%" 'pad-me) -(format #t "test A shorten(4): ~4a~%" 'a234567) -(format #t "test A don'tchange(4): ~4a~%" 'a234) -(format #t "test A shorten with pad(4): ~4,'za~%" 'shorten-me) -(format #t "test A a few things ~a ~a ~a ~a~%" "one thing" 'a-second integer print) - - -(format #t "test S ~s ~s ~s~%" "a string" 'a-symbol "another string!") - -(format #t "test C ~c ~c~%" 41 #x5d) - -(format #t "test P (no type) ~p~%" print) -(format #t "test P (with type) ~`integer`p~%" print) - -(format #t "test I (no type) ~i" inspect) -(format #t "test I (with type) ~`integer`i" inspect) - -(format #t "test X ~x ~10x ~10,'.x ~3x ~3,'.x~%" #xbaadbeef #x2 #x3 #x0badbeef #x0badbeef) - -(format #t "test D ~d ~10d ~10,'.d ~3d ~3,'.d~%" #xbaadbeef #x2 #x3 #x0badbeef #x0badbeef) - -(format #t "test B ~b ~10b ~10,'.b ~3b ~3,'.b~%" #xbaadbeef #x2 #x3 #x0badbeef #x0badbeef) - -;; test f, F, r, R, m, M - -(format #t "test E ~E ~e ~e~%" 1 20 301) -(format #t "test pass through ~10,'b,2W~%") - -(format #t "test tab~Taftertab~%") -(format #t "test many ~d ~d ~d ~d ~d~%" 1 2 3 4 5) - - -;; test floats -(format #t "test f ~F ~12,'0,2f ~f~%" -1.234 1.234 -1.234) -(format #t "test r ~R ~12,'0,2r ~r~%" 1.234 1.567 1.987) -(format #t "test m ~M ~12,'0,2m ~m~%" 1.234 1.567 1.987) -(format #t "test as float ~`float`P~%" -99987623.23123) -(format #t "test pi! ~f~%" M_PI) - -;; print the stack pointer? -(rlet ((sp :reg rsp :type integer) - (off :reg r14 :type integer) - (st :reg r15 :type integer)) - (format #t "stack pointer is #x~x~%" sp) - (format #t "offset pointer is #x~x~%" off) - (format #t "st pointer is #x~x~%" st) - ) diff --git a/test/old_goal_tests/tests/test-function-return-arg-1.gc b/test/old_goal_tests/tests/test-function-return-arg-1.gc deleted file mode 100644 index 7b67583f77..0000000000 --- a/test/old_goal_tests/tests/test-function-return-arg-1.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 23 #f) - -(defun return-second-arg (one two three) - two) - -(return-second-arg 1 23 4) - - diff --git a/test/old_goal_tests/tests/test-function-return-constant-float.gc b/test/old_goal_tests/tests/test-function-return-constant-float.gc deleted file mode 100644 index cd8866b434..0000000000 --- a/test/old_goal_tests/tests/test-function-return-constant-float.gc +++ /dev/null @@ -1,9 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 31415.0 #f) - -(defun return-const-float () - 31415.0 - ) -(format #t "~,,0f~%" (return-const-float)) - diff --git a/test/old_goal_tests/tests/test-goto-1.gc b/test/old_goal_tests/tests/test-goto-1.gc deleted file mode 100644 index 918e001067..0000000000 --- a/test/old_goal_tests/tests/test-goto-1.gc +++ /dev/null @@ -1,12 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 3 #f) - -(block my-block - 1 - (goto skip-early-return) - (return-from my-block 2) - (label skip-early-return) - 3 - ) diff --git a/test/old_goal_tests/tests/test-inline-array-field.gc b/test/old_goal_tests/tests/test-inline-array-field.gc deleted file mode 100644 index 3d48627098..0000000000 --- a/test/old_goal_tests/tests/test-inline-array-field.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 16 #f) - -(let* ((base (the integer integer)) - (field (the integer (-> integer methods))) - (offset (- field base))) - ;;(format #t "offset of methods table is ~d~%" offset) - offset - ) diff --git a/test/old_goal_tests/tests/test-inline-call.gc b/test/old_goal_tests/tests/test-inline-call.gc deleted file mode 100644 index 56945e5bb0..0000000000 --- a/test/old_goal_tests/tests/test-inline-call.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 44 #f) - -;; test calling an inline function. doesn't actually verify the call is inline. - -(defun inline-test-function-2 ((x integer)) - ;; inline this function by default. - (declare (allow-inline)) - (* 4 x) - ) - -(+ (inline-test-function-2 8) ((inline inline-test-function-2) 3)) diff --git a/test/old_goal_tests/tests/test-insert-cons.gc b/test/old_goal_tests/tests/test-insert-cons.gc deleted file mode 100644 index a77d63fb95..0000000000 --- a/test/old_goal_tests/tests/test-insert-cons.gc +++ /dev/null @@ -1,8 +0,0 @@ -(test-setup '((c . w) (a . b) (e . f)) #f) - -(let ((alist (list (cons 'a 'b) - (cons 'c 'd) - (cons 'e 'f)))) - (set! alist (insert-cons! (cons 'c 'w) alist)) - (format #t "~A~%" alist) - ) diff --git a/test/old_goal_tests/tests/test-last.gc b/test/old_goal_tests/tests/test-last.gc deleted file mode 100644 index c56f5ca1d8..0000000000 --- a/test/old_goal_tests/tests/test-last.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 'd #f) -(format #t "~A~%" - (car (last (list 'a 'b 'c 'd))) - ) diff --git a/test/old_goal_tests/tests/test-let-1.gc b/test/old_goal_tests/tests/test-let-1.gc deleted file mode 100644 index 75b1e673e1..0000000000 --- a/test/old_goal_tests/tests/test-let-1.gc +++ /dev/null @@ -1,10 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 30 #f) -(define *test-result* - (let ((x 1) - (y (test-function 1 2 3 4)) - (z 3)) - y) - ) -(test-result *test-result*) diff --git a/test/old_goal_tests/tests/test-let-star-1.gc b/test/old_goal_tests/tests/test-let-star-1.gc deleted file mode 100644 index eed9a53835..0000000000 --- a/test/old_goal_tests/tests/test-let-star-1.gc +++ /dev/null @@ -1,15 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 30 #f) -(define *test-result* - (let* ((x 1) - (y 2) - (z 3) - (a 4) - (b (test-function x y z a)) - (d 5) - ) - b - ) - ) -(test-result *test-result*) diff --git a/test/old_goal_tests/tests/test-list.gc b/test/old_goal_tests/tests/test-list.gc deleted file mode 100644 index 0edd68ea60..0000000000 --- a/test/old_goal_tests/tests/test-list.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup '(a b c d) #f) - -(print (list 'a 'b 'c 'd)) -(format #t "~%") diff --git a/test/old_goal_tests/tests/test-load-gcommon.gc b/test/old_goal_tests/tests/test-load-gcommon.gc deleted file mode 100644 index af516bee71..0000000000 --- a/test/old_goal_tests/tests/test-load-gcommon.gc +++ /dev/null @@ -1,5 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 'automatic-pass #f) - -(:gl) diff --git a/test/old_goal_tests/tests/test-member-1.gc b/test/old_goal_tests/tests/test-member-1.gc deleted file mode 100644 index 8f0ab48a37..0000000000 --- a/test/old_goal_tests/tests/test-member-1.gc +++ /dev/null @@ -1,4 +0,0 @@ -(test-setup '(c d) #f) - -(format #t "~A~%" - (member 'c (list 'a 'b 'c 'd))) diff --git a/test/old_goal_tests/tests/test-member-2.gc b/test/old_goal_tests/tests/test-member-2.gc deleted file mode 100644 index 2671d41277..0000000000 --- a/test/old_goal_tests/tests/test-member-2.gc +++ /dev/null @@ -1,5 +0,0 @@ -(test-setup #f #f) - -(format #t "~A~%" - (member 1234 (list 'a 'b 'c 'd)) - ) diff --git a/test/old_goal_tests/tests/test-memcpy.gc b/test/old_goal_tests/tests/test-memcpy.gc deleted file mode 100644 index 175ab9237e..0000000000 --- a/test/old_goal_tests/tests/test-memcpy.gc +++ /dev/null @@ -1,18 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup 13 #f) - -(let* ((base-addr #x6000000) - (offset #x123) - (ptr-int32 (the (pointer int32) base-addr)) - (ptr-int16 (the (pointer int16) #x6000123)) - ) - (set! (-> ptr-int32 1) #x00070006) - (mem-copy! ptr-int16 ptr-int32 8) - (+ (-> ptr-int16 2) - (-> ptr-int16 3) - ) - ) - - diff --git a/test/old_goal_tests/tests/test-memset.gc b/test/old_goal_tests/tests/test-memset.gc deleted file mode 100644 index 0995d5c31b..0000000000 --- a/test/old_goal_tests/tests/test-memset.gc +++ /dev/null @@ -1,25 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup #x0b #f) - -(let* ((base-addr #x6000000) - (word-cnt 23) - (base (the (pointer int32) base-addr)) - (foo (mem-set32! base #x0 (+ 1 word-cnt))) - (last-byte (the (pointer uint8) (+ base-addr 3 (* 4 (- word-cnt 1))))) - (dst (mem-set32! base #x0badbeef word-cnt)) - ) - - (if (!= dst base) - (format #t "test failed, bad base returned!~%") - ) - - (if (!= 0 (-> last-byte 1)) - (format #t "set too many bytes!~%") - ) - - (-> last-byte 0) - ) - - diff --git a/test/old_goal_tests/tests/test-methods.gc b/test/old_goal_tests/tests/test-methods.gc deleted file mode 100644 index c9a5a6846d..0000000000 --- a/test/old_goal_tests/tests/test-methods.gc +++ /dev/null @@ -1,8 +0,0 @@ - -(test-setup 12 #f) - -(expect-true (eq? (-> process methods 3) (method process inspect))) - -(expect-true (eq? (-> string methods 3) (method "test" inspect))) - -12 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-min-max.gc b/test/old_goal_tests/tests/test-min-max.gc deleted file mode 100644 index 29e6a1b945..0000000000 --- a/test/old_goal_tests/tests/test-min-max.gc +++ /dev/null @@ -1,6 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 10 #f) - -(+ (min 1 2) (min 2 -4) (max 10 2) (max 3 1)) diff --git a/test/old_goal_tests/tests/test-mlet.gc b/test/old_goal_tests/tests/test-mlet.gc deleted file mode 100644 index 28c364cbbc..0000000000 --- a/test/old_goal_tests/tests/test-mlet.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 10 #f) - -(defglobalconstant c1 3) - -(+ c1 (mlet ((c1 4)) - c1 - ) - c1 - ) diff --git a/test/old_goal_tests/tests/test-mod.gc b/test/old_goal_tests/tests/test-mod.gc deleted file mode 100644 index 9acc7bc16f..0000000000 --- a/test/old_goal_tests/tests/test-mod.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 7 #f) - -;; this computes nothing that we can check, but verifies that the coloring -;; doesn't do something crazy when constrained a little strangely -(rlet ((x :reg rsp :type int64)) - (mod x 2) - (mod 2 x) - ) - -(let ((x 33)) - (+ (mod x 10) 4) - ) diff --git a/test/old_goal_tests/tests/test-mul-1.gc b/test/old_goal_tests/tests/test-mul-1.gc deleted file mode 100644 index 77042112d4..0000000000 --- a/test/old_goal_tests/tests/test-mul-1.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - -(test-setup -12 #f) - -(defun product ((a integer) (b integer)) - (* b a) - ) - -(product 4 -3) - - diff --git a/test/old_goal_tests/tests/test-negative-integer-symbol.gc b/test/old_goal_tests/tests/test-negative-integer-symbol.gc deleted file mode 100644 index 5ab38699e1..0000000000 --- a/test/old_goal_tests/tests/test-negative-integer-symbol.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup -123 #f) - -(define a-negative-symbol -123) -a-negative-symbol diff --git a/test/old_goal_tests/tests/test-nested-blocks-1.gc b/test/old_goal_tests/tests/test-nested-blocks-1.gc deleted file mode 100644 index 7c07a89b55..0000000000 --- a/test/old_goal_tests/tests/test-nested-blocks-1.gc +++ /dev/null @@ -1,22 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 7 #f) - -(block outer-block - 1 - 2 - (block inner-block - 3 - 4 - (return-from inner-block 7) - 5 - 6 - ) - ) - -;; with v1. const prop and fancy coloring: -; 0: b8 07 00 00 00 mov eax,0x7 -; 5: e9 05 00 00 00 jmp 0xf -; a: b8 06 00 00 00 mov eax,0x6 -; f: c3 ret diff --git a/test/old_goal_tests/tests/test-nested-blocks-2.gc b/test/old_goal_tests/tests/test-nested-blocks-2.gc deleted file mode 100644 index cc219664ef..0000000000 --- a/test/old_goal_tests/tests/test-nested-blocks-2.gc +++ /dev/null @@ -1,16 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 8 #f) - -(block outer-block - 1 - 2 - (block inner-block - 3 - 4 - (return-from inner-block 7) - 5 - ) - 8 - ) diff --git a/test/old_goal_tests/tests/test-nested-blocks-3.gc b/test/old_goal_tests/tests/test-nested-blocks-3.gc deleted file mode 100644 index d01fdc3168..0000000000 --- a/test/old_goal_tests/tests/test-nested-blocks-3.gc +++ /dev/null @@ -1,16 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 7 #f) - -(block outer-block - 1 - 2 - (block inner-block - 3 - 4 - (return-from outer-block 7) - 5 - ) - 8 - ) diff --git a/test/old_goal_tests/tests/test-nested-car-cdr-set.gc b/test/old_goal_tests/tests/test-nested-car-cdr-set.gc deleted file mode 100644 index 1864a1b255..0000000000 --- a/test/old_goal_tests/tests/test-nested-car-cdr-set.gc +++ /dev/null @@ -1,13 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 'efgh #f) - -(let ((my-pair (cons (cons 'a 'b) (cons 'c 'd)))) - (set! (car (car my-pair)) 'e) - (set! (car (cdr my-pair)) 'f) - (set! (cdr (car my-pair)) 'g) - (set! (cdr (cdr my-pair)) 'h) - (format #t "~A~A~A~A~%" (car (car my-pair)) (car (cdr my-pair)) (cdr (car my-pair)) (cdr (cdr my-pair))) - (format #t "~A~%" my-pair) - ) diff --git a/test/old_goal_tests/tests/test-nested-function-call-2.gc b/test/old_goal_tests/tests/test-nested-function-call-2.gc deleted file mode 100644 index 003f8fefdd..0000000000 --- a/test/old_goal_tests/tests/test-nested-function-call-2.gc +++ /dev/null @@ -1,23 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 10 #f) - -;; by putting some more functions, we make sure that branches in functions -;; in later functions actually are using the right stuff -(defun first-function ((a integer)) - (+ a 2) - (+ a 3) - (+ a 4) - (+ a 6) - (+ a 10) - ) - -(defun second-function ((b integer)) - (if (> 2 b) - 0 - 10 - ) - ) - -(second-function (second-function (second-function 3))) diff --git a/test/old_goal_tests/tests/test-nested-function-call.gc b/test/old_goal_tests/tests/test-nested-function-call.gc deleted file mode 100644 index 0420d5e7b1..0000000000 --- a/test/old_goal_tests/tests/test-nested-function-call.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - -;; this is mostly to test that the coloring works. -(test-setup 2 #f) - -(defun r2 (one two three) - two) - -(defun r1 (one two three) - one) - - -(r2 1 (r1 2 3 4) 5) - diff --git a/test/old_goal_tests/tests/test-new-inline-array-class.gc b/test/old_goal_tests/tests/test-new-inline-array-class.gc deleted file mode 100644 index 13c3a2baea..0000000000 --- a/test/old_goal_tests/tests/test-new-inline-array-class.gc +++ /dev/null @@ -1,20 +0,0 @@ -(test-setup 2820 #f) - -(deftype my-inline-array-type (inline-array-class) - () - ) - -(set! (-> my-inline-array-type heap-base) 12) - -(let ((my-inline-array-obj - (the my-inline-array-type - ((-> my-inline-array-type methods 0) - 'debug - my-inline-array-type - 234)))) - ;;(-> my-inline-array-obj allocated-length) - (asize-of my-inline-array-obj) - ;;(inspect my-inline-array-type) - ;;(inspect my-inline-array-obj) - ;;(print-type my-inline-array-obj) - ) diff --git a/test/old_goal_tests/tests/test-new-string.gc b/test/old_goal_tests/tests/test-new-string.gc deleted file mode 100644 index 32f35de1d0..0000000000 --- a/test/old_goal_tests/tests/test-new-string.gc +++ /dev/null @@ -1,7 +0,0 @@ -(test-setup "alligator" #f) - -(let ((new-string (new 'global 'string 17 "alligator"))) - (expect-true (= 17 (-> new-string allocated-length))) - (expect-true (= 9 (length new-string))) - (printl new-string) - ) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-number-comparison.gc b/test/old_goal_tests/tests/test-number-comparison.gc deleted file mode 100644 index 6bc969d784..0000000000 --- a/test/old_goal_tests/tests/test-number-comparison.gc +++ /dev/null @@ -1,21 +0,0 @@ -(test-setup 4 #f) - -(expect-true (= 1.2 1.2)) -(expect-true (= 1 1)) -(expect-false (!= 1.2 1.2)) -(expect-false (= 1 2)) -(expect-true (= 1 1.2)) -(expect-false (= 1.2 1)) - -(expect-true (> 2 1)) -(expect-false (< 2 1)) - -(expect-true (> 3.2 3)) - -(expect-true (= 1 (the integer 1.2))) -(expect-true (= (the float 1) (the integer 1.2))) - -(expect-true (= 0.6 (- 1.2 0.6))) -(expect-true (= 0.6 (- 1.0 0.2 0.2))) -(expect-true (= 0.6 (- -0.6))) -4 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-packed-inline-array.gc b/test/old_goal_tests/tests/test-packed-inline-array.gc deleted file mode 100644 index 7a02863465..0000000000 --- a/test/old_goal_tests/tests/test-packed-inline-array.gc +++ /dev/null @@ -1,30 +0,0 @@ -(test-setup 16 #f) - -(deftype small-struct-packed (structure) - ((v1 int32) - (v2 int32) - (v3 int32)) - (:pack) - ) - -(deftype small-struct (structure) - ((v1 int32) - (v2 int32) - (v3 int32)) - (:no-pack) - ) - -(deftype test-struct-type (basic) - ((packed small-struct-packed 10 :inline #t) - (not-packed small-struct 10 :inline #t) - ) - ) - -(let* ((obj (new 'static 'test-struct-type)) - (pack-diff (- (the integer (&-> obj packed 1 v1)) (the integer (&-> obj packed 0 v1)))) - (unpack-diff (- (the integer (&-> obj not-packed 1 v1)) (the integer (&-> obj not-packed 0 v1)))) - ) - - (expect-true (eq? 12 pack-diff)) - unpack-diff - ) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-pair-asize.gc b/test/old_goal_tests/tests/test-pair-asize.gc deleted file mode 100644 index d38ed89c00..0000000000 --- a/test/old_goal_tests/tests/test-pair-asize.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 8 #f) -(let ((lst (list 5 4 3 2 1 0))) - (asize-of (the pair lst)) - ) - diff --git a/test/old_goal_tests/tests/test-pair-length.gc b/test/old_goal_tests/tests/test-pair-length.gc deleted file mode 100644 index f47e613a49..0000000000 --- a/test/old_goal_tests/tests/test-pair-length.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 6 #f) -(let ((lst (list 5 4 3 2 1 0))) - (length (the pair lst)) - ) - diff --git a/test/old_goal_tests/tests/test-pairp.gc b/test/old_goal_tests/tests/test-pairp.gc deleted file mode 100644 index 70730561c9..0000000000 --- a/test/old_goal_tests/tests/test-pairp.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - -(test-setup "test pass" #f) - -;; add two numbers in a function - -(expect-true (pair? '())) -(expect-false (pair? integer)) -(print "test pass") -(format #t "~%") - diff --git a/test/old_goal_tests/tests/test-pointer-as-array-numbers.gc b/test/old_goal_tests/tests/test-pointer-as-array-numbers.gc deleted file mode 100644 index 0e0ab51447..0000000000 --- a/test/old_goal_tests/tests/test-pointer-as-array-numbers.gc +++ /dev/null @@ -1,16 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup 13 #f) - -(let* ((base-addr #x6000000) - (ptr-int32 (the (pointer int32) base-addr)) - (ptr-int16 (the (pointer int16) base-addr)) - ) - (set! (-> ptr-int32 1) #x00070006) - (+ (-> ptr-int16 2) - (-> ptr-int16 3) - ) - ) - - diff --git a/test/old_goal_tests/tests/test-print-binteger.gc b/test/old_goal_tests/tests/test-print-binteger.gc deleted file mode 100644 index 73032b4ea7..0000000000 --- a/test/old_goal_tests/tests/test-print-binteger.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup -13 #f) -(printl (the binteger -13)) - - diff --git a/test/old_goal_tests/tests/test-protect.gc b/test/old_goal_tests/tests/test-protect.gc deleted file mode 100644 index 093e7a9873..0000000000 --- a/test/old_goal_tests/tests/test-protect.gc +++ /dev/null @@ -1,20 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 33 #f) - -(let ((var1 10) - (var2 20) - (sum 0) - ) - - (protect (var1 var2) - (set! var1 1) - (set! var2 2) - (+! sum var1) - (+! sum var2) - ) - (+! sum var1) - (+! sum var2) - sum - ) diff --git a/test/old_goal_tests/tests/test-qmemcpy-down.gc b/test/old_goal_tests/tests/test-qmemcpy-down.gc deleted file mode 100644 index c805d162db..0000000000 --- a/test/old_goal_tests/tests/test-qmemcpy-down.gc +++ /dev/null @@ -1,17 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup 13 #f) - -(let* ((base-addr #x6000000) - (ptr-int32 (the (pointer int32) base-addr)) - (ptr-int16 (the (pointer int16) #x6000120)) - ) - (set! (-> ptr-int32 1) #x00070006) - (qmem-copy<-! ptr-int16 ptr-int32 8) - (+ (-> ptr-int16 2) - (-> ptr-int16 3) - ) - ) - - diff --git a/test/old_goal_tests/tests/test-qmemcpy-up.gc b/test/old_goal_tests/tests/test-qmemcpy-up.gc deleted file mode 100644 index 4c7ae0537b..0000000000 --- a/test/old_goal_tests/tests/test-qmemcpy-up.gc +++ /dev/null @@ -1,17 +0,0 @@ - ;-*-Scheme-*- - -;; add two constants together. -(test-setup 5 #f) - -(let* ((base-addr #x6000000) - (ptr-int32 (the (pointer int32) base-addr)) - (ptr-int16 (the (pointer uint8) #x6000120)) - ) - (set! (-> ptr-int32 2) #x11031102) - (qmem-copy->! ptr-int16 ptr-int32 16) - (+ (-> ptr-int16 8) - (-> ptr-int16 10) - ) - ) - - diff --git a/test/old_goal_tests/tests/test-quote-symbol.gc b/test/old_goal_tests/tests/test-quote-symbol.gc deleted file mode 100644 index a370d01f76..0000000000 --- a/test/old_goal_tests/tests/test-quote-symbol.gc +++ /dev/null @@ -1,10 +0,0 @@ - ;-*-Scheme-*- - -;; a bit of a hack on how this one works, but I think it's ok for now. -(test-setup 'beans #f) - -(define my-sym 'apples) -(set! my-sym 'beans) -(printl my-sym) - - diff --git a/test/old_goal_tests/tests/test-ref.gc b/test/old_goal_tests/tests/test-ref.gc deleted file mode 100644 index e7ba49705e..0000000000 --- a/test/old_goal_tests/tests/test-ref.gc +++ /dev/null @@ -1,5 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 83 #f) - -(ref (list 1 23 5 83 4) 3) diff --git a/test/old_goal_tests/tests/test-return-from-f-tricky-color.gc b/test/old_goal_tests/tests/test-return-from-f-tricky-color.gc deleted file mode 100644 index 2536e18675..0000000000 --- a/test/old_goal_tests/tests/test-return-from-f-tricky-color.gc +++ /dev/null @@ -1,28 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 77 #f) - -(defun get-an-integer () - 12) - - -(defun test-function ((x integer)) - (while (> x 20) - (set! x (- x 1)) - ;;(format #t " x is now ~d~%" x) - (if (> 30 x) - (return-from #f 77) - ) - - (if (= (get-an-integer) 13) - (format #t "bad!~%") - ) - 987 - ) - ) - -(let ((result (test-function 64))) - result - ) - diff --git a/test/old_goal_tests/tests/test-return-from-f.gc b/test/old_goal_tests/tests/test-return-from-f.gc deleted file mode 100644 index c64e7632ef..0000000000 --- a/test/old_goal_tests/tests/test-return-from-f.gc +++ /dev/null @@ -1,20 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 77 #f) - -(defun test-function ((x integer)) - (while (> x 20) - (set! x (- x 1)) - ;;(format #t " x is now ~d~%" x) - (if (> 30 x) - (return-from #f 77) - ) - ) - 987 - ) - -(let ((result (test-function 64))) - result - ) - diff --git a/test/old_goal_tests/tests/test-return-integer.gc b/test/old_goal_tests/tests/test-return-integer.gc deleted file mode 100644 index c40bd19adb..0000000000 --- a/test/old_goal_tests/tests/test-return-integer.gc +++ /dev/null @@ -1,13 +0,0 @@ - ;-*-Scheme-*- - - -;; needs reset because it is the first test - -; test a 64-bit integer. -(test-setup #x123456789 #t) -(test-result #x123456789) - -; result is (same as gcc and clang exactly!) -; 0: 48 b8 89 67 45 23 01 movabs rax,0x123456789 -; 7: 00 00 00 -; a: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-integer1.gc b/test/old_goal_tests/tests/test-return-integer1.gc deleted file mode 100644 index e3a2023b8e..0000000000 --- a/test/old_goal_tests/tests/test-return-integer1.gc +++ /dev/null @@ -1,8 +0,0 @@ -; return something that fits in u32 and s32 - -(test-setup #x17 #f) -(test-result #x17) - -; result is (same as gcc and clang exactly) -; 0: b8 17 00 00 00 mov eax,0x17 -; 5: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-integer2.gc b/test/old_goal_tests/tests/test-return-integer2.gc deleted file mode 100644 index 2005d24445..0000000000 --- a/test/old_goal_tests/tests/test-return-integer2.gc +++ /dev/null @@ -1,8 +0,0 @@ -; return something that fits in u32 and but not s32 - -(test-setup #xaaaaaaaa #f) -(test-result #xaaaaaaaa) - -; result, matches gcc/clang exactly -; 0: b8 aa aa aa aa mov eax,0xaaaaaaaa -; 5: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-integer3.gc b/test/old_goal_tests/tests/test-return-integer3.gc deleted file mode 100644 index 0517ad2ca6..0000000000 --- a/test/old_goal_tests/tests/test-return-integer3.gc +++ /dev/null @@ -1,8 +0,0 @@ -; return something negative that fits in s32 - -(test-setup -17 #f) -(test-result -17) - -; matches clang/gcc exactly -; 0: 48 c7 c0 ef ff ff ff mov rax,0xffffffffffffffef -; 7: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-integer4.gc b/test/old_goal_tests/tests/test-return-integer4.gc deleted file mode 100644 index 3db2b1032d..0000000000 --- a/test/old_goal_tests/tests/test-return-integer4.gc +++ /dev/null @@ -1,8 +0,0 @@ -; return something negative that does fit in s32 - -(test-setup -2147483648 #f) -(test-result -2147483648) - -; result, exactly matches gcc/clang -; 0: 48 c7 c0 00 00 00 80 mov rax,0xffffffff80000000 -; 7: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-integer5.gc b/test/old_goal_tests/tests/test-return-integer5.gc deleted file mode 100644 index a43aea0609..0000000000 --- a/test/old_goal_tests/tests/test-return-integer5.gc +++ /dev/null @@ -1,7 +0,0 @@ -(test-setup -2147483649 #f) -(test-result -2147483649) - -; result, exactly matches gcc/clang -; 0: 48 b8 ff ff ff 7f ff movabs rax,0xffffffff7fffffff -; 7: ff ff ff -; a: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-integer6.gc b/test/old_goal_tests/tests/test-return-integer6.gc deleted file mode 100644 index 67f5e788dc..0000000000 --- a/test/old_goal_tests/tests/test-return-integer6.gc +++ /dev/null @@ -1,7 +0,0 @@ -(test-setup 0 #f) -(test-result 0) - -; Result, exactly matches gcc/clang: -; beautiful 3-byte function! -; 0: 31 c0 xor eax,eax -; 2: c3 ret \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-return-negative-integer.gc b/test/old_goal_tests/tests/test-return-negative-integer.gc deleted file mode 100644 index 07831a5ac8..0000000000 --- a/test/old_goal_tests/tests/test-return-negative-integer.gc +++ /dev/null @@ -1,5 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup -123 #f) -(test-result -123) diff --git a/test/old_goal_tests/tests/test-return-value-of-if.gc b/test/old_goal_tests/tests/test-return-value-of-if.gc deleted file mode 100644 index cdc7b9cc0d..0000000000 --- a/test/old_goal_tests/tests/test-return-value-of-if.gc +++ /dev/null @@ -1,13 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 123 #f) - - -(let ((x (if (> 1 2) "a string!")) - (y (if (> 2 1) 123))) - (if x - (format #t "failure!") - ) - y - ) - diff --git a/test/old_goal_tests/tests/test-set-symbol.gc b/test/old_goal_tests/tests/test-set-symbol.gc deleted file mode 100644 index bfa9249340..0000000000 --- a/test/old_goal_tests/tests/test-set-symbol.gc +++ /dev/null @@ -1,21 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 22 #f) - -(defun burp ((thing integer)) - (* thing 3) - ) - -(define thing 2) - -(set! thing 3) - - -(+ (let ((thing 4)) - (set! thing (+ thing 1)) - thing - ) - (burp thing) - (set! thing 4) - thing - ) diff --git a/test/old_goal_tests/tests/test-shiftvs.gc b/test/old_goal_tests/tests/test-shiftvs.gc deleted file mode 100644 index 1fa2faab45..0000000000 --- a/test/old_goal_tests/tests/test-shiftvs.gc +++ /dev/null @@ -1,7 +0,0 @@ - ;-*-Scheme-*- - - -(test-setup 11 #f) - -(+ (shlv 2 3) (shlv 1 0) (shlv 0 4) (shrv 2 3) (shrv 10 2) (shlv -2 1) (sarv -16 2)) -;; 16 1 0 0 2 -4 -4 diff --git a/test/old_goal_tests/tests/test-signed-int-compare.gc b/test/old_goal_tests/tests/test-signed-int-compare.gc deleted file mode 100644 index 4b03e3dad4..0000000000 --- a/test/old_goal_tests/tests/test-signed-int-compare.gc +++ /dev/null @@ -1,57 +0,0 @@ - ;-*-Scheme-*- - -;; test many comparisons of signed numbers -(test-setup 12 #f) - -(let ((total 0)) - (if (> 2 -1) - (+! total 1) - (+! total 999) - ) - (if (> -20 3) - (+! total 999) - (+! total 1) - ) - (if (> 1 1) - (+! total 999) - (+! total 1) - ) - (if (< -1 2) - (+! total 1) - (+! total 999) - ) - (if (< 2 -1) - (+! total 999) - (+! total 1) - ) - (if (< 3 3) - (+! total 999) - (+! total 1) - ) - - (if (>= 2 -1) - (+! total 1) - (+! total 999) - ) - (if (>= -20 3) - (+! total 999) - (+! total 1) - ) - (if (>= 1 1) - (+! total 1) - (+! total 999) - ) - (if (<= -1 2) - (+! total 1) - (+! total 999) - ) - (if (<= 2 -1) - (+! total 999) - (+! total 1) - ) - (if (<= 3 3) - (+! total 1) - (+! total 999) - ) - total - ) diff --git a/test/old_goal_tests/tests/test-simple-function-call.gc b/test/old_goal_tests/tests/test-simple-function-call.gc deleted file mode 100644 index 0812206568..0000000000 --- a/test/old_goal_tests/tests/test-simple-function-call.gc +++ /dev/null @@ -1,8 +0,0 @@ - ;-*-Scheme-*- - -;; this math will be evaluted in goos -(test-setup (+ 1 (* 2 2) (* 3 3) (* 4 4)) #f) - -;; this relies on the c kernel having this test-function defined. - -(test-result (test-function 1 2 3 4)) diff --git a/test/old_goal_tests/tests/test-sort.gc b/test/old_goal_tests/tests/test-sort.gc deleted file mode 100644 index c75edbcb43..0000000000 --- a/test/old_goal_tests/tests/test-sort.gc +++ /dev/null @@ -1,12 +0,0 @@ -(test-setup '(2 3 4 7 9) #f) - - - -(let ((my-list - (list 24 16 32 56 72) - )) - (sort my-list (lambda ((x integer) (y integer)) (- x y))) - ;;(sort my-list (lambda (x y) (<= x y))) - (format #t "~A~%" my-list) - ) - diff --git a/test/old_goal_tests/tests/test-static-new-integer-field.gc b/test/old_goal_tests/tests/test-static-new-integer-field.gc deleted file mode 100644 index a95b568227..0000000000 --- a/test/old_goal_tests/tests/test-static-new-integer-field.gc +++ /dev/null @@ -1,12 +0,0 @@ -(test-setup 213 #f) - -(deftype test-static-type (basic) - ((pad int32) - (value int16) - ) - ) - -(let ((new-obj (new 'static 'test-static-type :value 213))) - (expect-true (= test-static-type (-> new-obj type))) - (-> new-obj value) - ) \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-string-constant-1.gc b/test/old_goal_tests/tests/test-string-constant-1.gc deleted file mode 100644 index 2ca1591fd3..0000000000 --- a/test/old_goal_tests/tests/test-string-constant-1.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - -;; this is just a "does it crash?" test, and doesn't actually verify the strings are correct. -;; but this is all we have for now -(test-setup 'automatic-pass #f) - -(inspect "this is a string") -(define x "this is also a string") -(inspect x) - -(test-result 1) diff --git a/test/old_goal_tests/tests/test-string-constant-2.gc b/test/old_goal_tests/tests/test-string-constant-2.gc deleted file mode 100644 index cabecdebfc..0000000000 --- a/test/old_goal_tests/tests/test-string-constant-2.gc +++ /dev/null @@ -1,8 +0,0 @@ - ;-*-Scheme-*- - -;; a bit of a hack on how this one works, but I think it's ok for now. -(test-setup "this is a string" #f) - -(print "this is a string") - - diff --git a/test/old_goal_tests/tests/test-string-type.gc b/test/old_goal_tests/tests/test-string-type.gc deleted file mode 100644 index 7d586d57e8..0000000000 --- a/test/old_goal_tests/tests/test-string-type.gc +++ /dev/null @@ -1,15 +0,0 @@ -(test-setup "tfs" #f) - -(expect-true (= 101 (-> "test" data 1))) -(expect-true (= 4 (-> "test" allocated-length))) -(expect-true (= 13 (asize-of "test"))) - -(let ((temp "test")) - (set! (-> temp data 1) 102) - (set! (-> temp data 3) 0) - (expect-true (= 3 (length temp))) - (format #t "~A~%" temp) - - ) - -1 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-sub-1.gc b/test/old_goal_tests/tests/test-sub-1.gc deleted file mode 100644 index 611f3ea25b..0000000000 --- a/test/old_goal_tests/tests/test-sub-1.gc +++ /dev/null @@ -1,22 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 4 #f) - -(defun negative ((a integer)) - (- a) - ) - -(defun minus-two ((a integer)) - (- a 2) - ) - - -(defun sub-test ((a integer) (b integer)) - (- 1 a b) - ) - -(let ((x (sub-test 1 (minus-two 7)))) - (- 1 x (- -2)) - ) - - diff --git a/test/old_goal_tests/tests/test-sub-2.gc b/test/old_goal_tests/tests/test-sub-2.gc deleted file mode 100644 index 0f93e6b3fb..0000000000 --- a/test/old_goal_tests/tests/test-sub-2.gc +++ /dev/null @@ -1,23 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 4 #f) - -(defun negative ((a integer)) - (- a) - ) - -(defun minus-two ((a integer)) - (- a 2) - ) - - -(defun sub-test ((a integer) (b integer)) - (- 1 a b) - ) - -(let ((x (sub-test 1 (minus-two 7)))) - (- 1 (negative -2) x) - ) - - - diff --git a/test/old_goal_tests/tests/test-three-reg-add.gc b/test/old_goal_tests/tests/test-three-reg-add.gc deleted file mode 100644 index 80c471ca57..0000000000 --- a/test/old_goal_tests/tests/test-three-reg-add.gc +++ /dev/null @@ -1,14 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 7 #f) - -;; this will terribly crash things if the coloring goes wrong. -(rlet ((x :reg rsp :type int32)) - (+ x 3) - ) - -(let ((x 3)) - (+ (+ x 1) x) - ) - - diff --git a/test/old_goal_tests/tests/test-three-reg-mult.gc b/test/old_goal_tests/tests/test-three-reg-mult.gc deleted file mode 100644 index a43c355d5b..0000000000 --- a/test/old_goal_tests/tests/test-three-reg-mult.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 3 #f) - -(let ((x 3)) - (* x 4) - (* x) - x - ) - - diff --git a/test/old_goal_tests/tests/test-three-reg-sub.gc b/test/old_goal_tests/tests/test-three-reg-sub.gc deleted file mode 100644 index ade946dba0..0000000000 --- a/test/old_goal_tests/tests/test-three-reg-sub.gc +++ /dev/null @@ -1,11 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 3 #f) - -(let ((x 3)) - (- x 1) - (- x) - x - ) - - diff --git a/test/old_goal_tests/tests/test-type-arrays.gc b/test/old_goal_tests/tests/test-type-arrays.gc deleted file mode 100644 index 2ec28d3e69..0000000000 --- a/test/old_goal_tests/tests/test-type-arrays.gc +++ /dev/null @@ -1,80 +0,0 @@ -(test-setup 18 #f) - -;; no value, no array, no inline - -;; todo test signed/unsigned loads/stores etc... - -;; TODO - this test is not done. - -(defmacro new-type-hack (type-name) - `(the ,type-name ((-> ,type-name methods 0) 'global ,type-name)) - ) - -(deftype basic-type (basic) - ( - (flt float) - (dec int32) - ) - ) - -(deftype struct-type (structure) - ( - (flt float :offset-assert 0) - (dec int32 :offset-assert 4) - (flt-overlay float :offset 4) - (dec-overlay int32 :offset 4) - ) - ) - -(let ((obj-test (new-type-hack struct-type))) - ;(inspect obj-test) - (set! (-> obj-test dec) #x00f0f0f0) - (set! (-> obj-test flt) 123.456) - (expect (-> obj-test dec-overlay) #x00f0f0f0) - - ;((-> struct-type methods 3) obj-test) - ) - - -;;;;;; TEST 000 -;; create a new typ000 (no value, no array, no inline) -(deftype type000 (basic) - ( - (pad int32) - (x basic-type) - ) - ) - - -(let ((obj000 (new-type-hack type000)) - (bo (new-type-hack basic-type)) - ) - (set! (-> obj000 x) bo) - (expect (-> obj000 x type) basic-type) - ) - - -;;;;;; TEST 001 -;; create a new type001 (no value, no array, yes inline) -(deftype type001 (basic) - ((pad int32) - (x struct-type) - ) - ) - - -(let ((obj001 (new-type-hack type001)) - (sub-obj (new-type-hack struct-type))) - ;;(inspect obj001) - (set! (-> obj001 x) sub-obj) - (set! (-> obj001 x dec) 12) - (expect 12 (-> sub-obj dec)) - ;(inspect obj001) - ;((-> struct-type methods 3) (-> obj001 x)) - ) - - -;;;;;; TEST 010 -;; no value, yes array, no inline - -18 \ No newline at end of file diff --git a/test/old_goal_tests/tests/test-with-inline.gc b/test/old_goal_tests/tests/test-with-inline.gc deleted file mode 100644 index 400395e852..0000000000 --- a/test/old_goal_tests/tests/test-with-inline.gc +++ /dev/null @@ -1,26 +0,0 @@ - ;-*-Scheme-*- - -(test-setup 20 #f) - -(defglobalconstant constant 3) - -(defun inline-test-3 ((x integer)) - (declare (allow-inline)) - (* constant x) - ) - - -(let ((old-value (inline-test-3 2))) ;; 6 - (with-inline #t - (defglobalconstant constant 4) - (let ((second-value (inline-test-3 2))) ;; 8 - (with-inline #f - (+ old-value second-value (inline-test-3 2)) ;; 6 - ;;(inline-test-3 2) - ) - ) - ) - ) - -;; 6 good -;; 8 good diff --git a/test/test_compiler_and_runtime.cpp b/test/test_compiler_and_runtime.cpp index 8fb7b481ab..26f35b5970 100644 --- a/test/test_compiler_and_runtime.cpp +++ b/test/test_compiler_and_runtime.cpp @@ -10,27 +10,6 @@ TEST(CompilerAndRuntime, ConstructCompiler) { Compiler compiler; } -TEST(CompilerAndRuntime, StartRuntime) { - std::thread runtime_thread([]() { exec_runtime(0, nullptr); }); - - listener::Listener listener; - while (!listener.is_connected()) { - listener.connect_to_target(); - std::this_thread::sleep_for(std::chrono::microseconds(1000)); - } - - listener.send_reset(true); - runtime_thread.join(); -} - -TEST(CompilerAndRuntime, SendProgram) { - std::thread runtime_thread([]() { exec_runtime(0, nullptr); }); - Compiler compiler; - compiler.run_test("goal_src/test/test-return-integer-1.gc"); - compiler.shutdown_target(); - runtime_thread.join(); -} - namespace { std::string escaped_string(const std::string& in) { std::string result; @@ -115,14 +94,45 @@ std::vector get_test_pass_string(const std::string& name, int n_tes return {fmt::format("Test \"{}\": {} Passes\n0\n", name, n_tests)}; } +void runtime_no_kernel() { + constexpr int argc = 4; + const char* argv[argc] = {"", "-fakeiso", "-debug", "-nokernel"}; + exec_runtime(argc, const_cast(argv)); +} + +void runtime_with_kernel() { + constexpr int argc = 3; + const char* argv[argc] = {"", "-fakeiso", "-debug"}; + exec_runtime(argc, const_cast(argv)); +} } // namespace +TEST(CompilerAndRuntime, StartRuntime) { + std::thread runtime_thread(runtime_no_kernel); + + listener::Listener listener; + while (!listener.is_connected()) { + listener.connect_to_target(); + std::this_thread::sleep_for(std::chrono::microseconds(1000)); + } + + listener.send_reset(true); + runtime_thread.join(); +} + +TEST(CompilerAndRuntime, SendProgram) { + std::thread runtime_thread(runtime_no_kernel); + Compiler compiler; + compiler.run_test("goal_src/test/test-return-integer-1.gc"); + compiler.shutdown_target(); + runtime_thread.join(); +} + TEST(CompilerAndRuntime, BuildGameAndTest) { - std::thread runtime_thread([]() { exec_runtime(0, nullptr); }); Compiler compiler; try { - compiler.run_test("goal_src/test/test-build-game.gc"); + compiler.run_test_no_load("goal_src/test/test-build-game.gc"); } catch (std::exception& e) { fprintf(stderr, "caught exception %s\n", e.what()); EXPECT_TRUE(false); @@ -131,7 +141,7 @@ TEST(CompilerAndRuntime, BuildGameAndTest) { // todo, tests after loading the game. CompilerTestRunner runner; runner.c = &compiler; - + std::thread runtime_thread(runtime_with_kernel); runner.run_test("test-min-max.gc", {"10\n"}); runner.run_test("test-bfloat.gc", {"data 1.2330 print 1.2330 type bfloat\n0\n"}); runner.run_test("test-basic-type-check.gc", {"#f#t#t#f#t#f#t#t\n0\n"}); @@ -169,6 +179,10 @@ TEST(CompilerAndRuntime, BuildGameAndTest) { runner.run_test("test-number-comparison.gc", {"Test \"number-comparison\": 14 Passes\n0\n"}); runner.run_test("test-approx-pi.gc", get_test_pass_string("approx-pi", 4)); runner.run_test("test-dynamic-type.gc", get_test_pass_string("dynamic-type", 4)); + runner.run_test("test-string-type.gc", get_test_pass_string("string-type", 4)); + runner.run_test("test-new-string.gc", get_test_pass_string("new-string", 5)); + runner.run_test("test-addr-of.gc", get_test_pass_string("addr-of", 2)); + runner.run_test("test-set-self.gc", {"#t\n0\n"}); runner.print_summary(); @@ -219,7 +233,7 @@ TEST(CompilerAndRuntime, AllowInline) { } TEST(CompilerAndRuntime, CompilerTests) { - std::thread runtime_thread([]() { exec_runtime(0, nullptr); }); + std::thread runtime_thread(runtime_no_kernel); Compiler compiler; CompilerTestRunner runner; runner.c = &compiler; diff --git a/test/test_goos.cpp b/test/test_goos.cpp index d723fae816..7b5216179a 100644 --- a/test/test_goos.cpp +++ b/test/test_goos.cpp @@ -1290,3 +1290,13 @@ TEST(GoosSpecialForms, And) { EXPECT_ANY_THROW(e(i, x)); } } + +TEST(GoosBuiltins, Format) { + Interpreter i; + EXPECT_EQ(e(i, "(fmt #f \"{}, {}, {}\" 3 'bean \"str\")"), "\"3, bean, str\""); +} + +TEST(GoosBuiltins, Error) { + Interpreter i; + EXPECT_ANY_THROW(e(i, "(error \"hi\")")); +} \ No newline at end of file diff --git a/third-party/fmt/format.h b/third-party/fmt/format.h index 17509b7b45..39e8e106e6 100644 --- a/third-party/fmt/format.h +++ b/third-party/fmt/format.h @@ -1598,9 +1598,10 @@ template struct int_writer { make_checked(p, s.size())); } if (prefix_size != 0) p[-1] = static_cast('-'); - using iterator = remove_reference_t; + // NOTE - modified as part of jak-project to avoid compiler warning about shadowing + using iterator_ = remove_reference_t; auto data = buffer.data(); - out = write_padded(out, specs, size, size, [=](iterator it) { + out = write_padded(out, specs, size, size, [=](iterator_ it) { return copy_str(data, data + size, it); }); }