mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-19 05:39:17 +02:00
86 lines
2.5 KiB
Scheme
86 lines
2.5 KiB
Scheme
;; Some notes:
|
|
;; Need a new pass to identify all variables that contribute to each computed variable. Maybe write this as a separate program again, will need to flesh this out.
|
|
;;
|
|
;; Need another pass to flag all vars that cannot be inlined (or just add this to current checks). I think if any contribution var is mutated or passed to a function outside the module being compiled, then the var cannot be inlined. It is probably possible to be a bit smarter?
|
|
;;
|
|
;; Will have to assess how badly this hurts performance.
|
|
;;
|
|
(import
|
|
(scheme base)
|
|
(scheme write)
|
|
)
|
|
;(inline
|
|
; my-string<=?
|
|
; my-not)
|
|
;
|
|
; (define (my-string<=? str1 str2) (<= (string-cmp str1 str2) 0))
|
|
; (define (my-not x) (if x #f #t))
|
|
;
|
|
;(define (queue-empty) (cons '() '()))
|
|
;(define objects-dumped (queue-empty))
|
|
;(define object-queue (queue-empty))
|
|
;(define (queue->list queue) (car queue))
|
|
;(define (queue-put! queue x)
|
|
; (let ((entry (cons x '())))
|
|
; (if (null? (car queue))
|
|
; (set-car! queue entry)
|
|
; (set-cdr! (cdr queue) entry))
|
|
; (set-cdr! queue entry)
|
|
; x))
|
|
;
|
|
;(define (pos-in-list x l)
|
|
; (let loop ((l l) (i 0))
|
|
; (cond ((not (pair? l)) #f)
|
|
; ((eq? (car l) x) i)
|
|
; (else (loop (cdr l) (+ i 1))))))
|
|
;
|
|
;(define (proc-obj-code obj) (vector-ref obj 3))
|
|
;
|
|
;(define (proc-obj? x)
|
|
; (and (vector? x)
|
|
; (> (vector-length x) 0)
|
|
; (eq? (vector-ref x 0) proc-obj-tag)))
|
|
;
|
|
;(define proc-obj-tag (list 'proc-obj))
|
|
;
|
|
; (define (test obj)
|
|
; (if (and (proc-obj? obj) (not (proc-obj-code obj)))
|
|
; #f
|
|
; (let ((n (pos-in-list obj (queue->list objects-dumped))))
|
|
; (if n
|
|
; n
|
|
; (let ((m (length (queue->list objects-dumped))))
|
|
; (queue-put! objects-dumped obj)
|
|
; (queue-put! object-queue obj)
|
|
; m)))))
|
|
;
|
|
;
|
|
;;(define (test obj)
|
|
;; (let ((m (length (queue->list objects-dumped))))
|
|
;; (queue-put! objects-dumped obj)
|
|
;; (queue-put! object-queue obj)
|
|
;; m)
|
|
;;)
|
|
;
|
|
;(queue-put! objects-dumped 'a)
|
|
;(queue-put! objects-dumped 'b)
|
|
;(write (queue->list objects-dumped))
|
|
;(write (test 'c))
|
|
;(write (my-not (test 'd)))
|
|
;;(write (my-string<=? (symbol->string (car objects-dumped))))
|
|
|
|
(define current-fs 2)
|
|
(define pointer-size 4)
|
|
(define (add-n-to-loc68 x y)
|
|
;; TODO: these should be 4 15, NOT 0
|
|
(write `(add-n-to-loc68 ,x ,y))
|
|
(newline))
|
|
|
|
(define (adjust-current-fs n) (set! current-fs (+ current-fs n)))
|
|
(define (resize-frame n)
|
|
(write `(resize-frame ,n ,current-fs)) (newline)
|
|
(let ((x (- n current-fs)))
|
|
(adjust-current-fs x)
|
|
(add-n-to-loc68 (* (- pointer-size) x) 15)))
|
|
|
|
(write (resize-frame 1))
|