From 191a82e007d0c4673f12e29c055fb20731cd3167 Mon Sep 17 00:00:00 2001 From: Abdulaziz Ghuloum Date: Wed, 9 Apr 2008 07:04:02 -0400 Subject: [PATCH] Passing 685 tests in 64bit including handling of some foreign calls. --- scheme/ikarus.intel-assembler.ss | 9 ++-- scheme/last-revision | 2 +- scheme/test64.ss | 18 +++++--- src/ikarus-enter.S | 73 +++++++++++++++----------------- src/ikarus-fasl.c | 2 +- 5 files changed, 55 insertions(+), 49 deletions(-) diff --git a/scheme/ikarus.intel-assembler.ss b/scheme/ikarus.intel-assembler.ss index 787ff34..e500d91 100644 --- a/scheme/ikarus.intel-assembler.ss +++ b/scheme/ikarus.intel-assembler.ss @@ -802,10 +802,11 @@ (fx+ ac 1) (case (car x) [(byte) (fx+ ac 1)] - [(relative foreign-label local-relative) + [(relative local-relative) (fx+ ac 4)] [(label) ac] - [(word reloc-word reloc-word+ label-addr current-frame-offset) + [(word reloc-word reloc-word+ label-addr + current-frame-offset foreign-label) (+ ac wordsize)] [else (die 'compute-code-size "unknown instr" x)]))) 0 @@ -876,9 +877,9 @@ [(byte) (code-set! x idx (cdr a)) (f (cdr ls) (fx+ idx 1) reloc)] - [(relative local-relative foreign-label) + [(relative local-relative) (f (cdr ls) (fx+ idx 4) (cons (cons idx a) reloc))] - [(reloc-word reloc-word+ label-addr) + [(reloc-word reloc-word+ label-addr foreign-label) (f (cdr ls) (fx+ idx wordsize) (cons (cons idx a) reloc))] [(word) (let ([v (cdr a)]) diff --git a/scheme/last-revision b/scheme/last-revision index 45917ca..1eb0c5e 100644 --- a/scheme/last-revision +++ b/scheme/last-revision @@ -1 +1 @@ -1442 +1443 diff --git a/scheme/test64.ss b/scheme/test64.ss index c95dc06..76f6eb3 100755 --- a/scheme/test64.ss +++ b/scheme/test64.ss @@ -29,9 +29,13 @@ (define (compile-and-run x) (compile1 x) (let ([rs (system "../src/ikarus -b test64.fasl > test64.out")]) - (unless (= rs 0) (error 'run1 "died")) + (unless (= rs 0) (error 'run1 "died with status" rs)) (with-input-from-file "test64.out" - (lambda () (get-string-all (current-input-port)))))) + (lambda () + (let ([s (get-string-all (current-input-port))]) + (if (eof-object? s) + "" + s)))))) (define (compile-test-and-run expr expected) (printf "Compiling:\n") @@ -233,6 +237,9 @@ (cond [(assq x env) => (lambda (p) `(set! ,(cdr p) ,v))] [else (error 'fixup "unbound" x)])] + [(foreign-call ,str ,[arg*] ...) + (guard (string? str)) + `(foreign-call ',str ,arg* ...)] [(,[rator] ,[rand*] ...) `(,rator ,rand* ...)] [,_ (error 'fixup "invalid expression" _)])) (Expr x '())) @@ -260,7 +267,10 @@ (include "tests/tests-2.3-req.scm") (include "tests/tests-2.4-req.scm") (include "tests/tests-2.6-req.scm") - (include "tests/tests-2.8-req.scm")) + (include "tests/tests-2.8-req.scm") + (include "tests/tests-2.9-req.scm") + ) + (current-primitive-locations (lambda (x) @@ -277,8 +287,6 @@ [else (error 'current-primloc "invalid" x)]))) -;(assembler-output #t) - (test-all) (printf "Passed ~s tests\n" (length all-tests)) (printf "Happy Happy Joy Joy\n") diff --git a/src/ikarus-enter.S b/src/ikarus-enter.S index c443f56..d18f30e 100644 --- a/src/ikarus-enter.S +++ b/src/ikarus-enter.S @@ -124,47 +124,44 @@ L_multi_reentry: .align 8 ik_foreign_call: _ik_foreign_call: - movl %esp, 8(%esi) # (movl fpr (pcb-ref 'frame-pointer)) - movl %ebp, 0(%esi) # (movl apr (pcb-ref 'allocation-pointer)) - movl %esp, %ebx # (movl fpr ebx) - movl 24(%esi), %esp # (movl (pcb-ref 'system-stack) esp) + movq %rsp, 16(%rsi) # (movl fpr (pcb-ref 'frame-pointer)) + movq %rbp, 0(%rsi) # (movl apr (pcb-ref 'allocation-pointer)) + movq %rsp, %rbx # (movl fpr ebx) + movq 48(%rsi), %rsp # (movl (pcb-ref 'system-stack) esp) # %esp is the system stack, %eax is the index to the last arg, # %esi is the pcb. - # Now, the value of %esp is 16-byte aligned - # we always push %esi (4 bytes) and do a call (4 bytes), - # 0 args require 6 (2) pushes => argc= 0 (0000): %esp += -8 - # 1 args require 5 (1) pushes => argc= -4 (1100): %esp += -4 - # 2 args require 4 (0) pushes => argc= -8 (1000): %esp += 0 - # 3 args require 3 (3) pushes => argc= -12 (0100): %esp += -12 - movl %eax, %ecx - andl $15, %ecx -check_ecx: - cmpl $8, %ecx - je L_zero - cmpl $12, %ecx - je L_one - cmpl $0, %ecx - je L_two - push $0 -L_two: - push $0 -L_one: - push $0 -L_zero: - push %rsi # (pushl pcr) - cmpl $0, %eax # (cmpl (int 0) eax) - je L_set # (je (label Lset)) -L_loop: # (label Lloop) - movl (%ebx,%eax), %ecx # (movl (mem ebx eax) ecx) - push %rcx # (pushl ecx) - addl $4, %eax # (addl (int 4) eax) - cmpl $0, %eax # (cmpl (int 0) eax) - jne L_loop # (jne (label Lloop)) + + # align the system stack by subtracting 8 if it's not 16-byte aligned + movq %rsp, %r12 + andq $15, %r12 + subq %r12, %rsp + + # AMD64 says: %rbp, %rbx, %r12 .. %r15 are preserved by the callee + # %rdi, %rsi, %rdx, %rcx, %r8, %r9 are parameter regs + + movq %rdi, %r12 # put target of call in %r12 + movq %rsi, %r13 # put pcb in %r13 + + movq %rsi, %rdi # put pcb in first arg reg + cmpq $0, %rax + je L_zero_args + cmpq $-8, %rax + je L_one_arg + movq $0, %rax + movq %rax,0(%rax) +L_one_arg: + movq %rdi, %rsi + movq -8(%rbx), %rdi + jmp L_set + +L_zero_args: L_set: # (label Lset) - call *%rdi # (call cpr) - movl 8(%esi), %esp # (movl (pcb-ref 'frame-pointer) fpr) - movl 0(%esi), %ebp # (movl (pcb-ref 'allocation-pointer) apr) - ret # (ret))) + call *%r12 # (call cpr) +L_back: + movq %r13, %rsi # restore pcb from r13 + movq 16(%rsi), %rsp # get frame pointer from 16(pcb) + movq 0(%rsi), %rbp # get allocation pointer from 0(pcb) + ret # return to scheme #else diff --git a/src/ikarus-fasl.c b/src/ikarus-fasl.c index 0bf2d11..23741dd 100644 --- a/src/ikarus-fasl.c +++ b/src/ikarus-fasl.c @@ -213,7 +213,7 @@ ik_relocate_code(ikptr code){ fprintf(stderr, "failed to find foreign name %s: %s\n", name, err); exit(-1); } - ref(data,code_off) = (ikptr)(long)sym; + ref(data,code_off) = (ikptr)sym; p += (2*wordsize); } else {