3 <INCLUDE-WHEN <COMPILING? "EXPOSE"> "EXPOSE-DEFS">
5 <INCLUDE "EXPOSE-DATA">
7 <ENTRY EXPOSE VAX-NOVICE>
9 <GDECL (KERNEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]>>
11 <GDECL (REGISTER-NAMES) <VECTOR STRING>>
13 <DEFINE EXPOSE (MSB "OPT" (OUTCHAN .OUTCHAN))
14 #DECL ((MSB) MSUBR (OUTCHAN) <SPECIAL CHANNEL>)
15 <PRINTSTRING "Exposing ">
16 <PRINTSTRING <SPNAME <2 .MSB>>>
18 <BIND ((IMSB-ATM <1 .MSB>)
22 (LABEL-TABLE <STACK <IVECTOR ,LABEL-TABLE-LENGTH ()>>))
23 <PARSE-CODE .IMSB .START .END .LABEL-TABLE>
24 <PRINT-CODE .IMSB .START .END .LABEL-TABLE>>
30 <DEFINE PARSE-CODE (IMSB START END LABEL-TABLE "AUX" (CODE <1 .IMSB>))
31 #DECL ((START END) FIX (IMSB) IMSUBR
32 (LABEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]>
33 (CODE) <<PRIMTYPE UVECTOR> [REST FIX]>)
36 <REPEAT ((I .START) NUM OP)
37 #DECL ((NUM I) FIX (OP) <OR FALSE VECTOR OPCODE-TABLE>)
38 <COND (<G=? .I .END> <RETURN>)>
40 <SET NUM <GET-BYTE .CODE .I>>
42 <SET OP <NTH ,OPCODE-TABLE <+ .NUM 1>>>
43 <COND (<NOT <TYPE? .OP OPCODE-TABLE>> <RETURN>)>>
47 <SET I <PARSE-OPERAND .CODE .I .LEN .LABEL-TABLE
49 <2 .OP>:<VECTOR [REST FIX]>>)>>>
51 <DEFINE PRINT-CODE (IMSB START END LABEL-TABLE "AUX" NUM
53 (COMMENTS <STACK <IVECTOR 10>>))
54 #DECL ((IMSB) IMSUBR (START END NUM) FIX
55 (LABEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]>)
56 <REPEAT ((I .START) FIRST OP)
57 #DECL ((I) FIX (OP) <OR FALSE OPCODE-TABLE VECTOR>)
58 <COND (<G=? .I .END> <RETURN>)>
59 <1 .COMMENTS 1> ;"reset number of comments to 'zero'"
60 <COND (<PRINT-LABEL .LABEL-TABLE .I> <PRINTSTRING ":">)>
62 <SET NUM <GET-BYTE .CODE .I>>
64 <SET OP <NTH ,OPCODE-TABLE <+ .NUM 1>>>
65 <COND (<NOT <TYPE? .OP OPCODE-TABLE>>
67 <INDENT-TO ,OP-COLUMN>
70 <INDENT-TO ,ARG-COLUMN>
74 <COND (.FIRST <SET FIRST %<>>)
75 (ELSE <PRINTSTRING ",">)>
76 <SET I <PRINT-OPERAND .IMSB .I .LEN .LABEL-TABLE
78 <2 .OP>:<VECTOR [REST FIX]>>
80 <INDENT-TO ,COMMENT-COLUMN>
82 <PRINTSTRING <3 .OP>>)>
83 <PRINT-COMMENTS .COMMENTS ,VAX-NOVICE>)
86 <INDENT-TO ,ARG-COLUMN>
90 <DEFINE PARSE-OPERAND (MCODE I ORIGINAL-LEN LABEL-TABLE START END
91 "AUX" (LEN <ANDB .ORIGINAL-LEN ,LENGTH-MASK>)
93 #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I ORIGINAL-LEN ONE REG) FIX)
94 <COND (<BRANCH? .ORIGINAL-LEN>
95 <SET NUM <SIGN-EXT <GET-N-BYTES .MCODE .I .LEN> .LEN>>
97 <ADD-LABEL .LABEL-TABLE .I .NUM .START .END>)
98 (<CASE? .ORIGINAL-LEN>
99 <SET ONE <GET-BYTE .MCODE .I>>
101 <SET VAL <+ <ANDB .ONE 63> 1>>
102 <PARSE-WORDS .MCODE .I .VAL .LABEL-TABLE .START .END>
103 <SET I <+ .I <* 2 .VAL>>>)
105 <SET ONE <GET-BYTE .MCODE .I>>
107 <SET REG <ANDB .ONE 15>>
108 <CASE ,==? <LSH .ONE -4>
111 <PARSE-OPERAND .MCODE .I .LEN .LABEL-TABLE .START .END>>)
114 <SET I <+ .I .LEN>>)>)
132 <DEFINE PRINT-OPERAND (IMSB I LEN-CODE LABEL-TABLE COMMENTS
134 (LEN <ANDB .LEN-CODE ,LENGTH-MASK>)
137 #DECL ((CODE) <<PRIMTYPE UVECTOR> [REST FIX]> (IMSB) IMSUBR
138 (I LEN-CODE ONE REG NUM VAL) FIX)
139 <COND (<BRANCH? .LEN-CODE>
140 <SET NUM <SIGN-EXT <GET-N-BYTES .CODE .I .LEN> .LEN>>
142 <COND (<NOT <PRINT-LABEL .LABEL-TABLE <+ .I .NUM>>>
144 <PRINT-HEX .NUM .LEN>)>)
146 <SET ONE <GET-BYTE .CODE .I>>
148 <SET VAL <+ <ANDB .ONE 63> 1>>
151 <PRINT-WORDS .CODE .I .VAL .LABEL-TABLE>
152 <SET I <+ .I <* 2 .VAL>>>)
154 <SET ONE <GET-BYTE .CODE .I>>
156 <SET REG <ANDB .ONE 15>>
157 <CASE ,==? <LSH .ONE -4>
159 <SET I <PRINT-OPERAND .IMSB .I .LEN .LABEL-TABLE
162 <PRINT-REGISTER .REG>
165 <PRINT-REGISTER .REG>)
168 <PRINT-REGISTER .REG>
172 <PRINT-REGISTER .REG>
176 <SET NUM <GET-N-BYTES .CODE .I .LEN>>
179 <PRINT-HEX .NUM .LEN>)
182 <PRINT-REGISTER .REG>
183 <PRINTSTRING ")+">)>)
187 <SET VAL <GET-LONG .CODE .I>>
189 <COND (<NOT <PRINT-KERNEL-LOCATION .VAL>>
194 <PRINT-REGISTER .REG>
195 <PRINTSTRING ")+">)>)
197 <SET VAL <SIGN-EXT-BYTE <GET-BYTE .CODE .I>>>
200 <COND (<N==? .REG 15>
202 <PRINT-REGISTER .REG>
205 <ADD-COMMENT .COMMENTS
206 <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
208 <SET VAL <SIGN-EXT-BYTE <GET-BYTE .CODE .I>>>
212 <COND (<N==? .REG 15>
214 <PRINT-REGISTER .REG>
217 <ADD-COMMENT .COMMENTS
218 <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
220 <SET VAL <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
223 <COND (<N==? .REG 15>
225 <PRINT-REGISTER .REG>
228 <ADD-COMMENT .COMMENTS
229 <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
231 <SET VAL <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
235 <COND (<N==? .REG 15>
237 <PRINT-REGISTER .REG>
240 <ADD-COMMENT .COMMENTS
241 <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
243 <SET VAL <GET-LONG .CODE .I>>
246 <COND (<N==? .REG 15>
248 <PRINT-REGISTER .REG>
251 <ADD-COMMENT .COMMENTS
252 <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
254 <SET VAL <GET-LONG .CODE .I>>
258 <COND (<N==? .REG 15>
260 <PRINT-REGISTER .REG>
263 <ADD-COMMENT .COMMENTS
264 <NTH .IMSB <+ </ .VAL 8> 1>>>)>)
267 <PRINT-BYTE <ANDB .ONE 63>>)>)>
270 <DEFINE PARSE-WORDS (CODE ORIGINAL-I N LABEL-TABLE START END
271 "AUX" (I .ORIGINAL-I) NUM)
272 #DECL ((CODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I N NUM) FIX)
274 <COND (<0? .N> <RETURN>)>
275 <SET NUM <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
277 <ADD-LABEL .LABEL-TABLE .ORIGINAL-I .NUM .START .END>
281 <DEFINE PRINT-WORDS (CODE ORIGINAL-I N LABEL-TABLE "AUX" (I .ORIGINAL-I)
282 NUM (OUTCHAN .OUTCHAN))
283 #DECL ((CODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I N NUM) FIX)
285 <COND (<0? .N> <RETURN>)>
287 <INDENT-TO ,OP-COLUMN>
288 <PRINTSTRING ".word">
289 <INDENT-TO ,ARG-COLUMN>
290 <SET NUM <SIGN-EXT-WORD <GET-WORD .CODE .I>>>
292 <COND (<NOT <PRINT-LABEL .LABEL-TABLE <+ .ORIGINAL-I .NUM>>>
297 <DEFINE PRINT-BYTE (NUM "AUX" (ANUM <ABS .NUM>) (STR <STACK <ISTRING 3 !\->>))
298 #DECL ((NUM) FIX (STR) STRING)
299 <2 .STR <HEX-CHAR <LSH .ANUM -4>>>
300 <3 .STR <HEX-CHAR .ANUM>>
301 <COND (<L? .NUM 0> <PRINTSTRING .STR>)
302 (ELSE <PRINTSTRING <REST .STR>>)>>
304 <DEFINE PRINT-WORD (NUM "AUX" (ANUM <ABS .NUM>) (STR <STACK <ISTRING 5 !\->>))
305 #DECL ((NUM) FIX (STR) STRING)
306 <2 .STR <HEX-CHAR <LSH .ANUM -12>>>
307 <3 .STR <HEX-CHAR <LSH .ANUM -8>>>
308 <4 .STR <HEX-CHAR <LSH .ANUM -4>>>
309 <5 .STR <HEX-CHAR .ANUM>>
310 <COND (<L? .NUM 0> <PRINTSTRING .STR>)
311 (ELSE <PRINTSTRING <REST .STR>>)>>
313 <DEFINE PRINT-TRIBYTE (NUM "AUX" (ANUM <ABS .NUM>)
314 (STR <STACK <ISTRING 7 !\->>))
315 #DECL ((NUM) FIX (STR) STRING)
316 <2 .STR <HEX-CHAR <LSH .ANUM -20>>>
317 <3 .STR <HEX-CHAR <LSH .ANUM -16>>>
318 <4 .STR <HEX-CHAR <LSH .ANUM -12>>>
319 <5 .STR <HEX-CHAR <LSH .ANUM -8>>>
320 <6 .STR <HEX-CHAR <LSH .ANUM -4>>>
321 <7 .STR <HEX-CHAR .ANUM>>
322 <COND (<L? .NUM 0> <PRINTSTRING .STR>)
323 (ELSE <PRINTSTRING <REST .STR>>)>>
325 <DEFINE PRINT-LONG (NUM "AUX" (ANUM <ABS .NUM>) (STR <ISTRING 9 !\->))
326 #DECL ((NUM) FIX (STR) STRING)
327 <2 .STR <HEX-CHAR <LSH .ANUM -28>>>
328 <3 .STR <HEX-CHAR <LSH .ANUM -24>>>
329 <4 .STR <HEX-CHAR <LSH .ANUM -20>>>
330 <5 .STR <HEX-CHAR <LSH .ANUM -16>>>
331 <6 .STR <HEX-CHAR <LSH .ANUM -12>>>
332 <7 .STR <HEX-CHAR <LSH .ANUM -8>>>
333 <8 .STR <HEX-CHAR <LSH .ANUM -4>>>
334 <9 .STR <HEX-CHAR .ANUM>>
335 <COND (<L? .NUM 0> <PRINTSTRING .STR>)
336 (ELSE <PRINTSTRING <REST .STR>>)>>
338 <DEFINE SIGN-EXT (NUM LEN)
339 <COND (<==? .LEN 1> <SIGN-EXT-BYTE .NUM>)
340 (<==? .LEN 2> <SIGN-EXT-WORD .NUM>)
342 (ELSE <ERROR BAD-LENGTH!-ERRORS .LEN SIGN-EXT>)>>
344 <DEFINE PRINT-HEX (NUM LEN)
346 (1 <PRINT-BYTE .NUM>)
347 (2 <PRINT-WORD .NUM>)
348 (3 <PRINT-TRIBYTE .NUM>)
349 (4 <PRINT-LONG .NUM>)
351 (<ERROR BAD-LENGTH!-ERRORS .LEN PRINT-HEX>)>>
353 <DEFINE GET-BYTE (MCODE I)
354 #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I) FIX)
355 <GETBITS <NTH .MCODE <+ </ .I 4> 1>>
356 <BITS 8 <* <MOD .I 4> 8>>>>
358 <DEFINE GET-WORD (MCODE I)
359 #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I) FIX)
360 <ORB <GET-BYTE .MCODE .I>
361 <LSH <GET-BYTE .MCODE <+ .I 1>> 8>>>
363 <DEFINE GET-LONG (MCODE I)
364 #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I) FIX)
365 <ORB <GET-WORD .MCODE .I>
366 <LSH <GET-WORD .MCODE <+ .I 2>> 16>>>
368 <DEFINE GET-N-BYTES (MCODE I N)
369 #DECL ((MCODE) <<PRIMTYPE UVECTOR> [REST FIX]> (I N) FIX)
370 <REPEAT ((RES 0) (LSH-AMT 0))
371 <COND (<==? .N 0> <RETURN .RES>)>
372 <SET RES <ORB .RES <LSH <GET-BYTE .MCODE .I> .LSH-AMT>>>
375 <SET LSH-AMT <+ .LSH-AMT 8>>>>
377 <DEFINE SIGN-EXT-BYTE (NUM)
378 <COND (<0? <ANDB .NUM %<LSH 1 7>>>
381 <- <ANDB .NUM %<LSH -1 <- 7 32>>> %<LSH 1 7>>)>>
383 <DEFINE SIGN-EXT-WORD (NUM)
384 <COND (<0? <ANDB .NUM %<LSH 1 15>>>
387 <- <ANDB .NUM %<LSH -1 <- 15 32>>> %<LSH 1 15>>)>>
389 <DEFINE ADD-COMMENT (COMMENTS OBJ "AUX" PLACE)
390 #DECL ((COMMENTS) <<PRIMTYPE VECTOR> FIX> (PLACE) FIX)
391 <1 .COMMENTS <SET PLACE <+ <1 .COMMENTS> 1>>>
392 <PUT .COMMENTS .PLACE .OBJ>>
394 <DEFINE PRINT-COMMENTS (COMMENTS ALREADY-ONE "AUX" (PLACE <1 .COMMENTS>)
396 #DECL ((COMMENTS) <<PRIMTYPE VECTOR> FIX> (PLACE) FIX)
399 <COND (<G? .N .PLACE> <RETURN>)>
400 <COND (.ALREADY-ONE <CRLF>)>
401 <INDENT-TO ,COMMENT-COLUMN>
403 <&1 <NTH .COMMENTS .N>>
407 ;"These numbers keep track of the last label used. TAG-COUNT counts up."
408 ;"LOOP-COUNT counts down."
412 <GDECL (TAG-COUNT LOOP-COUNT) FIX>
414 <DEFINE FIND-LABEL (LABEL-TABLE I "AUX" BKTNUM)
415 #DECL ((LABEL-TABLE) <<PRIMTYPE VECTOR> [REST LIST]> (I BKTNUM) FIX)
416 <SET BKTNUM <+ <MOD .I ,LABEL-TABLE-LENGTH> 1>>
417 <REPEAT ((BKT <NTH .LABEL-TABLE .BKTNUM>))
418 #DECL ((BKT) <LIST [REST FIX]>)
419 <COND (<EMPTY? .BKT> <RETURN %<>>)>
420 <COND (<==? .I <1 .BKT>> <RETURN <2 .BKT>>)>
421 <SET BKT <REST .BKT 2>>>>
423 <DEFINE ADD-LABEL (LABEL-TABLE:<<PRIMTYPE VECTOR> [REST LIST]>
424 I:FIX NUM:FIX START:FIX END:FIX
425 "AUX" BKTNUM BKT (SUM <+ .I .NUM>))
426 #DECL ((BKTNUM SUM) FIX (BKT) <LIST [REST FIX]>)
428 <COND (<L? .SUM .END>
429 <SET BKTNUM <+ <MOD .SUM ,LABEL-TABLE-LENGTH> 1>>
430 <SET BKT <NTH .LABEL-TABLE .BKTNUM>>
433 <PUT .LABEL-TABLE .BKTNUM
435 <SETG TAG-COUNT <+ ,TAG-COUNT 1>>
438 <COND (<==? .SUM <1 .B>> <RETURN>)>
439 <SET B <REST .B 2>>>)>)
441 <COND (<G=? .SUM .START>
442 <SET BKTNUM <+ <MOD .SUM ,LABEL-TABLE-LENGTH> 1>>
443 <SET BKT <NTH .LABEL-TABLE .BKTNUM>>
446 <PUT .LABEL-TABLE .BKTNUM
448 <SETG LOOP-COUNT <- ,LOOP-COUNT 1>>
451 <COND (<==? .SUM <1 .B>>
453 <2 .B <SETG LOOP-COUNT <- ,LOOP-COUNT 1>>>)>
455 <SET B <REST .B 2>>>)>)>>
457 <DEFINE PRINT-LABEL (LABEL-TABLE I "AUX" LAB (OUTCHAN .OUTCHAN))
458 #DECL ((LAB) <OR FIX FALSE>)
459 <SET LAB <FIND-LABEL .LABEL-TABLE .I>>
466 <PRIN1 <- .LAB>>)>)>>
468 <DEFINE FIND-END (MSBR:MSUBR "AUX"
473 <1 ,.IMSB-ATM:IMSUBR>:<PRIMTYPE UVECTOR>>>))
474 #DECL ((START) FIX (END) FIX)
478 <FUNCTION (ATM "AUX" VAL STRT)
480 <COND (<AND <TYPE? .ATM ATOM>
482 <TYPE? <SET VAL ,.ATM> MSUBR>
483 <==? <1 .VAL> .IMSB-ATM>
484 <G? <SET STRT <4 .VAL>> .START>
491 ;"Stuff to handle the horrendous opcode table. There is a slot for each"
492 ;"possible opcode byte. An entry of %<> means that the opcode is undefined."
493 ;"An entry of type OPCODE-TABLE means that the next byte must also be"
494 ;"inspected. An entry of type vector specifies an instruction in the form:"
495 ;"[short-name:string operands:vector long-name:string]."
497 <GDECL (OPCODE-TABLE) OPCODE-TABLE>
499 ;"Stuff to handle register names"
501 <DEFINE PRINT-REGISTER (REG)
502 <PRINTSTRING <NTH ,REGISTER-NAMES <+ <ANDB .REG 15> 1>>>>
504 ;"Stuff to handle references to the kernel. This is used whenever EXPOSE"
505 ;"encounters the '@#address' construct. A hash table is used. Each bucket"
506 ;"is a list of the form (loc1 name1 loc2 name2 ...)."
508 ;"PRINT-KERNEL-LOCATION is defined to return %<> if it couldn't find"
509 ;"an appropriate symbolic name."
511 <DEFINE PRINT-KERNEL-LOCATION (LOC "AUX" BKTNUM BKT MEM)
512 #DECL ((LOC BKTNUM) FIX (BKT) LIST (MEM) <OR FALSE <LIST FIX STRING>>)
513 <SET BKTNUM <+ <MOD .LOC ,KERNEL-TABLE-LENGTH> 1>>
514 <SET BKT <NTH ,KERNEL-TABLE .BKTNUM>>
515 <SET MEM <MEMQ .LOC .BKT>>
516 <COND (.MEM <PRINTSTRING <2 .MEM>>)>>