1 %;
  2 /* ******************************************************
  3    *                                                    *
  4    *                                                    *
  5    * Copyright (c) 1972 by Massachusetts Institute of   *
  6    * Technology and Honeywell Information Systems, Inc. *
  7    *                                                    *
  8    *                                                    *
  9    ****************************************************** */
 10 
 11 dissassemble:       disassemble:        procedure ( data_ptr, ret_string, instr_word_num );
 12 
 13 
 14 
 15 /*        This procedure is called to produce a character string, symbolic
 16 *         representation of an instruction word (an instruction in object form).
 17 *
 18 *         Rewritten on  Nov 9, 1972  for the  6180  by  Bill Silver.
 19 */
 20 
 21 
 22 
 23 dcl       data_ptr      ptr,            /* The input pointer to the object instruction
 24                                         *  word to be  dissassembled. */
 25 
 26           ret_string    char (72) var,  /* The return string which will contain the
 27                                         *  instruction in symbolic form.  */
 28 
 29           instr_word_num      fixed bin;          /* The number of the instruction word to be
 30                                                   *  processed.
 31                                                   *  0 => process word 1 - do not return anything
 32                                                   *  1 => process word 1 - return the number of
 33                                                   *       words in this instrruction in instr_word_num
 34                                                   *  2-4 => process one of the descriptors.
 35                                                   *       The data_ptr must still point to the
 36                                                   *       instruction word.  */
 37 
 38 
 39 dcl       real_ilc fixed bin(18);       /* The program offset of the instruction */
 40                                         /* when it is being taken from the break map */
 41 
 42 
 43 dcl  1 op_mnemonic_$op_mnemonic(0:1023) ext static aligned,
 44           2 opcode            char(6) unal,
 45           2 dtype             fixed bin(2) unal,
 46           2 num_desc          fixed bin(5) unal,
 47           2 num_words         fixed bin(8) unal;
 48 
 49 dcl       opcode        fixed bin,      /* A numeric representation of the opcode.  */
 50 
 51           offset        fixed bin(17);  /* The value of the instruction offset. */
 52 
 53 dcl       note_offset fixed bin(17);    /* result of ic modification. */
 54 
 55 dcl       mnemonic      char (6),       /* Op code name. */
 56 
 57           sym_pr        char (4),       /* Symbolic pointer register field. */
 58 
 59           sym_tag       char (4),       /* Symbolic tag field. */
 60 
 61           note          char (24);      /* Special message returned with instruction. */
 62 
 63 
 64 dcl       string_len    fixed bin;                /* A dummy return variable  -  length of
 65                                                   *  string returned by  ioa_$rsnnl.  */
 66 
 67 dcl       word          fixed bin (35)  based;    /* Used to reference 1 word of data. */
 68 
 69 dcl       ic_word       fixed bin (35);           /* Word referenced by computed address
 70                                                   *  of an instruction that has  "ic"
 71                                                   *  modification.  */
 72 
 73 
 74 dcl       out_of_bounds       condition;
 75 
 76 dcl       ioa_$rsnnl          entry     options(variable);
 77 
 78 
 79 dcl       ( addrel, fixed, rel, substr )          builtin;
 80 /*^L*/
 81 % include db_inst;
 82 /*^L*/
 83 % include db_data_map;
 84 /*^L*/
 85           real_ilc = fixed(rel(data_ptr), 18);
 86 
 87 join:
 88           ilc_ptr  =  data_ptr;         /* Copy argument pointer to instruction. */
 89 
 90           note  =  " ";                 /* We don't usually have to return a note. */
 91 
 92 
 93           opcode  =  fixed(ilc_ptr -> instr.opcode);        /* Get numeric value of op code. */
 94 
 95           mnemonic  =  op_mnemonic_$op_mnemonic(opcode).opcode;       /* Get op code opcode. */
 96 
 97 
 98 /*        Find out which instruction word we must test.  If the word to be tested is greater
 99 *         thane the number of words in the instruction then there is an error.  If it is
100 *         OK then we will transfer to the routine which will process this particular word
101 *         of the instruction.
102 */
103 
104           if        op_mnemonic_$op_mnemonic(opcode).num_words < instr_word_num
105 
106                     then  do;
107                     ret_string  =  "Error in call to disassemble - word number too big.";
108                     return;
109                     end;
110 
111           goto      instruction_word ( instr_word_num );
112 
113 
114 
115 
116 instruction_word(0):                              /* This is the first word of the instruction. */
117 instruction_word(1):
118 
119 
120 /*        Look for multi-word instruction.  */
121 
122           if        op_mnemonic_$op_mnemonic(opcode).num_words  >  1
123 
124                     then  do;                               /* This is a multi-word instr. */
125                     call      multi_word_instr;
126                     return;
127                     end;
128 
129 
130 /*        Now get the  pr  name if there is one.  Note, the presence of the  pr  field
131 *         will imply that there is a small offset field.
132 */
133           if        ilc_ptr -> instr.pr_bit
134 
135                     then  do;
136                     sym_pr  =  substr( db_data$names( fixed( ilc_ptr->instr_pr.pr ) ), 1,3)  ||  "|";
137                     offset  =  ilc_ptr -> instr_pr.offset;
138                     end;
139 
140                     else  do;
141                     sym_pr  =  " ";
142                     offset  =  ilc_ptr -> instr.offset;
143                     end;
144 
145 
146 
147 /*        Now get the tag field.  Note, some instructions use their tag fields in non
148 *         standard ways.   Also special processing is required for the  "ic"  modifier.
149 */
150 
151           if        op_mnemonic_$op_mnemonic(opcode).num_desc  =  0
152 
153                     then  do;                               /* Standard tag field. */
154                     sym_tag  =  db_data$tags(fixed(ilc_ptr->instr.tag));
155                     if        sym_tag  =  ",ic"
156                               then  call  ic_modifier;
157                     end;
158 
159 
160 /*        Non standard tag field.  Get octal representation.  */
161 
162                     else  call  ioa_$rsnnl(",^o", sym_tag, string_len, fixed(ilc_ptr->instr.tag, 17));
163 
164 
165 
166 /*        Now generate the return string.  */
167 
168           call      ioa_$rsnnl("^6o   ^w     ^8a^a^o^a^a", ret_string, string_len,
169                     real_ilc,  ilc_ptr -> word, mnemonic,
170                     sym_pr, offset, sym_tag, note);
171 
172 
173           return;
174 
175 
176 with_ilc: entry(data_ptr, ret_string, instr_word_num, arg_ilc);
177 
178 dcl       arg_ilc fixed bin(18);
179 
180 /* This entry is used when the instruction being disassembled is in the
181 *  break map. The fourth argument contains the original offset of the instrucion.
182 */
183 
184 
185           real_ilc = arg_ilc;
186           go to join;
187 /*^L*/
188 instruction_word(2):
189 instruction_word(3):
190 instruction_word(4):
191 
192           /* make sure we point to the right word */
193 
194           real_ilc = real_ilc + instr_word_num - 1;
195           ilc_ptr = addrel(ilc_ptr, instr_word_num - 1);
196 
197           call      ioa_$rsnnl ("^6o   ^w^-^5x(EIS desc.)",
198                     ret_string, string_len, real_ilc, ilc_ptr -> word );
199 
200           return;
201 multi_word_instr:   procedure;
202 
203 
204 /*        This procedure returns a string that will print a multi-word instruction.
205 *         We don't want to actually dissassemble it.  We will just print a note telling
206 *         that  it is a multi-word instruction and then the octal representation of the
207 *         of the instruction word.
208 */
209 
210 
211 /*        We must test to see if we have to return the number of words in this instruction.
212 *         If the argument  instr_word_num  =  0  then the caller does not want us to return
213 *         this data.
214 */
215 
216           if        instr_word_num  =  1
217 
218                     then    instr_word_num  =  op_mnemonic_$op_mnemonic(opcode).num_words;
219 
220 
221           call      ioa_$rsnnl ("^6o   ^w     ^8a (EIS)",
222                     ret_string, string_len,
223                     real_ilc, ilc_ptr -> word, mnemonic);
224 
225 
226 
227           end       multi_word_instr;
228 /*^L*/
229 ic_modifier:        procedure;
230 
231 
232 /*        This procedure produces a special note which is appended to the end of a
233 *         dissassembled instruction which uses  ic  modification.
234 */
235 
236           if        ilc_ptr->instr.pr_bit         /* If there is a  pr  field just forget */
237                     then  return;                 /* it.  Too complicated and too rare to
238                                                   *  worry about.  */
239 
240 /*        No  pr  field implies that the computed address of the instruction will be in
241 *         the procedure segment.  We will try to retrieve the word the computed address
242 *         references.  If the computed address is out of the bounds of the segment then
243 *         we will set up a special note.
244 */
245 
246           on        condition  (out_of_bounds)
247 
248           begin;                                  /* Execute here only if out of bounds
249                                                   *  condition signalled. */
250 
251           note  =  "    (address not in seg)";    /* Set up special note. */
252 
253           goto      revert_oob_cond;              /* Go eliminate the condition. */
254 
255           end;
256 
257 
258 /*        The next statement is executed after the  "on"  statement.  This is where
259 *         the  out of bounds  may occur.
260 */
261 
262           ic_word  =  addrel(ptr(ilc_ptr, real_ilc), offset) -> word;
263 
264 
265 revert_oob_cond:
266 
267           revert  condition (out_of_bounds);      /* Turn off condition. */
268 
269 /*        If  note  not equal to blank then the condition was signalled and we will
270 *         just return.  If it is still blank then the computed address was within
271 *         the bounds of the segment.  Thus the  note  will contain the computed
272 *         address and the word that it references.
273 */
274 
275           if        note  ^=  " "  then  return;
276 
277           note_offset  =  offset + real_ilc;
278 
279           call  ioa_$rsnnl ("^-  ^6o   ^w", note, string_len, note_offset, ic_word);
280 
281 
282           end       ic_modifier;
283 
284 
285 
286           end       disassemble;