diff options
Diffstat (limited to 'module/system/vm')
-rw-r--r-- | module/system/vm/linker.scm | 78 |
1 files changed, 45 insertions, 33 deletions
diff --git a/module/system/vm/linker.scm b/module/system/vm/linker.scm index a5d43f267..9a5177857 100644 --- a/module/system/vm/linker.scm +++ b/module/system/vm/linker.scm @@ -85,8 +85,8 @@ (linker-object-symbols* . linker-object-symbols) make-string-table - string-table-intern - link-string-table + string-table-intern! + link-string-table! link-elf)) @@ -156,40 +156,52 @@ "Return the linker symbols defined by the user for this this section." (cdr (linker-object-symbols object))) +(define-record-type <string-table> + (%make-string-table strings linked?) + string-table? + (strings string-table-strings set-string-table-strings!) + (linked? string-table-linked? set-string-table-linked?!)) + (define (make-string-table) - "Return a functional string table with one entry: the empty string." - '(("" 0 #vu8()))) - -(define (string-table-length table) - "Return the number of bytes needed for the string table @var{table}." - (let ((last (car table))) - ;; The + 1 is for the trailing NUL byte. - (+ (cadr last) (bytevector-length (caddr last)) 1))) - -(define (string-table-intern table str) - "Add @var{str} to the string table @var{table}. Yields two values: a -possibly newly allocated string table, and the byte index of the string -in that table." - (cond - ((assoc str table) - => (lambda (ent) - (values table (cadr ent)))) - (else - (let* ((next (string-table-length table))) - (values (cons (list str next (string->utf8 str)) - table) - next))))) - -(define (link-string-table table) + "Return a string table with one entry: the empty string." + (%make-string-table '(("" 0 #vu8())) #f)) + +(define (string-table-length strings) + "Return the number of bytes needed for the @var{strings}." + (match strings + (((str pos bytes) . _) + ;; The + 1 is for the trailing NUL byte. + (+ pos (bytevector-length bytes) 1)))) + +(define (string-table-intern! table str) + "Ensure that @var{str} is present in the string table @var{table}. +Returns the byte index of the string in that table." + (match table + (($ <string-table> strings linked?) + (match (assoc str strings) + ((_ pos _) pos) + (#f + (let ((next (string-table-length strings))) + (when linked? + (error "string table already linked, can't intern" table str)) + (set-string-table-strings! table + (cons (list str next (string->utf8 str)) + strings)) + next)))))) + +(define (link-string-table! table) "Link the functional string table @var{table} into a sequence of bytes, suitable for use as the contents of an ELF string table section." - (let ((out (make-bytevector (string-table-length table) 0))) - (for-each - (lambda (ent) - (let ((bytes (caddr ent))) - (bytevector-copy! bytes 0 out (cadr ent) (bytevector-length bytes)))) - table) - out)) + (match table + (($ <string-table> strings #f) + (let ((out (make-bytevector (string-table-length strings) 0))) + (for-each + (match-lambda + ((_ pos bytes) + (bytevector-copy! bytes 0 out pos (bytevector-length bytes)))) + strings) + (set-string-table-linked?! table #t) + out)))) (define (segment-kind section) "Return the type of segment needed to store @var{section}, as a pair. |