-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathifunbind.ppcs
169 lines (158 loc) · 6.42 KB
/
ifunbind.ppcs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*-
;(include-header "aihead.s")
;(include-header "aistat.s")
;(include-header "ifunhead.s")
(comment "Binding Instructions.")
;;+++ Figure out if we can use WITH-MULTIPLE-MEMORY-READS
(define-instruction |DoBindLocativeToValue| :operand-from-stack-signed-immediate ()
(stack-pop2 arg5 arg6 "ltag/ldata")
(LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory))
(srdi arg2 arg1 32 "new tag")
(LD arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory))
(clrldi arg1 arg1 32 "new data")
(CheckDataType arg5 |TypeLocative| bindloctovaliop t1)
(passthru "#ifdef MINIMA")
(srdi t2 arg3 32)
(passthru "#endif")
(clrldi arg3 arg3 32)
(clrldi arg4 arg4 32)
(SUBF t1 arg4 arg3)
(branch-if-greater-than-or-equal-to-zero t1 bindloctovalov "J. if binding stack overflow")
(ADDI t3 arg3 1)
(passthru "#ifdef MINIMA")
(comment "BSP not a locative -> Deep-bound")
(CheckDataType t2 |TypeLocative| bindloctovaldeep t1)
(passthru "#endif")
(get-control-register t9)
(mov t8 arg6)
(memory-read t8 t2 t1 PROCESSORSTATE_BINDREAD t4 t5 t6 t7 nil t)
;; set the ls cdcode bit for ltag ifcleanupbindings
(srdi t10 t9 #.(- 25 6))
(TagType arg5 t8)
(ANDI-DOT t10 t10 #x40 "Extract the CR.cleanup-bindings bit")
(OR t11 t10 t8)
(memory-write t3 t11 arg6 PROCESSORSTATE_RAW t4 t5 t6 t7 t8)
(ADDI t3 arg3 2)
(memory-write t3 t2 t1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8)
(load-constant t1 #.1_25 "cr.cleanup-bindings")
(store-contents arg6 arg2 arg1 PROCESSORSTATE_BINDWRITE t4 t5 t6 t7 t8 t10)
(OR t9 t1 t9 "Set cr.cleanup-bindings bit")
(set-control-register t9)
(STW t3 PROCESSORSTATE_BINDINGSTACKPOINTER+4 (ivory) "vma only")
(ContinueToNextInstruction)
(label bindloctovalov)
(illegal-operand binding-stack-overflow)
(label bindloctovaliop) ;+++ exception if spare pointer type
(illegal-operand bind-locative-type-error)
(label bindloctovaldeep)
(LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2")
(SCAtoVMA t1 t2 t3)
(illegal-operand shallow-binding-operation-in-deep-binding-mode t2))
;;+++ Figure out if we can use WITH-MULTIPLE-MEMORY-READS
(define-instruction |DoBindLocative| :operand-from-stack ()
(LD arg1 0 (arg1) "Get the operand")
(LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory))
(srdi arg5 arg1 32 "tag")
(LD arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory))
(clrldi arg6 arg1 32 "data")
(CheckDataType arg5 |TypeLocative| bindlociop t1)
(passthru "#ifdef MINIMA")
(srdi t2 arg3 32)
(passthru "#endif")
(clrldi arg3 arg3 32)
(clrldi arg4 arg4 32)
(SUBF t1 arg4 arg3)
(branch-if-greater-than-or-equal-to-zero t1 bindlocov "J. if binding stack overflow")
(ADDI t3 arg3 1)
(passthru "#ifdef MINIMA")
(comment "BSP not a locative -> Deep-bound")
(CheckDataType t2 |TypeLocative| bindlocdeep t1)
(passthru "#endif")
(get-control-register t9)
(mov t8 arg6)
(memory-read t8 t2 t1 PROCESSORSTATE_BINDREAD t4 t5 t6 t7 nil t)
;; set the ls cdcode bit for ltag ifcleanupbindings
(srdi t10 t9 #.(- 25 6))
(TagType arg5 t8)
(ANDI-DOT t10 t10 #x40 "Extract the CR.cleanup-bindings bit")
(OR t11 t10 t8)
(memory-write t3 t11 arg6 PROCESSORSTATE_RAW t4 t5 t6 t7 t8)
(ADDI t3 arg3 2)
(memory-write t3 t2 t1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8)
(load-constant t1 #.1_25 "cr.cleanup-bindings")
(OR t9 t1 t9 "Set cr.cleanup-bindings bit")
(set-control-register t9)
(STW t3 PROCESSORSTATE_BINDINGSTACKPOINTER+4 (ivory) "vma only")
(ContinueToNextInstruction)
(label bindlocov)
(illegal-operand binding-stack-overflow)
(label bindlociop)
(illegal-operand bind-locative-type-error)
(label bindlocdeep)
(LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2")
(SCAtoVMA t1 t2 t3)
(illegal-operand shallow-binding-operation-in-deep-binding-mode t2))
;(align16k)
(define-instruction |DoUnbindN| :operand-from-stack-immediate ()
(passthru "#ifdef MINIMA")
(LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory))
(passthru "#endif")
(srdi arg2 arg1 32)
(clrldi arg1 arg1 32)
(CheckDataType arg2 |TypeFixnum| unbindniop t1)
(passthru "#ifdef MINIMA")
(comment "BSP not a locative -> Deep-bound")
(srdi t2 arg3 32)
(CheckDataType t2 |TypeLocative| unbindndeep t1)
(passthru "#endif")
(with-multiple-memory-reads (t9 t10 t11 t12)
(B unbindnendloop)
(label unbindntoploop)
(ADDI arg1 arg1 -1)
(unbind t1 t2 t3 t4 t5 t6 t7 t8 arg3 arg4 arg5 arg6)
(label unbindnendloop)
(branch-if-greater-than-zero arg1 unbindntoploop)
;; After we've unbound everything, check for a preempt request
(check-preempt-request NextInstruction t3 t4 t)
(ContinueToNextInstruction))
(label unbindniop)
(illegal-operand one-operand-fixnum-type-error)
(passthru "#ifdef MINIMA")
(label unbindndeep)
(LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2")
(SCAtoVMA t1 t2 t3)
(illegal-operand shallow-binding-operation-in-deep-binding-mode t2)
(passthru "#endif"))
(define-instruction |DoRestoreBindingStack| :operand-from-stack-immediate ()
(passthru "#ifdef MINIMA")
(LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory))
(passthru "#endif")
(srdi arg2 arg1 32 "arg2=tag")
(clrldi arg1 arg1 32 "arg1=data")
(CheckDataType arg2 |TypeLocative| restorebsiop t1)
(passthru "#ifdef MINIMA")
(comment "BSP not a locative -> Deep-bound")
(srdi t2 arg3 32)
(CheckDataType t2 |TypeLocative| restorebsdeep t1)
(passthru "#endif")
(LD t1 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory))
(with-multiple-memory-reads (t9 t10 t11 t12)
(B restorebsendloop)
(label restorebstoploop)
;; Leaves T1 as the new binding stack pointer
(unbind t1 t2 t3 t4 t5 t6 t7 t8 arg3 arg4 arg5 arg6)
(label restorebsendloop)
(CMPL 0 0 t1 arg1 "32-bit unsigned compare")
(BC 12 1 restorebstoploop "B. if greater than zero")
;; After we've unbound everything, check for a preempt request
(check-preempt-request NextInstruction t3 t4 t)
(ContinueToNextInstruction))
(label restorebsiop)
(illegal-operand operand-locative-type-error)
(passthru "#ifdef MINIMA")
(label restorebsdeep)
(LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2")
(SCAtoVMA t1 t2 t3)
(illegal-operand operand-locative-type-error t2)
(passthru "#endif"))
(comment "Fin.")