jak-project/test/goalc/source_templates/kernel/kernel-test.gc

(defun target-function ((a0 uint) (a1 uint) (a2 uint) (a3 uint) (a4 uint) (a5 uint))
  (format #t "TARGET FUNCTION ~D ~D ~D~%" a0 a1 a2)
  (format #t "~D ~D ~D~%" a3 a4 a5)
  
  (let ((stack-arr (new 'stack-no-clear 'array 'uint8 12)))
    (format #t "Stack Alignemnt ~D/16~%" (logand 15 (the uint stack-arr)))
    )
  
  (dotimes (i 10)
    (format #t "proc1: ~D~%" i)
    (when (> i 4)
      (format #t "DEACTIVATE PROC 1~%")
      (process-deactivate)
      )
    (suspend)
    )
  )

(define-extern recurse (function int (pointer int32) int))
(defun recurse ((i int) (ptr (pointer int32)))
  (if (> i 0)
      (recurse (- i 1) ptr)
      (suspend)
      )
  (set! (-> ptr) (+ (-> ptr) 1))
  1
  )

(defun target-function-2 ()
  (let ((stack-var (new 'stack-no-clear 'array 'int32 1)))
    (set! (-> stack-var) 0)
    (countdown (i 10)
      (format #t "proc2: ~D~%" (-> stack-var))
      (recurse 5 stack-var)
      )
    )
  
  )

(defun kernel-test ()
  (define test-process (get-process *nk-dead-pool* process 1024))
  
  (activate test-process *active-pool* 'test-proc *kernel-dram-stack*)
  
  
  (set-to-run (-> test-process main-thread)
              target-function
              1 2 3 4 5 6
              )
  
  (define test-process-2 (get-process *nk-dead-pool* process 1024))
  ;; test that the kernel fakes having process stacks on the scratchpad.
  (activate test-process-2 *active-pool* 'test-2 (the pointer #x70004000))
  (set-to-run (-> test-process-2 main-thread)
              target-function-2
              0 0 0 0 0 0)
  0
  )

(defun init-child-proc (a0 a1 a2 a3 a4 a5)
  (format #t "Args: ~D ~D ~D~%" a0 a1 a2)
  (format #t "~D ~D ~D~%" a3 a4 a5)
  (let ((stack-arr (new 'stack-no-clear 'array 'uint8 12)))
    (format #t "Stack Alignemnt ~D/16~%" (logand 15 (the uint stack-arr)))
    )
  (if (eq? a0 (the int 0))
      (process-deactivate)
      )
  'init-child-proc-result
  )


(defun initializer-process-function (a0)
  (let ((child-proc (get-process *nk-dead-pool* process 1024)))
    ;; let's go
    (activate child-proc *active-pool* 'child-proc *kernel-dram-stack*)
    (let ((result (run-function-in-process child-proc init-child-proc a0 2 3 4 5 6)))
      (format #t "run-function-in-process result: ~A~%" result)
      )
    )
  
  (process-deactivate)
  )

(defun kernel-test-2 ()
  (define initalizer-process (get-process *nk-dead-pool* process 1024))
  (activate initalizer-process *active-pool* 'initializer-proc *kernel-dram-stack*)
  (set-to-run (-> initalizer-process main-thread)
              initializer-process-function
              0 0 0 0 0 0
              )
  (define initalizer-process-2 (get-process *nk-dead-pool* process 1024))
  (activate initalizer-process-2 *active-pool* 'initializer-proc-2 *kernel-dram-stack*)
  (set-to-run (-> initalizer-process-2 main-thread)
              initializer-process-function
              1 0 0 0 0 0
              )
  0
  )


(defstate die-state (process)
    :enter (lambda () (format #t "enter die~%") (none))
    :exit (lambda () (format #t "exit die~%") (none))
    :code (lambda ()
            (format #t "time to die!~%")
            (process-deactivate)
            (format #t "don't see me~%")
            )
    )

(defun xmm-check-code (ax ay az aw)
  "This function relies on saved xmm register being backed up on a context switch"
  ;; (declare (print-asm))
  ;; compiler will put these in xmm8 and xmm9 to keep them from being clobbered
  (let ((x 12.34)
        (y 45.63))
    (dotimes (i 3)
      (format #t "run xmm-check ~f ~f ~D ~D ~D ~D~%" x y ax ay az aw)
      ;; should preserve xmm8 and xmm9
      (suspend)
      )
    ;; get the wreck process and make it go to die state.
    (go-process (process-by-name 'wreck-proc *active-pool*) die-state)
    (go die-state)
    (format #t "unreachable~%")
    )
  )

(defun xmm-wreck-code (ax ay az aw)
  "This function intentionally overwrites xmm8 and xmm9 and suspends"
  (while #t
    (rlet ((x :class fpr :type float :reg xmm8)
           (y :class fpr :type float :reg xmm9))
      (set! x 99.0)
      (set! y 101.0)
      (format #t "wreck: ~D ~D ~D ~D~%" ax ay az aw)
      (suspend)
      (set! x (+ x 1.0))
      (set! y (+ y 1.0))
      )
    )
  )

;; a state.
(defstate xmm-check-state (process)
    :enter (lambda (x y z w) (format #t "enter check: ~D ~D ~D ~D~%" x y z w) (none))
    :exit (lambda () (format #t "exit check~%") (none))
    :code xmm-check-code
    )

(defstate xmm-wreck-state (process)
    :enter (lambda (x y z w) (format #t "enter wreck: ~D ~D ~D ~D~%" x y z w) (none))
    :exit (lambda () (format #t "exit wreck~%") (none))
    :code xmm-wreck-code
    )

(defun state-test ()
  (let ((proc (get-process *nk-dead-pool* process 1024)))
    (activate proc *active-pool* 'check-proc *kernel-dram-stack*)
    (run-now-in-process proc (lambda (x y z w) (go xmm-check-state x y z w))
                        9 8 7 6)
    )

  (let ((proc (get-process *nk-dead-pool* process 1024)))
    (activate proc *active-pool* 'wreck-proc *kernel-dram-stack*)
    (run-next-time-in-process proc (lambda (x y z w) (go xmm-wreck-state x y z w))
                              3 4 5 6)
    )
  0
  )

(defun throw-backup-test ()
  (rlet ((x :reg xmm10 :class fpr :type float))
    (set! x 10.10)
    (let ((proc (get-process *nk-dead-pool* process 1024)))
      (activate proc *active-pool* 'asdf *kernel-dram-stack*)
      (format #t "value now is ~f~%" x)
      (run-now-in-process proc (lambda ()
                                 (rlet ((x2 :reg xmm10 :class fpr :type float))
                                   (set! x2 -1.0)
                                   )
                                 ;; this will throw back.
                                 (process-deactivate)
                                 )
                          )
      (format #t "now its ~f~%" x)
      
      )
    )
  )