From 5f120e02fe85ec65cd19e356ac9d79550fe47ffa Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Tue, 15 Jan 2019 16:29:02 +0000 Subject: [PATCH] Draft aarch64 cmpauxmd. --- src/compiler/machines/aarch64/lapgen.scm | 221 ++++++----- src/compiler/machines/aarch64/machine.scm | 48 ++- src/compiler/machines/aarch64/rules3.scm | 182 +++++---- src/compiler/machines/aarch64/rules4.scm | 14 +- src/microcode/cmpauxmd/aarch64.m4 | 452 ++++++++++++++++++++-- src/microcode/cmpintmd/aarch64.c | 20 +- src/microcode/cmpintmd/aarch64.h | 13 +- src/microcode/confshared.h | 7 +- 8 files changed, 708 insertions(+), 249 deletions(-) diff --git a/src/compiler/machines/aarch64/lapgen.scm b/src/compiler/machines/aarch64/lapgen.scm index 9dc14bf12..c831b08ee 100644 --- a/src/compiler/machines/aarch64/lapgen.scm +++ b/src/compiler/machines/aarch64/lapgen.scm @@ -61,7 +61,7 @@ USA. r25 r26 r27 - ;r28 - stack pointer + ;r28 - Scheme stack pointer, not r31 so we can use CMP for interrupt checks ;r29 - C frame pointer, callee-saved and left alone by Scheme ;r30 - link register (could maybe allocate) ;r31 - C stack pointer or zero register, depending on instruction @@ -466,6 +466,7 @@ USA. (define reg:memtop (regblock-ea register-block/memtop-offset)) (define reg:environment (regblock-ea register-block/environment-offset)) +(define reg:dynamic-link (regblock-ea register-block/dynamic-link-offset)) (define reg:lexpr-primitive-arity (regblock-ea register-block/lexpr-primitive-arity-offset)) (define reg:stack-guard (regblock-ea register-block/stack-guard-offset)) @@ -488,46 +489,51 @@ USA. ;; Must match utility_table in cmpint.c. (define-codes #x012 - primitive-apply - primitive-lexpr-apply - apply - error - lexpr-apply - link - interrupt-closure - interrupt-dlink - interrupt-procedure - interrupt-continuation - interrupt-ic-procedure - assignment-trap - cache-reference-apply - reference-trap - safe-reference-trap - unassigned?-trap - -1+ - &/ - &= - &> - 1+ - &< - &- - &* - negative? - &+ - positive? - zero? - access - lookup - safe-lookup - unassigned? - unbound? - set! - define - lookup-apply - primitive-error - quotient - remainder - modulo) + primitive-apply ;12 + primitive-lexpr-apply ;13 + apply ;14 + error ;15 + lexpr-apply ;16 + link ;17 + interrupt-closure ;18 + interrupt-dlink ;19 + interrupt-procedure ;1a + interrupt-continuation ;1b + interrupt-ic-procedure ;1c + assignment-trap ;1d + cache-reference-apply ;1e + reference-trap ;1f + safe-reference-trap ;20 + unassigned?-trap ;21 + -1+ ;22 + &/ ;23 + &= ;24 + &> ;25 + 1+ ;26 + &< ;27 + &- ;28 + &* ;29 + negative? ;2a + &+ ;2b + positive? ;2c + zero? ;2d + access ;2e (obsolete) + lookup ;2f (obsolete) + safe-lookup ;30 (obsolete) + unassigned? ;31 (obsolete) + unbound? ;32 (obsolete) + set! ;33 (obsolete) + define ;34 (obsolete) + lookup-apply ;35 (obsolete) + primitive-error ;36 + quotient ;37 + remainder ;38 + modulo ;39 + reflect-to-interface ;3a + interrupt-continuation-2 ;3b + compiled-code-bkpt ;3c + compiled-closure-bkpt ;3d + ) (define-syntax define-entries (sc-macro-transformer @@ -542,59 +548,52 @@ USA. (loop (cdr names) (+ index 1))) '())))))) -;; Must match aarch64_reset_hook in cmpintmd/aarch64.c. -(define-entries 16 - scheme-to-interface ; Main entry point (only one necessary) - interrupt-procedure - interrupt-continuation - interrupt-continuation-2 - interrupt-closure - interrupt-dlink - primitive-apply - primitive-lexpr-apply - assignment-trap - reference-trap - safe-reference-trap - link - error - primitive-error - &+ - &- - &* - &/ - &= - &< - &> - 1+ - -1+ - zero? - positive? - negative? - quotient - remainder - modulo - fixnum-shift - apply-setup - apply-setup-size-1 - apply-setup-size-2 - apply-setup-size-3 - apply-setup-size-4 - apply-setup-size-5 - apply-setup-size-6 - apply-setup-size-7 - apply-setup-size-8 - set-interrupt-enables!) +;; Must match hooks in cmpauxmd/aarch64.m4. +(define-entries 0 + scheme-to-interface ;00 Main entry point (only necessary) + &+ ;01 + &- ;02 + &* ;03 + &/ ;04 + &= ;05 + &< ;06 + &> ;07 + 1+ ;08 + -1+ ;09 + zero? ;0a + positive? ;0b + negative? ;0c + quotient ;0d + remainder ;0e + modulo ;0f + fixnum-shift ;10 + apply-setup ;11 + apply-setup-size-1 ;12 + apply-setup-size-2 ;13 + apply-setup-size-3 ;14 + apply-setup-size-4 ;15 + apply-setup-size-5 ;16 + apply-setup-size-6 ;17 + apply-setup-size-7 ;18 + apply-setup-size-8 ;19 + set-interrupt-enables! ;1a + ) -(define-integrable (invoke-hook entry) - (LAP (LDR X ,regnum:scratch-0 (+ ,regnum:regs-pointer (&U (* 8 ,entry)))) - (BR ,regnum:scratch-0))) +;; Jump to an assembly hook. No link register setup or anything. May +;; clobber r16, r17. + +(define (invoke-hook entry) + (if (zero? entry) ;scheme-to-interface + (LAP (BR ,regnum:hooks)) + (LAP (ADD X ,regnum:scratch-0 ,regnum:hooks (&U ,(* 8 entry))) + (BR ,regnum:scratch-0)))) ;; Invoke a hook that will return to the address in the link register ;; with RET. To be used for super-cheap assembly hooks that never fail ;; but are a little too large to copy in every caller. (define-integrable (invoke-hook/subroutine entry) - (LAP (LDR X ,regnum:scratch-0 (+ ,regnum:regs-pointer (&U (* 8 ,entry)))) + (LAP (ADD X ,regnum:scratch-0 ,regnum:hooks (&U ,(* 8 entry))) (BLR ,regnum:scratch-0))) ;; Invoke a hook that expects an untagged compiled return address in @@ -605,9 +604,9 @@ USA. ;; To be used for compiler utilities that are usually cheap but may ;; have error cases and may call back into C. -(define-integrable (invoke-hook/call entry label) +(define-integrable (invoke-hook/call entry continuation) (LAP ,@(invoke-hook/subroutine entry) - (B (@PCR ,label ,regnum:scratch-0)))) + (B (@PCR ,continuation ,regnum:scratch-0)))) ;; Invoke a hook that expects a compiled entry address as the first ;; utility argument, and will later jump to it with BR. It is not @@ -617,21 +616,49 @@ USA. ;; e.g., interrupts, which are assumed to be always expensive. (define-integrable (invoke-hook/reentry entry label) - (LAP (ADR X ,regnum:utility-arg0 (@PCR ,label ,regnum:scratch-0)) + (LAP (ADR X ,regnum:utility-arg1 (@PCR ,label ,regnum:scratch-0)) ,@(invoke-hook entry))) (define-integrable (invoke-interface code) (LAP (MOVZ X ,regnum:utility-index (&U ,code)) - (BR ,regnum:scheme-to-interface))) - -(define-integrable (invoke-interface/call code label) - (LAP (MOVZ X ,regnum:utility-index (&U ,code)) - (BLR ,regnum:scheme-to-interface) - (B (@PCR ,label ,regnum:scratch-0)))) + ,@(invoke-hook entry:compiler-scheme-to-interface))) + +(define (invoke-interface/shared name code) + (share-instruction-sequence! name + (lambda (label) (LAP (B (@PCR ,label ,regnum:scratch-0)))) + (lambda (label) + (LAP (LABEL ,label) + ,@(invoke-interface code))))) + +;; If this assumption is violated, then the definition below is silly +;; and should be replaced. +(assert (not (= rlr regnum:utility-arg1))) + +(define (invoke-interface/call code continuation) + (define (invoke subroutine) + (LAP (MOVZ X ,regnum:utility-index (&U ,code)) + (BL (@PCR ,subroutine ,regnum:scratch-0)) + (B (@PCR ,continuation ,regnum:scratch-0)))) + (share-instruction-sequence! 'SCHEME-TO-INTERFACE/CALL + (lambda (subroutine) (invoke subroutine)) + (lambda (subroutine) + (LAP ,@(invoke subroutine) + (LABEL ,subroutine) + ,@(register->register-transfer rlr regnum:utility-arg1) + ,@(invoke-hook entry:compiler-scheme-to-interface))))) (define-integrable (invoke-interface/reentry code label) - (LAP (ADR X ,regnum:utility-arg0 (@PCR ,label ,regnum:scratch-0)) + (LAP (ADR X ,regnum:utility-arg1 (@PCR ,label ,regnum:scratch-0)) ,@(invoke-interface code))) + +(define (invoke-interface/shared-reentry name code label) + (LAP (ADR X ,regnum:utility-arg1 (@PCR ,label ,regnum:scratch-0)) + ,@(share-instruction-sequence! name + (lambda (label) + (LAP (B (@PCR ,label ,regnum:scratch-0)))) + (lambda (label) + (LAP (LABEL ,label) + ,@(invoke-interface code)))))) ;; Operation tables diff --git a/src/compiler/machines/aarch64/machine.scm b/src/compiler/machines/aarch64/machine.scm index 0fe2c5156..a6f64fa6a 100644 --- a/src/compiler/machines/aarch64/machine.scm +++ b/src/compiler/machines/aarch64/machine.scm @@ -159,18 +159,16 @@ USA. ;;; 64-bit general purpose registers, variously named Wn or Xn in the ;;; ARM assembler depending on the operand size, 32-bit or 64-bit. ;;; We'll name the operand size separately. -;;; -;;; XXX To allocate: regnum:apply-pc, regnum:apply-target ;; register Scheme purpose C purpose (define-integrable r0 0) ;result, temporary first argument, result -(define-integrable r1 1) ;temporary, utilarg0 second argument -(define-integrable r2 2) ;temporary, utilarg1 third argument -(define-integrable r3 3) ;temporary, utilarg2 fourth argument -(define-integrable r4 4) ;temporary, utilarg3 fifth argument -(define-integrable r5 5) ;temporary, utilarg4 sixth argument -(define-integrable r6 6) ;temporary, utilarg6 seventh argument -(define-integrable r7 7) ;temporary, utilarg6 eighth argument +(define-integrable r1 1) ;temporary, utilarg1 second argument +(define-integrable r2 2) ;temporary, utilarg2 third argument +(define-integrable r3 3) ;temporary, utilarg3 fourth argument +(define-integrable r4 4) ;temporary, utilarg4 fifth argument +(define-integrable r5 5) ;temporary sixth argument +(define-integrable r6 6) ;temporary seventh argument +(define-integrable r7 7) ;temporary eighth argument (define-integrable r8 8) ;temporary indirect result location (define-integrable r9 9) ;temporary temporary (define-integrable r10 10) ;temporary temporary @@ -179,17 +177,18 @@ USA. (define-integrable r13 13) ;temporary temporary (define-integrable r14 14) ;temporary temporary (define-integrable r15 15) ;temporary temporary -(define-integrable r16 16) ;temporary, first PLT scratch register - ; indirect jump callee, +(define-integrable r16 16) ;scratch, first PLT scratch register + ; applicand (entry address) ; scheme-to-interface code -(define-integrable r17 17) ;temporary, second PLT scratch register - ; indirect jump pc +(define-integrable r17 17) ;scratch, second PLT scratch register + ; applicand PC, + ; utility index (define-integrable r18 18) ;reserved platform ABI register (define-integrable r19 19) ;interpreter regs callee-saved (define-integrable r20 20) ;free pointer callee-saved (define-integrable r21 21) ;dynamic link callee-saved (define-integrable r22 22) ;memtop (XXX why?) callee-saved -(define-integrable r23 23) ;scheme-to-interface callee-saved +(define-integrable r23 23) ;assembly hook table callee-saved (define-integrable r24 24) ;temporary callee-saved (define-integrable r25 25) ;temporary callee-saved (define-integrable r26 26) ;temporary callee-saved @@ -248,29 +247,26 @@ USA. ;; in the transition to and from C. (define-integrable regnum:value-register r0) -(define-integrable regnum:utility-arg0 r1) -(define-integrable regnum:utility-arg1 r2) -(define-integrable regnum:utility-arg2 r3) -(define-integrable regnum:utility-arg3 r4) -(define-integrable regnum:utility-arg4 r5) -(define-integrable regnum:utility-arg5 r6) -(define-integrable regnum:utility-arg6 r7) +(define-integrable regnum:utility-arg1 r1) +(define-integrable regnum:utility-arg2 r2) +(define-integrable regnum:utility-arg3 r3) +(define-integrable regnum:utility-arg4 r4) (define-integrable regnum:scratch-0 r16) (define-integrable regnum:scratch-1 r17) (define-integrable regnum:regs-pointer r19) (define-integrable regnum:free-pointer r20) (define-integrable regnum:dynamic-link r21) ;Pointer to parent stack frame. ;; (define-integrable regnum:memtop r22) -(define-integrable regnum:scheme-to-interface r23) +(define-integrable regnum:hooks r23) (define-integrable regnum:stack-pointer r27) (define-integrable regnum:c-frame-pointer r29) (define-integrable regnum:link-register rlr) ;Return address. (define-integrable regnum:c-stack-pointer rsp) -;; XXX Maybe we're playing a dangerous game to use the scratch registers for -;; these. -(define-integrable regnum:apply-target regnum:scratch-0) -(define-integrable regnum:apply-pc regnum:scratch-1) +;; XXX Maybe we're playing a dangerous game to use one of the scratch +;; registers for these. +(define-integrable regnum:applicand regnum:utility-arg1) +(define-integrable regnum:applicand-pc regnum:scratch-1) (define-integrable regnum:utility-index regnum:scratch-1) (define-integrable (machine-register-known-value register) diff --git a/src/compiler/machines/aarch64/rules3.scm b/src/compiler/machines/aarch64/rules3.scm index b040e2a58..ec7fbb4a8 100644 --- a/src/compiler/machines/aarch64/rules3.scm +++ b/src/compiler/machines/aarch64/rules3.scm @@ -56,7 +56,7 @@ USA. ,@(interrupt-check '(HEAP) interrupt-label) ,@(pop-return) (LABEL ,interrupt-label) - ,@(invoke-hook entry:compiler-interrupt-continuation-2)))))) + ,@(invoke-interface code:compiler-interrupt-continuation-2)))))) (define-rule statement (INVOCATION:APPLY (? frame-size) (? continuation)) @@ -64,9 +64,9 @@ USA. (let* ((prefix (clear-map!)) (setup (apply-setup frame-size))) (LAP ,@prefix - ,@(pop regnum:apply-target) + ,@(pop regnum:applicand) ,@setup - (BR ,regnum:apply-pc)))) + (BR ,regnum:applicand-pc)))) (define (apply-setup frame-size) (case frame-size @@ -79,7 +79,7 @@ USA. ((7) (invoke-hook/subroutine entry:compiler-apply-setup-size-7)) ((8) (invoke-hook/subroutine entry:compiler-apply-setup-size-8)) (else - (LAP ,@(load-unsigned-immediate regnum:utility-arg0 frame-size) + (LAP ,@(load-unsigned-immediate regnum:utility-arg1 frame-size) ,@(invoke-hook/subroutine entry:compiler-apply-setup))))) (define-rule statement @@ -102,27 +102,29 @@ USA. (expect-no-exit-interrupt-checks) ;; Tagged entry is on top of stack. (LAP ,@(clear-map!) - ,@(pop regnum:apply-target) - ,@(object->address regnum:apply-target regnum:apply-target) - ,@(entry->pc regnum:apply-pc regnum:apply-target) - (BR ,regnum:apply-pc))) + ,@(pop regnum:applicand) + ,@(object->address regnum:applicand regnum:applicand) + ,@(entry->pc regnum:applicand-pc regnum:applicand) + (BR ,regnum:applicand-pc))) (define-rule statement (INVOCATION:LEXPR (? number-pushed) (? continuation) (? label)) continuation (LAP ,@(clear-map!) - ,@(load-pc-relative-address regnum:utility-arg0 label) - ,@(load-unsigned-immediate regnum:utility-arg1 number-pushed) - ,@(invoke-interface code:compiler-lexpr-apply))) + ,@(load-pc-relative-address regnum:utility-arg1 label) + ,@(load-unsigned-immediate regnum:utility-arg2 number-pushed) + ,@(invoke-interface/shared 'COMPILER-LEXPR-APPLY + code:compiler-lexpr-apply))) (define-rule statement (INVOCATION:COMPUTED-LEXPR (? number-pushed) (? continuation)) continuation (LAP ,@(clear-map!) - ,@(pop regnum:utility-arg0) - ,@(object->address regnum:utility-arg0 regnum:utility-arg0) - ,@(load-unsigned-immediate regnum:utility-arg1 number-pushed) - ,@(invoke-interface code:compiler-lexpr-apply))) + ,@(pop regnum:utility-arg1) + ,@(object->address regnum:utility-arg1 regnum:utility-arg1) + ,@(load-unsigned-immediate regnum:utility-arg2 number-pushed) + ,@(invoke-interface/shared 'COMPILER-LEXPR-APPLY + code:compiler-lexpr-apply))) (define-rule statement (INVOCATION:UUO-LINK (? frame-size) (? continuation) (? name)) @@ -166,17 +168,18 @@ USA. (define (generate/compiled-error frame-size) (let* ((prefix (clear-map!)) - (arg0 (load-unsigned-immediate regnum:utility-arg0 frame-size)) - (invocation (invoke-hook entry:compiler-error))) + (arg1 (load-unsigned-immediate regnum:utility-arg1 frame-size)) + (invocation + (invoke-interface/shared 'COMPILER-ERROR code:compiler-error))) (LAP ,@prefix - ,@arg0 + ,@arg1 ,@invocation))) (define (generate/generic-primitive frame-size primitive) (let* ((prefix (clear-map!)) - (arg0 (load-constant regnum:utility-arg0 primitive))) + (arg1 (load-constant regnum:utility-arg1 primitive))) (LAP ,@prefix - ,@arg0 + ,@arg1 ,@(let ((arity (primitive-procedure-arity primitive))) (cond ((not (negative? arity)) (generate/primitive-apply)) @@ -186,20 +189,24 @@ USA. (generate/generic-apply frame-size))))))) (define (generate/primitive-apply) - (invoke-hook entry:compiler-primitive-apply)) + (invoke-interface/shared 'COMPILER-PRIMITIVE-APPLY + code:compiler-primitive-apply)) (define (generate/primitive-lexpr-apply frame-size) (let* ((load-nargs (load-unsigned-immediate regnum:scratch-0 (- frame-size 1))) - (invocation (invoke-hook entry:compiler-primitive-lexpr-apply))) + (invocation + (invoke-interface/shared 'COMPILER-PRIMITIVE-LEXPR-APPLY + code:compiler-primitive-lexpr-apply))) (LAP ,@load-nargs (STR X ,regnum:scratch-0 ,reg:lexpr-primitive-arity) ,@invocation))) (define (generate/generic-apply frame-size) - (let* ((arg1 (load-unsigned-immediate regnum:utility-arg1 frame-size)) - (invocation (invoke-interface code:compiler-apply))) - (LAP ,@arg1 + (let* ((arg2 (load-unsigned-immediate regnum:utility-arg2 frame-size)) + (invocation + (invoke-interface/shared 'COMPILER-APPLY code:compiler-apply))) + (LAP ,@arg2 ,@invocation))) (let-syntax @@ -240,7 +247,7 @@ USA. (define (special-primitive-invocation code) (let* ((prefix (clear-map!)) - (invocation (invoke-interface code))) + (invocation (invoke-interface/shared code))) (LAP ,@prefix ,@invocation))) @@ -417,7 +424,7 @@ USA. (B. LT (@PCR ,label ,regnum:scratch-0))) (LAP)))) -(define (simple-procedure-header code-word label entry) +(define (generate-procedure-header code-word label generate-interrupt-stub) (let ((checks (get-entry-interrupt-checks)) (interrupt-label (generate-label 'INTERRUPT))) ;; Put the interrupt check branch target after the branch so that @@ -428,9 +435,40 @@ USA. (add-end-of-block-code! (lambda () (LAP (LABEL ,interrupt-label) - ,@(invoke-hook/reentry entry label))))) + ,@(generate-interrupt-stub))))) (LAP ,@(make-external-label code-word label) ,@(interrupt-check checks interrupt-label)))) + +(define (simple-procedure-header code-word label name code) + (generate-procedure-header + code-word + label + (lambda () + (invoke-interface/shared-reentry name code label)))) + +(define (dlink-procedure-header code-word label) + (generate-procedure-header + code-word + label + (lambda () + ;; Save the dynamic link to an interpreter register, and then ask + ;; for help from the microcode. + ;; + ;; XXX The goal of sharing here is to reduce code size; it would + ;; be nice if we could ask the assembler to not share if we're so + ;; far away from the label that we require an indirect branch. + (LAP (ADR X ,regnum:utility-arg1 (@PCR ,label ,regnum:scratch-0)) + ,@(interrupt-procedure-dlink))))) + +(define (interrupt-procedure-dlink) + ;; Caller must arrange to load the entry into arg1. + (share-instruction-sequence! 'INTERRUPT-PROCEDURE-DLINK + (lambda (subroutine) + (LAP (B (@PCR ,subroutine ,regnum:scratch-0)))) + (lambda (subroutine) + (LAP (LABEL ,subroutine) + (STR X ,regnum:dynamic-link ,reg:dynamic-link) + ,@(invoke-interface code:compiler-interrupt-dlink))))) (define-rule statement (CONTINUATION-ENTRY (? internal-label)) @@ -443,7 +481,8 @@ USA. #| (simple-procedure-header (continuation-code-word internal-label) internal-label - entry:compiler-interrupt-continuation) + 'INTERRUPT-CONTINUATION + code:compiler-interrupt-continuation) |# (expect-no-entry-interrupt-checks) (make-external-label (continuation-code-word internal-label) @@ -456,13 +495,15 @@ USA. (define-rule statement (OPEN-PROCEDURE-HEADER (? internal-label)) - (let ((rtl-proc (label->object internal-label))) + (let* ((rtl-proc (label->object internal-label)) + (code-word (internal-procedure-code-word rtl-proc))) (LAP (EQUATE ,(rtl-procedure/external-label rtl-proc) ,internal-label) - ,@(simple-procedure-header (internal-procedure-code-word rtl-proc) - internal-label - (if (rtl-procedure/dynamic-link? rtl-proc) - entry:compiler-interrupt-dlink - entry:compiler-interrupt-procedure))))) + ,@(if (rtl-procedure/dynamic-link? rtl-proc) + (dlink-procedure-header code-word internal-label) + (simple-procedure-header code-word + internal-label + 'INTERRUPT-PROCEDURE + code:compiler-interrupt-procedure))))) (define-rule statement (PROCEDURE-HEADER (? internal-label) (? min) (? max)) @@ -470,7 +511,8 @@ USA. ,internal-label) ,@(simple-procedure-header (make-procedure-code-word min max) internal-label - entry:compiler-interrupt-procedure))) + 'INTERRUPT-PROCEDURE + code:compiler-interrupt-procedure))) ;;;; Closures @@ -483,17 +525,18 @@ USA. (type type-code:compiled-entry)) (define (label+adjustment) (LAP ,@(make-external-label internal-entry-code-word external-label) - ;; regnum:apply-target holds the untagged entry address. + ;; regnum:applicand holds the untagged entry address. ;; Push and tag it. - ,@(affix-type regnum:apply-target type regnum:apply-target) - ,@(push regnum:apply-target) + ,@(affix-type regnum:applicand type regnum:applicand) + ,@(push regnum:applicand) (LABEL ,internal-label))) (cond ((zero? nentries) (LAP (EQUATE ,external-label ,internal-label) ,@(simple-procedure-header (internal-procedure-code-word rtl-proc) internal-label - entry:compiler-interrupt-procedure))) + 'INTERRUPT-PROCEDURE + code:compiler-interrupt-procedure))) ((pair? checks) (LAP ,@(label+adjustment) ,@(interrupt-check checks (closure-interrupt-label)))) @@ -501,12 +544,15 @@ USA. (label+adjustment))))) (define (closure-interrupt-label) + ;; XXX Would be nice if we could ask the assembler to duplicate this + ;; whenever we're getting far enough that the conditional branch + ;; target requires branch tensioning. (or (block-association 'INTERRUPT-CLOSURE) (let ((label (generate-label 'INTERRUPT-CLOSURE))) (add-end-of-block-code! (lambda () (LAP (LABEL ,label) - ,@(invoke-hook entry:compiler-interrupt-closure)))) + ,@(invoke-interface code:compiler-interrupt-closure)))) (block-associate! 'INTERRUPT-CLOSURE label) label))) @@ -649,10 +695,10 @@ USA. (LAP (LDR X ,r0 ,reg:environment) (ADR X ,r1 (@PCR ,environment-label ,regnum:scratch-0)) (STR X ,r0 ,r1) - (ADR X ,regnum:utility-arg1 (@PCR ,*block-label* ,regnum:scratch-0)) - (ADR X ,regnum:utility-arg2 (@PCR ,free-ref-label ,regnum:scratch-0)) - ,@(load-unsigned-immediate regnum:utility-arg3 n-sections) - ,@(invoke-hook/call entry:compiler-link continuation-label) + (ADR X ,regnum:utility-arg2 (@PCR ,*block-label* ,regnum:scratch-0)) + (ADR X ,regnum:utility-arg3 (@PCR ,free-ref-label ,regnum:scratch-0)) + ,@(load-unsigned-immediate regnum:utility-arg4 n-sections) + ,@(invoke-interface/call code:compiler-link continuation-label) ,@(make-external-label (continuation-code-word #f) continuation-label)))) @@ -661,21 +707,21 @@ USA. free-ref-offset n-sections) (let ((continuation-label (generate-label 'LINKED)) - ;; arg0 will be the return address. - (arg1 regnum:utility-arg1) + ;; arg1 will be the return address. (arg2 regnum:utility-arg2) (arg3 regnum:utility-arg3) + (arg4 regnum:utility-arg4) (temp r1)) (LAP (LDR X ,temp ,reg:environment) - ;; arg1 := block address - ,@(load-pc-relative arg1 code-block-label) - ,@(object->address arg1 arg1) + ;; arg2 := block address + ,@(load-pc-relative arg2 code-block-label) + ,@(object->address arg2 arg2) ;; Set this block's environment. - (STR X ,temp (+ ,arg1 (&U (* 8 ,environment-offset)))) - ;; arg2 := constants address - ,@(add-immediate arg2 arg1 free-ref-offset) - ;; arg3 := n sections - ,@(load-unsigned-immediate arg3 n-sections) + (STR X ,temp (+ ,arg2 (&U (* 8 ,environment-offset)))) + ;; arg3 := constants address + ,@(add-immediate arg3 arg2 free-ref-offset) + ;; arg4 := n sections + ,@(load-unsigned-immediate arg4 n-sections) ,@(invoke-interface/call code:compiler-link continuation-label) ,@(make-external-label (continuation-code-word #f) continuation-label)))) @@ -690,27 +736,27 @@ USA. (counter r24) ;unallocated, callee-saves (temp1 r1) ;unallocated (temp2 r2) ;unallocated - ;; arg0 will be return address. - (arg1 regnum:utility-arg1) + ;; arg1 will be return address. (arg2 regnum:utility-arg2) - (arg3 regnum:utility-arg3)) + (arg3 regnum:utility-arg3) + (arg4 regnum:utility-arg4)) (LAP ,@(load-unsigned-immediate counter n-blocks) (LABEL ,loop-label) - ,@(load-pc-relative arg1 vector-label) ;arg1 := vector - ,@(object->address arg1 arg1) ;arg1 := vector addr - (LDR X ,arg1 (+ ,arg1 (LSL ,counter 3))) ;arg1 := vector[ctr-1] - ,@(object->address arg1 arg1) ;arg1 := block addr + ,@(load-pc-relative arg2 vector-label) ;arg2 := vector + ,@(object->address arg2 arg2) ;arg2 := vector addr + (LDR X ,arg2 (+ ,arg2 (LSL ,counter 3))) ;arg2 := vector[ctr-1] + ,@(object->address arg2 arg2) ;arg2 := block addr (LDR X ,temp1 ,reg:environment) ;temp1 := environment - (LDR X ,temp2 ,arg1) ;temp2 := manifest + (LDR X ,temp2 ,arg2) ;temp2 := manifest ,@(object->datum temp2 temp2) ;temp2 := block length - (STR X ,temp1 (+ ,arg1 (LSL ,temp2 3))) ;set block environment - (LDR X ,temp1 (+ ,arg1 (&U (* 8 1)))) ;temp1 := manifest-nmv + (STR X ,temp1 (+ ,arg2 (LSL ,temp2 3))) ;set block environment + (LDR X ,temp1 (+ ,arg2 (&U (* 8 1)))) ;temp1 := manifest-nmv ,@(object->datum temp1 temp1) ;temp1 := unmarked size (ADD X ,temp1 ,temp1 (&U #x10)) ;temp1 := consts offset - (ADD X ,arg2 ,arg1 ,temp1) ;temp1 := consts addr + (ADD X ,arg3 ,arg2 ,temp1) ;temp1 := consts addr (SUB X ,counter ,counter (&U 1)) ;ctr := ctr - 1 - (ADR X ,arg3 (@PCR ,nsects ,regnum:scratch-0)) ;arg3 := nsects - (LDR B ,arg3 (+ ,arg3 ,counter)) ;arg3 := nsects[ctr] + (ADR X ,arg4 (@PCR ,nsects ,regnum:scratch-0)) ;arg4 := nsects + (LDR B ,arg4 (+ ,arg4 ,counter)) ;arg4 := nsects[ctr] ,@(invoke-interface/call code:compiler-link continuation-label) ,@(make-external-label (continuation-code-word #f) continuation-label) diff --git a/src/compiler/machines/aarch64/rules4.scm b/src/compiler/machines/aarch64/rules4.scm index 78673e708..986ac3870 100644 --- a/src/compiler/machines/aarch64/rules4.scm +++ b/src/compiler/machines/aarch64/rules4.scm @@ -36,8 +36,8 @@ USA. (REGISTER (? extension)) (? safe?)) ;; arg0 will be the return address. - (require-register! regnum:utility-arg1) - (let* ((set-extension (load-machine-register! extension regnum:utility-arg1)) + (require-register! regnum:utility-arg2) + (let* ((set-extension (load-machine-register! extension regnum:utility-arg2)) (prefix (clear-map!))) (LAP ,@set-extension ,@prefix @@ -52,10 +52,10 @@ USA. (REGISTER (? extension)) (REGISTER (? value))) ;; arg0 will be the return address. - (require-register! regnum:utility-arg1) (require-register! regnum:utility-arg2) - (let* ((set-extension (load-machine-register! extension regnum:utility-arg1)) - (set-value (load-machine-register! value regnum:utility-arg1)) + (require-register! regnum:utility-arg3) + (let* ((set-extension (load-machine-register! extension regnum:utility-arg2)) + (set-value (load-machine-register! value regnum:utility-arg2)) (prefix (clear-map!))) (LAP ,@set-extension ,@set-value @@ -66,8 +66,8 @@ USA. (INTERPRETER-CALL:CACHE-UNASSIGNED? (? continuation) (REGISTER (? extension))) ;; arg0 will be the return address. - (require-register! regnum:utility-arg1) - (let* ((set-extension (load-machine-register! extension regnum:utility-arg1)) + (require-register! regnum:utility-arg2) + (let* ((set-extension (load-machine-register! extension regnum:utility-arg2)) (prefix (clear-map!))) (LAP ,@set-extension ,@prefix diff --git a/src/microcode/cmpauxmd/aarch64.m4 b/src/microcode/cmpauxmd/aarch64.m4 index 6df47d63f..8ffc59132 100644 --- a/src/microcode/cmpauxmd/aarch64.m4 +++ b/src/microcode/cmpauxmd/aarch64.m4 @@ -1,29 +1,423 @@ -### -*- Asm -*- -### -### Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, -### 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -### 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, -### 2014, 2015, 2016, 2017, 2018, 2019 Massachusetts Institute of -### Technology -### -### This file is part of MIT/GNU Scheme. -### -### MIT/GNU Scheme is free software; you can redistribute it and/or -### modify it under the terms of the GNU General Public License as -### published by the Free Software Foundation; either version 2 of the -### License, or (at your option) any later version. -### -### MIT/GNU Scheme is distributed in the hope that it will be useful, -### but WITHOUT ANY WARRANTY; without even the implied warranty of -### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -### General Public License for more details. -### -### You should have received a copy of the GNU General Public License -### along with MIT/GNU Scheme; if not, write to the Free Software -### Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA -### 02110-1301, USA. - -### Local Variables: -### comment-start: "#" -### asm-comment-char: ?# -### End: +// -*- Asm -*- +// +// Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, +// 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +// 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, +// 2014, 2015, 2016, 2017, 2018, 2019 Massachusetts Institute of +// Technology +// +// This file is part of MIT/GNU Scheme. +// +// MIT/GNU Scheme is free software; you can redistribute it and/or +// modify it under the terms of the GNU General Public License as +// published by the Free Software Foundation; either version 2 of the +// License, or (at your option) any later version. +// +// MIT/GNU Scheme is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +// General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with MIT/GNU Scheme; if not, write to the Free Software +// Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA +// 02110-1301, USA. + +/////////////////////////////////////////////////////////////////////////////// +// Scheme compiled code support for AArch64 +/////////////////////////////////////////////////////////////////////////////// + +ifdef(`SUPPRESS_LEADING_UNDERSCORE', + `define(SYMBOL,`$1')', + `define(SYMBOL,`_$1')') + + // Symbol definitions. + // + // XXX Use .def/.endef or .func/.endfunc? +define(GLOBAL,` .globl $1 +SYMBOL($1):') +define(LOCAL,` +SYMBOL($1):') +define(END,` .size SYMBOL($1),.-SYMBOL($1)') + + // gas has this for arm32 but not for aarch64, no idea why. +define(ADRL,` + adrp $1, :pg_hi21:$2 + add $1, $1, #:lo12:$2') + + // For some reason these are not automatically defined in gas? + ip0 .req x16 + ip1 .req x17 + fp .req x29 + lr .req x30 + + // Scheme machine registers. Must agree with + // aarch64/machine.scm, aarch64/lapgen.scm. + UARG1 .req x1 + UARG2 .req x2 + UARG3 .req x3 + UARG4 .req x4 + UINDEX .req x17 + APPLICAND .req x1 + APPLICAND_PC .req x17 + REGS .req x19 + FREE .req x20 + DYNLINK .req x21 + HOOKS .req x22 + SSP .req x28// Note: Scheme and C use separate stacks! + + // Interpreter register block offsets. Must agree with + // const.h. + .equiv REGBLOCK_VAL, 2 + .equiv REGBLOCK_DYNLINK, 4 // REGBLOCK_CC_TEMP + +/////////////////////////////////////////////////////////////////////////////// +// Entering Scheme from C +/////////////////////////////////////////////////////////////////////////////// + + // long C_to_interface (insn_t * addr@x0, insn_t * pc@x1) + // + // From C, call the compiled Scheme code with the + // specified entry address and PC. addr is an untagged + // compiled-entry address; pc is the pointer to actual + // instructions. + // + // Steps: + // + // 1. Save the return address, frame pointer, and + // callee-saves registers. + // 2. Set up the Scheme registers. + // 3. Jump. + // +GLOBAL(C_to_interface) + // Push frame and save frame pointer and return address. + stp fp, lr, [sp,#-96]! + + // Set our own frame pointer for fun. + mov fp, sp + + // Save callee-saves registers. + stp x19, x20, [sp,#16] + stp x21, x22, [sp,#32] + stp x23, x24, [sp,#48] + stp x25, x26, [sp,#64] + stp x27, x28, [sp,#80] + + // Set up Scheme registers. + ADRL(REGS,Registers) // address of register block + ADRL(FREE,Free) // address of Free pointer + ldr FREE, [FREE] // load current Free pointer + ADRL(HOOKS,hooks) // address of hook table + ADRL(SSP,stack_pointer) // address of stack pointer + ldr SSP, [SSP] // load current stack pointer + + // Jump! + mov APPLICAND_PC, x1 + mov APPLICAND, x0 + br APPLICAND_PC +END(C_to_interface) + +/////////////////////////////////////////////////////////////////////////////// +// Returning to C from Scheme +/////////////////////////////////////////////////////////////////////////////// + + // void interface_to_C (long code@x0) + // + // When a utility returns and it needs to fall back to the + // interpreter, it directs scheme_to_interface_return to + // jump here to return to C, making control come flying + // back out of the last C_to_interface. + // + // Steps: + // + // 1. Tear down the Scheme registers. + // 2. Restore the return address, frame pointer, and + // callee-saves registers. + // 3. Return. + // +GLOBAL(interface_to_C) + // Tear down the Scheme registers. + ADRL(x1,Free) // address of Free pointer + str FREE, [x1] // store current Free pointer + ADRL(x1,stack_pointer) // address of stack pointer + str SSP, [x1] // store current stack pointer + + // Restore callee-saves registers. + ldp x19, x20, [sp,#16] + ldp x21, x22, [sp,#32] + ldp x23, x24, [sp,#48] + ldp x25, x26, [sp,#64] + ldp x27, x28, [sp,#80] + + // Restore frame pointer and return address and pop frame. + ldp fp, lr, [sp],#96 + + // And we're done. + ret +END(interface_to_C) + +/////////////////////////////////////////////////////////////////////////////// +// Entering a C subroutine from Scheme +/////////////////////////////////////////////////////////////////////////////// + + // scheme_to_interface + // + // Compiled Scheme code needs help from the microcode. + // Possible return value or dynamic link is in x0; + // arguments are in x1,x2,x3,x4,x5,x6,x7; utility index + // is in ip1 = x17. + // + // Steps: + // + // 1. Save value, Free, and stack_pointer. + // => No need to save REGS because it's callee-saves. + // 2. Allocate a struct on the stack for return values in x0. + // 3. Call the function in utility_table. + // 4. Go to wherever the microcode directed us. + // +GLOBAL(scheme_to_interface) + // Save value, Free, and stack_pointer. + str x0, [REGS,#REGBLOCK_VAL] + ADRL(x8,Free) // address of Free pointer + str FREE, [x8] // store current Free pointer + ADRL(x8,stack_pointer) // address of stack pointer + str SSP, [x8] // store current stack pointer + + // Allocate a struct on the stack for return values in x0. Keep + // the stack 32-byte aligned just in case. + sub sp, sp, #32 + mov x0, sp + + // Call the function in utility_table. + ADRL(x8,utility_table) // address of utility table + ldr x8, [x8,UINDEX,lsl #3] // load utility function pointer + blr x8 // call + +scheme_to_interface_return: + // Pop the utility_result_t contents: + // ip1 := interface_dispatch (x17) + // x0 := interpreter code / compiled applicand + // x1 := interpreter garbage / compiled applicand PC + ldp ip1, x0, [sp] + ldr x1, [sp],#32 + + // Jump to interface_dispatch. + br ip1 +END(scheme_to_interface) + +/////////////////////////////////////////////////////////////////////////////// +// Returning from a C subroutine back into Scheme +/////////////////////////////////////////////////////////////////////////////// + + // void interface_to_scheme (insn_t * entry@x0, insn_t * pc@x1) + // + // When a utility wants to return control to Scheme at an + // entry, it directs scheme_to_interface_return to jump + // here, with x0 set to the entry address (such as a + // pointer to a compiled closure) and x1 set to the entry + // PC (the actual instructions to execute). + // +GLOBAL(interface_to_scheme) + // Set up the transition. + bl SYMBOL(interface_to_scheme_setup) + + // Jump to Scheme. + br APPLICAND_PC +END(interface_to_scheme) + + // void interface_to_scheme_return (insn_t * entry@x0, insn_t * pc@x1) + // + // When a utility wants to return to a Scheme return + // address, it directs scheme_to_interface_return to + // return here. We then RET to the specified pc. This + // ensures that if the utility was called via + // branch-and-link, we will use RET to return so that + // calls and returns are paired, which enables the CPU's + // return address branch target predictor to work. + // +GLOBAL(interface_to_scheme_return) + // Set up the transition. + bl SYMBOL(interface_to_scheme_setup) + + // Return to Scheme. + mov lr, APPLICAND_PC + ret +END(interface_to_scheme_return) + + // insn_t * + // interface_to_scheme_setup (insn_t * entry@x0, insn_t * pc@x1) + // + // Set up a transition to compiled Scheme code after a + // utility return, whether we are jumping to a Scheme + // entry or returning to a Scheme return address. + // + // - Sets x0 to be the preserved return value, if any. + // - Sets x1 (APPLICAND) to be the entry address. + // - Sets x17 (APPLICAND_PC) to be the entry PC. + // - Uses x8 as a temporary. + // - Sets up x20 (FREE) and x28 (Scheme SP). + // + // This is NOT a normal APCS2 subroutine. Meant to be + // used only from interface_to_scheme or + // interface_to_scheme_return. + // +LOCAL(interface_to_scheme_setup) + // Move the arguments to the destinations expected by the + // caller and future callee. + mov APPLICAND_PC, x1 // x17 := x1 + mov APPLICAND, x0 // x1 := x0 + + // Restore value, Free, and stack_pointer. + ldr x0, [REGS,#REGBLOCK_VAL] + ADRL(x8,Free) // address of Free pointer + ldr FREE, [x8] // load current Free pointer + ADRL(x8,stack_pointer) // address of stack pointer + ldr SSP, [x8] // load current stack pointer + + // Done setting up. Return to caller. + ret +END(interface_to_scheme_setup) + +/////////////////////////////////////////////////////////////////////////////// +// Scheme unknown procedure application setup +/////////////////////////////////////////////////////////////////////////////// + + // apply_setup(applicand@x1, frame_size@x2) + // + // If applicand is a compiled entry of exactly the correct + // arity, load its PC into APPLICAND_PC=x17. Otherwise, + // load apply_setup_fail into APPLICAND_PC=x17 to defer to + // microcode. Then return to link register. Caller is + // expected to jump to APPLICAND_PC=x17. + // + // Not yet implemented fully. + // +LOCAL(apply_setup) + ADRL(APPLICAND_PC,apply_setup_fail) + ret +END(apply_setup) + + // apply_setup_fail(applicand@x1, frame_size@x2) + // + // Enter the microcode to apply applicand. Note that the + // arguments are already in the correct places for a + // utility. + // +LOCAL(apply_setup_fail) + mov UINDEX, #0x14 // comutil_apply + b SYMBOL(scheme_to_interface) +END(apply_setup) + +/////////////////////////////////////////////////////////////////////////////// +// Scheme miscellaneous primitive subroutine hooks +/////////////////////////////////////////////////////////////////////////////// + + // fixnum_shift + // + // Compute a left shift, handling all possible signs of + // both inputs. Not yet implemented. + // +LOCAL(fixnum_shift) + hlt #0 +END(fixnum_shift) + + // set_interrupt_enables + // + // Set the interrupt mask, and adjust stack_guard and + // memtop accordingly. Not yet implemented. +LOCAL(set_interrupt_enables) + hlt #0 +END(set_interrupt_enables) + +/////////////////////////////////////////////////////////////////////////////// +// The hook table +/////////////////////////////////////////////////////////////////////////////// + + // JUMP_HOOK(name, target) + // + // Hook that just jumps to target, no questions asked. + // +define(JUMP_HOOK, ` +$1: + b SYMBOL($2) + nop + nop + nop') + + // UTILITY_HOOK(name, number) + // + // Hook that jumps to the utility with the specified + // number. Reduces caller code size. The number must + // match utility_table in cmpint.c. + // +define(UTILITY_HOOK, ` +$1: + mov UINDEX, #$2 + b SYMBOL(scheme_to_interface) + nop + nop') + + // APPLY_HOOK(name, label, n) + // + // Application setup hook, to be implemented at label. + // Currently not implemented, so just loads n into x1 and + // defers to apply_setup. + // +define(APPLY_HOOK, ` +$1: + mov x1, #$3 + b SYMBOL(apply_setup) + nop + nop') + + // hooks + // + // Table of hooks for support routines used by compiled + // Scheme code. The first one, scheme_to_interface, is + // needed to call the C utilities. The remainder are + // mainly to reduce compiled code size while avoiding + // unnecessary costly calls to C. + // + // Each entry must be exactly four instructions long, + // which is enough to load a far PC-relative address (up + // to two instructions) and branch to it (one more) and + // another instruction just for good measure in case we + // find a reason to need one. + // + // The order must match DEFINE-ENTRIES in + // aarch64/lapgen.scm. + // +LOCAL(hooks) + JUMP_HOOK(hook_scheme_to_interface, scheme_to_interface) // 00 + UTILITY_HOOK(hook_generic_add, 0x2b) // 01 + UTILITY_HOOK(hook_generic_sub, 0x28) // 02 + UTILITY_HOOK(hook_generic_mul, 0x29) // 03 + UTILITY_HOOK(hook_generic_div, 0x23) // 04 + UTILITY_HOOK(hook_generic_eq, 0x24) // 05 + UTILITY_HOOK(hook_generic_lt, 0x27) // 06 + UTILITY_HOOK(hook_generic_gt, 0x25) // 07 + UTILITY_HOOK(hook_generic_add1, 0x26) // 08 + UTILITY_HOOK(hook_generic_sub1, 0x22) // 09 + UTILITY_HOOK(hook_generic_zero_p, 0x2d) // 0a + UTILITY_HOOK(hook_generic_positive_p, 0x2c) // 0b + UTILITY_HOOK(hook_generic_negative_p, 0x2a) // 0c + UTILITY_HOOK(hook_generic_quotient, 0x37) // 0d + UTILITY_HOOK(hook_generic_remainder, 0x38) // 0e + UTILITY_HOOK(hook_generic_modulo, 0x39) // 0f + JUMP_HOOK(hook_fixnum_shift, fixnum_shift) // 10 + JUMP_HOOK(hook_apply_setup, apply_setup) // 11 + APPLY_HOOK(hook_apply_setup_1, apply_setup_1, 1) // 12 + APPLY_HOOK(hook_apply_setup_2, apply_setup_2, 2) // 13 + APPLY_HOOK(hook_apply_setup_3, apply_setup_3, 3) // 14 + APPLY_HOOK(hook_apply_setup_4, apply_setup_4, 4) // 15 + APPLY_HOOK(hook_apply_setup_5, apply_setup_5, 5) // 16 + APPLY_HOOK(hook_apply_setup_6, apply_setup_6, 6) // 17 + APPLY_HOOK(hook_apply_setup_7, apply_setup_7, 7) // 18 + APPLY_HOOK(hook_apply_setup_8, apply_setup_8, 8) // 19 + JUMP_HOOK(hook_set_interrupt_enables, set_interrupt_enables) // 1a +END(hooks) + +// Local Variables: +// comment-start: "//" +// asm-comment-char: ?/ +// End: diff --git a/src/microcode/cmpintmd/aarch64.c b/src/microcode/cmpintmd/aarch64.c index 5619c53b4..1896ada36 100644 --- a/src/microcode/cmpintmd/aarch64.c +++ b/src/microcode/cmpintmd/aarch64.c @@ -27,6 +27,7 @@ USA. /* Compiled code interface for AArch64. */ #include "cmpint.h" +#include "prims.h" extern void * tospace_to_newspace (void *); extern void * newspace_to_tospace (void *); @@ -207,7 +208,7 @@ read_uuo_target_no_reloc (SCHEME_OBJECT * saddr) } static void -write_uuo_insns (const insn_t * target, insn_t * iaddr, int pcrel) +write_uuo_insns (insn_t * target, insn_t * iaddr, int pcrel) { /* ldr x0, pc-pcrel */ (iaddr[0]) = (0x58000000UL | ((((unsigned) pcrel) & 0x7ffff) << 5)); @@ -226,9 +227,9 @@ write_uuo_insns (const insn_t * target, insn_t * iaddr, int pcrel) unsigned immhi19 = ((((unsigned) offset) >> 2) & 0x1ffff); assert (offset == ((ptrdiff_t) ((immhi19 << 2) | immlo2))); /* adr x1, target */ - (addr[1]) = (0x10000001UL | (immlo2 << 29) | (immhi19 << 5)); + (iaddr[1]) = (0x10000001UL | (immlo2 << 29) | (immhi19 << 5)); /* br x1 */ - (addr[2]) = 0xd61f0020UL; + (iaddr[2]) = 0xd61f0020UL; } else if (((- (INT64_C (0x200000000))) <= offset) && (offset <= (INT64_C (0x1ffffffff)))) @@ -317,22 +318,11 @@ store_trampoline_insns (insn_t * entry, uint8_t code) } /* br x17 */ (entry[3]) = 0xd61f0220UL; + return (false); /* no error */ } -#define SETUP_REGISTER(hook) do \ -{ \ - Registers[offset++] = ((unsigned long) hook); \ - declare_builtin (((unsigned long) hook), #hook); -} while (0) - void aarch64_reset_hook (void) { - unsigned offset = COMPILER_REGBLOCK_N_FIXED; - - /* Must agree with compiler/machines/aarch64/lapgen.scm. */ - SETUP_REGISTER (asm_scheme_to_interface); /* 0 */ - ... - /* XXX Make sure we're mapped write and execute. (Such is the state...) */ } diff --git a/src/microcode/cmpintmd/aarch64.h b/src/microcode/cmpintmd/aarch64.h index bf1046890..32f694f8d 100644 --- a/src/microcode/cmpintmd/aarch64.h +++ b/src/microcode/cmpintmd/aarch64.h @@ -153,14 +153,12 @@ void aarch64_reset_hook (void); #define CMPINT_USE_STRUCS 1 -/* Must agree with cmpauxmd/aarch64.s. */ -#define COMPILER_REGBLOCK_N_FIXED ... +/* Must agree with cmpauxmd/aarch64.m4 and aarch64/machine.scm. */ +#define COMPILER_REGBLOCK_N_FIXED 16 /* XXX why? */ #define COMPILER_TEMP_SIZE 1 /* size in objects of largest RTL registers */ #define COMPILER_REGBLOCK_N_TEMPS 256 -#define COMPILER_REGBLOCK_N_HOOKS ... -#define COMPILER_HOOK_SIZE 1 - -#define COMPILER_REGBLOCK_EXTRA_SIZE ... +#define COMPILER_REGBLOCK_N_HOOKS 0 /* we'll use a machine register instead */ +#define COMPILER_HOOK_SIZE (-1) /* All aarch64 instructions are 32-bit-aligned. */ typedef uint32_t insn_t; @@ -240,4 +238,7 @@ insn_t * read_compiled_closure_target (insn_t *, reloc_ref_t *); insn_t * read_uuo_target (SCHEME_OBJECT *); +/* C stack is completely separate. */ +#define within_c_stack(fn, cookie) (fn)(cookie) + #endif /* SCM_CMPINTMD_H_INCLUDED */ diff --git a/src/microcode/confshared.h b/src/microcode/confshared.h index a40bc4378..7deadf32d 100644 --- a/src/microcode/confshared.h +++ b/src/microcode/confshared.h @@ -609,8 +609,13 @@ extern void win32_stack_reset (void); #ifdef __aarch64__ # define MACHINE_TYPE "aarch64" -# define CURRENT_FASL_ARCH FASL_AARCH64 +# ifdef WORDS_BIGENDIAN +# define CURRENT_FASL_ARCH FASL_AARCH64BE +# else +# define CURRENT_FASL_ARCH FASL_AARCH64LE +# endif # define HEAP_IN_LOW_MEMORY 1 +# define PC_ZERO_BITS 2 #endif #ifdef sonyrisc -- 2.25.1