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
(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))
;; 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
+ )
\f
(define-syntax define-entries
(sc-macro-transformer
(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
+ )
\f
-(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
;; 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
;; 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))))))
\f
;; Operation tables
;;; 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
(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
;; 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)
,@(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))
(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
((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)))))
\f
(define-rule statement
(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))
(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))
(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)))
\f
(let-syntax
(define (special-primitive-invocation code)
(let* ((prefix (clear-map!))
- (invocation (invoke-interface code)))
+ (invocation (invoke-interface/shared code)))
(LAP ,@prefix
,@invocation)))
(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
(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)))))
\f
(define-rule statement
(CONTINUATION-ENTRY (? internal-label))
#|
(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)
(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))
,internal-label)
,@(simple-procedure-header (make-procedure-code-word min max)
internal-label
- entry:compiler-interrupt-procedure)))
+ 'INTERRUPT-PROCEDURE
+ code:compiler-interrupt-procedure)))
\f
;;;; Closures
(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))))
(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)))
(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))))
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))))
(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)
(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
(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
(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
-### -*- 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.
-\f
-### 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.
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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)
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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)
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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)
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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)
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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)
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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)
+\f
+///////////////////////////////////////////////////////////////////////////////
+// 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')
+\f
+ // 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)
+\f
+// Local Variables:
+// comment-start: "//"
+// asm-comment-char: ?/
+// End:
/* Compiled code interface for AArch64. */
#include "cmpint.h"
+#include "prims.h"
extern void * tospace_to_newspace (void *);
extern void * newspace_to_tospace (void *);
}
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));
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))))
}
/* br x17 */
(entry[3]) = 0xd61f0220UL;
+ return (false); /* no error */
}
\f
-#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...) */
}
#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;
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 */
#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
\f
#ifdef sonyrisc
projects / mit-scheme.git / commitdiff