|
|
1
|
+;;; -*- Package: ARM64 -*-
|
|
|
2
|
+;;;
|
|
|
3
|
+;;; **********************************************************************
|
|
|
4
|
+;;; This code was written as part of the CMU Common Lisp project at
|
|
|
5
|
+;;; Carnegie Mellon University, and has been placed in the public domain.
|
|
|
6
|
+;;;
|
|
|
7
|
+(ext:file-comment
|
|
|
8
|
+ "$Header: src/assembly/arm64/support.lisp $")
|
|
|
9
|
+;;;
|
|
|
10
|
+;;; **********************************************************************
|
|
|
11
|
+;;;
|
|
|
12
|
+(in-package "ARM64")
|
|
|
13
|
+
|
|
|
14
|
+(def-vm-support-routine generate-call-sequence (name style vop)
|
|
|
15
|
+ (ecase style
|
|
|
16
|
+ (:raw
|
|
|
17
|
+ #+(or)
|
|
|
18
|
+ (let ((temp (make-symbol "TEMP")))
|
|
|
19
|
+ (values
|
|
|
20
|
+ `((inst ldr ,temp (make-fixup ',name :assembly-routine))
|
|
|
21
|
+ (inst blr ,temp))
|
|
|
22
|
+ `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1))
|
|
|
23
|
+ ,temp))))
|
|
|
24
|
+ `((emit-not-implemented)))
|
|
|
25
|
+ (:full-call
|
|
|
26
|
+ #+(or)
|
|
|
27
|
+ (let ((temp (make-symbol "TEMP"))
|
|
|
28
|
+ (nfp-save (make-symbol "NFP-SAVE"))
|
|
|
29
|
+ (lra (make-symbol "LRA")))
|
|
|
30
|
+ (values
|
|
|
31
|
+ `((let ((lra-label (gen-label))
|
|
|
32
|
+ (cur-nfp (current-nfp-tn ,vop)))
|
|
|
33
|
+ (when cur-nfp
|
|
|
34
|
+ (store-stack-tn ,nfp-save cur-nfp))
|
|
|
35
|
+ (inst compute-lra-from-code ,lra code-tn lra-label ,temp)
|
|
|
36
|
+ (note-next-instruction ,vop :call-site)
|
|
|
37
|
+ (inst ldr ,temp (make-fixup ',name :assembly-routine))
|
|
|
38
|
+ (inst br ,temp)
|
|
|
39
|
+ (emit-return-pc lra-label)
|
|
|
40
|
+ (note-this-location ,vop :single-value-return)
|
|
|
41
|
+ (without-scheduling ()
|
|
|
42
|
+ (move csp-tn ocfp-tn)
|
|
|
43
|
+ (inst nop))
|
|
|
44
|
+ (inst compute-code-from-lra code-tn code-tn
|
|
|
45
|
+ lra-label ,temp)
|
|
|
46
|
+ (when cur-nfp
|
|
|
47
|
+ (load-stack-tn cur-nfp ,nfp-save))))
|
|
|
48
|
+ `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1))
|
|
|
49
|
+ ,temp)
|
|
|
50
|
+ (:temporary (:sc descriptor-reg :offset lra-offset
|
|
|
51
|
+ :from (:eval 0) :to (:eval 1))
|
|
|
52
|
+ ,lra)
|
|
|
53
|
+ (:temporary (:scs (control-stack) :offset nfp-save-offset)
|
|
|
54
|
+ ,nfp-save)
|
|
|
55
|
+ (:save-p :compute-only))))
|
|
|
56
|
+ `((emit-not-implemented)))
|
|
|
57
|
+ (:none
|
|
|
58
|
+ #+(or)
|
|
|
59
|
+ (let ((temp (make-symbol "TEMP")))
|
|
|
60
|
+ (values
|
|
|
61
|
+ `((inst ldr ,temp (make-fixup ',name :assembly-routine))
|
|
|
62
|
+ (inst br ,temp))
|
|
|
63
|
+ `((:temporary (:scs (non-descriptor-reg) :from (:eval 0) :to (:eval 1))
|
|
|
64
|
+ ,temp))))
|
|
|
65
|
+ `((emit-not-implemented)))))
|
|
|
66
|
+
|
|
|
67
|
+(def-vm-support-routine generate-return-sequence (style)
|
|
|
68
|
+ (ecase style
|
|
|
69
|
+ (:raw
|
|
|
70
|
+ #+(or)
|
|
|
71
|
+ `((inst br lr-tn))
|
|
|
72
|
+ `((emit-not-implemented)))
|
|
|
73
|
+ (:full-call
|
|
|
74
|
+ #+(or)
|
|
|
75
|
+ `((lisp-return (make-random-tn :kind :normal
|
|
|
76
|
+ :sc (sc-or-lose 'descriptor-reg *backend*)
|
|
|
77
|
+ :offset lra-offset)
|
|
|
78
|
+ (make-random-tn :kind :normal
|
|
|
79
|
+ :sc (sc-or-lose 'interior-reg *backend*)
|
|
|
80
|
+ :offset lip-offset)
|
|
|
81
|
+ :offset 2))
|
|
|
82
|
+ `((emit-not-implemented)))
|
|
|
83
|
+ (:none))) |