This commit is contained in:
Justin Ethier 2017-03-16 21:26:28 +00:00
parent 32003607fb
commit 3d55a37e27

View file

@ -960,24 +960,13 @@
make_pair(c, obj, thd->param_objs); make_pair(c, obj, thd->param_objs);
thd->param_objs = &c; thd->param_objs = &c;
return_closcall1(data, k, &c); ") return_closcall1(data, k, &c); ")
;"(void *data, int argc, closure _, object k, object obj)"
;" make_pair(p, obj, ((gc_thread_data *)data)->param_objs);
; gc_thread_data *thd = (gc_thread_data *)data;
; //Cyc_st_add(data, \"scheme/base.sld:set-param-objs!\");
; //fprintf(stderr, \"scheme/base.sld:set-param-objs!\\n\");
; global_set((thd->param_objs), &p);
; //thd->param_objs = (object)(&p);
; // obj is on the stack, need to add it to write barrier
; // to ensure it is transported to the heap
; //add_mutation(data, &p, -1, obj);
; return_closcall1(data, k, boolean_t); ")
(define *parameter-id* 0) (define *parameter-id* 0)
(define (make-parameter init . o) (define (make-parameter init . o)
(let* ((converter (let* ((converter
(if (pair? o) (car o) (lambda (x) x))) (if (pair? o) (car o) (lambda (x) x)))
(value (converter init)) (value (converter init))
(key #f)) (key #f))
;; TODO: this is not thread safe! ;; This is not thread safe!
(set! key *parameter-id*) (set! key *parameter-id*)
(set! *parameter-id* (+ *parameter-id* 1)) (set! *parameter-id* (+ *parameter-id* 1))
;; ;;
@ -986,25 +975,16 @@
(lambda args (lambda args
(cond (cond
((null? args) ((null? args)
;; DEBUG
(let ((pobj (get-param-objs))) (let ((pobj (get-param-objs)))
;(if (not (pair? (car pobj)))
; (Cyc-display `(get-param-objs not a list: ,(get-param-objs))))
(cdr (assoc key pobj)))) (cdr (assoc key pobj))))
;; END DEBUG
;(cdr (assoc key (get-param-objs))))
;value)
((eq? (car args) '<param-set!>) ((eq? (car args) '<param-set!>)
(let ((cell (assoc key (get-param-objs)))) (let ((cell (assoc key (get-param-objs))))
(set-cdr! cell (cadr args)))) (set-cdr! cell (cadr args))))
;(set! value (cadr args)))
((eq? (car args) '<param-convert>) ((eq? (car args) '<param-convert>)
converter) converter)
(else (else
;(error "bad parameter syntax" args)
(let ((cell (assoc key (get-param-objs)))) (let ((cell (assoc key (get-param-objs))))
(set-cdr! cell (converter (car args)))) (set-cdr! cell (converter (car args))))
;(set! value (converter (car args)))
))))) )))))
(define current-output-port (define current-output-port
(make-parameter (Cyc-stdout))) (make-parameter (Cyc-stdout)))