-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathimacgene.lisp
156 lines (149 loc) · 6.76 KB
/
imacgene.lisp
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
;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*-
(in-package "POWERPC-INTERNALS")
;; This ensures there are two arguments
(defmacro verify-generic-arity (cr nargs temp4)
(let ((recheck (gensym)))
`((load-constant ,temp4 #.1_17 "cr.apply")
(AND ,temp4 ,temp4 ,cr)
(branch-if-zero ,temp4 ,recheck "not applying")
(NEG arg1 ,nargs "4 - argsize")
;; Pulls arg1 args and retries
(B |PullApplyArgs|)
(label ,recheck)
(illegal-operand too-few-arguments))))
;; Reads the instance itag/idata and returns mask data and mapping table data
(defmacro instance-descriptor-info (itag idata mask-data table-data
vma tag data temp temp2 temp3 temp4)
(let ((masknotfix (gensym))
(notlocative (gensym))
(instance-tag (gensym))
(non-instance-tag (gensym)))
(push
`((label ,non-instance-tag)
(comment "not an instance, flavor description comes from magic vector")
(LD ,vma PROCESSORSTATE_TRAPVECBASE (ivory))
(TagType ,itag ,temp)
(ADDI ,vma ,vma #.sys:%generic-dispatch-vector)
(ADD ,vma ,temp ,vma)
;; We know the m-m-r is active when we are called
(using-multiple-memory-reads
(,*memoized-vmdata* ,*memoized-vmtags* ,*memoized-base* ,*memoized-limit*)
(memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4
,instance-tag))
(label ,masknotfix)
(illegal-operand (flavor-search-mask-not-fixnum data-read) ,vma)
(label ,notlocative)
(illegal-operand (flavor-search-table-pointer-not-locative data-read) ,vma))
*function-epilogue*)
`((CheckAdjacentDataTypes ,itag |TypeInstance| 4 ,non-instance-tag ,temp)
(mov ,vma ,idata "Don't clobber instance if it's forwarded")
(memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp ,temp2 ,temp3 ,temp4)
(label ,instance-tag)
(mov ,vma ,data)
(memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4)
(mov ,mask-data ,data)
(CheckDataType ,tag |TypeFixnum| ,masknotfix ,temp)
(ADDI ,vma ,vma 1)
(memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4)
(mov ,table-data ,data)
(CheckDataType ,tag |TypeLocative| ,notlocative ,temp))))
(defmacro non-instance-descriptor-info (itag idata mask-data table-data
temp temp2 temp3 temp4 temp5 temp6 temp7
instance-tag non-instance-tag)
(declare (ignore idata table-data temp7 non-instance-tag))
`((comment "not an instance, flavor description comes from magic vector")
(LD ,temp5 PROCESSORSTATE_TRAPVECBASE (ivory))
(TagType ,itag ,mask-data)
(load-constant ,temp6 #.sys:%generic-dispatch-vector "Damned 8-bit literals!")
(ADD ,mask-data ,mask-data ,temp5)
(ADD ,mask-data ,mask-data ,temp6)
(memory-read ,mask-data ,temp5 ,temp6 PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4
,instance-tag)
;; (B ,instance) done by MEMORY-READ
))
;; Returns parameter ptag/pdata and method mtag/mdata
(defmacro lookup-handler (gtag gdata table mask ptag pdata mtag mdata
offset vma tag data temp2 temp3 temp4 temp5)
(let ((found (gensym))
(loop (gensym))
)
`((AND ,vma ,mask ,gdata)
(sldi ,temp2 ,vma 1)
(ADD ,offset ,vma ,temp2 "(* (logand mask data) 3)")
(TagType ,gtag ,gtag)
(label ,loop)
(ADD ,vma ,table ,offset)
(ADDI ,offset ,offset 3)
(comment "Read key")
(memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5 nil t)
(TagType ,tag ,tag)
(XORI ,temp2 ,tag |TypeNIL|)
(branch-false ,temp2 ,found)
(XOR ,temp2 ,gtag ,tag)
(branch-true ,temp2 ,loop)
(CMPL 0 0 ,gdata ,data "32-bit compare (signed/unsigned irrelevant)")
(BC 4 2 ,loop "B. if different")
(label ,found)
(comment "Read method")
(ADDI ,vma ,vma 1)
(memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5)
(mov ,mtag ,tag)
(mov ,mdata ,data)
(comment "Read parameter")
(ADDI ,vma ,vma 1)
(memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5)
(mov ,ptag ,tag)
(mov ,pdata ,data)
)))
(defmacro generic-dispatch (gtag gdata itag idata mtag mdata ptag pdata cr nargs temp2 temp3)
(let ((isnil (gensym))
(notpc (gensym)))
`((get-control-register ,cr)
(stack-read2-disp-signed iFP ,(* 2 8) ,gtag ,gdata "get generic tag and data")
(ANDI-DOT ,nargs ,cr #xFF "get number of arguments")
(stack-read2-disp-signed iFP ,(* 3 8) ,itag ,idata "get instance tag and data")
(ADDI ,nargs ,nargs -4 "done if 2 or more arguments (plus 2 extra words)")
(branch-if-less-than-zero ,nargs |VerifyGenericArity|) ;CR in ARG6, restarts instruction
(clrldi ,gdata ,gdata 32)
(clrldi ,idata ,idata 32)
(call-subroutine |LookupHandler|) ;clobbers T1-T5, T10 linkage= R0
(CheckAdjacentDataTypes ,mtag |TypeEvenPC| 2 ,notpc ,temp2)
(ANDI-DOT ,temp2 ,ptag #x3F "Strip CDR code")
(ADDI ,temp2 ,temp2 #.(- |type$K-NIL|))
(branch-if-zero ,temp2 ,isnil)
(stack-write2-disp iFP ,(* 2 8) ,ptag ,pdata)
(label ,isnil)
(convert-continuation-to-pc ,mtag ,mdata iPC ,temp2)
(B interpretInstructionForJump)
(label ,notpc)
(SCAtoVMA iSP ,temp2 ,temp3)
(illegal-operand (generic-search-table-entry-not-pc data-read) ,temp2))))
(defmacro message-dispatch (gtag gdata itag idata mtag mdata ptag pdata cr nargs temp2 temp3)
(let ((isnil (gensym))
(isntnil (gensym))
(notpc (gensym)))
`((get-control-register ,cr)
(stack-read2-disp-signed iFP ,(* 3 8) ,gtag ,gdata "get message tag and data")
(ANDI-DOT ,nargs ,cr #xFF "get number of arguments")
(stack-read2-disp-signed iFP ,(* 2 8) ,itag ,idata "get instance tag and data")
(ADDI ,nargs ,nargs -4 "done if 2 or more arguments (plus 2 extra words)")
(branch-if-less-than-zero ,nargs |VerifyGenericArity|) ;CR in ARG6, restarts instruction
(clrldi ,gdata ,gdata 32)
(clrldi ,idata ,idata 32)
(call-subroutine |LookupHandler|) ;clobbers T1-T5, T10 linkage=R0
(stack-read-disp iFP ,(* 2 8) ,idata "clobbered by |LookupHandler|")
(CheckAdjacentDataTypes ,mtag |TypeEvenPC| 2 ,notpc ,temp2)
(ANDI-DOT ,temp2 ,ptag #x3F "Strip CDR code")
(ADDI ,temp2 ,temp2 #.(- |type$K-NIL|))
(branch-if-zero ,temp2 ,isnil)
(stack-write2-disp iFP ,(* 2 8) ,ptag ,pdata)
(B ,isntnil)
(label ,isnil)
(stack-write2-disp iFP ,(* 2 8) ,gtag ,gdata "swap message/instance in the frame")
(label ,isntnil)
(stack-write-disp iFP ,(* 3 8) ,idata)
(convert-continuation-to-pc ,mtag ,mdata iPC ,temp2)
(B interpretInstructionForJump)
(label ,notpc)
(SCAtoVMA iSP ,temp2 ,temp3)
(illegal-operand (generic-search-table-entry-not-pc data-read) ,temp2))))