* disp-code-data changed from 16 to 24 in order to allow for future
code annotations.
This commit is contained in:
parent
a291ed8ffb
commit
50dcf3a11f
BIN
bin/ikarus
BIN
bin/ikarus
Binary file not shown.
|
@ -10,7 +10,7 @@
|
||||||
#define disp_code_code_size 4
|
#define disp_code_code_size 4
|
||||||
#define disp_code_reloc_vector 8
|
#define disp_code_reloc_vector 8
|
||||||
#define disp_code_freevars 12
|
#define disp_code_freevars 12
|
||||||
#define disp_code_data 16
|
#define disp_code_data 24
|
||||||
#define off_code_data (disp_code_data - code_pri_tag)
|
#define off_code_data (disp_code_data - code_pri_tag)
|
||||||
#define off_code_reloc_vector (disp_code_reloc_vector - code_pri_tag)
|
#define off_code_reloc_vector (disp_code_reloc_vector - code_pri_tag)
|
||||||
|
|
||||||
|
|
BIN
src/ikarus.boot
BIN
src/ikarus.boot
Binary file not shown.
|
@ -1795,7 +1795,7 @@
|
||||||
(define disp-code-instrsize 4)
|
(define disp-code-instrsize 4)
|
||||||
(define disp-code-relocsize 8)
|
(define disp-code-relocsize 8)
|
||||||
(define disp-code-freevars 12)
|
(define disp-code-freevars 12)
|
||||||
(define disp-code-data 16)
|
(define disp-code-data 24)
|
||||||
|
|
||||||
(define port-tag #x3F)
|
(define port-tag #x3F)
|
||||||
(define output-port-tag #x7F)
|
(define output-port-tag #x7F)
|
||||||
|
@ -1828,6 +1828,10 @@
|
||||||
(define align-shift 3)
|
(define align-shift 3)
|
||||||
(define dirty-word -1))
|
(define dirty-word -1))
|
||||||
|
|
||||||
|
(module ()
|
||||||
|
;;; initialize the cogen
|
||||||
|
(code-entry-adjustment (- disp-code-data vector-tag)))
|
||||||
|
|
||||||
(begin ;;; COGEN HELERS
|
(begin ;;; COGEN HELERS
|
||||||
(define (align n)
|
(define (align n)
|
||||||
(fxsll (fxsra (fx+ n (fxsub1 object-alignment)) align-shift) align-shift))
|
(fxsll (fxsra (fx+ n (fxsub1 object-alignment)) align-shift) align-shift))
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
|
|
||||||
|
|
||||||
(library (ikarus intel-assembler)
|
(library (ikarus intel-assembler)
|
||||||
(export assemble-sources)
|
(export assemble-sources code-entry-adjustment)
|
||||||
(import
|
(import
|
||||||
(ikarus)
|
(ikarus)
|
||||||
(ikarus code-objects)
|
(ikarus code-objects)
|
||||||
|
@ -908,6 +908,12 @@
|
||||||
[else (f (cdr ls))])))))
|
[else (f (cdr ls))])))))
|
||||||
|
|
||||||
|
|
||||||
|
(define code-entry-adjustment
|
||||||
|
(let ([v #f])
|
||||||
|
(case-lambda
|
||||||
|
[() (or v (error 'code-entry-adjustment "uninitialized"))]
|
||||||
|
[(x) (set! v x)])))
|
||||||
|
|
||||||
(define whack-reloc
|
(define whack-reloc
|
||||||
(lambda (thunk?-label code vec)
|
(lambda (thunk?-label code vec)
|
||||||
(define reloc-idx 0)
|
(define reloc-idx 0)
|
||||||
|
@ -957,7 +963,8 @@
|
||||||
(let ([loc (label-loc v)])
|
(let ([loc (label-loc v)])
|
||||||
(let ([obj (car loc)] [disp (cadr loc)])
|
(let ([obj (car loc)] [disp (cadr loc)])
|
||||||
(vector-set! vec reloc-idx (fxlogor 2 (fxsll idx 2)))
|
(vector-set! vec reloc-idx (fxlogor 2 (fxsll idx 2)))
|
||||||
(vector-set! vec (fx+ reloc-idx 1) (fx+ disp 11))
|
(vector-set! vec (fx+ reloc-idx 1)
|
||||||
|
(fx+ disp (code-entry-adjustment)))
|
||||||
(vector-set! vec (fx+ reloc-idx 2) obj)))
|
(vector-set! vec (fx+ reloc-idx 2) obj)))
|
||||||
(set! reloc-idx (fx+ reloc-idx 3))]
|
(set! reloc-idx (fx+ reloc-idx 3))]
|
||||||
[(local-relative)
|
[(local-relative)
|
||||||
|
@ -977,7 +984,8 @@
|
||||||
(error 'whack-reloc "invalid relative jump obj=~s disp=~s\n"
|
(error 'whack-reloc "invalid relative jump obj=~s disp=~s\n"
|
||||||
obj disp))
|
obj disp))
|
||||||
(vector-set! vec reloc-idx (fxlogor 3 (fxsll idx 2)))
|
(vector-set! vec reloc-idx (fxlogor 3 (fxsll idx 2)))
|
||||||
(vector-set! vec (fx+ reloc-idx 1) (fx+ disp 11))
|
(vector-set! vec (fx+ reloc-idx 1)
|
||||||
|
(fx+ disp (code-entry-adjustment)))
|
||||||
(vector-set! vec (fx+ reloc-idx 2) obj)))
|
(vector-set! vec (fx+ reloc-idx 2) obj)))
|
||||||
(set! reloc-idx (fx+ reloc-idx 3))]
|
(set! reloc-idx (fx+ reloc-idx 3))]
|
||||||
[else (error 'whack-reloc "invalid reloc type ~s" type)]))
|
[else (error 'whack-reloc "invalid reloc type ~s" type)]))
|
||||||
|
|
Loading…
Reference in New Issue