conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

allocation overflow check sequence is a little tighter now.

This commit is contained in:
Abdulaziz Ghuloum 2008-06-10 23:01:22 -07:00
parent 3ee75bece0
commit 3bddca30c4
4 changed files with 48 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

55
scheme/ikarus.compiler.altcogen.ss
View File

@ -406,15 +406,15 @@
(do-bind (list t) (list x) (do-bind (list t) (list x)
(k t)))] (k t)))]
[else (error who "invalid S" x)])])) [else (error who "invalid S" x)])]))
;(define (Mem x k) (define (Mem x k)
; (struct-case x (struct-case x
; [(primcall op arg*) [(primcall op arg*)
; (if (eq? op 'mref) (if (eq? op 'mref)
; (S* arg* (S* arg*
; (lambda (arg*) (lambda (arg*)
; (make-disp (car arg*) (cadr arg*)))) (k (make-disp (car arg*) (cadr arg*)))))
; (S x k))] (S x k))]
; [else (S x k)])) [else (S x k)]))
;;; ;;;
(define (do-bind lhs* rhs* body) (define (do-bind lhs* rhs* body)
(cond (cond
@ -485,15 +485,25 @@
;;; (make-constant (- disp-symbol-record-proc symbol-ptag)))) ;;; (make-constant (- disp-symbol-record-proc symbol-ptag))))
;;; (list size))))) ;;; (list size)))))
(define (alloc-check size) (define (alloc-check size)
(E (make-shortcut (define (test size)
(make-conditional ;;; PCB ALLOC-REDLINE (if (struct-case size
[(constant i) (<= i 4096)]
[else #f])
(make-primcall '<=
(list
apr
(make-primcall 'mref
(list pcr (make-constant pcb-allocation-redline)))))
(make-primcall '>= (make-primcall '>=
(list (make-primcall 'int- (list (make-primcall 'int-
(list (list
(make-primcall 'mref (make-primcall 'mref
(list pcr (make-constant pcb-allocation-redline))) (list pcr (make-constant pcb-allocation-redline)))
apr)) apr))
size)) size))))
(E (make-shortcut
(make-conditional ;;; PCB ALLOC-REDLINE
(test size)
(make-primcall 'nop '()) (make-primcall 'nop '())
(make-primcall 'interrupt '())) (make-primcall 'interrupt '()))
(make-funcall (make-funcall
@ -666,15 +676,26 @@
(let ([t (unique-var 'tmp)]) (let ([t (unique-var 'tmp)])
(P (make-bind (list t) (list a) (P (make-bind (list t) (list a)
(make-primcall op (list t b)))))] (make-primcall op (list t b)))))]
[else
(Mem a
(lambda (a)
(Mem b
(lambda (b)
(make-asm-instr op a b)))))]))]
;(cond
; [(and (constant? a) (constant? b))
; (let ([t (unique-var 'tmp)])
; (P (make-bind (list t) (list a)
; (make-primcall op (list t b)))))]
; [(constant? a) ; [(constant? a)
; (Mem b (lambda (b) (make-asm-instr op a b)))] ; (Mem b (lambda (b) (make-asm-instr op a b)))]
; [(constant? b) ; [(constant? b)
; (Mem a (lambda (a) (make-asm-instr op a b)))] ; (Mem a (lambda (a) (make-asm-instr op a b)))]
[else ; [else
(S* rands ; (S* rands
(lambda (rands) ; (lambda (rands)
(let ([a (car rands)] [b (cadr rands)]) ; (let ([a (car rands)] [b (cadr rands)])
(make-asm-instr op a b))))]))] ; (make-asm-instr op a b))))]))]
[(shortcut body handler) [(shortcut body handler)
(make-shortcut (P body) (P handler))] (make-shortcut (P body) (P handler))]
[else (error who "invalid pred" x)])) [else (error who "invalid pred" x)]))

2
scheme/ikarus.intel-assembler.ss
View File

@ -663,7 +663,7 @@
[(and (reg? src) (reg? dst)) (CR* #x39 src dst ac)] [(and (reg? src) (reg? dst)) (CR* #x39 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x3B dst src ac)] [(and (mem? src) (reg? dst)) (CR* #x3B dst src ac)]
[(and (imm8? src) (mem? dst)) (CR* #x83 '/7 dst (IMM8 src ac))] [(and (imm8? src) (mem? dst)) (CR* #x83 '/7 dst (IMM8 src ac))]
[(and (imm32? src) (mem? dst)) (CR* #x81 '/8 dst (IMM32 src ac))] [(and (imm32? src) (mem? dst)) (CR* #x81 '/7 dst (IMM32 src ac))]
[else (die who "invalid" instr)])] [else (die who "invalid" instr)])]
[(imull src dst) [(imull src dst)
(cond (cond

2
scheme/last-revision
View File

@ -1 +1 @@
1512 1513