Add bounds-checking to strat and strat!

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`

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,
 			})
 	}
 

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}}

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))))

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."

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
+  ))

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