///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Library                                //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   This program is free software: you can redistribute it and/or modify    //
//   it under the terms of the GNU General Public License as published by    //
//   the Free Software Foundation, either version 3 of the License, or       //
//   (at your option) any later version.                                     //
//                                                                           //
//   This program is distributed in the hope that it will be useful,         //
//   but WITHOUT ANY WARRANTY; without even the implied warranty of          //
//   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           //
//   GNU General Public License for more details.                            //
//                                                                           //
//   You should have received a copy of the GNU General Public License       //
//   along with this program.  If not, see <http://www.gnu.org/licenses/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header
  
  + name     := Strict MEMORY;


  - copyright   := "2003-2005 Jérome Boutet, 2003-2007 Benoit Sonntag";
  
  - comment  := "Memory manager.";
  
  - external :=
`
#define MINIMUM_SIZE 256  
void *table_size[MINIMUM_SIZE/sizeof(void *)];
void *last_block[64];
`;
  
Section Inherit
  
  - parent_object:OBJECT := OBJECT;
  
  //
  // MACRO ALLOCATOR
  //
    
Section Mapping
  
  + previous_linear:UINTEGER_32;  
  + size_and_id:UINTEGER_32;
    
  //---------------> Limit for Busy (64 bits)
  
  + next_free    :MEMORY;
  + previous_free:MEMORY;
  
  //---------------> Limit for Free
  
Section Private  
  
  //
  // Product by compiler.
  //
    
  // For GC only.
  /*
  - get_object_size t:INTEGER :INTEGER <- `get_object_size(@t)`:INTEGER;
  
  - mark_static_object   <- `mark_static_object()`; 
  
  - demark_static_object <- `demark_static_object()`;
  
  - mark_object ptr:POINTER type t:INTEGER <- `mark_object(@ptr,@t)`;
  
  - demark_object ptr:POINTER type t:INTEGER <- `demark_object(@ptr,@t)`;
  */  
Section MEMORY
    
  - object_size:INTEGER <- 8; // 2x32bits = 64bits
  
  - this:POINTER        <- CONVERT[MEMORY,POINTER].on Self;
  
  - begin:POINTER       <- this + object_size;
  
  - size:UINTEGER_32    <- size_and_id & 0FFFF_FFFCh;
  
  - next_linear:MEMORY  <- CONVERT[POINTER,MEMORY].on (begin + size);
    
  - id:UINTEGER_32      <- size_and_id & 01b;
  
  - id_end:UINTEGER_32  <- 10b;
  
  - is_end:BOOLEAN      <- (size_and_id & id_end).to_boolean;
  
  - set_previous_linear p:UINTEGER_32 <- ( previous_linear := p; );
  
  - set_size_and_id s:UINTEGER_32     <- ( size_and_id     := s; );
  
  - get_index p:POINTER :UINTEGER_32  <- (p - begin_memory).to_uinteger_32 >> 26;
  
  - nb_page:UINTEGER_32;
  
  - put_last m:MEMORY to idx:UINTEGER_32 <-  
  (
    ? {idx < nb_page};
    `last_block[@idx] = @m`;
  );
  
  - get_last idx:UINTEGER_32 :MEMORY <-
  ( 
    ? {idx < nb_page};
    `last_block[@idx]`:MEMORY
  );
  
  - bound_test ptr:POINTER :BOOLEAN <-
  (
    (ptr < begin_memory) || {ptr > (begin_memory+capacity_max-4)}.if {
      "out of bound memory\n".print;
    };
    TRUE;
  );
  
  - search_capacity <-
  ( + cap:UINTEGER_32;
    + mem:POINTER;
       
    cap := 32.mb;
    {
      cap := cap * 2;
      mem := `malloc(@cap)`:POINTER;    
      (mem != NULL).if {
	`free(@mem)`;
      };
    }.do_until {(mem = NULL) || {cap = 2048.mb}};           
    (mem = NULL).if {
      cap := cap / 2;
    };
    capacity_max := cap;
    begin_memory := `malloc(@cap)`:POINTER;
    //
    //(capacity_max >> 20).print; "MB\n".print;
    
    //'['.print; begin_memory.print_hex; '-'.print; (begin_memory+capacity_max).print_hex; "]\n".print;
    
    //
    {begin_memory != NULL} ? "Memory: Not memory.";
    {(begin_memory & (POINTER.object_size - 1)) = 0} ? "Memory: Alignment.";
  );

  - new_page:MEMORY <-
  ( + old_size,new_size:UINTEGER_32;
    + block:MEMORY;
    
    (capacity_max = 0).if {
      search_capacity;
    };
    
    old_size := nb_page << 26;
    nb_page  := nb_page + 1;
    new_size := old_size + 64.mb;
    (new_size > capacity_max).if {
      "Not enough memory.\n".print;
      die_with_code exit_failure_code;
    };
    
    {nb_page < 64} ? "Memory: 4GB limit.";    
        
    block := CONVERT[POINTER,MEMORY].on (begin_memory + old_size);    
    
    block.set_previous_linear 0FFFF_FFFFh;
    block.set_size_and_id ((64.mb - object_size) | id_free | id_end);
    block.add_link_free;    
    put_last block to (nb_page - 1);
    
    /*    
    (nb_page < 7).if {
      new_page;
    };
    */  
    block
  );
    
  //
  // Busy / Free Block.
  //
  
  - id_free:UINTEGER_32 <- 00b;
  - id_busy:UINTEGER_32 <- 01b;
  
  - set_next_free     n:MEMORY <- ( next_free     := n; );
  - set_previous_free p:MEMORY <- ( previous_free := p; );
  
  - delete_link_free <-
  ( + prev,next:MEMORY;
    
    prev := previous_free;
    next := next_free;
    (prev = NULL).if {
      first_free := next;
    } else {
      prev.set_next_free next;
    };
    (next != NULL).if {
      next.set_previous_free prev;
    };
  );
  
  - add_link_free <-
  (    
    next_free     := first_free;
    previous_free := NULL;
    (first_free != NULL).if {      
      first_free.set_previous_free Self;
    };    
    first_free := Self;    
  );
      
Section MEMORY
  
  - first_free:MEMORY;
    
  //
  // Management.
  //
  
  - to_free idx:UINTEGER_32 <-
  ( + new_free,next:MEMORY;
    + prev:UINTEGER_32;
    + new_size:UINTEGER_32;
    {id = id_busy} ? "Memory: Macro block not busy.";
    {idx.in_range 0 to 63} ? "Memory: Bound index.";    
        
    prev := previous_linear;
    next := next_linear;
    new_free := CONVERT[POINTER,MEMORY].on (begin_memory + prev);
    new_size := size_and_id & 0FFFF_FFFEh;
    ((prev = 0FFFF_FFFFh) || {new_free.id != id_free}).if {
      // `Self' => Free
      new_free := Self;      
      add_link_free;
    } else {
      // `previous_linear' => Free
      new_size := new_size + new_free.size_and_id + object_size.to_uinteger_32;      
    };
        
    ((! is_end) && {next.id = id_free}).if {
      // Delete and concat `next_linear'
      new_size := new_size + next.size_and_id + object_size.to_uinteger_32;
      next.delete_link_free;	
    };    
    new_free.set_size_and_id new_size;
    (new_free.is_end).if {
      put_last new_free to idx;
    } else {
      next := next_linear;
      next.set_previous_linear ((new_free.this - begin_memory).to_uinteger_32);
    };    
  );
  
  - to_busy sz:UINTEGER_32 index idx:UINTEGER_32 <-
  ( + siz,new_size:UINTEGER_32;    
    + new,next:MEMORY;
    {id = id_free} ? "Memory: Macro block not free.";    
    {(sz & (POINTER.object_size.to_uinteger_32 - 1)) = 0} ? "Memory: Alignment.";
    
    delete_link_free;
    //    
    siz      := size_and_id;
    new_size := siz - sz;
    (new_size > (minimum_size+2+object_size.to_uinteger_32)).if {
      siz := sz;
      new := CONVERT[POINTER,MEMORY].on (begin+sz);
      new.set_previous_linear ((this - begin_memory).to_uinteger_32);
      new.set_size_and_id (new_size - object_size.to_uinteger_32);
      new.add_link_free;
      (new.is_end).if {
	put_last new to idx;
      } else {
	next := new.next_linear;
	next.set_previous_linear ((new.this - begin_memory).to_uinteger_32);
      };
    };
    size_and_id := siz | id_busy;
    {id = id_busy} ? "Memory: Macro Block not busy.";
  );
  
  - resize new_size:UINTEGER_32 index idx:UINTEGER_32 :MEMORY <-
  ( + nxt,result:MEMORY;
    + old_size,sz:UINTEGER_32;    
    
    {(new_size & (POINTER.object_size.to_uinteger_32 -1)) = 0} ? "Memory: Alignment.";
    {idx.in_range 0 to 63} ? "Memory: Bound index.";
    
    old_size := size;
    (new_size > old_size).if {      
      (! is_end).if {	
	nxt := next_linear;
	sz  := new_size - old_size - object_size.to_uinteger_32;
	((nxt.id = id_free) && {nxt.size >= sz}).if {
	  nxt.to_busy sz index idx;
	  size_and_id := size_and_id + (nxt.size_and_id&0FFFF_FFFEh) + object_size.to_uinteger_32;
	  (is_end).if {
	    put_last Self to idx;
	  } else {
	    nxt := next_linear;
	    nxt.set_previous_linear ((this - begin_memory).to_uinteger_32);
	  };
	  result := Self;
	};
      };
      (result = NULL).if { 
	// new allocation.	
	result := search new_size;
	
	//fill_memory (result.begin) size new_size;
	
	copy begin to (result.begin) size old_size;
	to_free idx;
      };
    } else {
      result := Self;
    };    
    result
  );
    
  //
  // Searching.
  //
  
  - search new_size:UINTEGER_32 :MEMORY <-
  ( + result:MEMORY;
    + idx:UINTEGER_32;
    
    {new_size > minimum_size-POINTER.object_size.to_uinteger_32} ? "Memory: Big block.";
    {(new_size & (POINTER.object_size.to_uinteger_32 - 1)) = 0} ? "Memory: Alignment.";
    
    result := first_free;        
    {(result != NULL) && {result.size < new_size}}.while_do {
      result := result.next_free;
    };
    (result = NULL).if {
      result := new_page;
    };
    idx := get_index (result.this);
    {idx.in_range 0 to 63} ? "Memory: Bound index.";
    result.to_busy new_size index idx;
            
    result
  );
  
  - new_lab t:UINTEGER_32 :POINTER <-
  ( + idx:UINTEGER_32;
    + blc,prev:MEMORY;
    + result:POINTER;
    + pv:UINTEGER_32;
    
    {
      (idx < nb_page) && 
      {
	blc := get_last idx;
	(blc.size < 4096) || {blc.id = id_busy}
      }
    }.while_do {
      idx := idx + 1;
    };
    
    (idx >= nb_page).if {    
      blc := new_page;
    };        
    blc.set_size_and_id (blc.size_and_id - 4096);
    result := blc.next_linear.this;        
 
    (blc.size < minimum_size).if {
      blc.delete_link_free;
      pv := blc.previous_linear;
      (pv != 0FFFF_FFFFh).if {
	prev := CONVERT[POINTER,MEMORY].on (begin_memory + pv);
	prev.set_size_and_id (prev.size_and_id + blc.size_and_id + object_size.to_uinteger_32);
	put_last prev to idx;
      };
    };
    put (t.to_pointer) to result;    
    
    {((result - begin_memory).to_uinteger_32 & 0FFFh) = 0} ? "Memory: Alignment LAB.";
    result + POINTER.object_size
  );  
  
Section Private
    
  - minimum_size:UINTEGER_32 <- `MINIMUM_SIZE`:UINTEGER_32;
  
  - table_type idx:UINTEGER_32 :POINTER <- 
  (
    //{idx.in_range 0 to 17} ? "Memory: Bound table_type.";
    `&(table_type[@idx])`:POINTER
  );
  
  - table_size idx:UINTEGER_32 :POINTER <- 
  (
    {idx.in_range 1 to (minimum_size/POINTER.object_size.to_uinteger_32)} ? "Memory: Bound table_size.";
    `&(table_size[@idx-1])`:POINTER
  );
          
  - begin_memory:POINTER;
  
  - capacity_max:UINTEGER_32;
  
  - read p:POINTER :POINTER <-
  ( + mem:NATIVE_ARRAY[POINTER];
    mem := CONVERT[POINTER, NATIVE_ARRAY[POINTER]].on p;
    mem.item 0
  );
  
  - put v:POINTER to p:POINTER <-
  ( + mem:NATIVE_ARRAY[POINTER];
    mem := CONVERT[POINTER, NATIVE_ARRAY[POINTER]].on p;
    mem.put v to 0;
  );
      
  - micro_alloc new_size:UINTEGER_32 table ptr_table:POINTER lab lab_type:UINTEGER_32 :POINTER <-
  ( + result,next,next2:POINTER;
    + page:UINTEGER_32;
    {(new_size & (POINTER.object_size.to_uinteger_32 - 1)) = 0} ? "Memory: Alignment.";
    {new_size >= POINTER.object_size.to_uinteger_32} ? "Memory: Size = 0.";

    result := read ptr_table;        
    (result = NULL).if {      
      // Allocation new LAB.      
      result := new_lab lab_type;          
      next := result + new_size;            
      put NULL to next;
      put next to ptr_table;          
    } else {      
      // Next Linked list.
      next := read result;
      (next = NULL).if {
	// Linear allocation.
	page := (result - begin_memory).to_uinteger_32 & 0FFFh;
	((page + (new_size << 1)) <= 4096).if {
	  next := result + new_size;
	} else {
	  next := new_lab lab_type;	  
	};
	put NULL to next;
	put next to ptr_table;
      } else {	
	// Linked list allocation.	
	next2 := read next & ~11b;
	put next2 to result;	
	result := next;	
      };		
    }; 
    result
  );
  
  - micro_free p:POINTER table ptr_table:POINTER <-
  ( + next,last:POINTER;
    {p != NULL} ? "Memory: Pointer NULL.";
    
    //"Free : ".print;
    //ptr_table.print_hex; '\n'.print;
    
    last := read ptr_table;
    {last != NULL} ? "Memory: Table NULL.";
    next := read last;
    put (next | 11b) to p;
    put p to last;
  );
  
Section Private

  - copy src:POINTER to dst:POINTER size sz:UINTEGER_32 <-
  ( + na_src,na_dst:NATIVE_ARRAY[POINTER];
    + siz:INTEGER;
    
    siz := sz.to_integer;
    {(siz & (POINTER.object_size -1)) = 0} ? "Memory: Copy alignment.";
    siz := siz / POINTER.object_size;
    na_src := CONVERT[POINTER, NATIVE_ARRAY[POINTER]].on src;
    na_dst := CONVERT[POINTER, NATIVE_ARRAY[POINTER]].on dst;
    //    
    (siz - 1).downto 0 do { j:INTEGER;      
      na_dst.put (na_src.item j) to j;
    };        
  );
  
  - fill_memory src:POINTER size sz:UINTEGER_32 <-
  // Just for debug.
  ( + na_src:NATIVE_ARRAY[POINTER];
    + siz:INTEGER;
    
    siz := sz.to_integer;
    {(siz & (POINTER.object_size -1)) = 0} ? "Memory: Copy alignment.";
    na_src := CONVERT[POINTER,NATIVE_ARRAY[POINTER]].on src;    
    ((siz / POINTER.object_size)-1).downto 0 do { j:INTEGER;
      na_src.put NULL to j;
    };    
  );  
  
Section Public

  //
  // MICRO ALLOCATOR
  //
  
  - alloc_type t:UINTEGER_32 size sz:UINTEGER_32 :POINTER <-
  // Allocation for object without type. (LAB_TYPE)
  ( + ptr_table,result:POINTER;    
    + new_size:UINTEGER_32;
    
    {sz <= minimum_size} ? "Memory: Size bound.";

    new_size  := sz.align_power (POINTER.object_size.to_uinteger_32); 
    
    {(new_size & (POINTER.object_size.to_uinteger_32 - 1)) = 0} ? "Memory: Alignment.";        
        
    ptr_table := table_type t;
    result := micro_alloc new_size table ptr_table lab (t | 1b);        
    result
  );
  
  - free p:POINTER type t:UINTEGER_32 <-
  ( + ptr_table:POINTER;
    {p != NULL} ? "Memory: Pointer NULL.";
    
    ptr_table := table_type t;
    micro_free p table ptr_table;
  );
  
  - alloc_size sz:UINTEGER_32 :POINTER <-
  // Allocation for object with type. (LAB_SIZE)
  ( + ptr_table,result:POINTER;
    + new_size:UINTEGER_32;
    
    {sz <= minimum_size} ? "Memory: Size bound.";
        
    new_size  := sz.align_power (POINTER.object_size.to_uinteger_32); 
    
    {(new_size & (POINTER.object_size.to_uinteger_32 - 1)) = 0} ? "Memory: Alignment.";
    
    ptr_table := table_size (new_size / POINTER.object_size.to_uinteger_32);
    result := micro_alloc new_size table ptr_table lab new_size;
    
    //fill_memory result size new_size;
    
    result
  );
  
  - free p:POINTER size sz:UINTEGER_32 <-
  ( + ptr_table:POINTER;
    + new_size:UINTEGER_32;
    {p != NULL} ? "Memory: Pointer NULL.";

    new_size  := sz.align_power (POINTER.object_size.to_uinteger_32); 
    
    {(new_size & (POINTER.object_size.to_uinteger_32 - 1)) = 0} ? "Memory: Alignment.";
    
    ptr_table := table_size (new_size / POINTER.object_size.to_uinteger_32);
    micro_free p table ptr_table;
  );
    
  - alloc_dynamic sz:UINTEGER_32 :POINTER <-
  // Allocation NATIVE_ARRAY[E]. (LAB_SIZE or malloc)
  ( + new_size,new_size2:UINTEGER_32;
    + result:POINTER;
    {sz != 0} ? "Memory: Size = 0";
        
    new_size  := sz.align_power (POINTER.object_size.to_uinteger_32); 
    new_size2 := new_size + POINTER.object_size.to_uinteger_32;
    (new_size2 <= minimum_size).if {
      result := alloc_size new_size2;      
      put 3 to result; // 3 : 2=NATIVE_ARRAY
      result := result + POINTER.object_size;
    } else {      
      result := search new_size .begin;      
    };
    
    //fill_memory result size new_size;
    
    result    
  );
    
  - realloc_dynamic p:POINTER old_size old_sz:UINTEGER_32 new_size new_sz:UINTEGER_32 :POINTER <-
  ( + old_size,old_size2,new_size:UINTEGER_32;
    + mem:MEMORY;
    + result:POINTER;    
    {old_size < new_sz} ? "Memory: New size < Old size.";
      
    old_size  := old_sz.align_power (POINTER.object_size.to_uinteger_32); 
    old_size2 := old_size + POINTER.object_size.to_uinteger_32;    
    new_size  := new_sz.align_power (POINTER.object_size.to_uinteger_32); 
    (old_size2 <= minimum_size).if {
      result := alloc_dynamic new_size;
      
      //fill_memory result size new_size;
      
      copy p to result size old_size;
      free (p - POINTER.object_size) size old_size2;
    } else {
      mem := CONVERT[POINTER, MEMORY].on (p - object_size);
      result := mem.resize new_size index (get_index p).begin;      
    };
        
    result
  );
  
  - free_dynamic p:POINTER size sz:UINTEGER_32 <-
  ( + new_size,new_size2:UINTEGER_32;
    + mem:MEMORY;
    
    new_size  := sz.align_power (POINTER.object_size.to_uinteger_32); // BSBS: Optim, alignment by compilo.
    new_size2 := new_size + POINTER.object_size.to_uinteger_32;
    (new_size2 <= minimum_size).if {
      free (p-POINTER.object_size) size new_size2;
    } else {
      mem := CONVERT[POINTER, MEMORY].on (p - object_size);
      mem.to_free (get_index p);
    };
  );
  
  //
  // GARBAGE COLLECTOR
  //
/*  
  - garbage_collector_pass <-
  (
    mark; 
    sweep;
  );
  
Section Private  
  
  - mark <-
  ( + stack,lab:NATIVE_ARRAY[POINTER];
    + ptr,beg_mem,end_mem,ptr_lab,ptr_table,lim_lab:POINTER;
    + size_stack:UINTEGER_32;
    + ptr_mem:UINTEGER_32;
    + mem:MEMORY;
    + type:UINTEGER_32;
    + type_object, size_object,step:UINTEGER_32;
    
    // Mark Global + BSS.
    mark_static_object; 
        
    // Mark Stack object.
    stack := `top_stack()`:NATIVE_ARRAY[POINTER];
    size_stack := (`@stack - begin_stack`:UINTEGER_32) / POINTER.object_size.to_uinteger_32;
    //
    beg_mem := begin_memory;
    end_mem := beg_mem + (nb_page << 26) - 1;
    size_stack.downto 0 do { i:UINTEGER_32;
      ptr := stack.item i;
      (ptr.in_range beg_mem to end_mem).if {
	// `ptr' is in Store.
	ptr_mem := ptr - begin_memory;
	mem := get_last (ptr_mem >> 26);
	(ptr > mem.next_linear.this).if {
	  // `ptr' is in LAB.
	  ptr_lab := begin_memory + (ptr_mem & 0FFFFF000h);	  
	  type := read ptr_lab .to_uinteger_32;
	  (type & 01b != 0).if {
	    // LAB Type.
	    type_object := type & 0FFFFFFFEh;
	    size_object := get_object_size type_object;
	    ptr_table   := table_type type_object;
	  } else {
	    // LAB Size.
	    type_object := read ptr .to_uinteger_32 & 0FFFFFFFCh;
	    size_object := type;
	    ptr_table   := table_size (size_object / POINTER.object_size.to_uinteger_32);
	  };
	  lim_lab := read ptr_table - begin_memory;
	  (! ptr_mem.in_range lim_lab to ((lim_lab+4095)&0FFFFF000h)).if {
	    step := ptr - ptr_lab - POINTER.object_size;
	    ((step > 0) && {(step % size_object) = 0}).if {
	      ((read ptr .to_uinteger_32 & 11b) = 0).if {
		mark_object ptr type type_object;
	      };
	    };
	  };
	};
      };
    };
  );
  
  - sweep <-
  ( + last:MEMORY;
    + ptr_lab,ptr_end,ptr,ptr_table,end_lab,ptr_max:POINTER;
    + type,type_object,size_object:UINTEGER_32;
    
    // Demark a Global + BSS.
    demark_static_object;
    
    // Demark a Store.
    ptr_end := begin_memory + 64.mb;
    (nb_page-1).downto 0 do { i:UINTEGER_32;
      last := get_last i;
      ptr_lab := last.next_linear.this;
      {ptr_lab < ptr_end}.while_do {
	type := read ptr_lab .to_uinteger_32;
	ptr  := ptr_lab + POINTER.object_size;
	ptr_lab := ptr_lab + 4096; // Next LAB
	(type & 01b != 0).if {
	  // LAB Type.
	  type_object := type & 0FFFFFFFCh;
	  size_object := get_object_size type_object;
	  ptr_table := table_type type_object;
	  end_lab   := read ptr_table;
	  (((end_lab + 4095) & 0FFFFF000h) = ptr_lab).if {
	    ptr_max := end_lab;
	  } else {
	    ptr_max := ptr_lab;
	  };
	  {ptr < ptr_max}.while_do {
	    demark_object ptr type type_object;
	    ptr := ptr + size_object;
	  };
	} else {
	  // LAB Size.	  
	  size_object := type;
	  ptr_table := table_size (size_object / POINTER.object_size.to_uinteger_32);
	  end_lab   := read ptr_table;
	  (((end_lab + 4095) & 0FFFFF000h) = ptr_lab).if {
	    ptr_max := end_lab;
	  } else {
	    ptr_max := ptr_lab;
	  };
	  {ptr < ptr_max}.while_do {
	    type_object := read ptr .to_uinteger_32 & 0FFFFFFFCh;
	    demark_object ptr type type_object;
	    ptr := ptr + size_object;
	  };
	};	    
      };
      ptr_end := ptr_end + 64.mb;
    };
  );
  */
  
Section Private
  
  - print_memory <-
  ( + m,next:MEMORY;
    
    "------------------------------------\n".print;
    "first free : ".print;
    first_free.this.print_hex; 
    '\n'.print;
    
    next := CONVERT[POINTER, MEMORY].on begin_memory;
    {
      m := next;
      next := m.next_linear;
      
      '['.print;
      (m.previous_linear = 0FFFF_FFFFh).if {
	"NULL".print;
      } else {
	(begin_memory + m.previous_linear).print_hex;
      };
      "<-".print;
      m.this.print_hex;      
      (m.id = id_busy).if {
	"(B)".print;
      } else {
	"(F)".print;
      };
      "->".print;
      (m.is_end).if {
	"NULL".print;
      } else {
	m.next_linear.this.print_hex;
      };
      ']'.print;
    }.do_until {m.is_end};
    '\n'.print;
    "------------------------------------\n".print;
  );