Track allocated memory to improve error messages

[pdarragh]

Currently, failed dereferences in bits->values result in an invalid memory reference error:

hoax/ $ racket
Welcome to Racket v9.0 [cs].
> (require "types.rkt")
> (bits->value 1)
invalid memory reference.  Some debugging context lost [,bt for context]
>

This happens when the call to ptr-ref fails due to an invalid or out-of-bounds pointer, resulting in a segfault. These issues can be tricky for students to diagnose because they cannot be distinguished from invalid memory references during student code execution.

One step we can take is to track the heap pointer allocated by the call to malloc in a86/interp.rkt:

a86/a86/interp.rkt

Lines 50 to 54 in 3874964

	;; WARNING: The heap is re-used, so make sure you're done with it
	;; before calling asm-interp again
	(define *heap*
	; IMPROVE ME: hard-coded heap size
	(malloc _int64 20000 'raw))

Then, in the types.rkt code of a compiler implementation, we could compare the value passed to bits->value to ensure it falls within the range between the heap pointer and its upper limit (deduced from its size).

[dvanhorn]

This will fail on references to statically allocated memory.

[pdarragh]

Ah yeah, I was just trying to get my commits sorted onto the new branch before mentioning that part haha.

I have a revised implementation of types.rkt for Hoax+, which makes use of the updated code in the tracked-memory branch, and the errors are improved:

hoax-plus/ $ racket
Welcome to Racket v9.0 [cs].
> (require "main.rkt")
> (exec (parse '(reverse '())))
mem-ref: contract violation while decoding a box
  expected: pointer to allocated memory
  given: pointer with address 281200367304736
 [,bt for context]
> 

As you say, it won't work for statically allocated memory, so gotta figure that part out.

;; hoax-plus/types.rkt
#lang racket
(provide (all-defined-out))
(require ffi/unsafe
         a86/guarded-memory)

(define imm-shift          3)
(define imm-mask       #b111)
(define ptr-mask       #b111)
(define type-box       #b001)
(define type-cons      #b010)
(define type-vect      #b011)
(define type-str       #b100)
(define int-shift (+ 1 imm-shift))
(define mask-int #b1111)
(define char-shift (+ 2 imm-shift))
(define type-int #b0000)
(define type-char #b01000)
(define mask-char #b11111)

;; Integer -> Value
(define (bits->value b)
  (cond [(= b (value->bits #t)) #t]
        [(= b (value->bits #f)) #f]
        [(= b (value->bits eof)) eof]
        [(= b (value->bits (void))) (void)]
        [(= b (value->bits '())) '()]
        [(int-bits? b)
         (arithmetic-shift b (- int-shift))]
        [(char-bits? b)
         (integer->char (arithmetic-shift b (- char-shift)))]
        [(box-bits? b)
         (box (bits->value (mem-ref "a box" (- b type-box))))]
        [(cons-bits? b)
         (cons (bits->value (mem-ref "the car of a cons" (+ 0 (- b type-cons))))
               (bits->value (mem-ref "the cdr of a cons" (+ 8 (- b type-cons)))))]

        [(vect-bits? b)
         (let ((p (- b type-vect)))
           (build-vector (bits->value (mem-ref "a vector" p))
                         (lambda (j)
                           (bits->value (mem-ref "an element of a vector"
                                                 (+ p (* 8 (add1 j))))))))]
        [(str-bits? b)
         (let ((p (- b type-str)))
           (build-string (bits->value (mem-ref "a string" p))
                         (lambda (j)
                           (integer->char (mem-ref32 "a character of a string"
                                                     (+ p 8 (* 4 j)))))))]
        [else (error 'bits->value "invalid bits: ~e" b)]))

;; Value -> Integer
;; v must be an immediate
(define (value->bits v)
  (cond [(eq? v #t) #b00011000]
        [(eq? v #f) #b00111000]
        [(eq? v eof) #b01011000]
        [(eq? v (void)) #b01111000]
        [(eq? v '()) #b10011000]
        [(integer? v) (arithmetic-shift v int-shift)]
        [(char? v)
         (bitwise-ior type-char
                      (arithmetic-shift (char->integer v) char-shift))]
        [else (error "not an immediate value" v)]))

(define (int-bits? v)
  (= type-int (bitwise-and v mask-int)))

(define (char-bits? v)
  (= type-char (bitwise-and v mask-char)))

(define (imm-bits? v)
  (zero? (bitwise-and v imm-mask)))

(define (cons-bits? v)
  (= type-cons (bitwise-and v imm-mask)))

(define (box-bits? v)
  (= type-box (bitwise-and v imm-mask)))

(define (vect-bits? v)
  (= type-vect (bitwise-and v imm-mask)))

(define (str-bits? v)
  (= type-str (bitwise-and v imm-mask)))

(define (mem-ref   what i) (gen-ref 'mem-ref   what i _int64))
(define (mem-ref32 what i) (gen-ref 'mem-ref32 what i _int32))

(define (gen-ref who what address [ref-type _int64])
  (unless (memory-allocated?)
    (error who
           (string-append "no heap configured while decoding ~.a\n"
                          "  given: pointer with address ~e")
           what
           address))
  (unless (pointer-in-allocated-memory? address)
    (error who
           (string-append "contract violation while decoding ~.a\n"
                          "  expected: pointer to allocated memory\n"
                          "  given: pointer with address ~e")
           what
           address))
  (pointer-ref (natural->pointer address) ref-type))