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.

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

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

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

@ -663,7 +663,7 @@
[(and (reg? src) (reg? dst)) (CR* #x39 src dst ac)]
[(and (mem? src) (reg? dst)) (CR* #x3B dst 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)])]
[(imull src dst)
(cond

2
scheme/last-revision
View File

@ -1 +1 @@
1512
1513