Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

adds a stub for realloc #1035

Merged
merged 11 commits into from
Feb 26, 2020
Merged

adds a stub for realloc #1035

Show file tree
Hide file tree
Changes from 4 commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
e647a29
few primus-lisp updates
gitoleg Jan 22, 2020
bf31a28
encoded length
gitoleg Jan 28, 2020
73f9c13
Merge remote-tracking branch 'upstream/master' into few-primus-lisp-u…
gitoleg Jan 29, 2020
8e74a24
removed unused function
gitoleg Jan 29, 2020
2491fcd
rewrote realloc
gitoleg Jan 31, 2020
90d5d18
refactored a little
gitoleg Jan 31, 2020
e393461
renaming
gitoleg Feb 5, 2020
d8080fe
merge with master
gitoleg Feb 12, 2020
a1ced40
removed unresolved names handling from promiscuous
gitoleg Feb 13, 2020
c272546
merge with master
gitoleg Feb 21, 2020
659cb45
Merge remote-tracking branch 'origin/few-primus-lisp-updates' into fe…
gitoleg Feb 21, 2020
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 31 additions & 8 deletions plugins/primus_lisp/lisp/simple-memory-allocator.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,22 +29,45 @@

(defun memory/allocate (ptr len)
(if *malloc-initialize-memory*
(memory-allocate ptr n *malloc-initial-value*)
(memory-allocate ptr n)))
(memory-allocate ptr len *malloc-initial-value*)
(memory-allocate ptr len)))

(defun word-size () (/ (word-width) 8))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

adding this function to the public interface will introduce confusion, between word-size and word-width so, please either remove it or mangle correspondingly.


(defun encode-memory-length(ptr len)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

lisp style issue, please add a space between the function name and the list of arguments.

(write-word ptr_t ptr len))

(defun decode-memory-length(ptr)
(read-word ptr_t ptr))

(defun decode-memory-length'(ptr)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I doubt that we need these two functions (again in the public interface).

  1. mangle the function name, e.g., malloc/get-chunk-length
  2. collapse them into one function.

(if ptr (decode-memory-length (- ptr (word-size))) 0))

(defun malloc (n)
"allocates a memory region of size N"
(declare (external "malloc"))
(if (= n 0) *malloc-zero-sentinel*
(if (malloc-will-reach-limit n) 0
(let ((n (+ n (* 2 *malloc-guard-edges*)))
(let ((width (word-size))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

a) we always use the word width for the size in bits. And in general, unless specified otherwise, we prefer bits to bytes. In that case, you maximize the astonishment when you first define a function word-size that translates word width into size in bytes and the bind it to a variable that is named width. This code will break on the next update...

b) please choose variable names that bear some semantics, instead of using generic width, array, etc. In this particular case, I suggest header-size, e.g.,

(let ((header-size (word-width / 8)) ...)

(full (+ n (* 2 *malloc-guard-edges*) width))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

rename full to chunk-size

(ptr brk)
(failed (memory/allocate ptr n)))
(failed (memory/allocate ptr full)))
(if failed 0
(set brk (+ brk n))
(malloc/fill-edges ptr n)
(+ ptr *malloc-guard-edges*))))))

(set brk (+ brk full))
(malloc/fill-edges ptr full)
(set ptr (+ ptr *malloc-guard-edges*))
(encode-memory-length ptr n)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

rename encode/decode to get/put or load/store or read/write. You choice.

(+ ptr width))))))

(defun realloc (ptr new)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Please, rewrite this function to conform with POSIX. In particular,

  1. when ptr is NULL it shall behave as malloc
  2. when len is NULL it shall behave as free
  3. when len is unchanged nothing should be done
  4. when len is smaller the pointer shall not change, but see a not below.
  5. only when len is greater than the old-len we may return a new pointer (and we don't have other choices with our current allocator).
  6. if a new chunk is allocated by realloc the old chunk, pointed by ptr shall be deallocated.
    The following code (untested) implements this semantics. Note, how (or (and ..) (and ..) ...) is used in place where you will be using pattern matching in OCaml. This is much easier to read than a bunch of nested if/then/elses.
(defun realloc (ptr len)
  (or (and (not ptr) (malloc ptr len))
      (and (not len) (free ptr))
      (let ((old-len (malloc/get-chunk-size ptr)))
        (if (<= old-len len)
            (prog (malloc/put-chunk-size ptr len) ptr)
          (free ptr)
          (let (new-ptr (malloc ptr len))
            (if new-ptr (memcpy new-ptr ptr old-len)
              new-ptr))))))

Note, if realloc is used to reduce the size of a chunk (e.g., for shrinking a dynamic vector), we shall return the same pointer, but mark the region ptr+len,ptr+old-len as invalid. Therefore, we need to update the region-analysis (where malloc is hooked into it, and track calls to realloc which shrink the regions and try to mark them as freed). If it would be too hard, we can ignore it right now and think about it later.

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This realloc is also buggy, by the way, the trick (or (and <cond> <body>) ...) doesn't work here, since <body> in our case could also evaluate to false so the control flow will fall down, i.e., both malloc and free could return false, in fact free always returns false, so we will fall after free to realloc. It won't break a lot, i.e., we will now hit the (<= old-len len) guard, and just write 0 to the length field. But still it is more a bug than a feature.

(declare (external "realloc"))
(let ((old (decode-memory-length' ptr))
(ptr' (malloc new))
(dst ptr'))
(if (not ptr) ptr'
(when (and ptr ptr')
(copy-right dst ptr old))
ptr')))

;; in our simplistic malloc implementation, free is just a nop
(defun free (p)
Expand Down
2 changes: 1 addition & 1 deletion plugins/primus_lisp/primus_lisp_main.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -100,7 +100,7 @@ module Signals(Machine : Primus.Machine.S) = struct
signal pc_change word one
{|(pc-change PC) is emitted when PC is updated|};
signal eval_cond value one
{|(eval_cond V) is emitted after evaluating a conditional to V|};
{|(eval-cond V) is emitted after evaluating a conditional to V|};
signal jumping (value,value) pair
{|(jumping C D) is emitted before jump to D occurs under the
condition C|};
Expand Down
2 changes: 1 addition & 1 deletion plugins/primus_test/lisp/check-value.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@
(check-value/unchecked pc)
(dict-del 'check-value/required taint))))

(defmethod enter-jmp (cnd dst)
(defmethod eval-cond (cnd)
(check-value-clear cnd))


Expand Down
3 changes: 3 additions & 0 deletions plugins/primus_test/lisp/memcheck-malloc.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,9 @@
(defmethod call (name ptr)
(when (and ptr (= name 'free)
(not (= ptr *malloc-zero-sentinel*)))
(when (and ptr
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

ptr is already non-NULL here, see the guard above. Also for when (not cond) there is unless until cond. Ooops, it should be, of course, unless, not until and not even unit (as it is documented) :) Could you please add unless in addition to (the now deprecated) until to the init.lisp? And, please, update the docs correspondingly, and mark until as deprecated.

So the code will be now much more readable:

(defmethod call (name ptr)
  (when (and ptr (= name 'free)
             (not (= ptr *malloc-zero-sentinel*)))
    (unless (memcheck-is-allocated 'malloc ptr)
      (memcheck-acquire 'malloc ptr 1))
    (memcheck-release 'malloc ptr)))

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Ok, I was really confused yesterday :) unless is not until. unless is a dual for when, where until is dual while. So here are the definitions that we should have,

(defmacro when (cnd body)
  "(when CND BODY) if CND evaluates to true, then BODY is evaluated and
   the value of the last expression in BODY becomes the value of the
   whole expression. Otherwise, if CND evaluates to false, nil is returned."
  (if cnd (prog body) ()))

(defmacro unless (cnd body)
  "(unless CND BODY) if CND evaluates to false, then BODY is evaluated and
   the value of the last expression in BODY becomes the value of the
   whole expression. Otherwise, if CND evaluates to true, nil is returned."
  (if (not cnd) () body))

(defmacro until (c b)
  "(until COND BODY) if COND evaluates to true, then the whole expression
   evaluates to nil and BODY is not evaluated. Otherwise, if COND evaluates
   to false, then BODY is evaluated until COND evaluates to true and the value
   of the last evaluation of BODY becomes the value of the whole expression."
  (while (not c) b))

(not (memcheck-is-allocated 'malloc ptr)))
(memcheck-acquire 'malloc ptr 1))
(memcheck-release 'malloc ptr)))

(defmethod loaded (ptr)
Expand Down
6 changes: 6 additions & 0 deletions plugins/primus_test/lisp/memcheck.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,12 @@
(require incident)

;; Public Interface

(defun memcheck-is-allocated (heap ptr)
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I would name it memcheck-is/was-allocated or even better, memcheck-is-tracked to prevent future confusion.

(or
(region-contains (symbol-concat 'memcheck/live heap) ptr)
(region-contains (symbol-concat 'memcheck/dead heap) ptr)))

(defun memcheck-release (heap ptr)
(let ((dead (region-contains (symbol-concat 'memcheck/dead heap) ptr)))
(if dead (memcheck/report-double-release ptr)
Expand Down