Merge pull request #699 from andrew-johnson-4/realloc

Realloc

LIB/default-malloc.lm

@@ -74,7 +74,7 @@ mextend := λ(: ptr ?[])(: sz U64). (: (
 
    (let data malloc-block-tail)
 
-   (if (<=( sz (.free-space block) )) (
+   (if (<=( (+( sz 24_u64 )) (.free-space block) )) (
       (set.block-size( block (+( (.block-size block) sz )) ))
       (if (==( (as (.block-next block) U64) 0_u64 )) (
          (set malloc-block-tail (+( malloc-block-tail sz )))
@@ -86,6 +86,38 @@ mextend := λ(: ptr ?[])(: sz U64). (: (
    (as data ?[])
 ) ?[]);
 
+realloc := λ(: ptr ?[])(: sz U64). (: (
+   (let block (as (-( (as ptr U64) 24_u64 )) MallocBlock[]))
+
+   (let data malloc-block-tail)
+
+   (if (||(
+      (>=( (.block-size block) sz ))
+      (<=( (-( sz (.block-size block) )) (.free-space block) ))
+   )) (
+      (set.block-size( block sz ))
+      (if (&&( (==( (as (.block-next block) U64) 0_u64 ))
+               (<( (.block-size block) sz ))
+          )) (
+         (set malloc-block-tail (+( malloc-block-tail (-( sz (.block-size block) )) )))
+      ) ())
+   ) (
+      (let new-data (malloc sz))
+      (let new-block (as (-( (as new-data U64) 24_u64 )) MallocBlock[]))
+      (let bi 0_u64)
+      (while (<( bi sz )) (
+         (let dst (as (.block-data new-block) U8[]))
+         (let src (as (.block-data block) U8[]))
+         (set[]( dst bi ([]( src bi )) ))
+         (set bi (+( bi 1_u64 )))
+      ))
+      (free(.block-data block))
+      (set block new-block)
+   ))
+
+   (.block-data block)
+) ?[]);
+
 .free-space := λ(: head MallocBlock[]). (: (
    (let space 0_u64)
    (if (==( (as (.block-next head) U64) 0_u64 )) (

LIB/default-primitives.lm

@@ -77,6 +77,15 @@ fragment : DontChain set[] := λ(: l LocalVariable+Array<Sized<8>,?>)(: i Litera
       \t 'mov \s '%R14 , \s (*( '8 (.expression i) )) \[ '%R15 \] \n
    ))
 ) Nil);
+fragment : DontChain set[] := λ(: l LocalVariable+Array<Sized<1>,?>)(: i LocalVariable+U64)(: v Reg8+Sized<1>). (: (
+   (.program (
+      \t 'mov \s '% (.expression v) , \s '%R14B \n
+      \t 'mov \s (.expression i) \[ '%RBP \] , \s '%R13 \n
+      \t 'mov \s (.expression l) \[ '%RBP \] , \s '%R15 \n
+      \t 'add \s '%R13 , \s '%R15 \n
+      \t 'mov \s '%R14B , \s '0 \[ '%R15 \] \n
+   ))
+) Nil);
 
 fragment : DontChain set[] := λ(: dst Reg64+Array<Sized<size>,?>)(: src LocalVariable+Sized<size>). (: (
    (.program (

tests/regress/malloc.lm

@@ -4,8 +4,12 @@ import LIB/default.lm;
 main := λ. (: (
    (let region1 (malloc 11_u64))
    (let region2 (malloc 5_u64))
+   (let region12 (realloc( region1 12_u64 )))
+   (let region13 (realloc( region1 25_u64 )))
    (print (-( (as region1 U64) malloc-block-head )))(print '\n_s) # sizeof(MallocBlock::header) = 24
    (print (-( (as region2 U64) malloc-block-head )))(print '\n_s) # sizeof(MallocBlock::header)*2 + 16 = 64
+   (print (-( (as region12 U64) malloc-block-head )))(print '\n_s) # new region = ?
+   (print (-( (as region13 U64) malloc-block-head )))(print '\n_s) # new region = ?
 
    (let loop-counter 0_u64)
    (while (<( loop-counter 1000000_u64 )) (

tests/regress/malloc.lm.out

@@ -1,2 +1,4 @@
 24
 64
+24
+96