diff --git a/bin/ikarus b/bin/ikarus index 1a0f2d5..c8e9047 100755 Binary files a/bin/ikarus and b/bin/ikarus differ diff --git a/bin/ikarus-data.h b/bin/ikarus-data.h index 5fbd02e..93c3ce3 100644 --- a/bin/ikarus-data.h +++ b/bin/ikarus-data.h @@ -10,7 +10,7 @@ #define disp_code_code_size 4 #define disp_code_reloc_vector 8 #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_reloc_vector (disp_code_reloc_vector - code_pri_tag) diff --git a/src/ikarus.boot b/src/ikarus.boot index f93b02a..2aefbcc 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss index 85393d5..2557b92 100644 --- a/src/ikarus.compiler.ss +++ b/src/ikarus.compiler.ss @@ -1795,7 +1795,7 @@ (define disp-code-instrsize 4) (define disp-code-relocsize 8) (define disp-code-freevars 12) - (define disp-code-data 16) + (define disp-code-data 24) (define port-tag #x3F) (define output-port-tag #x7F) @@ -1828,6 +1828,10 @@ (define align-shift 3) (define dirty-word -1)) +(module () + ;;; initialize the cogen + (code-entry-adjustment (- disp-code-data vector-tag))) + (begin ;;; COGEN HELERS (define (align n) (fxsll (fxsra (fx+ n (fxsub1 object-alignment)) align-shift) align-shift)) diff --git a/src/ikarus.intel-assembler.ss b/src/ikarus.intel-assembler.ss index 17e7591..7081b05 100644 --- a/src/ikarus.intel-assembler.ss +++ b/src/ikarus.intel-assembler.ss @@ -1,7 +1,7 @@ (library (ikarus intel-assembler) - (export assemble-sources) + (export assemble-sources code-entry-adjustment) (import (ikarus) (ikarus code-objects) @@ -908,6 +908,12 @@ [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 (lambda (thunk?-label code vec) (define reloc-idx 0) @@ -957,7 +963,8 @@ (let ([loc (label-loc v)]) (let ([obj (car loc)] [disp (cadr loc)]) (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))) (set! reloc-idx (fx+ reloc-idx 3))] [(local-relative) @@ -977,7 +984,8 @@ (error 'whack-reloc "invalid relative jump obj=~s disp=~s\n" obj disp)) (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))) (set! reloc-idx (fx+ reloc-idx 3))] [else (error 'whack-reloc "invalid reloc type ~s" type)]))