mirror of
https://github.com/open-goal/jak-project.git
synced 2024-10-20 11:26:18 -04:00
2d11e44eaf
* start cleanup * fix typos * fix syntax highlighting in doc * lots of documentation updates * clean and add tests * more documentation and more error messages * more document and try building kernel differently
644 lines
22 KiB
Common Lisp
644 lines
22 KiB
Common Lisp
;-*-Lisp-*-
|
|
(in-package goal)
|
|
|
|
;; name: gcommon.gc
|
|
;; name in dgo: gcommon
|
|
;; dgos: KERNEL
|
|
|
|
;; gcommon is the first file compiled and loaded.
|
|
;; it's expected that this function will mostly be hand-decompiled
|
|
|
|
|
|
|
|
;; The "identity" returns its input unchanged. It uses the special GOAL "object"
|
|
;; type, which can basically be anything, so this will work on integers, floats,
|
|
;; strings, structures, arrays, etc. The only things which doesn't work with "object"
|
|
;; is a 128-bit integer. The upper 64-bits of the integer will usually be lost.
|
|
(defun identity ((x object))
|
|
;; there is an optional "docstring" that can go at the beginning of a function
|
|
"Function which returns its input. The first function of the game!"
|
|
|
|
;; the last thing in the function body is the return value. This is like "return x;" in C
|
|
;; the return type of the function is figured out automatically by the compiler
|
|
;; you don't have to specify it manually.
|
|
x
|
|
)
|
|
|
|
|
|
(defun 1/ ((x float))
|
|
"Reciprocal floating point"
|
|
|
|
;; this function computes 1.0 / x. GOAL allows strange function names like "1/".
|
|
|
|
;; Declaring this an inline function is like a C inline function, however code is
|
|
;; still generated so it can be used a function object. GOAL inline functions have type
|
|
;; checking, so they are preferable to macros when possible, to get better error messages.
|
|
(declare (inline))
|
|
|
|
;; the division form will pick the math type (float, int) based on the type of the first
|
|
;; argument. In this case, "1." is a floating point constant, so this becomes a floating point division.
|
|
(/ 1. x)
|
|
)
|
|
|
|
(defun + ((x int) (y int))
|
|
"Compute the sum of two integers"
|
|
|
|
;; this wraps the compiler's built-in handling of "add two integers" in a GOAL function.
|
|
;; now "+" can be used as a function object, but is limited to adding two integers when used like this.
|
|
;; The compiler is smart enough to not use this function unless "+" is being used as a function object.
|
|
;; ex: (+ a b c), (+ a b) ; won't use this function, uses built-in addition
|
|
;; (set-combination-function! my-thing +) ; + becomes a function pointer in this case
|
|
(+ x y)
|
|
)
|
|
|
|
(defun - ((x int) (y int))
|
|
"Compute the difference of two integers"
|
|
(- x y)
|
|
)
|
|
|
|
(defun * ((x int) (y int))
|
|
"Compute the product of two integers"
|
|
;; TODO - verify that this matches the PS2 exactly.
|
|
;; Uses mult (three operand form) in MIPS
|
|
(* x y)
|
|
)
|
|
|
|
(defun / ((x int) (y int))
|
|
"Compute the quotient of two integers"
|
|
;; TODO - verify this matches the PS2 exactly
|
|
(/ x y)
|
|
)
|
|
|
|
(defun ash ((value integer) (shift-amount integer))
|
|
"Arithmetic shift value by shift-amount.
|
|
A positive shift-amount will shift to the left and a negative will shift to the right.
|
|
"
|
|
|
|
;; currently the compiler does not support "ash", so this function is also used to implement "ash".
|
|
;; in the future, the compiler should be able to use constant propagation to turn constant shifts
|
|
;; into x86 constant shifts when possible (which are faster). The GOAL compiler seems to do this.
|
|
|
|
;; The original implementation was inline assembly, to take advantage of branch delay slots:
|
|
;; (or v1 a0 r0) ;; likely inserted by register coloring, not entirely needed
|
|
;; (bgezl a1 end) ;; branch to function end if positive shift (left)...
|
|
;; (dsllv v0 v1 a1) ;; do left shift in delay slot
|
|
;;
|
|
;; (dsubu a0 r0 a1) ;; negative shift amount for right shift
|
|
;; (dsrav v0 v1 a0) ;; do right shift
|
|
;; (label end)
|
|
|
|
(declare (inline))
|
|
(if (> shift-amount 0)
|
|
;; these correspond to x86-64 variable shift instructions.
|
|
;; the exact behavior of GOAL shifts (signed/unsigned) are unknown so for now shifts must
|
|
;; be manually specified.
|
|
(shlv value shift-amount)
|
|
(sarv value (- shift-amount))
|
|
)
|
|
)
|
|
|
|
(defun mod ((a integer) (b integer))
|
|
"Compute mod. It does what you expect for positive numbers. For negative numbers, nobody knows what to expect.
|
|
This is a 32-bit operation. It uses an idiv on x86 and gets the remainder."
|
|
|
|
;; The original implementation is div, mfhi
|
|
;; todo - verify this is exactly the same as the PS2.
|
|
(mod a b)
|
|
)
|
|
|
|
|
|
(defun rem ((a integer) (b integer))
|
|
"Compute remainder (32-bit). It is identical to mod. It uses a idiv and gets the remainder"
|
|
|
|
;; The original implementation is div, mfhi
|
|
;; todo - verify this is exactly the same as the PS2.
|
|
(mod a b)
|
|
)
|
|
|
|
(defun abs ((a int))
|
|
"Take the absolute value of an integer"
|
|
|
|
;; short function, good candidate for inlining
|
|
(declare (inline))
|
|
|
|
;; The original implementation was inline assembly, to take advantage of branch delay slots:
|
|
;; (or v0 a0 r0) ;; move input to output unchanged, for positive case
|
|
;; (bltzl v0 end) ;; if negative, execute the branch delay slot below...
|
|
;; (dsubu v0 r0 v0) ;; negate
|
|
;; (label end)
|
|
|
|
|
|
(if (> a 0) ;; condition is "a > 0"
|
|
a ;; true case, return a
|
|
(- a) ;; false case, return -a. (- a) is like (- 0 a)
|
|
)
|
|
)
|
|
|
|
(defun min ((a integer) (b integer))
|
|
"Compute minimum."
|
|
|
|
;; The original implementation was inline assembly, to take advantage of branch delay slots:
|
|
;; (or v0 a0 r0) ;; move first arg to output (case of second arg being min)
|
|
;; (or v1 a1 r0) ;; move second arg to v1 (likely strange coloring)
|
|
;; (slt a0 v0 v1) ;; compare args
|
|
;; (movz v0 v1 a0) ;; conditional move the second arg to v0 if it's the minimum
|
|
|
|
(declare (inline))
|
|
(if (> a b) b a)
|
|
)
|
|
|
|
(defun max ((a integer) (b integer))
|
|
"Compute maximum."
|
|
(declare (inline))
|
|
(if (> a b) a b)
|
|
)
|
|
|
|
(defun logior ((a integer) (b integer))
|
|
"Compute the bitwise inclusive-or"
|
|
(logior a b)
|
|
)
|
|
|
|
(defun logand ((a integer) (b integer))
|
|
"Compute the bitwise and"
|
|
(logand a b)
|
|
)
|
|
|
|
(defun lognor ((a integer) (b integer))
|
|
"Compute not or."
|
|
;; Note - MIPS has a 'nor' instruction, but x86 doesn't.
|
|
;; the GOAL x86 compiler therefore doesn't have a nor operation,
|
|
;; so lognor is implemented by this inline function instead.
|
|
(declare (inline))
|
|
(lognot (logior a b))
|
|
)
|
|
|
|
(defun logxor ((a integer) (b integer))
|
|
"Compute the logical exclusive-or"
|
|
(logxor a b)
|
|
)
|
|
|
|
(defun lognot ((a integer))
|
|
"Compute the bitwise not"
|
|
(lognot a)
|
|
)
|
|
|
|
(defun false-func ()
|
|
"Return false"
|
|
;; In GOAL, #f is false. It's a symbol. Each symbol exists as an object, and each symbol has a value
|
|
;; The value of the false symbol #f is the false symbol #f.
|
|
|
|
;; To get the symbol, instead of its value, we use quote. Writing 'x is equivalent to (quote x)
|
|
'#f
|
|
)
|
|
|
|
(defun true-func ()
|
|
"Return true"
|
|
;; GOAL consideres anything that's not #f to be true. But there's also an explicit true symbol.
|
|
'#t
|
|
)
|
|
|
|
;; The C Kernel implements the format function and creates a trampoline function in the GOAL heap which jumps to
|
|
;; format. (In OpenGOAL, there's actually two trampoline functions, to make the 8 arguments all work.)
|
|
;; For some reason, the C Kernel names this trampoline function _format. We need to set the value of format
|
|
;; _format in order for format to work.
|
|
|
|
;; I suspect this was to let us define (yet another) function here which set up C-style var args (supported from C Kernel)
|
|
;; or 128-bit arguments (unimplemented in C Kernel), but both of these were never finished.
|
|
(define format _format)
|
|
|
|
;; TODO - vec4s
|
|
|
|
;; The "boxed float" type "bfloat" is just a float wrapped in a basic (structure type that has runtime type information)
|
|
;; it's a way to have a floating point number that knows its a floating point number and can print/inspect itself
|
|
;; Compared to a normal float, it's much less efficient, so this is used extremely rarely.
|
|
|
|
;; a GOAL deftype contains the following:
|
|
;; - type name
|
|
;; - parent type name
|
|
;; - field list
|
|
;; - method declarations
|
|
;; - additional options
|
|
;; It has "asserts" that can be used to make sure that the type is laid out in memory in the same way as the game.
|
|
;; You provide the actual offsets/sizes/method ids, and if there is a mismatch, it throws a compiler error.
|
|
;; The decompile will generate these automatically in the future.
|
|
|
|
;; Type Name: should be a unique name. Can't be the name of a function or global variable. In this case, it's bfloat
|
|
;; Parent Type: Should be the name of the parent type ("basic" in this case). Will inherit fields and methods from the parent.
|
|
;; children of "basic" are structure types with runtime type information.
|
|
;; Field List: each field of the type, listed as (name type-name [options])
|
|
;; use the :offset-assert X to do a check at comile-time that the OpenGOAL compiler places the field at the given offset.
|
|
;; if the compiler came up with a different offset, it will create an error. This used to make sure the memory layout matches
|
|
;; the original game.
|
|
;; Method Declarations: Any methods which are defined in this type but not the parent must be declared here.
|
|
;; you may optionally declare methods defined only in the parent, or defined in both the parent and child (overridden methods)
|
|
;; the method declarations is (method-name (arg-list) return-type [optional-id-assert])
|
|
;; the optional id assert is used to check that the compiler places the method in the given slot of the method table.
|
|
;; like the offset-assert, it's used to make sure the type hierarchy matches the game.
|
|
;; Note that the special type "_type_" can be used in methods args/returns to indicate "the type of the object method is called on".
|
|
;; this is used for 2 things:
|
|
;; 1. Child who overrides it can use their own type as an argument, rather than a less specific parent type.
|
|
;; 2. Caller who calls an overriden method and knows it at compile time can know a return type more specifically.
|
|
|
|
|
|
(deftype bfloat (basic)
|
|
;; fields
|
|
((data float :offset-assert 4)) ;; field "data" is a float.
|
|
;; methods
|
|
(:methods (print (_type_) _type_ 2) ;; we will override print later on. This is optional to include
|
|
(inspect (_type_) _type_ 3) ;; this is a parent method we won't override. This is also optional to inlcude
|
|
)
|
|
|
|
;; options
|
|
|
|
;; make sure the size of the type is correct (compare to value from game)
|
|
:size-assert 8
|
|
;; make sure method count is correct (again, compare to value from game)
|
|
:method-count-assert 9
|
|
;; flags passed to the new_type function in the runtime, compare from game
|
|
:flag-assert #x900000008
|
|
)
|
|
|
|
|
|
;; The "print" method of a type should print out a single line representation of the object.
|
|
;; The default print method for a basic will be something like #<my-type @ #xbeef>
|
|
;; This is used when printing an object with format, using the "~A" format specification.
|
|
;; And of course in functions like print, printl.
|
|
(defmethod print bfloat ((obj bfloat))
|
|
"Override the default print method to print a bfloat like a normal float"
|
|
(format #t "~f" (-> obj data))
|
|
obj
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Type System
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
; The asize-of method should return the total size in memory used by an object.
|
|
; It's used for traversing heaps of basics and copying basics.
|
|
; Most basic/structure types are "fixed size", and their default asize-of method will simply
|
|
; return the "size" field of their type, so you don't have to worry about it.
|
|
; However, some types are dynamic (like a string) and require that you provide your own method.
|
|
; A common approach is to have an "allocated-length" field, then have the asize-of method return
|
|
; (+ (-> obj type size) (* elem-size (-> obj allocated-length)))
|
|
; asize-of returns the actual size, including the type field, and can have any alignment.
|
|
|
|
;; A "type" object contains some basic information about a type as well as the list of methods.
|
|
;; Some types have more methods than others, so the method table makes "type" a dynamic type.
|
|
;; As a result, we should define an "asize-of" method for type. It's possibly unused because it's wrong.
|
|
|
|
(defmethod asize-of type ((obj type))
|
|
"Get the size in memory of a type"
|
|
;; The 28 is 8 bytes too large. It's also strange that types have a 16-byte aligned size always,
|
|
;; but this matches what the runtime does as well. There's no reason that I can see for this,
|
|
;; as other basics don't require 16-byte aligned sizes.
|
|
(align16 (+ 28 (* 4 (-> type allocated-length))))
|
|
)
|
|
|
|
(defun basic-type? ((obj basic) (input-type type))
|
|
"Is obj an object of type input-type, or of child type of input-type?
|
|
Note: checking if a basic is of type object will return #f."
|
|
(let ((basics-type (-> obj type))
|
|
(object-type object))
|
|
(until (eq? (set! basics-type (-> basics-type parent)) object-type)
|
|
(if (eq? basics-type input-type)
|
|
;; return-from #f will return from the function with the value of #t
|
|
(return-from #f #t)
|
|
)
|
|
)
|
|
)
|
|
#f ;; didn't find it, return false
|
|
)
|
|
|
|
(defun type-type? ((a type) (b type))
|
|
"is a a type (or child type) of type b?"
|
|
(until (eq? a object)
|
|
;; it's not clear why a might be zero?
|
|
;; perhaps if the type system is not yet initialized fully for the type?
|
|
(if (or (eq? a b) (zero? a))
|
|
(return-from #f #t)
|
|
)
|
|
(set! a (-> a parent))
|
|
)
|
|
#f
|
|
)
|
|
|
|
(defun find-parent-method ((the-type type) (method-id int))
|
|
"Find the nearest parent which has a different method, and get that method.
|
|
Use with extreme caution - if a checked parent has fewer methods than the child, it will
|
|
access out-of-bounds memory. Returns the nothing function if it gets to the top and
|
|
the parent has the same type, or if any parent has 0 as a method."
|
|
(let* ((child-method (-> the-type method-table method-id))
|
|
(parent-method child-method)
|
|
)
|
|
|
|
;; keep looking until we find a different parent method
|
|
(until (not (eq? parent-method child-method))
|
|
;; at the top of the type tree.
|
|
(if (eq? the-type object)
|
|
(return-from #f nothing)
|
|
)
|
|
|
|
(set! the-type (-> the-type parent))
|
|
(set! parent-method (-> the-type method-table method-id))
|
|
(if (eq? 0 (the int parent-method))
|
|
(return-from #f nothing)
|
|
)
|
|
)
|
|
parent-method
|
|
)
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; pair and list
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun ref ((obj object) (idx int))
|
|
"Get the nth item from a list. No type checking or range checking is done, so be careful!"
|
|
(dotimes (i idx (car obj))
|
|
(set! obj (cdr obj))
|
|
)
|
|
)
|
|
|
|
(defmethod length pair ((obj pair))
|
|
"Get the number of elements in a proper list"
|
|
(if (eq? obj '())
|
|
(return-from #f 0)
|
|
)
|
|
|
|
(let ((lst (cdr obj))
|
|
(len 1))
|
|
(while (and (not (eq? lst '()))
|
|
(pair? lst)
|
|
)
|
|
(+1! len)
|
|
(set! lst (cdr lst))
|
|
)
|
|
len)
|
|
)
|
|
|
|
|
|
|
|
(defmethod asize-of pair ((obj pair))
|
|
"Get the asize of a pair"
|
|
(the-as int (-> pair size))
|
|
)
|
|
|
|
(defun last ((obj object))
|
|
"Get the last pair in a list."
|
|
(while (not (eq? (cdr obj) '()))
|
|
(set! obj (cdr obj))
|
|
)
|
|
obj
|
|
)
|
|
|
|
(defun member ((obj object) (lst object))
|
|
"if obj is a member of the list, return the pair containing obj as its car.
|
|
if not, return #f."
|
|
(while (and (not (eq? lst '()))
|
|
(not (eq? (car lst) obj)))
|
|
(set! lst (cdr lst))
|
|
)
|
|
|
|
(if (eq? lst '())
|
|
#f
|
|
lst
|
|
)
|
|
)
|
|
|
|
(define-extern name= (function basic basic symbol))
|
|
|
|
(defun nmember ((obj basic) (lst object))
|
|
"If obj is a member of the list, return the pair containing obj as its car.
|
|
If not, return #f. Use name= (see gstring.gc) to check equality."
|
|
(while (and (not (eq? lst '()))
|
|
(not (name= (the basic (car lst)) obj))
|
|
)
|
|
(set! lst (cdr lst))
|
|
)
|
|
|
|
(if (eq? lst '())
|
|
#f
|
|
lst
|
|
)
|
|
)
|
|
|
|
(defun assoc ((item object) (alst object))
|
|
"Get a pair with car of item from the association list (list of pairs) alst."
|
|
(while (and (not (null? alst))
|
|
(not (eq? (caar alst) item)))
|
|
(set! alst (cdr alst))
|
|
)
|
|
(if (not (null? alst))
|
|
(car alst)
|
|
#f
|
|
)
|
|
)
|
|
|
|
(defun assoce ((item object) (alst object))
|
|
"Like assoc, but a pair with car of 'else will match anything"
|
|
(while (and (not (null? alst))
|
|
(not (eq? (caar alst) item))
|
|
(not (eq? (caar alst) 'else))
|
|
)
|
|
(set! alst (cdr alst))
|
|
)
|
|
(if (not (null? alst))
|
|
(car alst)
|
|
#f
|
|
)
|
|
)
|
|
|
|
;; todo
|
|
;; nassoc
|
|
;; nassce
|
|
|
|
(defun append! ((front object) (back object))
|
|
"Append back to front."
|
|
(if (null? front)
|
|
(return-from #f back)
|
|
)
|
|
|
|
(let ((lst front))
|
|
;; seek to the end of front
|
|
(while (not (null? (cdr lst)))
|
|
(set! lst (cdr lst))
|
|
)
|
|
|
|
;; this check seems not needed
|
|
(if (not (null? lst))
|
|
(set! (cdr lst) back)
|
|
)
|
|
|
|
front
|
|
)
|
|
)
|
|
|
|
(defun delete! ((item object) (lst object))
|
|
"Delete the first occurance of item from a list and return the list.
|
|
Does nothing if the item isn't in the list."
|
|
(if (eq? (car lst) item)
|
|
(return-from #f (cdr lst))
|
|
)
|
|
|
|
(let ((iter (cdr lst))
|
|
(rep lst))
|
|
|
|
(while (and (not (null? iter))
|
|
(not (eq? (car iter) item)))
|
|
(set! rep iter)
|
|
(set! iter (cdr iter))
|
|
)
|
|
|
|
(if (not (null? iter))
|
|
(set! (cdr rep) (cdr iter))
|
|
)
|
|
)
|
|
(the pair lst)
|
|
)
|
|
|
|
(defun delete-car! ((item object) (lst object))
|
|
"Like delete, but will delete if (car item-from-list) is equal to item. Useful for deleting from association list by key."
|
|
;(format #t "call to delete car: ~A ~A~%" item lst)
|
|
(if (eq? (caar lst) item)
|
|
(return-from #f (cdr lst))
|
|
)
|
|
|
|
(let ((rep lst)
|
|
(iter (cdr lst)))
|
|
(while (and (not (null? iter))
|
|
(not (eq? (caar iter) item)))
|
|
(set! rep iter)
|
|
(set! iter (cdr iter))
|
|
)
|
|
|
|
(if (not (null? iter))
|
|
(set! (cdr rep) (cdr iter))
|
|
)
|
|
)
|
|
lst
|
|
)
|
|
|
|
(defun insert-cons! ((kv object) (alst object))
|
|
"Insert key-value pair into an association list. Also removes the old one if it was there."
|
|
(cons kv (delete-car! (car kv) alst))
|
|
)
|
|
|
|
(defun sort ((lst object) (compare (function object object object)))
|
|
"Sort the given list in place. Uses the given comparison function. The comparison function can
|
|
either return #t/#f or an integer, in which case the sign of the integer determines lt/gt."
|
|
;; in each iteration, we count how many changes we make. Once we make no changes, the list is sorted.
|
|
(let ((changes -1))
|
|
|
|
(while (not (zero? changes)) ;; outer loop
|
|
(set! changes 0) ;; reset changes for this iteration
|
|
(let ((iter lst)) ;; iterate through list
|
|
(while (and (not (null? (cdr iter)))
|
|
(pair? (cdr iter)))
|
|
;; L221
|
|
(let* ((val1 (car iter)) ;; value at iterator
|
|
(val2 (car (cdr iter))) ;; value after iterator
|
|
(c-result (compare val1 val2))) ;; run comparison function
|
|
;; check if val1 and val2 are in order. The compare function may either return #t
|
|
;; or it may return val1 - val2. There is an issue if val1 - val2 happens to equal #t or #f.
|
|
(unless (or
|
|
(and c-result (<= (the integer c-result) 0)) ;; not #f, and negative, we're sorted!
|
|
(eq? c-result #t) ;; explictly return #t, we're sorted!
|
|
)
|
|
;; these two aren't sorted! so we swap them and increment changes.
|
|
(+1! changes)
|
|
(set! (car iter) val2)
|
|
(set! (car (cdr iter)) val1)
|
|
)
|
|
;; move on to the next thing in the list.
|
|
(set! iter (cdr iter))
|
|
)
|
|
)
|
|
)
|
|
)
|
|
)
|
|
lst
|
|
)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;;;; inline array
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; a parent class for boxed "inline arrays" classes,
|
|
;; An inline-array is an array with a bunch of objects back-to-back, as opposed to a bunch of
|
|
;; references back to back.
|
|
;; Most inline-arrays are unboxed and are just data - this is a somewhat rarely used container parent
|
|
;; class for a class that wraps an unboxed inline-array.
|
|
;; the "heap-base" field of the type is used to store the indexing scale.
|
|
|
|
(deftype inline-array-class (basic)
|
|
((length int32 :offset-assert 4)
|
|
(allocated-length int32 :offset-assert 8)
|
|
(data uint8 :dynamic)
|
|
)
|
|
(:methods (new (symbol type int) _type_ 0) ;; we will override print later on. This is optional to include
|
|
)
|
|
)
|
|
|
|
(defmethod new inline-array-class ((allocation symbol) (type-to-make type) (cnt int))
|
|
"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)))
|
|
;;(format 0 "create sz ~d at #x~X~%" sz new-object)
|
|
(unless (zero? new-object)
|
|
(set! (-> new-object length) cnt)
|
|
(set! (-> new-object allocated-length) cnt)
|
|
)
|
|
new-object
|
|
)
|
|
)
|
|
|
|
(defmethod length inline-array-class ((obj inline-array-class))
|
|
;"Get the length of an inline-array"
|
|
(-> obj length)
|
|
)
|
|
|
|
(defmethod asize-of inline-array-class ((obj inline-array-class))
|
|
;"Get the size in memory of an inline-array-class"
|
|
(+ (the-as int (-> obj type size))
|
|
(* (-> obj allocated-length) (-> obj type heap-base))
|
|
)
|
|
)
|
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; array (todo)
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; memcpy and similar
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(defun mem-copy! ((dst pointer) (src pointer) (size integer))
|
|
"Copy memory from src to dst. Size is in bytes. This is not an efficient implementation,
|
|
however, there are _no restrictions_ on size, alignment etc. Increasing address copy."
|
|
(let ((i 0)
|
|
(d (the pointer dst))
|
|
(s (the pointer src))
|
|
)
|
|
|
|
(while (< i size)
|
|
(set! (-> (the (pointer uint8) d) 0) (-> (the (pointer uint8) s) 0))
|
|
(&+! d 1)
|
|
(&+! s 1)
|
|
(+1! i)
|
|
)
|
|
)
|
|
dst
|
|
)
|
|
|
|
(defun mem-set32! ((dst pointer) (value int) (n int))
|
|
"Memset a 32-bit value n times. Total memory filled is 4 * n bytes."
|
|
(let ((p (the pointer dst))
|
|
(i 0))
|
|
(while (< i n)
|
|
(set! (-> (the (pointer int32) p) 0) value)
|
|
(&+! p 4)
|
|
(+1! i)
|
|
)
|
|
)
|
|
dst
|
|
) |