Browse Source

Make more modules support C mode

* Use __alignof__() for GCC (this will probably break other platforms)
* Include stdbool in a bunch of places
* Include missing string.h for memcpy
* Make introspection metadata const so that C doesn't complain about
initializers not being constant
* Make Math.cake C compatible by not using the implicit initializers
nor matrix array operators
* Prefix enki C types with struct
* Exclusively use the Tracy C API to not require infecting every
module with C++ just to use profiling. This was possible thanks to my
defer feature work in Cakelisp.
* Use C linkage to make C/C++ interaction possible
master
Macoy Madson 3 weeks ago
parent
commit
40bef96497
  1. 20
      src/Allocator.cake
  2. 2
      src/Compression.cake
  3. 2
      src/Cryptography.cake
  4. 2
      src/Curl.cake
  5. 2
      src/FreeType.cake
  6. 2
      src/Image.cake
  7. 6
      src/Introspection.cake
  8. 30
      src/Math.cake
  9. 2
      src/OpenGL.cake
  10. 2
      src/SDLFontAtlas.cake
  11. 32
      src/TaskSystem.cake
  12. 37
      src/Tracy.cake
  13. 2
      test/src/Config_Linux.cake

20
src/Allocator.cake

@ -82,12 +82,12 @@
;; (var my-stack-allocator-root chain-allocation last-chain-link)
;; (var working-allocator (addr chain-allocation) last-chain-link)
;; (var my-thing (addr thing) (chain-allocate-aligned (addr working-allocator)
;; (sizeof thing) (alignof thing)))
;; (sizeof thing) (alignment-of thing)))
;; ;; All done, "pop" from our stack and reset the capacity
;; (chain-allocation-free my-stack-allocator-root)
;; (set (deref last-chain-link) stack-before-my-operation)
(defstruct chain-allocation
next-link (addr chain-allocation)
next-link (addr (struct chain-allocation))
new-block-size size_t
block block-allocation)
@ -202,13 +202,13 @@
(type-cast (chain-allocate-aligned
(token-splice chain)
(* (token-splice count) (sizeof (type (token-splice type))))
(alignof (type (token-splice type))))
(alignment-of (type (token-splice type))))
(addr (token-splice type))))
(tokenize-push output
(type-cast (chain-allocate-aligned
(token-splice chain)
(sizeof (type (token-splice type)))
(alignof (type (token-splice type))))
(alignment-of (type (token-splice type))))
(addr (token-splice type)))))
(return true))
@ -307,9 +307,9 @@
(var-cast-to first-aligned (addr my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
(alignment-of (type my-align-struct))))
(unless (and first-aligned
(= 0 (mod (type-cast first-aligned ptrdiff_t) (alignof (type my-align-struct)))))
(= 0 (mod (type-cast first-aligned ptrdiff_t) (alignment-of (type my-align-struct)))))
(fprintf stderr "Failed aligned allocation\n")
(chain-allocation-free chain-root)
(return 1))
@ -318,9 +318,9 @@
(var-cast-to second-aligned (addr my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
(alignment-of (type my-align-struct))))
(unless (and second-aligned
(= 0 (mod (type-cast second-aligned ptrdiff_t) (alignof (type my-align-struct))))
(= 0 (mod (type-cast second-aligned ptrdiff_t) (alignment-of (type my-align-struct))))
(= (+ 1 first-aligned) second-aligned))
(fprintf stderr "Failed aligned allocation with subsequent aligned element\n")
(chain-allocation-free chain-root)
@ -331,9 +331,9 @@
(var-cast-to many-aligned (addr my-align-struct)
(chain-allocate-aligned (addr chain)
(sizeof (type my-align-struct))
(alignof (type my-align-struct))))
(alignment-of (type my-align-struct))))
(unless (and many-aligned
(= 0 (mod (type-cast many-aligned ptrdiff_t) (alignof (type my-align-struct)))))
(= 0 (mod (type-cast many-aligned ptrdiff_t) (alignment-of (type my-align-struct)))))
(fprintf stderr "Failed aligned allocation %d\n" i)
(chain-allocation-free chain-root)
(return 1)))

2
src/Compression.cake

@ -9,7 +9,7 @@
(register-module-license "miniz" g-miniz-license-string)
(c-import "miniz.h" &with-decls "<stddef.h>")
(c-import "miniz.h" &with-decls "<stddef.h>" "<stdbool.h>")
;; TODO Limitation: subdirectories will not be created
(defun decompress-zip-from-memory-to-files (buffer (addr (const void))

2
src/Cryptography.cake

@ -2,7 +2,7 @@
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(import "CHelpers.cake" "BuildTools.cake" "Dependencies.cake")
(c-import "<stdio.h>")
(c-import "<stdio.h>" &with-decls "<stdbool.h>")
(export-and-evaluate
(comptime-cond

2
src/Curl.cake

@ -19,6 +19,8 @@
(add-c-search-directory-module "Dependencies/curl/include/curl")))
(c-import "curl.h"))
(c-import &with-decls "<stdbool.h>")
(def-type-alias-global CURL void)
;; Note: Must come after export above

2
src/FreeType.cake

@ -19,7 +19,7 @@
(return true))
(c-import "<stdio.h>"
&with-decls "<stdint.h>")
&with-decls "<stdint.h>" "<stdbool.h>")
;; TODO: Support UTF-8 by using non char-sized keys
(defstruct glyph-entry

2
src/Image.cake

@ -30,6 +30,8 @@
(comptime-cond
('auto-test
(c-import "<string.h>") ;; memcpy
(defun-nodecl test--stb-image (&return int)
(var image-to-load (addr (const char)) "assets/town.jpg")
(var width int 0)

6
src/Introspection.cake

@ -310,9 +310,9 @@
(defstruct (token-splice struct-name)
(token-splice-array (deref processed-arguments)))
(var (token-splice-addr metadata-fields-name) (array metadata-field)
(var (token-splice-addr metadata-fields-name) (const (array metadata-field))
(array (token-splice-array (deref fields-metadata))))
(var (token-splice-addr metadata-name) metadata-struct
(var (token-splice-addr metadata-name) (const metadata-struct)
(array (token-splice-addr struct-name-to-str)
(token-splice-addr metadata-fields-name)
(array-size (token-splice-addr metadata-fields-name))
@ -320,7 +320,7 @@
;; Allow access to the metadata without having to declare all the types in the header
(forward-declare (struct metadata-struct)) ;; TODO Would be nice to not do this for every struct
(var-global (token-splice-addr metadata-pointer-name) (addr (const metadata-struct))
(var-global (token-splice-addr metadata-pointer-name) (const (addr (const metadata-struct)))
(addr (token-splice-addr metadata-name))))
(return true))

30
src/Math.cake

@ -12,7 +12,8 @@
(import "Dependencies.cake" "CHelpers.cake"
&defs-only "Licenses.cake")
(c-import "<stdio.h>")
(c-import "<stdio.h>"
&with-decls "<stdbool.h>")
(export-and-evaluate (add-c-search-directory-module "Dependencies/Handmade-Math"))
@ -82,22 +83,24 @@
;; Factor 0 to 1
(defun vec2-interpolate (factor float from vec2 to vec2 &return vec2)
(return (array
(interpolate-range (vec-x from) (vec-x to)
(var new-vec vec2
(array (interpolate-range (vec-x from) (vec-x to)
0.f 1.f factor)
(interpolate-range (vec-y from) (vec-y to)
0.f 1.f factor))))
0.f 1.f factor)))
(return new-vec))
;; Factor 0 to 1
(defun vec3-interpolate (factor float from vec3 to vec3 &return vec3)
(return
(var new-vec vec3
(array
(interpolate-range (vec-x from) (vec-x to)
0.f 1.f factor)
(interpolate-range (vec-y from) (vec-y to)
0.f 1.f factor)
(interpolate-range (vec-z from) (vec-z to)
0.f 1.f factor))))
0.f 1.f factor)))
(return new-vec))
(defun vec2-is-zero (vec vec2 &return bool)
(return (and (= 0.f (vec-x vec))
@ -222,10 +225,10 @@
(while (< vec-index 4)
(fprintf stderr "%d [%f %f %f %f]\n"
vec-index
(at 0 vec-index mat)
(at 1 vec-index mat)
(at 2 vec-index mat)
(at 3 vec-index mat))
(at 0 vec-index (field mat Elements))
(at 1 vec-index (field mat Elements))
(at 2 vec-index (field mat Elements))
(at 3 vec-index (field mat Elements)))
(incr vec-index)))
;; Useful when e.g. passing the matrix into OpenGL
@ -256,7 +259,7 @@
(fprintf stderr "\nTranslation matrix:\n")
(var mat-a mat4 (mat4-identity))
(mat4-print (mat4-multiply mat-a (mat4-translate (array 1.f 2.f 3.f))))
(mat4-print (mat4-multiply mat-a (mat4-translate my-vec)))
(fprintf stderr "\n45 degrees about the Y axis matrix:\n")
(mat4-print (mat4-rotate-degrees 45.f g-up-axis))
@ -265,11 +268,12 @@
;; order is reversed
(fprintf stderr "\n45 degrees about the Y axis, then translate:\n")
(var transformation-mat mat4
(mat4-multiply (mat4-translate (array 1.f 2.f 3.f))
(mat4-multiply (mat4-translate my-vec)
(mat4-rotate-degrees 45.f g-up-axis)))
(mat4-print transformation-mat)
(var transformed-vec vec3 (mat4-transform-vec3 transformation-mat (array 1.f 0.f 0.f)))
(var x-vector vec3 (array 1.f 0.f 0.f))
(var transformed-vec vec3 (mat4-transform-vec3 transformation-mat x-vector))
(fprintf stderr "%f %f %f\n" (vec-xyz transformed-vec))
(return 0))))

2
src/OpenGL.cake

@ -150,7 +150,7 @@ void main()
;; Generate a texture
(var width (const int) 256)
(var height (const int) 256)
(var checker-image (array (* width height 3) (unsigned char)) (array 0))
(var checker-image (array (* 256 256 3) (unsigned char)) (array 0))
(each-in-range height y
(each-in-range width x
(set (at (+ (* y width 3) (* 3 x) 0) checker-image) (? (or (= 0 (mod (/ x 64) 2))

2
src/SDLFontAtlas.cake

@ -6,6 +6,8 @@
(import "SDL.cake" "FreeType.cake" "Dictionary.cake"
"CHelpers.cake")
(c-import &with-decls "<stdbool.h>")
(forward-declare (struct SDL_Renderer)
(struct SDL_Texture)
(struct font-atlas))

32
src/TaskSystem.cake

@ -375,7 +375,7 @@
(type-cast (malloc (sizeof (type task-system-pinned-task-arguments)))
(addr task-system-pinned-task-arguments)))
(scope
(var task-params enkiParamsPinnedTask (enkiGetParamsPinnedTask (token-splice-addr task-name)))
(var task-params (struct enkiParamsPinnedTask) (enkiGetParamsPinnedTask (token-splice-addr task-name)))
(set (path (token-splice-addr pinned-task-arguments-name) > task-thread-id)
g-task-system-main-thread-index) ;; Hard coded to main thread
(set (path (token-splice-addr pinned-task-arguments-name) > task-to-execute)
@ -407,7 +407,7 @@
(type-cast (malloc (sizeof (type task-system-pinned-task-arguments)))
(addr task-system-pinned-task-arguments)))
(scope
(var task-params enkiParamsPinnedTask
(var task-params (struct enkiParamsPinnedTask)
(enkiGetParamsPinnedTask (token-splice-addr task-name)))
((token-splice-addr task-argument-fill) (token-splice-addr task-arguments-name)
(token-splice-array parsed-arguments))
@ -439,7 +439,7 @@
(enkiCreateTaskSet (field g-task-system task-scheduler)
(token-splice invocation-token)))
(scope
(var task-params enkiParamsTaskSet
(var task-params (struct enkiParamsTaskSet)
(enkiGetParamsTaskSet (token-splice-addr task-name)))
(token-splice-array params-setters)
(enkiSetParamsTaskSet (token-splice-addr task-name) task-params))))
@ -461,7 +461,7 @@
(addr (token-splice-addr task-argument-type))
(malloc (sizeof (type (token-splice-addr task-argument-type)))))
(scope
(var task-params enkiParamsTaskSet
(var task-params (struct enkiParamsTaskSet)
(enkiGetParamsTaskSet (token-splice-addr task-name)))
(token-splice-array params-setters)
((token-splice-addr task-argument-fill) (token-splice-addr task-arguments-name)
@ -657,7 +657,7 @@
(var cleanup-action (addr enkiCompletionAction)
(enkiCreateCompletionAction (field g-task-system task-scheduler) null ;; No pre-complete
task-system-cleanup-execution-action))
(var action-params enkiParamsCompletionAction
(var action-params (struct enkiParamsCompletionAction)
(enkiGetParamsCompletionAction cleanup-action))
(set (field action-params pArgsPostComplete) cleanup-action-arguments)
(set (field action-params pDependency) (token-splice-array task-to-depend-on-arg))
@ -812,7 +812,7 @@
(fprintf stderr "\nCreating tasks within the complete call!\n")
(var my-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler my-long-task))
(scope
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-task))
(set (field task-params setSize) 100)
(set (field task-params minRange) 10)
(enkiSetParamsTaskSet my-task task-params))
@ -820,14 +820,14 @@
;; This time, use dependencies rather than completion action
(var my-dependent-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler after-my-long-task))
(scope
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-dependent-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-dependent-task))
(set (field task-params setSize) 1)
(set (field task-params minRange) 1)
(enkiSetParamsTaskSet my-dependent-task task-params))
(var my-other-dependent-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler test-task))
(scope
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-other-dependent-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-other-dependent-task))
(var-static my-args test-task-arguments
(array 42 "Hello, TaskSystem!"))
(set (field task-params pArgs) (addr my-args))
@ -857,7 +857,7 @@
(var cleanup-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler cleanup-complete-tasks))
(scope
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet cleanup-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet cleanup-task))
(var-cast-to cleanup-args (addr cleanup-complete-tasks-arguments)
(malloc (sizeof (type cleanup-complete-tasks-arguments))))
(cleanup-complete-tasks-arguments-fill cleanup-args my-task my-dependent-task my-other-dependent-task
@ -891,14 +891,14 @@
(fprintf stderr "Created %d threads\n" (enkiGetNumTaskThreads task-scheduler))
(var my-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler my-long-task))
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-task))
(set (field task-params setSize) 100)
(set (field task-params minRange) 10)
(enkiSetParamsTaskSet my-task task-params)
(var completion-action (addr enkiCompletionAction)
(enkiCreateCompletionAction task-scheduler null on-my-long-task-complete))
(var completion-args enkiParamsCompletionAction
(var completion-args (struct enkiParamsCompletionAction)
(enkiGetParamsCompletionAction completion-action))
(set (field completion-args pDependency) (enkiGetCompletableFromTaskSet my-task))
(enkiSetParamsCompletionAction completion-action completion-args)
@ -926,7 +926,7 @@
(defun-local on-discover-task-complete (args (addr void) threadnum uint32_t)
(fprintf stderr "[thread %d] Set task params\n" threadnum)
(var-cast-to my-utilize-task (addr enkiTaskSet) args)
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-utilize-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-utilize-task))
;; Discovered amount of work would go here
(set (field task-params setSize) 30)
(set (field task-params minRange) 5)
@ -940,21 +940,21 @@
(var my-discover-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler discover-task))
(scope
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-discover-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-discover-task))
(set (field task-params setSize) 1)
(set (field task-params minRange) 1)
(enkiSetParamsTaskSet my-discover-task task-params))
(var my-utilize-task (addr enkiTaskSet) (enkiCreateTaskSet task-scheduler utilize-task))
(scope
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet my-utilize-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet my-utilize-task))
(set (field task-params setSize) 1)
(set (field task-params minRange) 1)
(enkiSetParamsTaskSet my-utilize-task task-params))
(var completion-action (addr enkiCompletionAction)
(enkiCreateCompletionAction task-scheduler on-discover-task-complete null))
(var completion-args enkiParamsCompletionAction
(var completion-args (struct enkiParamsCompletionAction)
(enkiGetParamsCompletionAction completion-action))
(set (field completion-args pDependency) (enkiGetCompletableFromTaskSet my-discover-task))
(set (field completion-args pArgsPreComplete) my-utilize-task)
@ -983,7 +983,7 @@
(def-task on-discover-task-complete-sys (utilize-task (addr enkiTaskSet))
(fprintf stderr "[thread %d] Set task params\n" task-thread-id)
(var-cast-to my-utilize-task (addr enkiTaskSet) args)
(var task-params enkiParamsTaskSet (enkiGetParamsTaskSet utilize-task))
(var task-params (struct enkiParamsTaskSet) (enkiGetParamsTaskSet utilize-task))
;; Discovered amount of work would go here
(set (field task-params setSize) 30)
(set (field task-params minRange) 5)

37
src/Tracy.cake

@ -3,23 +3,32 @@
(import "ComptimeHelpers.cake" "Dependencies.cake" "BuildTools.cake")
(c-import &with-decls "Tracy.hpp" "TracyC.h")
(export-and-evaluate
(require-cpp))
(c-import &with-decls "TracyC.h")
;; (export-and-evaluate
;; (require-cpp))
;; Open a scope and time it
(defmacro scope-timed (scope-label string &rest body any)
(var varname Token (deref scope-label))
(set (field varname type) TokenType_Symbol)
(MakeContextUniqueSymbolName environment context "timeScope" (addr varname))
(tokenize-push output
(scope
(ZoneScopedN (token-splice scope-label))
(time-this-scope (token-splice-addr varname) (token-splice scope-label))
(token-splice-rest body tokens)))
(return true))
;; Time the current scope
;; TODO: Move into Profiler.cake?
(defmacro time-this-scope (varname symbol &optional name string)
(if name
(tokenize-push output (ZoneNamedN (token-splice varname name) 1))
(tokenize-push output
(TracyCZoneN (token-splice varname name) 1)
(defer (TracyCZoneEnd (token-splice varname))))
;; Doesn't work. Why not?
(tokenize-push output (ZoneNamed (token-splice varname) 1)))
(tokenize-push output
(TracyCZone (token-splice varname) 1)
(defer (TracyCZoneEnd (token-splice varname)))))
(return true))
;; This needed to be a generator to output "FrameMark;" with no parens.
@ -64,7 +73,7 @@
(c-import "unistd.h")
(defun test--tracy-main (&return int)
(ZoneScopedN "main")
(time-this-scope main-scope "main")
(var status int 0)
(runtime-start-process-or
@ -73,17 +82,17 @@
(return 1))
(fprintf stderr "Waiting for profiler to connect...\n")
(while (not (call-on IsConnected (call (in tracy GetProfiler))))
(ZoneScopedN "wait for profiler")
(sleep 1))
(while (not TracyCIsConnected)
(scope-timed "wait for profiler"
(sleep 1)))
(var i int 0)
(var num-times (const int) 2)
(while (< i num-times)
(ZoneScopedN "hot loop")
(fprintf stderr "hot loop %d / %d\n" i num-times)
(sleep 1)
(incr i))
(scope-timed "hot loop"
(fprintf stderr "hot loop %d / %d\n" i num-times)
(sleep 1)
(incr i)))
(return 0))))
;;

2
test/src/Config_Linux.cake

@ -7,3 +7,5 @@
;; Need to define this to not have to manually delete dependencies after testing is done
(comptime-define-symbol 'Dependencies-Clone-Only)
(set-cakelisp-option use-c-linkage true)

Loading…
Cancel
Save