Archive/jak-project
1
0
Fork 0
mirror of https://github.com/open-goal/jak-project.git synced 2024-10-20 11:26:18 -04:00
Code Issues Actions 3 Packages Projects Releases Wiki Activity

Clean up files in kernel (#625)

Browse source 
* clean up gcommon

* cleanup kernel
This commit is contained in:
water111 2021-06-25 17:55:50 -04:00 committed by GitHub
parent 9e6dec9829
commit bfc1173ed5
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
9 changed files with 760 additions and 768 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
docs/markdown/progress-notes/changelog.md
View file

@ -166,3 +166,5 @@
- The `declare-type` form now supports any parent type. The type system will do a better job of trying to make things work out when only part of the type hierarchy is defined, and you can now chain type forward declarations. The compiler is stricter and will not accept forward declarations that are possibly incompatible. Instead, forward declare enough types and their parents for the compiler to be able to figure it out.
- The `deftype` form is more strict and will throw an error if the type definition is in any way incompatible with existing forward declarations of types.
- Added a `type-ref` form to insert a reference to a type into a static structure and optionally forward declare the number of methods
- The `method-of-type` form will now accept an expression returning a type instead of just a type name. In this case, it will only allow you to access method of `object`.
- Added a `defun-recursive` to make it easier to define recursive functions

17
goal_src/goal-lib.gc
View file

@ -217,6 +217,23 @@
)
)
;; the compiler can't figure out types of a recursive function without
;; first knowing the return type, so we use this form to forward declare
;; and define a function.
(defmacro defun-recursive (name return-type bindings &rest body)
`(begin
(define-extern ,name
(function ,@(apply (lambda (x)
(if (pair? x)
(second x)
'object)
)
bindings)
,return-type))
(defun ,name ,bindings ,@body)
)
)
(defmacro defun-extern (function-name &rest type-info)
`(define-extern ,function-name (function ,@type-info))
)

4
goal_src/goos-lib.gs
View file

@ -157,6 +157,10 @@
`(type? 'integer ,x)
)
(defsmacro pair? (x)
`(type? 'pair ,x)
)
(defsmacro ferror (&rest args)
`(error (fmt #f ,@args))
)

778
goal_src/kernel/gcommon.gc
View file

File diff suppressed because it is too large Load diff

2
goal_src/kernel/gkernel.gc
View file

@ -98,7 +98,7 @@
;; all user code (that I know of) runs using *dram-stack*
(define *dram-stack* (new 'global 'array 'uint8 DPROCESS_STACK_SIZE))
;; note - this name is a bit confusing. The kernel-dram-stack is not the stack that the kernel runs in.
;; I think it refers to the fact that it's _not_ the scratchpad stack (which wasn't used anyway)
;; I think it refers to the fact that it's _not_ the scratchpad stack
(defconstant *kernel-dram-stack* (&+ *dram-stack* DPROCESS_STACK_SIZE))
;; I don't think this stack is used, but I'm not sure.

271
goal_src/kernel/gstring.gc
View file

@ -5,11 +5,20 @@
;; 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!
;; The GOAL string type is like a C string plus a length field.
;; The number of bytes stored is the length + 1 for the null terminator.
;; Note that string is a bit of a special type, and the compiler assumes there is no
;; child type of string ever created.
;;;;;;;;;;;;;;;;;;;;;;;;;
;; String methods
;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod length string ((obj string))
; Get the length of a string. Like strlen
"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)))
@ -19,9 +28,7 @@
)
(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.
"get the size in bytes of a string."
(+ (-> obj allocated-length) 1 (-> string size))
)
@ -60,48 +67,52 @@
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
;; String comparison
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun string= ((str-a string) (str-b string))
"Does str-a hold the same data as str-b?.
If either string is null, returns #f."
(local-vars (b-ptr (pointer uint8)) (a-ptr (pointer uint8)))
(set! a-ptr (-> str-a data))
(set! b-ptr (-> str-b data))
(if (or (zero? str-a) (zero? str-b))
(return '#f)
(let ((a-ptr (-> str-a data))
(b-ptr (-> str-b data))
)
(if (or (zero? str-a) (zero? str-b))
(return #f)
)
;; loop until we reach the end of one string
(while (and (nonzero? (-> a-ptr 0)) (nonzero? (-> b-ptr 0)))
(if (!= (-> a-ptr 0) (-> b-ptr 0))
(return '#f)
(return #f)
)
(set! a-ptr (&-> a-ptr 1))
(set! b-ptr (&-> b-ptr 1))
)
;; only equal if both at the end.
;; only equal if both end here.
(and (zero? (-> a-ptr 0)) (zero? (-> b-ptr 0)))
)
)
(defun string-charp= ((str string) (charp (pointer uint8)))
"Is the data in str equal to the C string charp?"
(local-vars (str-ptr (pointer uint8)))
(set! str-ptr (-> str data))
(let ((str-ptr (-> str data)))
(while (and (nonzero? (-> str-ptr 0)) (nonzero? (-> charp 0)))
(if (!= (-> str-ptr 0) (-> charp 0))
(return '#f)
(return #f)
)
(set! str-ptr (&-> str-ptr 1))
(set! charp (&-> charp 1))
)
(and (zero? (-> str-ptr 0)) (zero? (-> charp 0)))
)
)
(defun name= ((arg0 basic) (arg1 basic))
"Do arg0 and arg1 have the same name?
This can use either strings or symbols"
(cond
((= arg0 arg1)
"Either same symbols, or same string objects, fast check pass!"
'#t)
;; Either same symbols, or same string objects, fast check pass!
#t)
((and (= (-> arg0 type) string) (= (-> arg1 type) string))
(string= (the-as string arg0) (the-as string arg1))
)
@ -111,35 +122,38 @@
((and (= (-> arg1 type) string) (= (-> arg0 type) symbol))
(string= (the-as string arg1) (symbol->string arg0))
)
;; no need to check symbol - symbol, that would have passed the first check.
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
;; String copying
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun copyn-string<-charp ((str string) (charp (pointer uint8)) (len int))
"Copy data from a charp to a GOAL string. Copies len chars, plus a null."
(local-vars (str-ptr (pointer uint8)) (i int))
(set! str-ptr (-> str data))
(set! i 0)
(while (< i len)
(let ((str-ptr (-> str data)))
(dotimes (i len)
(set! (-> str-ptr 0) (-> charp 0))
(set! str-ptr (&-> str-ptr 1))
(set! charp (&-> charp 1))
(set! i (+ i 1))
)
(set! (-> str-ptr 0) 0)
(set! (-> str-ptr 0) (the-as uint 0))
)
str
)
(defun string<-charp ((str string) (charp (pointer uint8)))
"Copy all chars from a char* to a GOAL string.
Does NO length checking."
(local-vars (str-ptr (pointer uint8)))
(set! str-ptr (-> str data))
(let ((str-ptr (-> str data)))
(while (nonzero? (-> charp 0))
(set! (-> str-ptr 0) (-> charp 0))
(set! str-ptr (&-> str-ptr 1))
(set! charp (&-> charp 1))
)
(set! (-> str-ptr 0) 0)
(set! (-> str-ptr 0) (the-as uint 0))
)
str
)
@ -169,47 +183,38 @@
(defun cat-string<-string ((a string) (b string))
"Append b to a. No length checks"
(local-vars (a-ptr (pointer uint8)) (b-ptr (pointer uint8)))
(set! a-ptr (-> a data))
(set! b-ptr (-> b data))
;; seek to the end of a
(let ((a-ptr (-> a data)))
(let ((b-ptr (-> b data)))
(while (nonzero? (-> a-ptr 0))
(nop!)
(nop!)
(nop!)
(set! a-ptr (&-> a-ptr 1))
)
;; append b
(while (nonzero? (-> b-ptr 0))
(set! (-> a-ptr 0) (-> b-ptr 0))
(set! a-ptr (&-> a-ptr 1))
(set! b-ptr (&-> b-ptr 1))
)
;; null terminate
(set! (-> a-ptr 0) 0)
)
(set! (-> a-ptr 0) (the-as uint 0))
)
a
)
(defun catn-string<-charp ((a string) (b (pointer uint8)) (len int))
"Append b to a, exactly len chars"
(local-vars (a-ptr (pointer uint8)) (i int) )
(set! a-ptr (-> a data))
;; seek to end of a
(let ((a-ptr (-> a data)))
(while (nonzero? (-> a-ptr 0))
(nop!)
(nop!)
(nop!)
(set! a-ptr (&-> a-ptr 1))
)
;; append
(set! i 0)
(while (< i len)
(dotimes (i len)
(set! (-> a-ptr 0) (-> b 0))
(set! a-ptr (&-> a-ptr 1))
(set! b (&-> b 1))
(set! i (+ i 1))
)
(set! (-> a-ptr 0) 0)
(set! (-> a-ptr 0) (the-as uint 0))
)
a
)
@ -254,6 +259,10 @@
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;
;; String utilities
;;;;;;;;;;;;;;;;;;;;;;;;;
(defun charp-basename ((charp (pointer uint8)))
"Like basename in C"
(let ((ptr charp))
@ -282,6 +291,10 @@
)
;;;;;;;;;;;;;;;;;;;;;;;;;
;; String ordering
;;;;;;;;;;;;;;;;;;;;;;;;;
;; NOTE: these string comparisons are a little broken.
;; ex: (string<? "asd" "asdf") = #f
;; (string<? "asdf" "asd") = #f
@ -289,76 +302,73 @@
(defun string<? ((a string) (b string))
"In dictionary order, is a < b?"
(local-vars (i int) (len int))
;; get the minimum length.
;; note - we don't do virtual calls here for some reason.
(set! len (min ((method-of-type string length) a)
((method-of-type string length) b)
)
)
;; loop through chars, up until the minimum length.
(set! i 0)
(while (< i len)
(let ((len (min (length a) (length b))))
(dotimes (i len)
(cond
((< (-> a data i) (-> b data i)) (return '#t))
((< (-> b data i) (-> a data i)) (return '#f))
((< (-> a data i) (-> b data i))
(return #t)
)
(set! i (+ i 1))
((< (-> b data i) (-> a data i))
(return #f)
)
'#f
)
)
)
#f
)
(defun string>? ((a string) (b string))
"In dictionary order, is a > b?"
(local-vars (i int) (len int))
(set! len (min ((method-of-type string length) a)
((method-of-type string length) b))
)
(set! i 0)
(while (< i len)
(let ((len (min (length a) (length b))))
(dotimes (i len)
(cond
((< (-> a data i) (-> b data i)) (return '#f))
((< (-> b data i) (-> a data i)) (return '#t))
((< (-> a data i) (-> b data i))
(return #f)
)
(set! i (+ i 1))
((< (-> b data i) (-> a data i))
(return #t)
)
'#f
)
)
)
#f
)
(defun string<=? ((a string) (b string))
(local-vars (i int) (len int))
(set! len (min ((method-of-type string length) a)
((method-of-type string length) b))
)
(set! i 0)
(while
(< i len)
(let ((len (min (length a) (length b))))
(dotimes (i len)
(cond
((< (-> a data i) (-> b data i)) (return '#t))
((< (-> b data i) (-> a data i)) (return '#f))
((< (-> a data i) (-> b data i))
(return #t)
)
(set! i (+ i 1))
((< (-> b data i) (-> a data i))
(return #f)
)
'#t
)
)
)
#t
)
(defun string>=? ((a string) (b string))
(local-vars (i int) (len int))
(set! len (min ((method-of-type string length) a)
((method-of-type string length) b))
)
(set! i 0)
(while (< i len)
(let ((len (min (length a) (length b))))
(dotimes (i len)
(cond
((< (-> a data i) (-> b data i)) (return '#f))
((< (-> b data i) (-> a data i)) (return '#t))
((< (-> a data i) (-> b data i))
(return #f)
)
(set! i (+ i 1))
((< (-> b data i) (-> a data i))
(return #t)
)
'#t
)
)
)
#t
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; String argument parsing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; temporary string for argument functions
(define *string-tmp-str* (new 'global 'string 128 (the string #f)))
@ -480,63 +490,56 @@
The arguments can be in quotes or not.
Removes argument from arg string, sucks up white space before the next one
Outputs argument to a-str."
(local-vars
(arg-start (pointer uint8))
(v1-11 (pointer uint8))
(a0-6 symbol)
(a0-20 symbol)
(a1-3 (pointer uint8))
(a1-9 (pointer uint8))
(arg-word-start (pointer uint8))
(arg-end (pointer uint8))
)
;; seek up the beginning of a word.
(set! arg-word-start (string-skip-whitespace (-> arg data)))
;; seek to first arg
(let ((arg-word-start (string-skip-whitespace (-> arg data))))
(cond
((= (-> arg-word-start 0) 34) ;; starts with quote
;; seek past quote to first char of name
(set! arg-end (&-> arg-word-start 1))
;; now, find the end
(set! arg-start arg-end)
(while (and (nonzero? (-> arg-end 0))
;; (nonzero? (+ (-> arg-end 0) -34))
(!= (-> arg-end 0) 34) ;; quote
;; seek past quote
(let ((arg-end (&-> arg-word-start 1)))
;; now find end
(let ((arg-start arg-end))
(while (and (nonzero? (-> arg-end 0)) (!= (-> arg-end 0) 34)) ;; close quote
(set! arg-end (&-> arg-end 1))
)
;; copy to output
(copyn-string<-charp a-str arg-start (&- arg-end (the-as uint arg-start)))
)
;; if we got a close quote, seek past it.
(if (= (-> arg-end 0) 34)
(set! arg-end (&-> arg-end 1))
)
;; copy to output.
(copyn-string<-charp a-str arg-start (- (the-as int arg-end) (the-as uint arg-start)))
;; if we got a close quote
(when (= (-> arg-end 0) 34)
;; seek past it
(set! arg-end (&-> arg-end 1))
)
(set! a1-3 (string-skip-whitespace arg-end))
;; kill leading white space
(let ((a1-3 (string-skip-whitespace arg-end)))
(string-suck-up! arg a1-3)
(return '#t)
)
)
(return #t)
)
((nonzero? (-> arg-word-start 0))
(set! v1-11 arg-word-start)
(while
(and
(let ((v1-11 arg-word-start))
;; find end
(while (and
(nonzero? (-> arg-word-start 0))
(nonzero? (+ (-> arg-word-start 0) -32))
(nonzero? (+ (-> arg-word-start 0) -9))
(nonzero? (+ (-> arg-word-start 0) -13))
(nonzero? (+ (-> arg-word-start 0) -10))
(!= (-> arg-word-start 0) 32)
(!= (-> arg-word-start 0) 9)
(!= (-> arg-word-start 0) 13)
(!= (-> arg-word-start 0) 10)
)
(set! arg-word-start (&-> arg-word-start 1))
)
(copyn-string<-charp a-str v1-11 (- (the-as int arg-word-start) (the-as uint v1-11)))
(set! a1-9 (string-skip-whitespace arg-word-start))
(copyn-string<-charp a-str v1-11 (&- arg-word-start (the-as uint v1-11)))
)
(let ((a1-9 (string-skip-whitespace arg-word-start)))
(string-suck-up! arg a1-9)
(return '#t)
)
(return #t)
)
)
'#f
)
#f
)
(defun string->int ((str string))

7
goalc/compiler/Compiler.h
View file

@ -285,7 +285,12 @@ class Compiler {
StructureType* type);
Val* generate_inspector_for_bitfield_type(const goos::Object& form, Env* env, BitFieldType* type);
RegVal* compile_get_method_of_type(const goos::Object& form,
const TypeSpec& type,
const TypeSpec& compile_time_type,
RegVal* type_object,
const std::string& method_name,
Env* env);
RegVal* compile_get_method_of_type(const goos::Object& form,
const TypeSpec& compile_time_type,
const std::string& method_name,
Env* env);
RegVal* compile_get_method_of_object(const goos::Object& form,

43
goalc/compiler/compilation/Type.cpp
View file

@ -17,25 +17,28 @@ int get_offset_of_method(int id) {
} // namespace
/*!
* Given a type and method name (known at compile time), get the method.
* This can be used for method calls where the type is unknown at run time (non-virtual method call)
* Given a type and method name (known at compile time), get the method, from the given type object.
* To do method lookup, the given type must be the same as, or a child of, the given compile time
* type.
*/
RegVal* Compiler::compile_get_method_of_type(const goos::Object& form,
const TypeSpec& type,
RegVal* Compiler::compile_get_method_of_type(const goos::Object& /*form*/,
const TypeSpec& compile_time_type,
RegVal* 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 info = m_ts.lookup_method(compile_time_type.base_type(), method_name);
info.type = info.type.substitute_for_method_call(compile_time_type.base_type());
auto offset_of_method = get_offset_of_method(info.id);
assert(type->type() == TypeSpec("type"));
auto fe = get_parent_env_of_type<FunctionEnv>(env);
auto typ = compile_get_symbol_value(form, type.base_type(), env)->to_gpr(env);
MemLoadInfo load_info;
load_info.sign_extend = false;
load_info.size = POINTER_SIZE;
auto loc_type = m_ts.make_pointer_typespec(info.type);
auto loc = fe->alloc_val<MemoryOffsetConstantVal>(loc_type, typ, offset_of_method);
auto loc = fe->alloc_val<MemoryOffsetConstantVal>(loc_type, type, offset_of_method);
auto di = m_ts.get_deref_info(loc_type);
assert(di.can_deref);
assert(di.mem_deref);
@ -46,6 +49,19 @@ RegVal* Compiler::compile_get_method_of_type(const goos::Object& form,
return deref->to_reg(env);
}
/*!
* Look up a method from the type, with the type specified at compile time.
* This can be used for method calls where the type can't be found at run time, but is known at
* compile time. (non-virtual method call)
*/
RegVal* Compiler::compile_get_method_of_type(const goos::Object& form,
const TypeSpec& compile_time_type,
const std::string& method_name,
Env* env) {
auto typ = compile_get_symbol_value(form, compile_time_type.base_type(), env)->to_gpr(env);
return compile_get_method_of_type(form, compile_time_type, typ, method_name, env);
}
/*!
* Given an object, get a method. If at compile time we know it's a basic, we use its runtime
* type to look up the method at runtime (virtual call). If we don't know it's a basic, we get the
@ -1091,6 +1107,8 @@ Val* Compiler::compile_method_of_type(const goos::Object& form,
auto arg = args.unnamed.at(0);
auto method_name = symbol_string(args.unnamed.at(1));
// in order to do proper method lookup, we peek at the symbol that the user provided and see if
// its a type name
if (arg.is_symbol()) {
if (m_ts.fully_defined_type_exists(symbol_string(arg))) {
return compile_get_method_of_type(form, m_ts.make_typespec(symbol_string(arg)), method_name,
@ -1101,6 +1119,15 @@ Val* Compiler::compile_method_of_type(const goos::Object& form,
}
}
// if the user didn't provide a symbol, but instead some expression that gives us a type, then use
// that, and do method lookup as if it was a plain object.
// this will let you do (method-of-type <something-complicated> inspect) and get the inspect
// method, with the proper type, from the given type's method table.
auto user_type = compile_error_guard(arg, env)->to_gpr(env);
if (user_type->type() == TypeSpec("type")) {
return compile_get_method_of_type(form, TypeSpec("object"), user_type, method_name, env);
}
throw_compiler_error(form, "Cannot get method of type {}: the type is invalid", arg.print());
return get_none();
}

4
test/offline/offline_test_main.cpp
View file

@ -102,10 +102,6 @@ const std::unordered_set<std::string> g_functions_to_skip_compiling = {
"lognor",
// weird PS2 specific debug registers:
"breakpoint-range-set!",
// does weird stuff with the type system.
"print",
"printl",
"inspect",
// inline assembly
"valid?",