added an mmap cache to avoid repeated mmaps/munmaps

bin/ikarus-runtime.c

@@ -94,14 +94,46 @@ ik_munmap_from_segment(unsigned char* base, int size, ikpcb* pcb){
     *s = 0;  
     p++; s++;
   }
-  ik_munmap(base, size);
+  ikpage* r = pcb->uncached_pages;
+  if (r){
+    ikpage* cache = pcb->cached_pages;
+    do{
+      r->base = base;
+      ikpage* next = r->next;
+      r->next = cache;
+      cache = r;
+      r = next;
+      base += pagesize;
+      size -= pagesize;
+    } while(r && size);
+    pcb->cached_pages = cache;
+    pcb->uncached_pages = r;
+  }
+  if(size){
+    ik_munmap(base, size);
+  }
 }
 
 
 
 void* 
 ik_mmap_typed(int size, unsigned int type, ikpcb* pcb){
-  unsigned char* p = ik_mmap(size);
+  unsigned char* p;
+  if(size == pagesize) {
+    ikpage* s = pcb->cached_pages;
+    if(s){
+      p = s->base;
+      pcb->cached_pages = s->next;
+      s->next = pcb->uncached_pages;
+      pcb->uncached_pages = s; 
+    } 
+    else {
+      p = ik_mmap(size);
+    }
+  } 
+  else {
+    p = ik_mmap(size);
+  }
   extend_table_maybe(p, size, pcb);
   set_segment_type(p, size, type, pcb);
   return p;
@@ -219,6 +251,7 @@ ikp ik_mmap_protected(int size){
 }
 
 
+#define CACHE_SIZE (pagesize * 8) /* must be multiple of pagesize*/
 
 ikpcb* ik_make_pcb(){
   ikpcb* pcb = ik_malloc(sizeof(ikpcb));
@@ -237,6 +270,19 @@ ikpcb* ik_make_pcb(){
   pcb->frame_base = pcb->frame_pointer;
   pcb->frame_redline = pcb->stack_base + 2 * 4096;
 
+
+  { /* make cache ikpage */
+    ikpage* p = ik_mmap(CACHE_SIZE * sizeof(ikpage));
+    ikpage* q = 0;
+    ikpage* e = p + CACHE_SIZE;
+    while(p < e){
+      p->next = q;
+      q = p;
+      p++;
+    }
+    pcb->uncached_pages = q;
+  }
+
   {
     /* compute extent of heap and stack */
     unsigned char* lo_mem;
@@ -303,6 +349,7 @@ void ik_delete_pcb(ikpcb* pcb){
   int vecsize = (segment_index(end) - segment_index(base)) * pagesize;
   ik_munmap(pcb->dirty_vector_base, vecsize);
   ik_munmap(pcb->segment_vector_base, vecsize);
+   
   ik_free(pcb, sizeof(ikpcb));
 }
 

bin/ikarus.h

@@ -62,6 +62,11 @@ inthash(int key) {
 typedef unsigned char* ikp;
 void ik_error(ikp args);
 
+typedef struct ikpage{
+  ikp base;
+  struct ikpage* next;
+} ikpage;
+
 typedef struct ikpages{
   ikp base;
   int size;
@@ -94,6 +99,8 @@ typedef struct {
   ikp   heap_base; 
   int   heap_size;
   ikpages* heap_pages;
+  ikpage* cached_pages; /* pages cached so that we don't map/unmap */
+  ikpage* uncached_pages; /* ikpages cached so that we don't malloc/free */
   ikp   stack_base;
   int   stack_size;
   ikp   oblist;

lab/.vimview/~=+Work=+ikarus-scheme=+lab=+pretty-print.ss=

@@ -1,129 +0,0 @@
-let s:so_save = &so | let s:siso_save = &siso | set so=0 siso=0
-argglobal
-setlocal noarabic
-setlocal autoindent
-setlocal autoread
-setlocal nobinary
-setlocal bufhidden=
-setlocal buflisted
-setlocal buftype=
-setlocal nocindent
-setlocal cinkeys=0{,0},0),:,0#,!^F,o,O,e
-setlocal cinoptions=
-setlocal cinwords=if,else,while,do,for,switch
-setlocal comments=s1:/*,mb:*,ex:*/,://,b:#,:%,:XCOMM,n:>,fb:-
-setlocal commentstring=/*%s*/
-setlocal complete=.,w,b,u,t,i
-setlocal completefunc=
-setlocal nocopyindent
-setlocal nocursorcolumn
-setlocal nocursorline
-setlocal define=
-setlocal dictionary=
-setlocal nodiff
-setlocal equalprg=
-setlocal errorformat=
-setlocal expandtab
-if &filetype != 'scheme'
-setlocal filetype=scheme
-endif
-setlocal foldcolumn=0
-setlocal foldenable
-setlocal foldexpr=0
-setlocal foldignore=#
-setlocal foldlevel=0
-setlocal foldmarker={{{,}}}
-setlocal foldmethod=manual
-setlocal foldminlines=1
-setlocal foldnestmax=20
-setlocal foldtext=foldtext()
-setlocal formatexpr=
-setlocal formatoptions=tcq
-setlocal formatlistpat=^\\s*\\d\\+[\\]:.)}\\t\ ]\\s*
-setlocal grepprg=
-setlocal iminsert=0
-setlocal imsearch=0
-setlocal include=
-setlocal includeexpr=
-setlocal indentexpr=
-setlocal indentkeys=0{,0},:,0#,!^F,o,O,e
-setlocal noinfercase
-setlocal iskeyword=33,35-39,42-58,60-90,94,95,97-122,126,_
-setlocal keymap=
-setlocal keywordprg=
-setlocal nolinebreak
-setlocal lisp
-setlocal nolist
-setlocal makeprg=
-setlocal matchpairs=(:),{:},[:]
-setlocal modeline
-setlocal modifiable
-setlocal nrformats=octal,hex
-setlocal nonumber
-setlocal numberwidth=4
-setlocal omnifunc=
-setlocal path=
-setlocal nopreserveindent
-setlocal nopreviewwindow
-setlocal quoteescape=\\
-setlocal noreadonly
-setlocal norightleft
-setlocal rightleftcmd=search
-setlocal noscrollbind
-setlocal shiftwidth=2
-setlocal noshortname
-setlocal nosmartindent
-setlocal softtabstop=0
-setlocal nospell
-setlocal spellcapcheck=[.?!]\\_[\\])'\"\	\ ]\\+
-setlocal spellfile=
-setlocal spelllang=en
-setlocal statusline=
-setlocal suffixesadd=
-setlocal swapfile
-setlocal synmaxcol=3000
-if &syntax != 'scheme'
-setlocal syntax=scheme
-endif
-setlocal tabstop=8
-setlocal tags=
-setlocal textwidth=68
-setlocal thesaurus=
-setlocal nowinfixheight
-setlocal nowinfixwidth
-setlocal wrap
-setlocal wrapmargin=0
-silent! normal! zE
-184,239fold
-240,283fold
-284,285fold
-286,294fold
-295,298fold
-299,311fold
-313,349fold
-350,361fold
-184
-normal zc
-240
-normal zc
-284
-normal zc
-286
-normal zc
-295
-normal zc
-299
-normal zc
-313
-normal zc
-350
-normal zc
-let s:l = 615 - ((33 * winheight(0) + 17) / 35)
-if s:l < 1 | let s:l = 1 | endif
-exe s:l
-normal! zt
-615
-normal! 0
-let &so = s:so_save | let &siso = s:siso_save
-doautoall SessionLoadPost
-" vim: set ft=vim :

lab/streams.ss

@@ -0,0 +1,76 @@
+
+(module (s-car s-cdr (s-cons make-stream) stream? s-head)
+  (import scheme)
+  (define-record stream (car cdr))
+  (define (s-car x)
+    (if (stream? x)
+        ((stream-car x))
+        (error 's-car "~s is not a stream" x)))
+  (define (s-cdr x)
+    (if (stream? x)
+        ((stream-cdr x))
+        (error 's-cdr "~s is not a stream" x)))
+  (define-syntax s-cons
+    (syntax-rules ()
+      [(_ a d) (make-stream (lambda () a) (lambda () d))]))
+  (define (s-head n s)
+    (unless (and (fixnum? n) (fx>= n 0))
+      (error 's-head 
+             "length must be a non-negative fixnum, got ~s"
+             n))
+    (unless (stream? s)
+      (error 's-head "~s is not a stream" s))
+    (let f ([n n] [s s] [ac '()])
+      (cond
+        [(fxzero? n) (reverse ac)]
+        [else 
+         (f (fx- n 1) (s-cdr s) (cons (s-car s) ac))]))))
+
+
+  (define (going-up x lim)
+    (cond ((= x lim) (s-cons x (going-down (- x 1) (+ lim 1))))
+          (else (s-cons x (going-up (+ x 1) lim)))))
+  (define (going-down x lim)
+    (cond ((= x 0) (going-up 1 lim))
+          (else (s-cons x (going-down (- x 1) lim)))))
+  (define s (going-up 1 1))
+
+#!eof
+
+Path: g2news2.google.com!news3.google.com!newshub.sdsu.edu!tethys.csu.net!okeanos.csu.net!53ab2750!not-for-mail
+Sender: luv...@localhost.localdomain
+Newsgroups: comp.lang.scheme
+Subject: Re: Stream problem
+References: <1164352610.327618.225810@l39g2000cwd.googlegroups.com>
+From: Andru Luvisi <luv...@andru.sonoma.edu>
+Message-ID: <8764cq9fhg.fsf@localhost.localdomain>
+Lines: 21
+User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.4
+MIME-Version: 1.0
+Content-Type: text/plain; charset=us-ascii
+Date: 05 Dec 2006 13:53:31 -0800
+NNTP-Posting-Host: 130.157.65.249
+X-Trace: okeanos.csu.net 1165355611 130.157.65.249 (Tue, 05 Dec 2006 13:53:31 PST)
+NNTP-Posting-Date: Tue, 05 Dec 2006 13:53:31 PST
+
+
+Several of the answers that have been posted involve using reverse,
+which has the disadvantage that the later you go in the stream, the
+more of it you will need to hold in ram if you are processing and
+discarding elements as you go.
+
+  (define (going-up x lim)
+    (cond ((= x lim) (s-cons x (going-down (- x 1) (+ lim 1))))
+          (else (s-cons x (going-up (+ x 1) lim)))))
+  (define (going-down x lim)
+    (cond ((= x 0) (going-up 1 lim))
+          (else (s-cons x (going-down (- x 1) lim)))))
+  (define s (going-up 1 1))
+
+Andru
+-- 
+Andru Luvisi
+
+Quote Of The Moment:
+  Quidquid latine dictum sit, altum viditur.
+  ( Whatever is said in Latin sounds profound. )