99c113680efb — Leonard Ritter 20 days ago
* more work on new module format
2 files changed, 117 insertions(+), 115 deletions(-)

M testing/logregion.sc => lib/tukan/logregion.sc
M testing/test_node4.sc
M testing/logregion.sc => lib/tukan/logregion.sc +12 -1
@@ 10,6 10,12 @@ 
     The final partitioning resembles a binary subdivision; when regions are
     ordered by decreasing size, the packing will be gapless.
 
+    Trying to quantize ranges across major block alignments is associated with
+    a strong penalty though; e.g. 2045..2048 is quantized to 2044..2048, but
+    2045..2049 requires the entire 0..4096 region. In practice this is hardly a
+    problem, because ranges are always subregions of allocations, and so by
+    definition will never cross block alignments greater than the parent region.
+
 """"round x to the next highest power of 2
 inline... alignsize (x : u32)
     x := x - 1

          
@@ 69,7 75,7 @@ fn encaddrrangeun (lhs rhs)
         result is undefined.
     assert (rhs > lhs)
     # highest changing bit in inclusive range
-    blocksize := (max (1 as (typeof rhs)) (msbbit (lhs ^ (rhs - 1))))
+    blocksize := (msbbit (1 | (lhs ^ (rhs - 1))))
     _lhs := (alignoffsetd lhs blocksize)
     _rhs := (alignoffsetu rhs blocksize)
     size := (_rhs - _lhs)

          
@@ 108,6 114,10 @@ if main-module?
     print
         decaddr
             encaddrrangeun 2045:u32 2048:u32
+    # 0:u32 4096:u32
+    print
+        decaddr
+            encaddrrangeun 2045:u32 2049:u32
 
     # 113152:u32 256:u32
     print

          
@@ 122,5 132,6 @@ if main-module?
 do
     let encaddr encaddrun encaddrrangeun decaddr alignoffsetu alignoffsetd
         \ alignsize
+    locals;
 
 

          
M testing/test_node4.sc +105 -114
@@ 1,9 1,14 @@ 
 using import struct
 using import Array
 using import String
+using import property
+
+import ..lib.tukan.use
+using import tukan.logregion
 
 inline firstbit (mask bit)
     mask & (~ (mask - bit))
+    # same as mask & (bit - (mask + 1))
 
 inline nextbit (mask bit)
     mask & (~ (mask - (bit << 1)))

          
@@ 39,23 44,94 @@ inline... ritermaskbits (value : integer
 
 ################################################################################
 
+WordType := u32
+
+type Region : u32
+
+# for single indices
+type Id : u32
+    @@ memo
+    inline __imply (cls T)
+        static-if (T == integer) storagecast
+        elseif (T == (storageof this-type)) storagecast
+        elseif (T == Region)
+            inline (self)
+                bitcast (encaddr (storagecast self) 1) Region
+
+    inline makeop (op)
+        @@ memo
+        inline (cls T)
+            static-if (cls == T)
+                inline (self other)
+                    op (storagecast self) (storagecast other)
+
+    fn __repr (self)
+        self := (storagecast self)
+        if (self == 0) "none"
+        else
+            .. "%" (hex self)
+
+    let
+        __== = (makeop ==)
+        __!= = (makeop !=)
+        __>= = (makeop >=)
+        __<= = (makeop <=)
+        __> = (makeop >)
+        __< = (makeop <)
+
+type+ Region
+    #@@ memo
+    #inline __imply (cls T)
+        static-if (T == integer) storagecast
+        elseif (T == (storageof this-type)) storagecast
+
+    fn __unpack (self)
+        decaddr (storagecast self)
+
+    fn __repr (self)
+        let offset size = (unpack self)
+        let b = (max (0 as (typeof size)) (findlsb size))
+        .. "%" (hex offset) ":" (tostring b)
+
+    fn... __@ (self, index : u32)
+        let offset size = (unpack self)
+        assert (index < size)
+        bitcast (offset + index) Id
+
+    @@ memo
+    inline __rin (cls T)
+        static-if (cls == Id)
+            inline (self other)
+                let offset size = (unpack other)
+                (self >= offset) & (self < (offset + size))
+
+    @@ memo
+    inline __< (cls T)
+        static-if (T == Id)
+            inline (self other)
+                let offset size = (unpack self)
+                other >= (offset + size)
+
+    @@ memo
+    inline __> (cls T)
+        static-if (T == Id)
+            inline (self other)
+                let offset size = (unpack self)
+                other < offset
+
+################################################################################
+
 struct Module
-    WordType := u32
-    Id := WordType
     BitWordType := WordType
     BitWordWidth := (bitcountof BitWordType)
 
     p : (Array WordType)
-    # 1 word -> 32 words
-    # bits indicate the start of a sequence
-    sep : (Array BitWordType)
     # reference bits
     ref : (Array BitWordType)
 
     inline __typecall (cls)
         local self = (super-type.__typecall cls)
         'append self.p 0:u32
-        'append self.sep 1:u32
         'append self.ref 0:u32
         deref self
 

          
@@ 67,25 143,28 @@ struct Module
 
     fn alloc (self wordcount)
         count := (countof self.p)
-        id := (count as u32)
-        let bitwordofs bitofs = (id2bitpos id)
-        count := count + wordcount
-        'resize self.p count (nullof WordType)
-        bitcount := (count + BitWordWidth - 1) // BitWordWidth
-        sep := self.sep
-        'resize sep bitcount (nullof BitWordType)
+        offset := (count as u32)
+        size := (alignsize (wordcount as u32))
+        offset := (alignoffsetu offset size)
+        newcount := offset + size
+        'resize self.p newcount (nullof WordType)
+        bitcount := (newcount + BitWordWidth - 1) // BitWordWidth
         'resize self.ref bitcount (nullof BitWordType)
-        sep @ bitwordofs |= (1 as BitWordType) << bitofs
-        id
+        id := (encaddr offset size)
+        let o s = (decaddr id)
+        assert ((o == offset) & (s == size))
+        bitcast id Region
 
-    fn... setref (self, targetid : Id, sourceid : Id)
-        self.p @ targetid = sourceid
+    fn... setref (self, targetid : Id, sourceid : Region)
+        assert (sourceid < targetid)
+        targetid as:= integer
+        self.p @ targetid = (storagecast sourceid)
         bitwordofs := (targetid // BitWordWidth)
         bitofs := targetid & (BitWordWidth - 1)
         self.ref @ bitwordofs |= (1 as BitWordType) << bitofs
         ;
 
-    fn... collect (self, root : Id)
+    #fn... collect (self, root : Id)
         let bitwordofs bitofs = (id2bitpos root)
         # dirty flags
         local used : (Array BitWordType)

          
@@ 170,7 249,7 @@ struct Module
             flag beginning of range as used
 
 
-#do
+do
     local module : Module
     print "n1="
         n1 := ('alloc module 5)

          
@@ 182,101 261,13 @@ struct Module
         n4 := ('alloc module 16)
     print "n5="
         n5 := ('alloc module 40)
-    'setref module (n5 + 2) n4
-    'setref module (n5 + 35) n3
-    'setref module (n3 + 0) (n1 + 2)
-    'setref module (n3 + 1) (n2 + 3)
-    'setref module (n2 + 2) n1
-    'collect module n5
-
-#
-    0123456789ABCDEF
-    --------0-------
-    ----1-------1---
-    --2---2---2---2-
-    -3-3-3-3-3-3-3-3
-    -323132303231323 - type B: tree order equivalent to sorted array
-    ?2428646?ACA8ECE
-     848284818482848
-    ?0010011?0011011
-    -0-1-0-1-0-1-0-1
-    --0---1---0---1-
-    ----0-------1---
-    0101010101010101
-    0011001100110011
-    0000111100001111
-    0000000011111111
-
-    ----0-------1---
-    00X100X100X100X1
-    0000XX1X0000XX1X
-    00000000XXXX1XXX
-
-    ?0010011?0011011
-    0001000100010001
-    0000001100000011
-    0000000000001111
-    0000000000000000
-    0000000000000000
-
-    in type B, best to keep array at size=2**depth and blank at index 0; then
-    depth(index) = (max_depth - findlsb(index))
-    parent_radius(index) = (index & ~(index - 1))
-    radius(index) = (parent_radius(index) >> 1)
-    is_leaf(index) = (width(index) == 0)
-    left/right(index) = (index ± radius(index))
-    is_left(index) = ((parent_radius (index + parent_radius(index))) == parent_radius(index) * 2)
-    parent(index) = index + is_left(index)?w:-w
-    root() = size >> 1
-
-
-    right(index) = index + radius(index)
-    r_child_index - radius(parent_index) = parent_index
-
-fn radius (index)
-    (index & (~ (index - 1))) >> 1
-
-fn parent-radius (index)
-    index & (~ (index - 1))
-
-fn is_right (b)
-    let ~b = (~ b)
-    # (b0 b1 (b1 b2 (b2 b3 0)))
-
-    & 1
-        |
-            b & (b >> 1)
-            ~b & (b >> 1) & (b >> 2)
-            ~b & (~b >> 1) & (b >> 2) & (b >> 3)
-            ~b & (~b >> 1) & (~b >> 2) & (b >> 3) & (b >> 4)
-            ~b & (~b >> 1) & (~b >> 2) & (~b >> 3) & (b >> 4) & (b >> 5)
-
-fn is_right2 (index)
-    w := (index & (~ (index - 1)))
-    q := (index - w)
-    == 0
-        (q & (~ (q - 1))) - w * 2
-
-fn parent (index)
-    w := index & (~ (index - 1))
-    pl := index - w
-    pr := index + w
-    ? (pl + (radius pl) == index) pl pr
-
-fn parent2 (index)
-    w := index & -index
-    ql := index - w
-    qr := index + w
-    #wwl := ql & -ql
-    wwr := qr & -qr
-    # w * 2 is either wwl or wwr
-    ? (wwr == w * 2) qr ql
-
-for i in (range 128)
-    if (i > 0)
-        #assert ((is_right i) == (is_right2 i))
-        assert ((parent2 i) == (parent i))
-    print i (parent i) (radius i) #(is_right i) (is_right2 i)
+    print (n5 @ 2)
+    'setref module (n5 @ 2) n4
+    'setref module (n5 @ 35) n3
+    'setref module (n3 @ 0) (n1 @ 2)
+    'setref module (n3 @ 1) (n2 @ 3)
+    'setref module (n2 @ 2) n1
+    #'collect module n5
 
 ;