-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathPDP11SET.LSP
265 lines (218 loc) · 6.54 KB
/
PDP11SET.LSP
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
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
/*
Definition of assembly & disassembly-time behaviour of patterns
and opcodes for PDP11.
For GLAD (Generic Lisp Assembler/Disassembler).
By Antti Karttunen 1991
*/
/*
Patterns:
%S, %D General addressing mode. (any of the above)
%R Any register R0 - R7
%N Just a number itself.
%I Displacement, like byte but must be in branching range from branch.
%J SOB-displacement, like 77, but must be in branching range from SOB.
%W Sixteen bit word located after instruction. (Or after previous %W)
%Z Relative address, otherwise like %W.
*/
/* Assembly & Disassembly routines for %N & %Y:
Just pass the values intact:
*/
(def-a (%N %Y) (lambda (n) (intp n)))
(def-d (%N %Y) (lambda (n) n))
; Compute the displacement from the destination address & location counter
; at the assembly time.
; Maybe I should add branch range checking to this in future:
(def-a %I
(lambda (x)
(if (intp x)
(cond ((neq ($and x 1) 0) ; If bit-0 is on, i.e. x is odd.
(rplast '(Branch destination address must be even, not X) x)
) ; If greaterp & lessp are signed, then change and to or:
((and (greaterp (setq diff ($sar (- x (get-LC)) 1)) 127.)
(lessp diff -128.)
)
(list 'Cannot 'branch 'from (- (get-LC) 2) 'to x
'low-lim: (- (get-LC) 256.)
'up-lim: (+ (get-LC) 254.)
)
)
(($and diff 0xff)) ; Mask the upper byte off.
)
)
)
)
; Compute the destination address from LC & displacement:
(def-d %I (lambda (d) (+ (get-LC) ($shl (sxt d) 1))))
; Like above, but for SOB:
(def-a %J
(lambda (x)
(if (intp x)
(cond ((neq ($and x 1) 0) ; If bit-0 is on, i.e. x is odd.
(rplast '(SOB: destination address must be even, not X) x)
) ; This must be unsigned greaterp:
((greaterp (setq diff ($shr (- (get-LC) x) 1)) 077)
(list 'SOB: 'cannot 'branch 'from (- (get-LC) 2) 'to x
'low-lim: (- (get-LC) 0176) 'up-lim: (get-LC)
)
)
(diff)
)
)
)
)
(def-d %J (lambda (d) (- (get-LC) ($shl d 1))))
; One more word to input/output (but without any calculations):
(def-a %W (lambda (word)
(cond ((intp word) (outqueue word) t))
)
)
(def-d %W (lambda (turha) (input-word)))
; Like previous, but that word is understood as PC-relative address,
; so subtract LC from it at assembly time,
; and add LC to it at disassembly:
(def-a %Z (lambda (word)
(cond ((intp word) (outqueue (- word (get-LC))) t))
)
)
(def-d %Z (lambda (turha) (+ (get-LC) (input-word))))
; Return the corresponding numeric value 0-7 for symbols R0 - R7
; (SP & PC are also usable), or -1 if invalid register name.
(def-a %R
(lambda (reg) (if (setq reg (memqnth reg regs))
(if (greaterp reg 7) (- reg 2)
reg
)
)
)
)
; Return the corresponding symbol R0-R5, SP or PC for numeric values 0-7
(def-d %R (lambda (n) (nth n regs)))
(setq regs '(R0 R1 R2 R3 R4 R5 SP PC R6 R7))
; Define the %S & %D modes which are used by the most of instructions:
(def-a-et-d (%S %D)
(patterns
; PC-addressing modes:
(^o27 # %W) ; Immediate
(^o37 @ # %W) ; Absolute
(^o67 %Z) ; Relative
(^o77 @ %Z) ; Relative deferred
; Normal modes:
(^o0R %R) ; Register
(^o1R (%R)) ; Register deferred
(^o2R (%R)+) ; Autoincrement
(^o3R @(%R)+) ; Autoincrement deferred
(^o4R -(%R)) ; Autodecrement
(^o5R @ -(%R)) ; Autodecrement deferred
(^o6R %W(%R)) ; Index
(^o7R @ %W(%R)) ; Index deferred
)
)
; All the pattern variables which are allowed to match more than one
; elements from the datum list, MUST be included in this list:
(setq *ALLOW-PLURALS* '(%D %S))
(defun pluralp (x) (memq x *ALLOW-PLURALS*))
; Instruction set for PDP11
; branches and traps are best defined in hexadecimal,
; all others in octal.
(setq s11
'(
(^o000000 HALT)
(^o000001 WAIT)
(^o000002 RTI)
(^o000003 BPT)
(^o000004 IOT)
(^o000005 RESET)
(^o000006 RTT)
(^o000007 MFPT)
(^o0001DD JMP %D)
(^o00020R RTS %R)
(^o00023N SPL %N)
(^o000240 NOP)
(^o000241 CLC)
(^o000242 CLV)
(^o000244 CLZ)
(^o000250 CLN)
(^o000257 CCC)
(^o000260 NOP2)
(^o000261 SEC)
(^o000262 SEV)
(^o000264 SEZ)
(^o000270 SEN)
(^o000277 SCC)
(^o0003DD SWAB %D)
(^x01II BR %I)
(^x02II BNE %I)
(^x03II BEQ %I)
(^x04II BGE %I)
(^x05II BLT %I)
(^x06II BGT %I)
(^x07II BLE %I)
(^o004RDD JSR %R , %D)
(^o0050DD CLR %D)
(^o0051DD COM %D)
(^o0052DD INC %D)
(^o0053DD DEC %D)
(^o0054DD NEG %D)
(^o0055DD ADC %D)
(^o0056DD SBC %D)
(^o0057DD TST %D)
(^o0060DD ROR %D)
(^o0061DD ROL %D)
(^o0062DD ASR %D)
(^o0063DD ASL %D)
(^o0064NN MARK %N)
(^o0065SS MFPI %S)
(^o0066DD MTPI %D)
(^o0067DD SXT %D)
(^o0070DD CSM %D)
(^o01SSDD MOV %S , %D)
(^o02SSDD CMP %S , %D)
(^o03SSDD BIT %S , %D)
(^o04SSDD BIC %S , %D)
(^o05SSDD BIS %S , %D)
(^o06SSDD ADD %S , %D)
(^o070RSS MUL %S , %R)
(^o071RSS DIV %S , %R)
(^o072RSS ASH %S , %R)
(^o073RSS ASHC %S , %R)
(^o074RDD XOR %R , %D)
(^o077RJJ SOB %R , %J)
(^x80II BPL %I)
(^x81II BMI %I)
(^x82II BHI %I)
(^x83II BLOS %I)
(^x84II BVC %I)
(^x85II BVS %I)
(^x86II BCC %I)
(^x86II BHIS %I) ; Synonym for BCC
(^x87II BCS %I)
(^x87II BLO %I) ; Synonym for BCS
(^x88YY EMT %Y)
(^x89YY TRAP %Y)
(^o1050DD CLRB %D)
(^o1051DD COMB %D)
(^o1052DD INCB %D)
(^o1053DD DECB %D)
(^o1054DD NEGB %D)
(^o1055DD ADCB %D)
(^o1056DD SBCB %D)
(^o1057DD TSTB %D)
(^o1060DD RORB %D)
(^o1061DD ROLB %D)
(^o1062DD ASRB %D)
(^o1063DD ASLB %D)
(^o1064SS MTPS %S)
(^o1065SS MFPD %S)
(^o1066DD MTPD %D)
(^o1067DD MFPS %D)
(^o11SSDD MOVB %S , %D)
(^o12SSDD CMPB %S , %D)
(^o13SSDD BITB %S , %D)
(^o14SSDD BICB %S , %D)
(^o15SSDD BISB %S , %D)
(^o16SSDD SUB %S , %D)
(^xNNNN .WORD %N)
))
; Wildcard patterns which match everything which
; above patterns hasn't matched, i.e. illegal instructions:
; (setq *WC* '((^xNNNN .WORD %N)))