diff --git a/PRIMITIVES.md b/PRIMITIVES.md index e94efe3..7886281 100644 --- a/PRIMITIVES.md +++ b/PRIMITIVES.md @@ -158,8 +158,11 @@ added to them too. * `stdlib` * Return the contents of our slisp stdlib at runtime. * `strat` - * Read the byte at offset N from the given string. - * This is a dangerous function, with no bounds-checking, which works around the fact `explode` and `substr` get foiled by embedded NULL characters. + * Read the byte at offset N within the given string. + * This function works around the fact `explode` and `substr` get foiled by embedded NULL characters. + * `strat!` + * Update the byte at offset N within the given string. + * This corresponds to the `strat` function which reads a byte. * `strcat` * Join two strings together and return them. * `strcmp` @@ -170,7 +173,7 @@ added to them too. * Convert characters, integers, and floats to strings. * Everything else returns an empty string. * `strlen` - * Return the length of the given string. + * Return the length of the given string, stopping at the first NULL character. * `substr` * Return a substring from a given string. * `sys-gc` diff --git a/compiler/compiler.go b/compiler/compiler.go index f9efbee..88c08e8 100644 --- a/compiler/compiler.go +++ b/compiler/compiler.go @@ -568,16 +568,19 @@ func (c *Compiler) Compile() (string, error) { // from our string-table // type String struct { - Name string - Value string + Length int + Name string + Value string } stringLiterals := []String{} for id, str := range c.strings { + val := strings.ReplaceAll(str, "`", "\\`") stringLiterals = append(stringLiterals, String{ - Name: id, - Value: strings.ReplaceAll(str, "`", "\\`"), + Length: len(val), + Name: id, + Value: val, }) } diff --git a/compiler/template.tmpl b/compiler/template.tmpl index e924d1f..7bb8279 100644 --- a/compiler/template.tmpl +++ b/compiler/template.tmpl @@ -1291,6 +1291,19 @@ fn_printstr: ;; +;; Return the size of the allocation for the given string. +FUNC fn_sys_alen + mov rbx, rdi + GET_TAG_BITS rbx + cmp rbx, TAG_ID_STRING + jne type_error + UNTAG_REG rdi + mov rbx, rdi + OBJ_TO_HEADER rbx ; move to header + mov rax, [rbx] ; get the size + TAG_INTEGER_REG rax + ret + ;; Allocate (string) memory and return it. FUNC fn_sys_alloc mov rbx, rdi @@ -1300,7 +1313,7 @@ FUNC fn_sys_alloc UNTAG_REG rdi cmp rdi, 0 ; N must be >= 1 jle .nil - push rdi + push rdi ; size mov rax, rdi mov rbx, TAG_ID_STRING call alloc @@ -2410,14 +2423,11 @@ FUNC fn_sys_stdlib ;; Return the given byte from the string, as an integer. ;; -;; This function is dangerous as it has no bound checking, we could add -;; it since we know the size of all allocations made with alloc.. -;; -;; For the moment it is a workaround for the fact our strings can't have -;; embedded null-characters - if they do "explode" and "substr" don't work -;; any longer. +;; This is a workaround for the fact our strings can't have embedded null-characters - if +;; they do "explode" and "substr" don't work any longer. ;; -;; TODO: Add bound-checking. +;; Users should avoid this function, although it is required for some of the calls +;; relating to linux syscalls. ;; FUNC fn_sys_strat mov rbx, rdi ; type-check arg1 @@ -2432,9 +2442,22 @@ FUNC fn_sys_strat UNTAG_REG rdi UNTAG_REG rsi + ; Get the size of the allocation to make sure we're not moving past it + mov rax, rdi ; start of object + OBJ_TO_HEADER rax ; move to header + mov rax, [rax] ; read size from header + sub rax, OBJ_PAYLOAD ; Remove the size of the header itself, to leave only the size requested. + add rax, rdi ; Add the size to the starting address. + ; RDI points to the string, add the RSI/offset to it add rdi, rsi + ; Run the range-check. Note that this will allow access past the end of strings + ; as allocations are rounded up to 16 bytes, however it will not allow access to + ; anything that follows the string. + cmp rdi, rax + ja out_of_range + ; Load and return the character/byte as an integer. xor rax, rax mov al, byte [rdi] @@ -2443,14 +2466,12 @@ FUNC fn_sys_strat ;; Allow updating the Nth byte of the given string. ;; -;; This function is dangerous as it has no bound checking, we could add -;; it since we know the size of all allocations made with alloc.. -;; ;; For the moment it is a workaround for the fact our strings can't have ;; embedded null-characters - if they do "explode" and "substr" don't work ;; any longer. ;; -;; TODO: Add bound-checking. +;; Users should avoid this function, although it is required for some of the calls +;; relating to linux syscalls. ;; FUNC fn_sys_stratBANG mov rbx, rdi ; type-check arg1 @@ -2466,10 +2487,24 @@ FUNC fn_sys_stratBANG UNTAG_REG rsi UNTAG_REG rdx + + ; Get the size of the allocation to make sure we're not moving past it + mov rax, rdi ; start of object + OBJ_TO_HEADER rax ; move to header + mov rax, [rax] ; read size from header + sub rax, OBJ_PAYLOAD ; Remove the size of the header itself, to leave only the size requested. + add rax, rdi ; Add the size to the starting address. + ; RDI points to the string, add the RSI/offset to it add rdi, rsi - ; Load and return the character/byte as an integer. + ; Run the range-check. Note that this will allow access past the end of strings + ; as allocations are rounded up to 16 bytes, however it will not allow access to + ; anything that follows the string. + cmp rdi, rax + ja out_of_range + + ; Store the value into the address. mov byte [rdi], dl mov rax, rdx and rax, 0xFF @@ -3543,8 +3578,14 @@ gc_scan_stack: section .data +;; Fake header before each string so that we can perform +;; bounds-checking in strat and strat! + {{ range .StringTable }} align 16 + dq {{ .Length }} + OBJ_PAYLOAD ; object_size + dq 0 ; object_forward + dq TAG_ID_STRING ; object_type {{ .Name }}: db `{{ .Value }}`, 0x00 {{end}} diff --git a/inception.lisp b/inception.lisp index 0bdf0df..50b43a3 100644 --- a/inception.lisp +++ b/inception.lisp @@ -287,25 +287,26 @@ (register-builtin "string" (lambda (args) (string (car args)))) (register-builtin "sys-gc" (lambda (args) (sys-gc))) (register-builtin "sys-gc-threshold" (lambda (args) (sys-gc-threshold))) - (register-builtin "sys-stdlib-loaded" (lambda (args) (sys-stdlib-loaded))) (register-builtin "sys-heap-allocs" (lambda (args) (sys-heap-allocs))) (register-builtin "sys-heap-bytes" (lambda (args) (sys-heap-bytes))) (register-builtin "sys-heap-data" (lambda (args) (sys-heap-data))) (register-builtin "sys-heap-dump" (lambda (args) (sys-heap-dump))) (register-builtin "sys-heap-objects" (lambda (args) (sys-heap-objects))) + (register-builtin "sys-stdlib-loaded" (lambda (args) (sys-stdlib-loaded))) (register-builtin "sys_%" (lambda (args) (sys_% (car args) (cadr args)))) (register-builtin "sys_<" (lambda (args) (sys_< (car args) (cadr args)))) (register-builtin "sys_<=" (lambda (args) (sys_<= (car args) (cadr args)))) (register-builtin "sys_=" (lambda (args) (sys_= (car args) (cadr args)))) (register-builtin "sys_>" (lambda (args) (sys_> (car args) (cadr args)))) (register-builtin "sys_>=" (lambda (args) (sys_>= (car args) (cadr args)))) + (register-builtin "sys_alen" (lambda (args) (sys_alen (car args)))) (register-builtin "sys_alloc" (lambda (args) (sys_alloc (car args)))) + (register-builtin "sys_and" (lambda (args) (sys_and (car args) (cadr args)))) (register-builtin "sys_car" (lambda (args) (sys_car (car args)))) (register-builtin "sys_cdr" (lambda (args) (sys_cdr (car args)))) (register-builtin "sys_chr" (lambda (args) (sys_chr (car args)))) (register-builtin "sys_cons" (lambda (args) (sys_cons (car args) (cadr args)))) (register-builtin "sys_divide" (lambda (args) (sys_divide (car args) (cadr args)))) - (register-builtin "sys_and" (lambda (args) (sys_and (car args) (cadr args)))) (register-builtin "sys_environment" (lambda (args) (sys_environment))) (register-builtin "sys_exit" (lambda (args) (sys_exit (car args)))) (register-builtin "sys_explode" (lambda (args) (sys_explode (car args)))) @@ -328,8 +329,8 @@ (register-builtin "sys_split" (lambda (args) (sys_split (car args) (cadr args)))) (register-builtin "sys_sqrt" (lambda (args) (sys_sqrt (car args)))) (register-builtin "sys_stdlib" (lambda (args) (sys_stdlib))) - (register-builtin "sys_strat" (lambda (args) (sys_strat (car args) (cadr args)))) (register-builtin "sys_strat!" (lambda (args) (sys_strat! (car args) (cadr args) (caddr args)))) + (register-builtin "sys_strat" (lambda (args) (sys_strat (car args) (cadr args)))) (register-builtin "sys_strcat" (lambda (args) (sys_strcat (car args) (cadr args)))) (register-builtin "sys_strcmp" (lambda (args) (sys_strcmp (car args) (cadr args)))) (register-builtin "sys_strdup" (lambda (args) (sys_strdup (car args)))) diff --git a/stdlib.slisp b/stdlib.slisp index 5cc1380..3ceab55 100644 --- a/stdlib.slisp +++ b/stdlib.slisp @@ -75,6 +75,10 @@ NOTE There is no corresponding free function, the garbage collector will reap orphaned memory." (sys_alloc n)) +(defun alen (str) + "Return the allocated size of the given string." + (sys_alen str)) + (defun car (xs) "Return the first item from the list" (sys_car xs)) @@ -182,6 +186,10 @@ Return a list of (BEFORE . AFTER)." This ignores embedded NULLs which would otherwise break substr and explode." (sys_strat str n)) +(defun strat!(str n x) + "Update the content of the given string, by changing the byte at offset N to be X." + (sys_strat! str n x)) + (defun strcat(a b) "Return the result of concatenating the two specified strings into one." (sys_strcat a b)) @@ -439,12 +447,12 @@ The implementation here is either horrid, or awesome. You decide." ;; Copy the name byte-by-byte. (while (< i name-len) - (sys_strat! name i + (strat! name i (u8 buf (+ name-pos i))) (set! i (+ i 1))) ;; Add the terminating NUL. - (sys_strat! name name-len 0) + (strat! name name-len 0) ;; Add name to the result list. (set! result (cons name result))) @@ -588,7 +596,7 @@ Note that this does not create parents, use (mkdirs) for that." (defun u8 (buf pos) "Read and return a 8-bit value from the specified offset in the given buffer." - (sys_strat buf pos)) + (strat buf pos)) (defun u16 (buf pos) "Read and return a 16-bit value from the specified offset in the given buffer." diff --git a/test/alen.lisp b/test/alen.lisp new file mode 100644 index 0000000..5beacd7 --- /dev/null +++ b/test/alen.lisp @@ -0,0 +1,16 @@ +(defun main() + (let ((a (strdup "slisp")) ; heap-allocated string + (b "slisp")) ; static string + + ; The string lengths will be identical + (println "heap-allocated str is " (strlen a) " bytes") + (println "static str is " (strlen b) " bytes") + + ; But the size of the "allocation" will be differ + (println "heap-allocated str is " (alen a) " bytes") + (println "static str is " (alen b) " bytes") + + ;; heap-allocated things are rounded up to multiples of 16 + ;; static ones are not, but they have a fake header to allow + ;; us to pretend we're there + )) diff --git a/test/alen.test.expected b/test/alen.test.expected new file mode 100644 index 0000000..795698f --- /dev/null +++ b/test/alen.test.expected @@ -0,0 +1,4 @@ +heap-allocated str is 5 bytes +static str is 5 bytes +heap-allocated str is 32 bytes +static str is 29 bytes