init meta-circular gc
This commit is contained in:
Johan Ceupens
parent
9e9ac82ba0
commit
7b6041f961
|
|
@ -0,0 +1,103 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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/>.
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Fixed chunk size gc, can be used in meta-gc.scm API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(define (make-sized-fast-gc)
|
||||
(let ((*heap '())
|
||||
(*null '())
|
||||
(*max-datasize 1024)
|
||||
(*datasize 0)
|
||||
(*currentn 0)
|
||||
(*max-chunksize 8)
|
||||
(*dynamic-data '())
|
||||
)
|
||||
|
||||
(define (malloc)
|
||||
(add-to-heap! 1)
|
||||
)
|
||||
|
||||
(define (calloc nchunks)
|
||||
(add-to-heap! nchunks)
|
||||
)
|
||||
|
||||
;; private procedures
|
||||
|
||||
(define (get-heap) *heap)
|
||||
|
||||
;; data is a string
|
||||
(define (get-data-size d) (string-length d))
|
||||
|
||||
(define (generate-error msg)
|
||||
(cond ((eq? msg 'memory-exhausted)
|
||||
(display "memory exhausted")(newline))
|
||||
))
|
||||
|
||||
(define (add-to-heap! n)
|
||||
(do ((n2 0 (+ n2 1)))
|
||||
((>= n2 n) *heap)
|
||||
(set! *heap (append (get-heap) (list (make-chunk)))))
|
||||
)
|
||||
|
||||
(define (make-chunk)
|
||||
(cons 'chunk *null))
|
||||
|
||||
;;NOTE append null string after <8
|
||||
;; data is a string
|
||||
(define (split-data data)
|
||||
(let ((s ""))
|
||||
(let ((retl '()))
|
||||
(do ((n2 0 (+ n2 1)))
|
||||
((>= n2 (string-length data))
|
||||
retl)
|
||||
(do ((n 0 (+ n 1)))
|
||||
((or (>= n 8)(>= (+ n2 n) (string-length data)))
|
||||
(append retl (list s))(set! n2 (+ n2 n)))
|
||||
(string-append s (string-ref data n))
|
||||
))
|
||||
)))
|
||||
|
||||
;; FIX over *currentn
|
||||
(define (set-data-rec! lst n)
|
||||
(cond ((eq? n 0)
|
||||
'())
|
||||
;; reverses
|
||||
(else (append (list (list-ref lst n))
|
||||
(set-data-rec! lst (- n 1))))))
|
||||
|
||||
|
||||
(define (set-data! chunk data)
|
||||
(let ((lst (split-data data)))
|
||||
(set-data-rec! lst (length lst))
|
||||
(set! *currentn (+ n *currentn))
|
||||
))
|
||||
|
||||
(define (set-chunk-data! chunk)
|
||||
(set! *datasize (+ *datasize (get-data-size chunk)))
|
||||
(if (> *datasize *max-datasize)
|
||||
(generate-error 'memory-exhausted)
|
||||
;; The data is dynamically bound in this actor
|
||||
(set-data! chunk *dynamic-data)
|
||||
))
|
||||
|
||||
(define (dispatch msg)
|
||||
(cond ((eq? msg 'malloc) malloc)
|
||||
((eq? msg 'calloc) calloc)
|
||||
(else (display "make-gc : message not understood : ")(display msg)(newline))
|
||||
))
|
||||
dispatch))
|
||||
|
|
@ -0,0 +1,109 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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/>.
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Fixed chunk size gc, can be used in meta-gc.scm API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(load "stringutil.scm")
|
||||
|
||||
(define (make-sized-gc)
|
||||
(let ((*heap '())
|
||||
(*null '())
|
||||
(*max-datasize 1024)
|
||||
(*datasize 0)
|
||||
(*currentn 0) ;; right write mark
|
||||
(*max-chunksize 8)
|
||||
(*dynamic-data '())
|
||||
)
|
||||
|
||||
(define (malloc)
|
||||
(add-to-heap! 1)
|
||||
)
|
||||
|
||||
(define (calloc nchunks)
|
||||
(add-to-heap! nchunks)
|
||||
)
|
||||
|
||||
;; private procedures
|
||||
|
||||
(define (get-heap) *heap)
|
||||
|
||||
;; data is a string
|
||||
(define (get-data-size d) (string-length d))
|
||||
|
||||
(define (generate-error msg)
|
||||
(cond ((eq? msg 'memory-exhausted)
|
||||
(display "memory exhausted")(newline))
|
||||
))
|
||||
|
||||
(define (add-to-heap! n)
|
||||
((lambda (n)
|
||||
(if (= n 0)
|
||||
'()
|
||||
(append (list (make-chunk)) (add-to-heap! (- n 1)))))))
|
||||
|
||||
(define (make-chunk)
|
||||
(cons 'chunk *null))
|
||||
|
||||
;;NOTE append null string after <8
|
||||
;; data is a string
|
||||
(define (split-data data)
|
||||
(let ((split-data-func (lambda (datastr)
|
||||
(append (list (substring datastr 0 8))
|
||||
4 (cond ((< (string-length datastr) 8)
|
||||
datastr)
|
||||
(else
|
||||
;; this might be a guilism
|
||||
(split-data-func (substring data 8 (string-length data)))))))
|
||||
))
|
||||
(split-data-func data)))
|
||||
|
||||
(define (split-data2 data)
|
||||
(let ((split-data-func2 (lambda (datalist)
|
||||
(append (sublist datalist 0 8)
|
||||
(cond ((< (length datalist) 8)
|
||||
datalist)
|
||||
(else
|
||||
(split-data-func2 (sublist datalist 8 (- (string-length datalist) 8)))))))))
|
||||
(map split-data-func2 (string->list data))))
|
||||
|
||||
;; FIX over *currentn
|
||||
(define (set-data-rec! lst n)
|
||||
(cond ((= n (length lst))
|
||||
'())
|
||||
;; reverses
|
||||
(else (append (list (list-ref lst n))
|
||||
(set-data-rec! lst (- n 1))))))
|
||||
|
||||
(define (set-data! chunk data)
|
||||
(let* ((lst (split-data data)))
|
||||
(set! *heap (set-data-rec! lst (length lst)))
|
||||
(set! *currentn (+ n *currentn))
|
||||
))
|
||||
|
||||
(define (set-chunk-data! chunk)
|
||||
(set! *datasize (+ *datasize (get-data-size chunk)))
|
||||
(if (> *datasize *max-datasize)
|
||||
(generate-error 'memory-exhausted)
|
||||
;; The data is dynamically bound in this actor
|
||||
(set-data! chunk *dynamic-data)
|
||||
))
|
||||
|
||||
(define (dispatch msg)
|
||||
(cond ((eq? msg 'malloc) malloc)
|
||||
((eq? msg 'calloc) calloc)
|
||||
(else (display "make-gc : message not understood : ")(display msg)(newline))
|
||||
))
|
||||
dispatch))
|
||||
|
|
@ -0,0 +1,70 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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/>.
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; One chunk per memory allocation, can be used in meta-gc.scm API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (make-gc)
|
||||
(let ((*heap '())
|
||||
(*null '())
|
||||
(*max-datasize 1024)
|
||||
(*datasize 0)
|
||||
(*dynamic-data '())
|
||||
)
|
||||
|
||||
(define (malloc)
|
||||
(add-to-heap! 1)
|
||||
)
|
||||
(define (calloc nchunks)
|
||||
(add-to-heap! nchunks)
|
||||
)
|
||||
|
||||
|
||||
;; private procedures
|
||||
|
||||
(define (get-heap) *heap)
|
||||
|
||||
;; data is a string
|
||||
(define (get-data-size d) (string-length d))
|
||||
|
||||
(define (generate-error msg)
|
||||
(cond ((eq? msg 'memory-exhausted)
|
||||
(display "memory exhausted")(newline))
|
||||
))
|
||||
|
||||
(define (add-to-heap! n)
|
||||
(set! *heap (append (get-heap) (list (make-chunk)))))
|
||||
|
||||
(define (make-chunk)
|
||||
(cons 'chunk *null))
|
||||
|
||||
(define (set-data! chunk data)
|
||||
(set-cdr! chunk data))
|
||||
|
||||
(define (set-chunk-data! chunk)
|
||||
(set! *datasize (+ *datasize (get-data-size chunk)))
|
||||
(if (> *datasize *max-datasize)
|
||||
(generate-error 'memory-exhausted)
|
||||
;; The data is dynamically bound in this actor
|
||||
(set-data! chunk *dynamic-data)
|
||||
))
|
||||
|
||||
(define (dispatch msg)
|
||||
(cond ((eq? msg 'malloc) malloc)
|
||||
((eq? msg 'calloc) calloc)
|
||||
(else (display "make-gc : message not understood : ")(display msg)(newline))
|
||||
))
|
||||
dispatch))
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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/>.
|
||||
|
||||
(load "gc.scm")
|
||||
(load "gc-sized.scm")
|
||||
(load "gc-sized-fast.scm")
|
||||
|
||||
(define (make-meta-gc gc-actor-maker)
|
||||
(let ((*gc-program (gc-actor-maker))
|
||||
)
|
||||
|
||||
;; interrupt system : FIXME sort of hooks
|
||||
(define (signal number)
|
||||
(cond ((= number 9)
|
||||
;;(display "exiting meta-gc...")
|
||||
;;,exit
|
||||
0)
|
||||
((= number 7)
|
||||
;;(display "exiting meta-gc...")
|
||||
;;,exit
|
||||
0)
|
||||
(else (display "make-meta-gc : SIGNAL == ")(display number)(display " unknown signal to gc")
|
||||
(newline)
|
||||
)))
|
||||
|
||||
(define (run)
|
||||
0)
|
||||
|
||||
(define (dispatch msg)
|
||||
(cond ((eq? msg 'run) run)
|
||||
((eq? msg 'signal) signal)
|
||||
((eq? msg 'int) signal)
|
||||
((eq? msg 'interrupt) signal)
|
||||
|
||||
(else (display "make-meta-gc : message not understood : ")(display msg)(newline)
|
||||
)))
|
||||
dispatch))
|
||||
|
|
@ -0,0 +1,28 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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/>.
|
||||
|
||||
(load "meta-gc.scm")
|
||||
|
||||
(define (make-gc-hook)
|
||||
(define (add-hook)
|
||||
;;FIXME fill in SMOB system in C
|
||||
#f)
|
||||
|
||||
(define (dispatch msg)
|
||||
(cond ((eq? msg 'add-hook) add-hook)
|
||||
(else (display "make-gc-hook : message not understood : ")(display msg)(newline)
|
||||
)))
|
||||
|
||||
dispatch)
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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/>.
|
||||
|
||||
(load "meta-gc.scm")
|
||||
|
||||
;; special REPL
|
||||
;; You can add REPL functions such as ((make-meta) 'cons our-cons)
|
||||
(define (make-meta)
|
||||
(let ((*applicants '()))
|
||||
|
||||
(define (add-hook symbol fun)
|
||||
(set! *applicants (append *applicants (list (cons symbol fun)))))
|
||||
|
||||
(define (search-applicants msgsymbol)
|
||||
(do ((l *applicants (cdr *applicants)))
|
||||
((cond ((null? l)
|
||||
#f)
|
||||
((eq? (caar *applicants) msgsymbol)
|
||||
(cdar *applicants))
|
||||
))))
|
||||
|
||||
;; dynamically bound f- function
|
||||
(define (post-applicants args)
|
||||
(if (procedure? f-)
|
||||
(f- args)))
|
||||
|
||||
(define (dispatch msg)
|
||||
(cond ((eq? msg 'add-hook) add-hook)
|
||||
((let ((f- (search-applicants msg)))
|
||||
(if f-
|
||||
post-applicants)))
|
||||
(else (display "make-meta : message not understood : ")(display msg)(newline)
|
||||
)))
|
||||
|
||||
dispatch))
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
;; Copyright (C) Johan Ceuppens 2013
|
||||
;;
|
||||
;; 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 2 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. , see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define (sublist list start number)
|
||||
(cond ((> start 0) (sublist (cdr list) (- start 1) number))
|
||||
((> number 0) (cons (car list)
|
||||
(sublist (cdr list) 0 (- number 1))))
|
||||
(else '())))
|
||||
Loading…
Reference in New Issue