GameLib is a collection of libraries for creating applications in Cakelisp.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 
 
 

1857 lines
86 KiB

;; IntrospectionV2.cake: A more sustainable introspection system than Introspection.cake.
;; Goals:
;; - Provide zero-copy reads and writes for plain-old-data at a field-by-field granularity, i.e.
;; support mixed POD/non POD in the same operation
;; - Solve the Expression Problem by allowing easier type handler specification
;; - Support optional versioning and version migration (old versions to current versions)
;; - Code generate as late as possible so the system can have more information about types
;; Add the following for debug output: (comptime-define-symbol 'Introspection-Verbose)
;; TODO:
;; - Assumes POD types. We should validate that.
;; - Custom migration functions for entire structs?
;; - Support array resizes?
(import
&with-decls "IntrospectionV2Generated.cake" &with-defs
"Hash.cake"
;; Cakelisp
"CHelpers.cake" "ComptimeHelpers.cake")
(c-import
&with-decls "<stdint.h>" "<stdbool.h>"
;; For validation functions
"<assert.h>"
&with-defs "<stdio.h>"
;; For memcpy
"<string.h>"
"<assert.h>")
;;
;; Metadata
;;
;; (defstruct metadata2-field
;; name (addr (const char))
;; name-crc32 (unsigned int)
;; ;; A hash of the type signature
;; type-id (unsigned int)
;; ;; For pointers to structures or arrays of structures, this stores the referenced type
;; reference-type-id (unsigned int)
;; ;; Offset in the parent structure
;; offset (unsigned int)
;; ;; Size of a single element (arrays), or size of field
;; element-size (unsigned int)
;; ;; Size of array (static array only)
;; count (unsigned int)
;; ;; Hashes of arbitrary tags associated with this field
;; tags (array 4 (unsigned int)))
;; (defstruct metadata2-struct
;; name (addr (const char))
;; type-id (unsigned int)
;; fields (addr (const metadata2-field))
;; num-fields (unsigned int)
;; struct-size (unsigned int)
;; ;; If true, binary serialized versions of this struct can be read/written directly into memory,
;; ;; no field-by-field traversal necessary.
;; is-plain-old-data bool)
;;
;; Compile-time interface
;;
(defmacro when-introspection-verbose (&rest body any)
(tokenize-push output
(comptime-cond
('Introspection-Verbose
(token-splice-rest body tokens))))
(return true))
;; TODO: Cakelisp support for shared comptime declarations
(defmacro define-versioned-struct-metadata-comptime-types ()
(tokenize-push output
(defstruct versioned-struct
start-declaration (addr (const Token))
struct-name (addr (const Token)) ;; Also used for splice output name
;; Populated later
name-crc32 uint32_t
latest-version (unsigned int)
start-field-versionings (unsigned int)
num-field-versionings (unsigned int))
(defstruct comptime-field-versioning
field-name-crc32 uint32_t
core-type-crc32 uint32_t
;; When non-zero, the core type is a versioned struct
core-type-version int
core-type (addr (const Token))
array-count (addr (const Token))
start-version (unsigned short)
end-version (unsigned short)) ;; 0 for live fields
;; TODO: If I need this for another case, I should macro-ize it.
(defstruct versioned-struct-state
versioned-structs (array 256 versioned-struct)
num-used-versioned-structs int
num-generated-structs int
field-versionings (array 2048 comptime-field-versioning)
num-used-field-versionings int)
(var comptime-versioned-struct-state (addr versioned-struct-state) null)
(unless (GetCompileTimeVariable environment
"comptime-versioned-struct-state" "versioned-struct-state"
(type-cast (addr comptime-versioned-struct-state) (addr (addr void))))
(set comptime-versioned-struct-state
(type-cast
(calloc
1 (sizeof (type versioned-struct-state)))
(addr versioned-struct-state)))
(unless (CreateCompileTimeVariable environment
"comptime-versioned-struct-state" "versioned-struct-state"
(type-cast comptime-versioned-struct-state (addr void))
"destroy-versioned-struct-state")
(free comptime-versioned-struct-state)
(return false))))
(return true))
(defmacro def-versioned-struct
(name symbol
version array
&rest body-index (index any))
(var help-string (addr (const char))
"def-versioned-struct expects: field-name field-type field-options\n
\texample: position vec3 (live 1)\nAll fields must have a live/dead specifier, where e.g. (live 2)
means the field is currently valid and was added in struct version 2, while (dead 2 3) means the
field was valid from versions 2 through 3 but is now invalid in all versions after 3.")
(var version-number-token (addr (const Token)) (+ 2 version))
(var live-fields (template (in std vector) Token))
(var live-field-validation (template (in std vector) Token))
(each-token-argument-in-range
tokens startTokenIndex body-index end-struct-fields field-index field-name-token
(unless (ExpectTokenType "def-versioned-struct" (deref field-name-token) TokenType_Symbol)
(NoteAtToken (deref field-name-token) help-string)
(return false))
(set field-index
(getNextArgument tokens field-index end-struct-fields))
(var field-type-token (addr (const Token)) (addr (at field-index tokens)))
(set field-index
(getNextArgument tokens field-index end-struct-fields))
(var field-options-token (addr (const Token)) (addr (at field-index tokens)))
(unless (ExpectTokenType "def-versioned-struct" (deref field-options-token) TokenType_OpenParen)
(NoteAtToken (deref field-options-token) help-string)
(return false))
;; Parse the options to determine whether the field is alive or not. That's all we do at this
;; stage; more options parsing will happen later.
(var options-end (addr (const Token))
(FindTokenExpressionEnd field-options-token))
(var options-specified-live-or-dead bool false)
(c-for (var options-read-head (addr (const Token)) (+ 1 field-options-token))
(< options-read-head options-end)
(incr options-read-head)
(unless (and
(= TokenType_Symbol (path options-read-head > type))
(= TokenType_OpenParen (path (- options-read-head 1) > type)))
(continue))
(var field-is-dead bool (std-str-equals (path options-read-head > contents) "dead"))
(var field-is-live bool (std-str-equals (path options-read-head > contents) "live"))
;; Some other option we'll just ignore
(unless (or field-is-live field-is-dead)
(continue))
(when field-is-live
(tokenize-push live-fields
(token-splice field-name-token field-type-token))
(var field-hash-token Token (deref field-name-token))
(var field-name-crc32 uint32_t 0)
(crc32
(call-on c_str (path field-name-token > contents))
(call-on size (path field-name-token > contents))
(addr field-name-crc32))
(token-contents-snprintf field-hash-token "%u" field-name-crc32)
(tokenize-push live-field-validation
(assert
(and
(get-field-offset-in-layout
(token-splice-addr field-hash-token)
field-layouts num-fields (addr offset))
(= (offsetof (type (token-splice name)) (token-splice field-name-token))
offset)
"compiled struct layout does not match versioning struct layout"))))
(set options-specified-live-or-dead true)
(break))
(unless options-specified-live-or-dead
(ErrorAtToken (deref field-options-token) "live or dead must be specified for every field in
a versioned struct.\n")))
(var struct-active-version-var-token Token (deref name))
(token-contents-snprintf struct-active-version-var-token "%s--active-version-number"
(call-on c_str (path name > contents)))
(tokenize-push output
(defstruct (token-splice name)
(token-splice-array live-fields))
(var-global (token-splice-addr struct-active-version-var-token) (unsigned short)
(token-splice version-number-token))
;; Used for outputting metadata variables etc.
(splice-point (token-splice name)))
;; Generate validation function
(scope
(var validation-function-name Token (deref name))
(token-contents-snprintf validation-function-name "validate-versionings--%s"
(call-on c_str (path name > contents)))
(var struct-name-crc32 uint32_t 0)
(var struct-name-crc32-token Token (deref name))
(crc32
(call-on c_str (path name > contents))
(call-on size (path name > contents))
(addr struct-name-crc32))
(token-contents-snprintf struct-name-crc32-token "%u" struct-name-crc32)
(tokenize-push output
(defun (token-splice-addr validation-function-name) ()
(var num-versioned-structs (unsigned int) 0)
(var all-versioned-structs (addr versioned-struct)
(get-all-versioned-structs (addr num-versioned-structs)))
(assert all-versioned-structs)
(var struct-versionings (addr versioned-struct)
(get-field-versionings-for-struct
(token-splice-addr struct-name-crc32-token)
all-versioned-structs num-versioned-structs))
(var struct-layout versioned-struct-layout (array 0))
(var field-layouts (array 256 versioned-struct-field-layout) (array 0))
(var num-fields int
(get-versioned-struct-layout-at-version
(path struct-versionings > field-versioning)
(path struct-versionings > num-field-versionings)
(token-splice version-number-token)
field-layouts
(array-size field-layouts) (addr struct-layout)))
(assert (and num-fields
(= (sizeof (type (token-splice name)))
(field struct-layout total-size))
"compiled struct layout does not match versioning struct layout"))
(var offset (unsigned int) 0)
(token-splice-array live-field-validation))))
(define-versioned-struct-metadata-comptime-types)
(unless (< (path comptime-versioned-struct-state > num-used-versioned-structs)
(array-size (path comptime-versioned-struct-state > versioned-structs)))
(ErrorAtTokenf
(deref name)
"There is no more room for more versioned structs. The maximum is %d. Increase the maximum by
editing comptime-versioned-struct-state definition in %s."
(type-cast (array-size (path comptime-versioned-struct-state > versioned-structs)) int)
(this-file))
(return false))
(var new-struct (addr versioned-struct)
(addr (at (path comptime-versioned-struct-state > num-used-versioned-structs)
(path comptime-versioned-struct-state > versioned-structs))))
(set-fields (deref new-struct)
start-declaration (addr (at startTokenIndex tokens))
struct-name name
start-field-versionings -1)
(incr (path comptime-versioned-struct-state > num-used-versioned-structs))
(return true))
(defun-comptime destroy-versioned-struct-state
(data (addr void))
(free data))
;; While unlikely, we definitely need to check for collisions because it will lead to very
;; frustrating bugs otherwise.
(defun-comptime introspection-add-hash-is-hash-unique
(environment (addr EvaluatorEnvironment)
hash uint32_t
from-tokens-start (addr (const Token))
&return bool)
(get-or-create-comptime-var
(deref environment)
introspection-hashes
(template (in std unordered_map) uint32_t (addr (const Token))))
(def-type-alias introspection-hash-to-tokens
(template (in std unordered_map) uint32_t (addr (const Token))))
(var found-hash
(in introspection-hash-to-tokens iterator)
(call-on-ptr find introspection-hashes hash))
(var is-match bool true)
(if (= (call-on-ptr end introspection-hashes) found-hash)
(scope
(set (at hash (deref introspection-hashes)) from-tokens-start)
(return true))
(scope
(if (= TokenType_OpenParen (path from-tokens-start > type))
(scope
(var existing-hash-read-head (addr (const Token))
(path found-hash > second))
(var end (addr (const Token)) (FindTokenExpressionEnd from-tokens-start))
(c-for (var read-head (addr (const Token)) from-tokens-start)
(< read-head end)
(incr read-head)
(unless (and (= (path read-head > type) (path existing-hash-read-head > type))
(= 0 (call-on compare
(path read-head > contents)
(path existing-hash-read-head > contents))))
(set is-match false)
(break))
(incr existing-hash-read-head)))
(scope
(set is-match
(= 0 (call-on compare
(path from-tokens-start > contents)
(path found-hash > second > contents))))))))
(unless is-match
(ErrorAtTokenf (deref from-tokens-start)
"Hash collision detected for hash value %u. One of the names needs to change
names or else the Introspection system will not be able to tell them apart. (def-type-alias) may
be used if the underlying type name cannot be changed."
hash)
(NoteAtToken (deref (path found-hash > second)) "The other type is here.")
(return false))
(return is-match))
;; TODO: Convert to regular comptime function once Cakelisp supports shared comptime definitions
(defmacro declare-acquire-field-versioning
(acquired-versioning-var-name symbol
assigned-struct-name symbol
blame-token any)
(tokenize-push output
(var (token-splice acquired-versioning-var-name) (addr comptime-field-versioning)
(addr (at (path comptime-versioned-struct-state > num-used-field-versionings)
(path comptime-versioned-struct-state > field-versionings))))
(when (= -1 (path (token-splice assigned-struct-name) > start-field-versionings))
(set (path (token-splice assigned-struct-name) > start-field-versionings)
(path comptime-versioned-struct-state > num-used-field-versionings)))
(incr (path (token-splice assigned-struct-name) > num-field-versionings))
(incr (path comptime-versioned-struct-state > num-used-field-versionings))
(unless (< (path comptime-versioned-struct-state > num-used-field-versionings)
(array-size (path comptime-versioned-struct-state > field-versionings)))
(ErrorAtTokenf
(token-splice blame-token)
"Reached the hard-coded maximum number of tracked versionings. Edit %s
(comptime-versioned-struct-state > field-versionings) to increase this limit." (this-file))
(return false)))
(return true))
(defun-comptime sort-hash-name-pair (a-void (addr (const void))
b-void (addr (const void))
&return int)
;; Ignore the null call hack for Cakelisp dependency resolution
(unless a-void
(return 0))
(defstruct hash-to-string
hash uint32_t
str (array 64 char)
blame-token (addr (const Token)))
(var-cast-to a (addr (const hash-to-string)) a-void)
(var-cast-to b (addr (const hash-to-string)) b-void)
(cond
((< (path a > hash) (path b > hash))
(return -1))
((> (path a > hash) (path b > hash))
(return 1))
(true ;; Should never happen
(return 0))))
(defstruct versioned-struct-hash-string-pair
hash uint32_t
str (addr (const char)))
;; Done as late as possible so we know more about types and can do more validation
(defun-comptime generate-introspection2-versioned-metadata
(environment (ref EvaluatorEnvironment)
&return bool)
(define-versioned-struct-metadata-comptime-types)
;; No new structs found
(unless (> (path comptime-versioned-struct-state > num-used-versioned-structs)
(path comptime-versioned-struct-state > num-generated-structs))
(return true))
(get-or-create-comptime-var
environment
versioned-structs-initialize-required bool false)
(var central-metadata-output (addr (template (in std vector) Token))
(new (template (in std vector) Token)))
(call-on push_back (field environment comptimeTokens) central-metadata-output)
;; Preprocess structs, hashing their names and getting their versions
(each-in-range (path comptime-versioned-struct-state > num-used-versioned-structs) struct-index
(var current-struct (addr versioned-struct)
(addr (at struct-index (path comptime-versioned-struct-state > versioned-structs))))
(unless (path current-struct > start-declaration)
(break))
(var struct-name-token (addr (const Token))
(path current-struct > struct-name))
(var struct-version-start-token (addr (const Token))
(+ 3 (path current-struct > start-declaration)))
(var version-keyword (addr (const Token))
(+ 1 struct-version-start-token))
(var version-token (addr (const Token))
(+ 1 version-keyword))
(unless (and (= TokenType_OpenParen (path struct-version-start-token > type))
(= TokenType_Symbol (path version-keyword > type))
(std-str-equals (path version-keyword > contents) "version")
(= TokenType_Symbol (path version-token > type)))
(ErrorAtToken (deref struct-version-start-token) "Expected version specifier, e.g. (version 1)")
(return false))
(var struct-latest-version (unsigned int)
(atoi (call-on c_str (path version-token > contents))))
(unless (> struct-latest-version 0)
(ErrorAtToken (deref version-token) "Version must be greater than 0")
(return false))
(when-introspection-verbose
(NoteAtTokenf (deref (path current-struct > start-declaration))
"Registered versioned struct %s, currently version %d"
(call-on c_str (path struct-name-token > contents))
struct-latest-version))
(set (path current-struct > latest-version) struct-latest-version)
(crc32
(call-on c_str (path struct-name-token > contents))
(call-on size (path struct-name-token > contents))
(addr (path current-struct > name-crc32)))
(unless (introspection-add-hash-is-hash-unique
(addr environment) (path current-struct > name-crc32) struct-name-token)
(return false)))
;; Field-by-field metadata generation and cross-struct version validation
(each-in-range (path comptime-versioned-struct-state > num-used-versioned-structs) struct-index
(var current-struct (addr versioned-struct)
(addr (at struct-index (path comptime-versioned-struct-state > versioned-structs))))
(unless (path current-struct > start-declaration)
(break))
(var struct-end-token (addr (const Token))
(FindTokenExpressionEnd (path current-struct > start-declaration)))
(var struct-name-token (addr (const Token))
(path current-struct > struct-name))
(var struct-version-start-token (addr (const Token))
(+ 3 (path current-struct > start-declaration)))
(var current-token (addr (const Token))
(+ 1 (FindTokenExpressionEnd struct-version-start-token)))
(while (< current-token struct-end-token)
(var field-name (addr (const Token)) current-token)
(var field-name-crc32 uint32_t 0)
(crc32
(call-on c_str (path field-name > contents))
(call-on size (path field-name > contents))
(addr field-name-crc32))
(unless (introspection-add-hash-is-hash-unique
(addr environment) field-name-crc32 field-name)
(return false))
(var field-type-token (addr (const Token)) (+ 1 current-token))
(var field-options (addr (const Token))
(+ 1 (FindTokenExpressionEnd field-type-token)))
(var options-end (addr (const Token))
(FindTokenExpressionEnd field-options))
(when-introspection-verbose
(NoteAtTokenf (deref field-name) "Field %s" (call-on c_str (path field-name > contents))))
(defstruct field-type-data
core-type (addr (const Token))
core-type-name-crc32 uint32_t
is-plain-old-data bool
is-array bool
array-size-start (addr (const Token)))
(var field-type field-type-data (array 0))
(set-fields field-type
is-plain-old-data true
core-type field-type-token)
(scope ;; Read type
(when (= TokenType_OpenParen (path field-type-token > type))
(var type-specifier (addr (const Token)) (+ field-type-token 1))
(cond
((std-str-equals (path type-specifier > contents) "array")
(set-fields field-type
is-array true
array-size-start (+ type-specifier 1)
core-type (+ 1 (FindTokenExpressionEnd (field field-type array-size-start)))))
((std-str-equals (path type-specifier > contents) "addr")
(set-fields field-type
is-plain-old-data false
core-type (+ type-specifier 1)))))
(var core-type-end (addr (const Token))
(FindTokenExpressionEnd (field field-type core-type)))
(c-for (var type-read-head (addr (const Token)) (field field-type core-type))
;; Less than or equal here to read single symbol types. The symbol check below filters
;; the closing parenthesis for other types.
(<= type-read-head core-type-end)
(incr type-read-head)
(unless (= TokenType_Symbol (path type-read-head > type))
(continue))
(crc32
(call-on c_str (path type-read-head > contents))
(call-on size (path type-read-head > contents))
(addr (field field-type core-type-name-crc32))))
(unless (introspection-add-hash-is-hash-unique
(addr environment) (field field-type core-type-name-crc32)
(field field-type core-type))
(return false)))
(var referenced-versioned-struct (addr versioned-struct) null)
(scope
(each-in-range (path comptime-versioned-struct-state > num-used-versioned-structs) struct-index
(var current-struct (addr versioned-struct)
(addr (at struct-index (path comptime-versioned-struct-state > versioned-structs))))
(unless (path current-struct > start-declaration)
(break))
(when (= (field field-type core-type-name-crc32)
(path current-struct > name-crc32))
(when-introspection-verbose
(NoteAtToken (deref (field field-type core-type))
"References versioned struct"))
(set referenced-versioned-struct current-struct)
(break))))
(if referenced-versioned-struct
(scope ;; Versioned struct
(c-for (var options-read-head (addr (const Token)) (+ 1 field-options))
(< options-read-head options-end)
(incr options-read-head)
(unless (and
(= TokenType_Symbol (path options-read-head > type))
(= TokenType_OpenParen (path (- options-read-head 1) > type)))
(continue))
(var field-is-dead bool (std-str-equals (path options-read-head > contents) "dead"))
(var field-is-live bool (std-str-equals (path options-read-head > contents) "live"))
;; Some other option we'll just ignore
(unless (or field-is-live field-is-dead)
(continue))
(var versioning-end (addr (const Token))
(FindTokenExpressionEnd (- options-read-head 1)))
(c-for (var versioning-read-head (addr (const Token)) (+ 1 options-read-head))
(< versioning-read-head versioning-end)
(incr versioning-read-head)
(var struct-version (addr (const Token)) (+ versioning-read-head 1))
(var start-version (addr (const Token)) (+ versioning-read-head 2))
(var end-version (addr (const Token)) (+ versioning-read-head 3))
(var end-struct-versioning (addr (const Token)) (+ versioning-read-head 4))
(unless (and (= TokenType_OpenParen (path versioning-read-head > type))
(= TokenType_Symbol (path struct-version > type))
(= TokenType_Symbol (path start-version > type))
(= TokenType_Symbol (path end-version > type))
(= TokenType_CloseParen (path end-struct-versioning > type)))
(ErrorAtToken (deref versioning-read-head) "Expected struct versioning in the
following format:\n
(substruct-version start-version end-version)\n
Examples:\n
(live (1 1 .)) = Substruct at version 1 is live in current struct since version 1\n
(live (1 1 2) (2 3 .)) = Substruct at version 2 is live in current struct since version 3\n
(dead (1 5 7) (2 8 8)) = Substruct at version 2 is now dead in current struct since version 8")
(return false))
(declare-acquire-field-versioning
write-versioning current-struct (deref versioning-read-head))
(var parsed-end-version int 0)
(var end-version-string (addr (const char))
(call-on c_str (path end-version > contents)))
(when (!= '.' (at 0 end-version-string))
(set parsed-end-version (atoi end-version-string)))
(set-fields (deref write-versioning)
field-name-crc32 field-name-crc32
core-type-crc32 (path referenced-versioned-struct > name-crc32)
core-type-version (atoi (call-on c_str (path struct-version > contents)))
start-version (atoi (call-on c_str (path start-version > contents)))
end-version parsed-end-version
core-type (field field-type core-type)
array-count (field field-type array-size-start))
(unless (and (path write-versioning > field-name-crc32)
(path write-versioning > start-version)
(path write-versioning > core-type-version))
(ErrorAtToken (deref versioning-read-head)
"Unable to parse struct versioning. Ensure substruct versions are
within the substruct's range, and ensure versions are within the current struct's range. The live
indicator '.' must only appear as an end version in live field ranges.")
(return false))
(unless (<= (path write-versioning > core-type-version)
(path referenced-versioned-struct > latest-version))
(ErrorAtTokenf (deref struct-version)
"Substruct version is invalid. The referenced struct's latest version is %d."
(path referenced-versioned-struct > latest-version))
(NoteAtToken (deref (path referenced-versioned-struct > start-declaration))
"The referenced struct is defined here.")
(return false))
(when (and
(not (path write-versioning > end-version)) ;; live version
(!= (path write-versioning > core-type-version)
(path referenced-versioned-struct > latest-version)))
(ErrorAtTokenf (deref struct-version)
"The referenced struct's live version is %d. All users of this
struct must upgrade their versions to match the live version accordingly."
(path referenced-versioned-struct > latest-version))
(NoteAtToken (deref (path referenced-versioned-struct > start-declaration))
"The referenced struct is defined here.")
(return false))
(when (and (not (path write-versioning > end-version))
field-is-dead)
(ErrorAtToken (deref end-version)
"The field is marked as dead but the version range indicates it is
live. This should become the final live version instead.")
(return false))
(set versioning-read-head end-struct-versioning))))
(scope ;; Basic types
(defstruct field-versioning
is-live bool
first-valid-version (unsigned int)
last-valid-version (unsigned int))
(var versioning field-versioning (array 0))
(scope ;; Read options
(c-for (var options-read-head (addr (const Token)) (+ 1 field-options))
(< options-read-head options-end)
(incr options-read-head)
(cond
((and
(= TokenType_Symbol (path options-read-head > type))
(std-str-equals (path options-read-head > contents) "live"))
(var live-since-version (addr (const Token)) (+ 1 options-read-head))
(unless (= TokenType_Symbol (path live-since-version > type))
(ErrorAtToken (deref live-since-version) "Expected version since live, e.g. live 1")
(return false))
(set-fields versioning
is-live true
first-valid-version (atoi (call-on c_str (path live-since-version > contents))))
(incr options-read-head))
((and
(= TokenType_Symbol (path options-read-head > type))
(std-str-equals (path options-read-head > contents) "dead"))
(var first-version (addr (const Token)) (+ 1 options-read-head))
(var last-version (addr (const Token)) (+ 2 options-read-head))
(unless (and (= TokenType_Symbol (path first-version > type))
(= TokenType_Symbol (path last-version > type)))
(ErrorAtToken (deref first-version)
"Expected valid version range, e.g. dead 2 4 means the field was valid
in struct versions 2, 3, and 4.")
(return false))
(set-fields versioning
is-live false
first-valid-version (atoi (call-on c_str (path first-version > contents)))
last-valid-version (atoi (call-on c_str (path last-version > contents))))
(set options-read-head (+ options-read-head 2)))
(true
(ErrorAtToken (deref options-read-head)
"Unexpected field option. Expected either live or dead.")
(return false))))
;; Validate versioning
(unless (field versioning first-valid-version)
(ErrorAtToken (deref field-options)
"Expected version number greater than 0 in which this field became valid.")
(return false))
(when (and (not (field versioning is-live))
(not (field versioning last-valid-version)))
(ErrorAtToken (deref field-options)
"Expected version number greater than 0 denoting the final version this
field was valid.")
(return false))
(when (or (> (field versioning first-valid-version) (path current-struct > latest-version))
(> (field versioning last-valid-version) (path current-struct > latest-version)))
(ErrorAtTokenf (deref field-options) "Field version is greater than struct version %d.
Field versions are defined in terms of the struct version, so they must be less than or equal to
the struct version." (path current-struct > latest-version))
(return false))
(declare-acquire-field-versioning
write-versioning current-struct (deref field-options))
(set-fields (deref write-versioning)
field-name-crc32 field-name-crc32
core-type-crc32 0
core-type-version 0
start-version (field versioning first-valid-version)
end-version (field versioning last-valid-version)
core-type (field field-type core-type)
array-count (field field-type array-size-start)))))
;; Move on to next field
(set current-token (+ 1 options-end))))
;; Finally, generate the field-versionings for use at runtime
(var versioned-struct-forward-declarations (template (in std vector) Token))
(var versioned-struct-tokens (template (in std vector) Token))
(var field-versionings-output (template (in std vector) Token))
(var validation-functions-tokens (template (in std vector) Token))
(call-on reserve versioned-struct-forward-declarations 1024)
(call-on reserve versioned-struct-tokens 1024)
(call-on reserve field-versionings-output 1024)
(call-on reserve validation-functions-tokens 1024)
(var element-or-type-alignment (template (in std vector) Token))
(var element-or-type-size (template (in std vector) Token))
(each-in-range (path comptime-versioned-struct-state > num-used-versioned-structs) struct-index
(var current-struct (addr versioned-struct)
(addr (at struct-index (path comptime-versioned-struct-state > versioned-structs))))
(unless (path current-struct > start-declaration)
(break))
(var struct-name-token (addr (const Token))
(path current-struct > struct-name))
(var validation-function-name Token (deref struct-name-token))
(token-contents-snprintf validation-function-name "validate-versionings--%s"
(call-on c_str (path struct-name-token > contents)))
(tokenize-push validation-functions-tokens
(declare-extern-function (token-splice-addr validation-function-name) ())
(call (token-splice-addr validation-function-name)))
(call-on clear field-versionings-output)
(each-in-range (path current-struct > num-field-versionings) field-version-index
(var current-versioning (addr comptime-field-versioning)
(addr (at (+ (path current-struct > start-field-versionings) field-version-index)
(path comptime-versioned-struct-state > field-versionings))))
(var blame-symbol-token Token (deref (path current-struct > start-declaration)))
(set (field blame-symbol-token type) TokenType_Symbol)
(var field-name-crc32-token Token blame-symbol-token)
(var core-type-crc32-token Token blame-symbol-token)
(var core-type-version-token Token blame-symbol-token)
(var start-version-token Token blame-symbol-token)
(var end-version-token Token blame-symbol-token)
(var alignment-token Token blame-symbol-token)
(var element-size-token Token blame-symbol-token)
(var array-count-token Token blame-symbol-token)
(token-contents-snprintf field-name-crc32-token "%u"
(path current-versioning > field-name-crc32))
(token-contents-snprintf core-type-crc32-token "%u"
(path current-versioning > core-type-crc32))
(token-contents-snprintf core-type-version-token "%d"
(path current-versioning > core-type-version))
(token-contents-snprintf start-version-token "%d"
(path current-versioning > start-version))
(token-contents-snprintf end-version-token "%d"
(path current-versioning > end-version))
(token-contents-snprintf alignment-token "%s" "-1") ;; c-versioned-struct-fixup-required
(call-on clear element-or-type-alignment)
(if (path current-versioning > core-type-version)
;; Need to compute virtual type alignments at runtime
(scope
(tokenize-push element-or-type-alignment
(token-splice-addr alignment-token))
(set (deref versioned-structs-initialize-required) true))
(tokenize-push element-or-type-alignment
(alignment-of (type (token-splice (path current-versioning > core-type))))))
(call-on clear element-or-type-size)
(token-contents-snprintf element-size-token "%s" "-1") ;; c-versioned-struct-fixup-required
(if (path current-versioning > core-type-version)
(tokenize-push element-or-type-size
(token-splice-addr element-size-token)) ;; Need to compute virtual types
(tokenize-push element-or-type-size
(sizeof (type (token-splice (path current-versioning > core-type))))))
(set (field array-count-token contents) "0")
(var optional-array-count (addr (const Token))
(? (path current-versioning > array-count)
(path current-versioning > array-count)
(addr array-count-token)))
(tokenize-push field-versionings-output
(array
(token-splice-addr field-name-crc32-token) ;; field-name-crc32
(token-splice-addr core-type-crc32-token) ;; core-type-crc32
(token-splice-addr core-type-version-token) ;; core-type-version
(token-splice-addr start-version-token) ;; start-version
(token-splice-addr end-version-token) ;; end-version
(token-splice-array element-or-type-alignment) ;; alignment
(token-splice-array element-or-type-size) ;; element-size
(token-splice optional-array-count)))) ;; array-count
(var struct-versionings-name Token (deref struct-name-token))
(token-contents-snprintf struct-versionings-name "%s--versionings"
(call-on c_str (path struct-name-token > contents)))
(var num-struct-versionings-name Token (deref struct-name-token))
(token-contents-snprintf num-struct-versionings-name "%s--num-versionings"
(call-on c_str (path struct-name-token > contents)))
(var final-versionings-output (addr (template (in std vector) Token))
(new (template (in std vector) Token)))
(call-on push_back (field environment comptimeTokens) final-versionings-output)
(tokenize-push (deref final-versionings-output)
(var-hidden-global
(token-splice-addr struct-versionings-name) (array field-version-data)
(array (token-splice-array field-versionings-output)))
(var-hidden-global
(token-splice-addr num-struct-versionings-name) int
(array-size (token-splice-addr struct-versionings-name))))
(unless (ClearAndEvaluateAtSplicePoint
environment (call-on c_str (path struct-name-token > contents))
final-versionings-output)
(return false))
;; Generate code for runtime fixup (centralized)
(tokenize-push versioned-struct-forward-declarations
(declare-external (var (token-splice-addr struct-versionings-name)
(array field-version-data))))
(var struct-versionings-struct-name-crc32 Token (deref struct-name-token))
(token-contents-snprintf struct-versionings-struct-name-crc32 "%u"
(path current-struct > name-crc32))
(var struct-versionings-array-size Token (deref struct-name-token))
(token-contents-snprintf
struct-versionings-array-size "%d"
(path current-struct > num-field-versionings))
(tokenize-push versioned-struct-tokens
(array
(token-splice-addr struct-versionings-struct-name-crc32)
(token-splice-addr struct-versionings-name)
(token-splice-addr struct-versionings-array-size))))
;; And output our names to hashes for debugging, printing, etc.
(var all-names-hashes (template (in std vector) Token))
(call-on reserve all-names-hashes 1024)
(scope
(get-or-create-comptime-var
environment
introspection-hashes
(template (in std unordered_map) uint32_t (addr (const Token))))
;; Do not change without also changing sort-hash-name-pair
(defstruct hash-to-string
hash uint32_t
str (array 128 char)
blame-token (addr (const Token)))
(var num-hashes (unsigned int) (call-on-ptr size introspection-hashes))
(var-cast-to all-hashes (addr hash-to-string)
(calloc num-hashes (sizeof (type hash-to-string))))
(var write-hash (addr hash-to-string) all-hashes)
(defer (free all-hashes))
(def-type-alias introspection-hash-to-tokens
(template (in std unordered_map) uint32_t (addr (const Token))))
(def-type-alias introspection-hash-to-token-pair
(template (in std pair) uint32_t (addr (const Token))))
(for-in hash-name-pair (ref (const introspection-hash-to-token-pair)) (deref introspection-hashes)
(var hash uint32_t (field hash-name-pair first))
(var name-start-token (addr (const Token))
(field hash-name-pair second))
(set-fields (deref write-hash)
hash hash
blame-token name-start-token)
(if (= TokenType_OpenParen (path name-start-token > type))
(scope ;; Stringify type
(var str-write (addr char) (path write-hash > str))
(var end (addr (const Token)) (FindTokenExpressionEnd name-start-token))
(c-for (var read-head (addr (const Token)) name-start-token)
(< read-head end)
(incr read-head)
(unless (= (path read-head > type) TokenType_Symbol)
(continue))
(set str-write
(+ str-write
(snprintf
str-write
(- (sizeof (path write-hash > str))
(- str-write (path write-hash > str)))
"%s%s"
(call-on c_str (path read-head > contents))
(? (= end (+ 1 read-head)) "" " "))))))
(scope
(SafeSnprintf (path write-hash > str) (sizeof (path write-hash > str)) "%s"
(call-on c_str (path name-start-token > contents)))))
(incr write-hash))
;; Call it once to ensure Cakelisp builds it for us
(sort-hash-name-pair null null)
(qsort all-hashes num-hashes (sizeof (type hash-to-string)) sort-hash-name-pair)
(each-item-addr-in-addr-array all-hashes num-hashes
hash-index current-pair (addr hash-to-string)
(var hash-token Token (deref (path current-pair > blame-token)))
(set (field hash-token type) TokenType_Symbol)
(var hash-string-token Token (deref (path current-pair > blame-token)))
(set (field hash-string-token type) TokenType_String)
(token-contents-snprintf hash-token "%u"
(path current-pair > hash))
(token-contents-snprintf hash-string-token "%s"
(path current-pair > str))
(tokenize-push all-names-hashes
(array (token-splice-addr hash-token) (token-splice-addr hash-string-token)))))
(tokenize-push (deref central-metadata-output)
(token-splice-array versioned-struct-forward-declarations)
(var g-all-versioned-structs (array versioned-struct)
(array
(token-splice-array versioned-struct-tokens)))
(var-hidden-global
g-versioned-struct-name-hashes
(array versioned-struct-hash-string-pair)
(array
(token-splice-array all-names-hashes)))
(var-global g-num-versioned-struct-name-hashes int
(array-size g-versioned-struct-name-hashes))
(defun validate-struct-versionings ()
(token-splice-array validation-functions-tokens)))
(unless (ClearAndEvaluateAtSplicePoint
environment "versioned-struct-metadata-splice-point"
central-metadata-output)
(return false))
(set (path comptime-versioned-struct-state > num-generated-structs)
(path comptime-versioned-struct-state > num-used-versioned-structs))
(return true))
(add-compile-time-hook post-references-resolved generate-introspection2-versioned-metadata)
(defun-comptime versioned-struct-check-initialize-called
(manager (ref ModuleManager)
module (addr Module)
&return bool)
(get-or-create-comptime-var
(field manager environment)
versioned-structs-initialize-required bool)
(unless versioned-structs-initialize-required
;; No reason to call because no fixups are necessary
(return true))
(get-or-create-comptime-var
(field manager environment)
versioned-structs-initialize-called bool false)
(unless (deref versioned-structs-initialize-called)
(Log "error: call (versioned-structs-initialize) somewhere in your program initialization in " \
"order to properly set versioning metadata.\n")
(return false))
(return true))
(add-compile-time-hook-module pre-build versioned-struct-check-initialize-called)
;;
;; Runtime interface
;;
(defstruct field-version-data
field-name-crc32 uint32_t
core-type-crc32 uint32_t ;; struct-name-crc32 for substruct types
core-type-version (unsigned short) ;; 0 for basic types
start-version (unsigned short)
end-version (unsigned short) ;; 0 for live fields
;; When migrating, we are working with completely virtualized types built implicitly through
;; version history, which means we won't know the offset until we compute it based on previous
;; fields live in the current version, so we need the alignment to properly determine field
;; placement in memory.
alignment (unsigned short)
element-size (unsigned int)
array-count (unsigned int))
(var c-field-is-live (const (unsigned int)) 0)
;; next-free-byte-in-out will be advanced by field-size plus any bytes used for padding to align the
;; placed field. Note that this function will NOT align your structure as a whole; it assumes
;; next-free-byte-in-out is at a valid alignment for the entire struct when the first field is
;; placed. In addition, it will not be able to tell you how much padding is at the end of the struct
;; in order to maintain alignment in a contiguous array of the struct.
(defun struct-place-field-advance-head
(next-free-byte-in-out (addr (addr uint8_t))
field-start-out (addr (addr uint8_t))
field-size (unsigned int)
alignment (unsigned short)
array-count (unsigned int))
(unless alignment
(set alignment 1))
(unless array-count
(set array-count 1))
(var-cast-to throwaway-bytes (unsigned short)
(- alignment
(mod (+ (type-cast (deref next-free-byte-in-out) uintptr_t) alignment) alignment)))
(when (= alignment throwaway-bytes) ;; Already exactly aligned
(set throwaway-bytes 0))
(set (deref field-start-out)
(+ (deref next-free-byte-in-out) throwaway-bytes))
(set (deref next-free-byte-in-out)
(+ (deref field-start-out) (* array-count field-size)))
(when-introspection-verbose
(fprintf stderr "throw away %d bytes for %d byte alignment, advance %d\n"
throwaway-bytes alignment (* array-count field-size))))
(def-function-signature-global versioned-struct-name-from-crc32
(hash uint32_t
&return (addr (const char))))
(defun versioned-struct-name-from-crc32-default
(hash uint32_t
&return (addr (const char)))
(declare-external (var g-versioned-struct-name-hashes
(array versioned-struct-hash-string-pair)))
(declare-external (var g-num-versioned-struct-name-hashes int))
;; TODO Performance: this is large enough to warrant moving to a hash table
(each-item-addr-in-addr-array g-versioned-struct-name-hashes g-num-versioned-struct-name-hashes
hash-index current-pair (addr versioned-struct-hash-string-pair)
(when (= (path current-pair > hash) hash)
(return (path current-pair > str))))
(return "<unknown>"))
(defstruct versioned-struct-field-layout
field-name-crc32 uint32_t
offset (unsigned int)
version-data (addr field-version-data))
(defstruct versioned-struct-layout
max-alignment-requirement (unsigned short)
padding (unsigned short)
total-size (unsigned int))
(defun get-field-offset-in-layout
(field-name-crc32 uint32_t
field-layouts (addr versioned-struct-field-layout)
num-fields int
offset-out (addr (unsigned int))
&return bool)
(each-item-addr-in-addr-array field-layouts num-fields
field-index field (addr versioned-struct-field-layout)
(when (= (path field > field-name-crc32) field-name-crc32)
(when offset-out
(set (deref offset-out) (path field > offset)))
(return true)))
(return false))
;; Returns the number of fields or 0 if failed (because field-layouts-out wasn't large enough to
;; hold all the fields, or the field hasn't been sized yet). Both -out parameters are optional.
(defun get-versioned-struct-layout-at-version
(field-versioning (addr field-version-data)
num-field-versionings int
at-version (unsigned int)
field-layouts-out (addr versioned-struct-field-layout)
max-num-fields int
layout-out (addr versioned-struct-layout)
&return int)
(var current-field-name-crc32 uint32_t 0)
(var base (addr uint8_t) 0)
(var from-read (addr uint8_t) 0)
(var max-alignment-requirement (unsigned short) 0)
(var num-fields int 0)
(each-in-range num-field-versionings field-versioning-index
(var current-versioning (addr field-version-data)
(addr (at field-versioning-index field-versioning)))
(set current-field-name-crc32 (path current-versioning > field-name-crc32))
;; Find any relevant versionings, advancing field-versioning-index to the next field in the
;; process.
(var scan-versioning (addr field-version-data)
(addr (at field-versioning-index field-versioning)))
(var first-versioning (addr field-version-data) null)
(while (and (not first-versioning) ;; break once we find it
(= current-field-name-crc32 (path scan-versioning > field-name-crc32))
(< field-versioning-index num-field-versionings))
(when (and (>= at-version (path scan-versioning > start-version))
(or (= c-field-is-live (path scan-versioning > end-version))
(<= at-version (path scan-versioning > end-version))))
(set first-versioning scan-versioning))
(incr field-versioning-index)
(set scan-versioning (addr (at field-versioning-index field-versioning))))
;; We looked ahead one, so go back for the field increment
(decr field-versioning-index)
(when first-versioning
;; The referenced type hasn't been through the runtime fixup to determine its virtual size.
;; See (versioned-structs-initialize) for how this gets resolved.
(when (= c-versioned-struct-fixup-required (path first-versioning > element-size))
(return 0))
(var field-read (addr uint8_t) null)
(struct-place-field-advance-head
(addr from-read) (addr field-read)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(when (< max-alignment-requirement (path first-versioning > alignment))
(set max-alignment-requirement (path first-versioning > alignment)))
(when field-layouts-out
(unless (< num-fields max-num-fields)
(return 0))
(var write-field (addr versioned-struct-field-layout)
(addr (at num-fields field-layouts-out)))
(set-fields (deref write-field)
field-name-crc32 (path first-versioning > field-name-crc32)
offset (type-cast (- field-read base) (unsigned int))
version-data first-versioning))
(incr num-fields)))
(when layout-out
(var-cast-to padding (unsigned short)
(- max-alignment-requirement
(mod (+ (type-cast from-read uintptr_t) max-alignment-requirement)
max-alignment-requirement)))
(when (= max-alignment-requirement padding) ;; Already exactly aligned
(set padding 0))
(var total-size (unsigned int) (+ padding (type-cast from-read uintptr_t)))
(set-fields (deref layout-out)
padding padding
total-size total-size
max-alignment-requirement max-alignment-requirement))
(return num-fields))
(defun print-versioned-struct-layout-at-version
(field-versioning (addr field-version-data)
num-field-versionings int
at-version (unsigned int)
get-name-func versioned-struct-name-from-crc32
&return bool)
(unless get-name-func
(set get-name-func versioned-struct-name-from-crc32-default))
(var field-layouts (array 256 versioned-struct-field-layout) (array 0))
(var struct-layout versioned-struct-layout (array 0))
(var num-fields int
(get-versioned-struct-layout-at-version
field-versioning num-field-versionings
at-version
field-layouts
(array-size field-layouts) (addr struct-layout)))
(unless num-fields
(fprintf
stderr
"Not enough field-layouts in print-versioned-struct-layout-at-version to print struct\n")
(return false))
(when-introspection-verbose
(each-item-addr-in-addr-array field-layouts num-fields field-index
field (addr versioned-struct-field-layout)
(fprintf stderr "----- Field %s is at offset %d\n"
(get-name-func (path field > field-name-crc32)) (path field > offset)))
(fprintf
stderr
"Struct has alignment requirement of %d, which means %d bytes of padding for a total size of %d\n"
(field struct-layout max-alignment-requirement)
(field struct-layout padding)
(field struct-layout total-size)))
(return true))
;; Used to indicate that a value isn't valid right after compilation. Code is automatically
;; generated to fix these up.
(var-global c-versioned-struct-fixup-required int -1)
(defstruct versioned-struct-layout-cache-data
struct-name-crc32 uint32_t
at-version (unsigned short)
struct-layout versioned-struct-layout)
(var s-versioned-struct-layout-cache (array 1024 versioned-struct-layout-cache-data) (array 0))
(var s-num-cached-versioned-struct-layouts int 0)
;; TODO Performance: This could of course be accelerated by a hash table
(defun-local get-cached-versioned-struct-layout
(struct-name-crc32 uint32_t
at-version (unsigned short)
&return (addr versioned-struct-layout-cache-data))
(each-item-addr-in-addr-array s-versioned-struct-layout-cache s-num-cached-versioned-struct-layouts
layout-index current-struct-layout (addr versioned-struct-layout-cache-data)
(when (and (= (path current-struct-layout > struct-name-crc32) struct-name-crc32)
(= (path current-struct-layout > at-version) at-version))
(return current-struct-layout)))
(return null))
(defun get-or-cache-versioned-struct-layout
(struct-name-crc32 uint32_t
at-version (unsigned short)
&return (addr versioned-struct-layout-cache-data))
(var num-versioned-structs (unsigned int) 0)
(var all-versioned-structs (addr versioned-struct)
(get-all-versioned-structs (addr num-versioned-structs)))
(unless (and num-versioned-structs all-versioned-structs)
(return null))
(var cached-layout (addr versioned-struct-layout-cache-data)
(get-cached-versioned-struct-layout
struct-name-crc32
at-version))
(unless cached-layout
;; Not found; try to cache it (may not be possible until we cache more structs)
(assert (and (< (+ 1 s-num-cached-versioned-struct-layouts)
(array-size s-versioned-struct-layout-cache))
"Not enough room in cache for every referenced struct version. Edit
IntrospectionV2.cake to increase this arbitrary cache size."))
(var layout versioned-struct-layout (array 0))
(var core-type-struct (addr versioned-struct)
(get-field-versionings-for-struct
struct-name-crc32
all-versioned-structs
num-versioned-structs))
(when (and
core-type-struct
(get-versioned-struct-layout-at-version
(path core-type-struct > field-versioning)
(path core-type-struct > num-field-versionings)
at-version
;; Ignore the per-field layout. We could cache this too if we want.
null 0
(addr layout)))
(var new-cached-struct (addr versioned-struct-layout-cache-data)
(addr (at s-num-cached-versioned-struct-layouts
s-versioned-struct-layout-cache)))
(set-fields (deref new-cached-struct)
struct-name-crc32 struct-name-crc32
at-version at-version
struct-layout layout)
(set cached-layout new-cached-struct)
(incr s-num-cached-versioned-struct-layouts)))
(return cached-layout))
(defmacro versioned-structs-initialize ()
(get-or-create-comptime-var environment versioned-structs-initialize-called bool false)
(set (deref versioned-structs-initialize-called) true)
(tokenize-push output (versioned-structs-initialize-internal))
(return true))
(defun versioned-structs-initialize-internal ()
(var num-versioned-structs (unsigned int) 0)
(var all-versioned-structs (addr versioned-struct)
(get-all-versioned-structs (addr num-versioned-structs)))
(unless (and num-versioned-structs all-versioned-structs)
(return))
(var num-iterations int 0)
(var new-struct-layouts-cached int 1) ;; Kick us off with 1
;; Rather than tracking dependencies between structs, we're just going to try to size every struct
;; at every version, and if we don't have enough info, wait until other structs have had a turn
;; and try again later. I'm sure there are faster ways but this is easy to implement.
(while new-struct-layouts-cached
(incr num-iterations)
(set new-struct-layouts-cached 0)
(each-item-addr-in-addr-array all-versioned-structs num-versioned-structs struct-index
current-struct (addr versioned-struct)
(var versionings (addr field-version-data) (path current-struct > field-versioning))
(var num-field-versionings int (path current-struct > num-field-versionings))
(each-item-addr-in-addr-array versionings num-field-versionings versioning-index
current-versioning (addr field-version-data)
(when (= c-versioned-struct-fixup-required (path current-versioning > element-size))
(when-introspection-verbose
(fprintf stderr "struct[%d] field[%d] needs fixup\n" struct-index versioning-index))
(var cached-layout (addr versioned-struct-layout-cache-data)
(get-or-cache-versioned-struct-layout
(path current-versioning > core-type-crc32)
(path current-versioning > core-type-version)))
(when cached-layout ;; Found it or just barely cached it; set the fields
(set-fields (deref current-versioning)
alignment (path cached-layout > struct-layout . max-alignment-requirement)
element-size (path cached-layout > struct-layout . total-size))
(when-introspection-verbose
(fprintf stderr "struct[%d] field[%d] fixed: size %d alignment %d\n"
struct-index versioning-index
(path current-versioning > element-size)
(path current-versioning > alignment))))))))
(fprintf stderr "Fixed up versioning data in %d iterations over %d structs.\n"
num-iterations num-versioned-structs)
;; Let's check to see if the latest version matches the compiled struct layout
(validate-struct-versionings))
(forward-declare (struct migrate-versioned-struct-parameters))
(defstruct migrate-field-data
struct-args (addr migrate-versioned-struct-parameters)
;; The start of the containing struct, which lets the migration function move a dead field to a
;; different live field, for example.
read-struct (addr void)
write-struct (addr void)
read-field (addr void)
;; Will be null if read-field became dead in to-version
write-field (addr void)
;; Always the field which triggered the migration, i.e., the read-field. May be zero for
;; entire-struct migrations.
field-name-crc32 uint32_t
from-version (unsigned short)
to-version (unsigned short))
(def-function-signature-global migrate-versioned-field
(args (addr migrate-field-data)
&return bool))
(defstruct migration-handler-criteria
struct-name-crc32 uint32_t
;; May be 0 to denote whole-struct handler override (e.g. if enough fields have changed in the
;; struct that field-by-field migration is impractical or nonsensical)
field-name-crc32 uint32_t
from-version (unsigned short)
to-version (unsigned short))
(defstruct migration-handler
migrate-func migrate-versioned-field
criteria migration-handler-criteria)
;; The most specific handler is chosen from the list, or null is returned if there are no handlers
;; which meet the criteria.
;; TODO: Performance: Consider moving to compile-time collated switch rather than function pointers
(defun-local get-migration-handler
(handlers (addr migration-handler)
num-handlers (unsigned int)
criteria (addr migration-handler-criteria)
&return (addr migration-handler))
(var matching-handler (addr migration-handler) null)
(each-item-addr-in-addr-array handlers num-handlers handler-index
current-handler (addr migration-handler)
;; Non-negotiables: Handlers must have specific struct and exact versions matched
(unless (and (path current-handler > criteria . struct-name-crc32)
(= (path current-handler > criteria . from-version)
(path criteria > from-version))
(= (path current-handler > criteria . to-version)
(path criteria > to-version)))
(continue))
(cond
;; Exact match
((= (path current-handler > criteria . field-name-crc32)
(path criteria > field-name-crc32))
(return current-handler))
;; The handler operates on all structs of this type
((not (path current-handler > criteria . field-name-crc32))
(set matching-handler current-handler))))
(return matching-handler))
;; Note that element-size should have padding included to ensure the elements stay aligned in the
;; array. This function does NOT handle that for you.
(defun migrate-copy-compatible-field
(from-field (addr void)
to-field (addr void)
element-size (unsigned int)
array-count (unsigned int))
(unless array-count
(set array-count 1))
(memcpy to-field from-field
(* element-size array-count)))
(defstruct versioned-struct
struct-name-crc32 uint32_t
field-versioning (addr field-version-data)
num-field-versionings int)
(defstruct migrate-versioned-struct-parameters
struct-name-crc32 uint32_t
from-version (unsigned int)
from-version-data (addr void)
to-version (unsigned int)
to-version-data (addr void)
;; The following are optional parameters. If unset, global variables/defaults will be used. The
;; passed in arguments structure will be modified to cache these for later migration operations.
handlers (addr migration-handler)
num-handlers (unsigned int)
get-name-func versioned-struct-name-from-crc32
field-versioning (addr field-version-data)
num-field-versionings int
all-versioned-structs (addr versioned-struct)
num-versioned-structs int)
(defun get-field-versionings-for-struct
(struct-name-crc32 uint32_t
all-versioned-structs (addr versioned-struct)
num-versioned-structs int
&return (addr versioned-struct))
(each-item-addr-in-addr-array all-versioned-structs num-versioned-structs
struct-index current-struct (addr versioned-struct)
(when (= struct-name-crc32 (path current-struct > struct-name-crc32))
(return current-struct)))
(return null))
(defun migrate-versioned-struct
(args (addr migrate-versioned-struct-parameters) ;; may be modified for caching
&return bool)
;; Check and prepare arguments
(unless (= (path args > from-version) (- (path args > to-version) 1))
(fprintf stderr "migrate-versioned-struct expects from-version to be one version behind
to-version. If the distance is greater, migrate one-by-one through the versions.\n")
(return false))
(unless (path args > all-versioned-structs)
(set (path args > all-versioned-structs)
(get-all-versioned-structs (addr (path args > num-versioned-structs))))
(unless (path args > all-versioned-structs)
(return false)))
(unless (path args > field-versioning)
(var lazy-struct-versionings (addr versioned-struct)
(get-field-versionings-for-struct
(path args > struct-name-crc32)
(path args > all-versioned-structs)
(path args > num-versioned-structs)))
(unless lazy-struct-versionings
(fprintf stderr "migrate-versioned-struct failed to get versionings for struct hash %u\n"
(path args > struct-name-crc32))
(return false))
(set-fields (deref args)
field-versioning (path lazy-struct-versionings > field-versioning)
num-field-versionings (path lazy-struct-versionings > num-field-versionings)))
(unless (path args > get-name-func)
(set (path args > get-name-func) versioned-struct-name-from-crc32-default))
(var-cast-to from-read (addr uint8_t) (path args > from-version-data))
(var-cast-to to-write (addr uint8_t) (path args > to-version-data))
(var current-field-name-crc32 uint32_t 0)
(var criteria migration-handler-criteria (array 0))
(set-fields criteria
from-version (path args > from-version)
to-version (path args > to-version)
struct-name-crc32 (path args > struct-name-crc32)
field-name-crc32 0)
(each-in-range (path args > num-field-versionings) field-versioning-index
(var current-versioning (addr field-version-data)
(addr (at field-versioning-index (path args > field-versioning))))
(set current-field-name-crc32 (path current-versioning > field-name-crc32))
;; Find any relevant versionings, advancing field-versioning-index to the next field in the
;; process.
(var scan-versioning (addr field-version-data) current-versioning)
(var first-versioning (addr field-version-data) null)
(var second-versioning (addr field-version-data) null)
(while (and (= current-field-name-crc32 (path scan-versioning > field-name-crc32))
(< field-versioning-index (path args > num-field-versionings)))
(cond
((and (>= (path args > from-version) (path scan-versioning > start-version))
(or (= c-field-is-live (path scan-versioning > end-version))
(<= (path args > from-version) (path scan-versioning > end-version))))
(set first-versioning scan-versioning))
((and (>= (path args > to-version) (path scan-versioning > start-version))
(or (= c-field-is-live (path scan-versioning > end-version))
(<= (path args > to-version) (path scan-versioning > end-version))))
(set second-versioning scan-versioning)))
(incr field-versioning-index)
(set scan-versioning (addr (at field-versioning-index (path args > field-versioning)))))
;; We looked ahead one, so go back for the field increment
(decr field-versioning-index)
;; Traversing versioning data:
(cond
;; Field is dead before both from and to (neither are ever set)
;; => No action necessary.
((and (not first-versioning)
(not second-versioning))
(when-introspection-verbose
(fprintf stderr "No relevant history for field %s. It must be dead before %d or
live after %d.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path args > from-version) (path args > to-version))))
;; Field became live in to
;; => No action necessary. (Initialization of new fields should happen elsewhere) (advance to alignment)
((and (not first-versioning)
second-versioning)
(when-introspection-verbose
(fprintf stderr "Field %s became live in version %d. No migration necessary.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path args > to-version)))
(var field-write (addr uint8_t) null)
(struct-place-field-advance-head
(addr to-write) (addr field-write)
(path second-versioning > element-size) (path second-versioning > alignment)
(path second-versioning > array-count)))
;; Field is live in both from and to (the from end-version equals c-field-is-live)
;; => Copy the field from->to, (advance from alignment), and (advance to alignment)
((and first-versioning
(or (= c-field-is-live (path first-versioning > end-version))
(<= (path args > to-version) (path first-versioning > end-version))))
(when-introspection-verbose
(fprintf stderr "Field %s became live in version %d and remains live in version %d. Copying
it over.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path args > from-version) (path args > to-version)))
(var field-read (addr uint8_t) null)
(var field-write (addr uint8_t) null)
(struct-place-field-advance-head
(addr from-read) (addr field-read)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(struct-place-field-advance-head
(addr to-write) (addr field-write)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(migrate-copy-compatible-field
field-read field-write
(path first-versioning > element-size)
(path first-versioning > array-count)))
;; Field was live in from and now dead:
;; => Check for handler, else (advance from alignment) and ignore
((and first-versioning
(not second-versioning))
(when-introspection-verbose
(fprintf stderr "Field %s became live in version %d and is dead before version %d. Checking
for migration function to allow for field conversion.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path args > from-version) (path args > to-version)))
;; Note: This case handles both basic and versioned struct types. The latter can be checked for via
;; (path first-versioning > core-type-version) being non-zero
(var field-read (addr uint8_t) null)
(struct-place-field-advance-head
(addr from-read) (addr field-read)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(set-fields criteria
field-name-crc32 current-field-name-crc32)
(var handler (addr migration-handler)
(get-migration-handler (path args > handlers) (path args > num-handlers) (addr criteria)))
(when handler
(var handler-args migrate-field-data (array 0))
(set-fields handler-args
struct-args args
read-struct (path args > from-version-data)
write-struct (path args > to-version-data)
read-field field-read
write-field null
field-name-crc32 current-field-name-crc32
from-version (path args > from-version)
to-version (path args > to-version))
(unless (call (path handler > migrate-func) (addr handler-args))
(when-introspection-verbose
(fprintf stderr "Custom handler for field %s returned failure to convert.\n"
(call (path args > get-name-func) current-field-name-crc32)))
(return false))))
;; Field was live in from and now dead:
;; - Versioned struct: Check for live to immedatiely after from which should match target to
;; If present, => recurse on versioned struct using from and to versions, then
;; (advance from alignment) and (advance to aligment)
((and first-versioning
(path first-versioning > core-type-version)
second-versioning)
(when-introspection-verbose
(fprintf stderr "Field %s is live in version %d with substruct version %d and became
substruct version %d in %d. Recursing on the versioned struct type.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path args > from-version)
(path first-versioning > core-type-version)
(path second-versioning > core-type-version)
(path args > to-version)))
(var field-read (addr uint8_t) null)
(var field-write (addr uint8_t) null)
(struct-place-field-advance-head
(addr from-read) (addr field-read)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(struct-place-field-advance-head
(addr to-write) (addr field-write)
(path second-versioning > element-size) (path second-versioning > alignment)
(path second-versioning > array-count))
(var substruct-versioning (addr versioned-struct)
(get-field-versionings-for-struct
(path first-versioning > core-type-crc32)
(path args > all-versioned-structs)
(path args > num-versioned-structs)))
(unless substruct-versioning
(when-introspection-verbose
(fprintf stderr "Field %s referenced a versioned struct that was not found in
all-versioned-structs. The referenced struct's hash is %u.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path first-versioning > core-type-crc32)))
(return false))
(var substruct-args migrate-versioned-struct-parameters (deref args))
(set-fields substruct-args
struct-name-crc32 (path first-versioning > core-type-crc32)
field-versioning (path substruct-versioning > field-versioning)
num-field-versionings (path substruct-versioning > num-field-versionings)
from-version (path first-versioning > core-type-version)
from-version-data field-read
to-version (path second-versioning > core-type-version)
to-version-data field-write)
(var num-structs-to-migrate (unsigned int) (path first-versioning > array-count))
(unless num-structs-to-migrate
(set num-structs-to-migrate 1))
(each-in-range num-structs-to-migrate migrate-struct-index
(var read-struct-offset (unsigned int)
(* migrate-struct-index (path first-versioning > element-size)))
(var write-struct-offset (unsigned int)
(* migrate-struct-index (path second-versioning > element-size)))
(set-fields substruct-args
from-version-data (+ field-read read-struct-offset)
to-version-data (+ field-write write-struct-offset))
(unless (migrate-versioned-struct (addr substruct-args))
(when-introspection-verbose
(fprintf stderr "Versioned substruct field %s index %d returned failure to convert.\n"
(call (path args > get-name-func) current-field-name-crc32)
migrate-struct-index))
(return false))))
((and first-versioning
(path first-versioning > core-type-version)
(<= (path args > to-version) (path first-versioning > end-version)))
(when-introspection-verbose
(fprintf stderr "Field %s became live in version %d and is still valid in version %d.
Copying the versioned struct type.\n"
(call (path args > get-name-func) current-field-name-crc32)
(path args > from-version) (path args > to-version)))
(var field-read (addr uint8_t) null)
(var field-write (addr uint8_t) null)
(struct-place-field-advance-head
(addr from-read) (addr field-read)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(struct-place-field-advance-head
(addr to-write) (addr field-write)
(path first-versioning > element-size) (path first-versioning > alignment)
(path first-versioning > array-count))
(migrate-copy-compatible-field
field-read field-write
(path first-versioning > element-size)
(path first-versioning > array-count)))
(true
(fprintf stderr "Field %s resulted in an unexpected condition.\n"
(call (path args > get-name-func) current-field-name-crc32))
(return false))))
(return true))
;;
;; Testing
;;
(comptime-cond
('auto-test
(comptime-define-symbol 'Introspection-Verbose)
(def-versioned-struct test-substruct (version 2)
subby int (live 1)
now-dead int (dead 1 1))
(def-versioned-struct test-migrate-data (version 4)
a char (dead 1 1) ;; Move a into b with custom handler
b int (live 2)
c (array 3 test-substruct) (dead (1 1 2) (2 3 3))
d (array 5 int) (live 3)
e int (dead 1 2)
f test-substruct (dead (1 1 2))
g char (dead 1 1))
(defstruct test-substruct-v1
subby int
now-dead int)
(defstruct test-substruct-v2
subby int)
(defstruct test-migrate-data-v1
a char
c (array 3 test-substruct-v1)
e int
f test-substruct-v1
g char)
(defstruct test-migrate-data-v3
b int
c (array 3 test-substruct-v2)
d (array 5 int))
;; Move a into b; assumes specific versions.
(defun-local test-handler
(args (addr migrate-field-data)
&return bool)
(fprintf stderr "Migrating with custom handler\n")
;; Technically I could get away with just using read-field for 'a'
(var-static a-offset int -1)
(var-static b-offset int -1)
(unless (and (!= a-offset -1) (!= b-offset -1))
(var a-layout (array 16 versioned-struct-field-layout) (array 0))
(var b-layout (array 16 versioned-struct-field-layout) (array 0))
(var a-num-fields int
(get-versioned-struct-layout-at-version
(path args > struct-args > field-versioning)
(path args > struct-args > num-field-versionings)
(path args > from-version)
a-layout (array-size a-layout) null))
(var b-num-fields int
(get-versioned-struct-layout-at-version
(path args > struct-args > field-versioning)
(path args > struct-args > num-field-versionings)
(path args > to-version)
b-layout (array-size b-layout) null))
(unless (and a-num-fields b-num-fields
(get-field-offset-in-layout
(hash-crc32-string-null-terminated "a")
a-layout a-num-fields (addr a-offset))
(get-field-offset-in-layout
(hash-crc32-string-null-terminated "b")
b-layout b-num-fields (addr b-offset)))
(return false)))
(var a (addr char) (+ (path args > read-struct) a-offset))
(var b (addr int) (+ (path args > write-struct) b-offset))
(set (deref b) (type-cast (deref a) int))
(return true))
(defun test--introspection-v2 (&return int)
(hash-crc32-initialize)
(versioned-structs-initialize)
;; (var test-migrate-data--versionings (array field-version-data)
;; (array
;; (array
;; (hash-crc32-string-null-terminated "a") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 1 ;; start-version
;; 1 ;; end-version
;; 1 ;; alignment
;; (sizeof char) ;; element-size
;; 0 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "b") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 2 ;; start-version
;; 0 ;; end-version
;; 4 ;; alignment
;; (sizeof int) ;; element-size
;; 0 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "c") ;; field-name-crc32
;; (hash-crc32-string-null-terminated "test-substruct") ;; core-type-crc32
;; 1 ;; core-type-version
;; 1 ;; start-version
;; 2 ;; end-version
;; 4 ;; alignment
;; (sizeof (type test-substruct-v1)) ;; element-size
;; 3 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "c") ;; field-name-crc32
;; (hash-crc32-string-null-terminated "test-substruct") ;; core-type-crc32
;; 2 ;; core-type-version
;; 3 ;; start-version
;; 0 ;; end-version
;; 4 ;; alignment
;; (sizeof (type test-substruct-v2)) ;; element-size
;; 3 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "d") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 3 ;; start-version
;; 0 ;; end-version
;; 4 ;; alignment
;; (sizeof int) ;; element-size
;; 5 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "e") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 1 ;; start-version
;; 2 ;; end-version
;; 4 ;; alignment
;; (sizeof int) ;; element-size
;; 0 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "f") ;; field-name-crc32
;; (hash-crc32-string-null-terminated "test-substruct") ;; core-type-crc32
;; 1 ;; core-type-version
;; 1 ;; start-version
;; 2 ;; end-version
;; 4 ;; alignment
;; (sizeof (type test-substruct-v1)) ;; element-size
;; 0 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "g") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 1 ;; start-version
;; 1 ;; end-version
;; 1 ;; alignment
;; (sizeof (type char)) ;; element-size
;; 0 ;; array-count
;; )))
(var struct-name-crc32 uint32_t (hash-crc32-string-null-terminated "test-migrate-data"))
;; (var test-substruct--versionings (array field-version-data)
;; (array
;; (array
;; (hash-crc32-string-null-terminated "subby") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 1 ;; start-version
;; 0 ;; end-version
;; (alignment-of (type int)) ;; alignment
;; (sizeof (type int)) ;; element-size
;; 0 ;; array-count
;; )
;; (array
;; (hash-crc32-string-null-terminated "now-dead") ;; field-name-crc32
;; 0 ;; core-type-crc32
;; 0 ;; core-type-version
;; 1 ;; start-version
;; 1 ;; end-version
;; (alignment-of (type int)) ;; alignment
;; (sizeof (type int)) ;; element-size
;; 0 ;; array-count
;; )))
;; (var all-versioned-structs (array versioned-struct)
;; (array
;; (array (hash-crc32-string-null-terminated "test-migrate-data")
;; test-migrate-data--versionings
;; (array-size test-migrate-data--versionings))
;; (array (hash-crc32-string-null-terminated "test-substruct")
;; test-substruct--versionings
;; (array-size test-substruct--versionings))))
(var num-versioned-structs (unsigned int) 0)
(var all-versioned-structs (addr versioned-struct)
(get-all-versioned-structs (addr num-versioned-structs)))
(unless (and num-versioned-structs all-versioned-structs)
(return 1))
(var handlers (array 1 migration-handler)
(array 0))
(set-fields (at 0 handlers)
migrate-func test-handler
(criteria struct-name-crc32) struct-name-crc32
(criteria field-name-crc32) (hash-crc32-string-null-terminated "a")
(criteria from-version) 1
(criteria to-version) 2)
(var from-version (unsigned int) 1)
(var from-version-data (array 1024 uint8_t) (array 0))
(var to-version (unsigned int) 3)
(var to-version-data (array 1024 uint8_t) (array 0))
(var validate-data test-migrate-data-v3 (array 0))
(scope
(var-cast-to start-test-data (addr test-migrate-data-v1) from-version-data)
(set-fields (deref start-test-data)
a 'f'
e 42
(f subby) 69
(f now-dead) 777
g 'g')
(set-fields (at 0 (path start-test-data > c))
subby 1
now-dead 4)
(set-fields (at 1 (path start-test-data > c))
subby 2
now-dead 5)
(set-fields (at 2 (path start-test-data > c))
subby 3
now-dead 6)
(set-fields validate-data
b (type-cast (path start-test-data > a) int))
(each-in-range (array-size (field validate-data c)) i
(set-fields (at i (field validate-data c))
subby (field (at i (path start-test-data > c)) subby))))
(var read-buffer (addr uint8_t) from-version-data)
(var write-buffer (addr uint8_t) to-version-data)
(var buffer-size size_t (sizeof from-version-data))
(each-in-range (- to-version from-version) version-delta
(fprintf stderr "Migrate from %d to %d\n"
(+ from-version version-delta)
(+ from-version version-delta 1))
(fprintf stderr "\ntest-migrate-data version %d\n"
(+ from-version version-delta))
(print-versioned-struct-layout-at-version
test-migrate-data--versionings
(array-size test-migrate-data--versionings)
(+ from-version version-delta)
versioned-struct-name-from-crc32-default)
(fprintf stderr "\n")
(var args migrate-versioned-struct-parameters (array 0))
(set-fields args
struct-name-crc32 struct-name-crc32
field-versioning test-migrate-data--versionings
num-field-versionings (array-size test-migrate-data--versionings)
from-version (+ from-version version-delta)
from-version-data (type-cast read-buffer (addr void))
to-version (+ from-version version-delta 1)
to-version-data (type-cast write-buffer (addr void))
all-versioned-structs all-versioned-structs
num-versioned-structs num-versioned-structs
handlers handlers
num-handlers (array-size handlers)
get-name-func versioned-struct-name-from-crc32-default)
(unless (migrate-versioned-struct (addr args))
(return 1))
;; Swap buffers
(var temp (addr uint8_t) read-buffer)
(set read-buffer write-buffer)
(set write-buffer temp)
(memset write-buffer 0 buffer-size))
(fprintf stderr "\ntest-migrate-data version %d\n"
to-version)
(print-versioned-struct-layout-at-version
test-migrate-data--versionings
(array-size test-migrate-data--versionings)
to-version
versioned-struct-name-from-crc32-default)
(fprintf stderr "\n")
(var-cast-to result (addr test-migrate-data-v3) read-buffer)
(fprintf stderr "b %d '%c'\n
c[0] subby %d\n
c[1] subby %d\n
c[2] subby %d\n
d %d %d %d %d %d\n"
(path result > b) (type-cast (path result > b) char)
(field (at 0 (path result > c)) subby)
(field (at 1 (path result > c)) subby)
(field (at 2 (path result > c)) subby)
(at 0 (path result > d))
(at 1 (path result > d))
(at 2 (path result > d))
(at 3 (path result > d))
(at 4 (path result > d)))
(unless (= 0 (memcmp result (addr validate-data) (sizeof (type test-migrate-data-v3))))
(fprintf stderr "Migrated struct did not have the data we expected!\n")
(return 1))
(return 0))))