Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 1 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 1 0 PROGRAM dis_rel; 2 0 { 3 0 Disassemble a .ERL or .REL file. 4 0 5 0 AUTHOR: 6 0 7 0 Professor Ronald E. Bruck 8 0 Department of Mathematics 9 0 University of Southern California 10 0 Los Angeles, CA 90089 11 0 } 12 0 13 0 CONST 14 1 tty_name = 'CON:'; 15 1 tabu = 9; 16 1 bs = 8; 17 1 bell = 7; 18 1 argMark = '%'; 19 1 op_code_filename = 'A:OPCODES.TXT'; 20 1 { 21 1 Maximum code size. Maximum REL info size is 1/4 this: 22 1 } 23 1 maxpc = 16384; 24 1 maxrel = 4096; 25 1 26 1 TYPE 27 1 op_code_type = 28 1 RECORD 29 1 follow : 0..2; { # bytes which follow opcode } 30 1 name : STRING [ 15 ]; { mnemonic for opcode } 31 1 END; 32 1 33 1 tipe_type = (abslute, code_rel, data_rel, common_rel); 34 1 35 1 a_field = 36 1 RECORD 37 1 tipe : tipe_type; 38 1 value : INTEGER; 39 1 END; 40 1 41 1 name_type = STRING [ 8 ]; 42 1 43 1 ms_item = 44 1 RECORD 45 1 rel : BOOLEAN; 46 1 value : INTEGER; 47 1 tipe : tipe_type; 48 1 control : INTEGER; 49 1 a : a_field; 50 1 b : name_type; 51 1 END; 52 1 53 1 ref_type = 54 1 RECORD Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 2 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 55 1 tipe : BYTE; 56 1 { Bit assignments: 57 1 Bit 0 : 0 = code relative, 1 = data relative; 58 1 Bit 1 : 0 = public name, 1 = private name. 59 1 Bit 1 is irrelevant if the item is placed in the chain 60 1 of external references. 61 1 } 62 1 value : INTEGER; 63 1 name : name_type; 64 1 ptr : ^ref_type; 65 1 END; 66 1 67 1 ptr_to_ref = ^ref_type; 68 1 69 1 offset_type = 70 1 RECORD 71 1 sign : -1..+1; 72 1 loc, 73 1 offset : INTEGER; 74 1 next : ^offset_type; 75 1 END; 76 1 77 1 VAR 78 1 sysmem : EXTERNAL INTEGER; 79 1 pgm_name, 80 1 in_f_name, 81 1 out_f_name : STRING; 82 1 item : ms_item; 83 1 ch,tab : CHAR; 84 1 next_label, 85 1 first_code_ref, 86 1 last_code_ref, 87 1 first_data_ref, 88 1 last_data_ref, 89 1 first_ext_ref, 90 1 last_ext_ref : ptr_to_ref; 91 1 first_offset, 92 1 last_offset, 93 1 next_offset : ^offset_type; 94 1 n, 95 1 pc, { program counter } 96 1 final_pc, { last byte of code } 97 1 old_mark, { mark top of heap } 98 1 pgm_size, 99 1 data_size, 100 1 result, 101 1 cur_bit : INTEGER; 102 1 fbyte : FILE OF BYTE; { File of char does interpretation } 103 1 fout : TEXT; 104 1 code_buffer: ARRAY [ 0..maxpc ] OF BYTE; 105 1 rel_info : ARRAY [ 0..maxrel ] OF BYTE; 106 1 op_codes : ARRAY [ 0..255 ] OF op_code_type; 107 1 108 1 EXTERNAL PROCEDURE @HLT; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 3 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 109 1 EXTERNAL FUNCTION keypress : BOOLEAN; 110 1 { 111 1 Procedure to extract two filenames from the command line. 112 1 The CCP has already done this, of course, but this way we don't 113 1 have to define an FCB: 114 1 } 115 1 EXTERNAL PROCEDURE xtrctcmd ( VAR name1, name2 : STRING ); 116 1 117 1 PROCEDURE mark; 118 1 BEGIN 119 2 old_mark := sysmem; 120 2 END; 121 1 122 1 PROCEDURE release; 123 1 BEGIN 124 2 sysmem := old_mark; 125 2 END; 126 1 127 1 PROCEDURE syntax_error; 128 1 VAR 129 2 i : INTEGER; 130 2 BEGIN 131 2 WRITELN ( CHR ( bell ), '*** SYNTAX ERROR:' ); 132 2 WRITELN; 133 2 WRITELN ( 'Syntax should be either' ); 134 2 WRITELN; 135 2 WRITELN ( 'DISASM d:source.ext' ); 136 2 WRITELN ( ' (routing output to CON:)' ); 137 2 WRITELN; 138 2 WRITELN ( ' OR' ); 139 2 WRITELN; 140 2 WRITELN ( 'DISASM d:source.ext d:dest.ext' ); 141 2 WRITELN ( ' (routing output to d:dest.ext' ); 142 2 END { syntax_error }; 143 1 144 1 PROCEDURE halt ( message : STRING ); 145 1 BEGIN 146 2 CLOSE ( fbyte, result ); 147 2 CLOSE ( fout, result ); 148 2 WRITELN; 149 2 WRITELN ( message ); 150 2 @HLT; 151 2 END; 152 1 153 1 PROCEDURE open_files; 154 1 VAR 155 2 i : INTEGER; 156 2 BEGIN 157 2 xtrctcmd ( in_f_name, out_f_name ); 158 2 IF (in_f_name = '') THEN syntax_error; 159 2 IF (out_f_name = '') THEN out_f_name := tty_name; 160 2 ASSIGN ( fbyte, in_f_name ); 161 2 RESET ( fbyte ); 162 2 IF IORESULT = 255 THEN Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 4 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 163 2 halt ( CONCAT ( 'Unable to open file ', in_f_name, '.' ) ); 164 2 cur_bit := 7; 165 2 ASSIGN ( fout, op_code_file_name ); 166 2 RESET ( fout ); 167 2 IF IORESULT = 255 THEN 168 2 halt ( 'Unable to open file of opcode names.' ); 169 2 FOR i := 0 TO 255 DO 170 2 BEGIN 171 3 READ ( fout, op_codes [ i ].follow ); 172 3 READ ( fout, ch ); 173 3 READLN ( fout, op_codes [ i ].name ); 174 3 END; 175 2 CLOSE ( fout, result ); 176 2 ASSIGN ( fout, out_f_name ); 177 2 REWRITE ( fout ); 178 2 IF IORESULT = 255 THEN halt ( 'Unable to REWRITE output file.' ); 179 2 END; 180 1 181 1 FUNCTION test_type ( n : INTEGER ) : INTEGER; 182 1 { 183 1 Each item in the code buffer has associated with it two bits, meaning: 184 1 00 = ABSOLUTE item, use this byte AS-IS; 185 1 01 = CODE-RELATIVE item; relative to program base; 186 1 10 = DATA-RELATIVE item; relative to data base; 187 1 11 = POINTER; the two bytes point to a REF item in the heap 188 1 giving more information. 189 1 } 190 1 VAR 191 2 dv, md, i : INTEGER; 192 2 BEGIN 193 2 dv := n DIV 4; 194 2 md := 2 * (n MOD 4); 195 2 i := 0; 196 2 IF TSTBIT ( rel_info [ dv ], md ) THEN i := i + 1; 197 2 IF TSTBIT ( rel_info [ dv ], md + 1 ) THEN i := i + 2; 198 2 test_type := i; 199 2 END; 200 1 201 1 PROCEDURE set_type ( n, tipe : INTEGER ); 202 1 { 203 1 SETS the two bits mentioned above to reflect tipe. 204 1 Uses only the bottom two bits of tipe. 205 1 } 206 1 VAR 207 2 dv, md : INTEGER; 208 2 BEGIN 209 2 dv := n DIV 4; 210 2 md := 2 * ( n MOD 4 ); 211 2 IF TSTBIT ( tipe, 0 ) 212 2 THEN SETBIT ( rel_info [ dv ], md ) 213 2 ELSE CLRBIT ( rel_info [ dv ], md ); 214 2 IF TSTBIT ( tipe, 1 ) 215 2 THEN SETBIT ( rel_info [ dv ], md + 1 ) 216 2 ELSE CLRBIT ( rel_info [ dv ], md + 1 ); Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 5 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 217 2 END; 218 1 219 1 FUNCTION bit : INTEGER; 220 1 BEGIN 221 2 IF cur_bit < 0 THEN 222 2 BEGIN 223 3 IF EOF ( fbyte ) THEN halt ( '*** ERROR: Last byte read...' ); 224 3 get ( fbyte ); 225 3 cur_bit := 7; 226 3 END; 227 2 IF TSTBIT ( fbyte^, cur_bit ) THEN bit := 1 ELSE bit := 0; 228 2 cur_bit := cur_bit - 1; 229 2 END; 230 1 231 1 FUNCTION bits ( n : INTEGER ) : INTEGER; 232 1 VAR 233 2 i, m : INTEGER; 234 2 BEGIN 235 2 m := 0; 236 2 FOR i := 1 TO n DO m := 2 * m + bit; 237 2 bits := m; 238 2 END; 239 1 240 1 PROCEDURE get_a_field ( VAR a : a_field ); 241 1 VAR 242 2 n : INTEGER; 243 2 BEGIN 244 2 n := bits ( 2 ); 245 2 CASE n OF 246 2 0 : a.tipe := abslute; 247 3 1 : a.tipe := code_rel; 248 3 2 : a.tipe := data_rel; 249 3 3 : a.tipe := common_rel; 250 3 END; 251 2 n := bits ( 16 ); 252 2 a.value := SWAP ( n ); 253 2 END; 254 1 255 1 PROCEDURE get_b_field ( VAR b : name_type ); 256 1 VAR 257 2 i, n : INTEGER; 258 2 BEGIN 259 2 n := bits ( 3 ); 260 2 MOVELEFT ( n, b, 1 ); 261 2 FOR i := 1 TO n DO b [ i ] := CHR ( bits ( 8 ) ); 262 2 END; 263 1 264 1 PROCEDURE get_ms_item ( VAR item : ms_item ); 265 1 VAR 266 2 n : INTEGER; 267 2 BEGIN 268 2 FILLCHAR ( item, SIZEOF ( ms_item ), CHR ( 0 ) ); 269 2 CASE bit OF 270 2 0 : BEGIN Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 6 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 271 4 item.rel := FALSE; 272 4 item.value := bits ( 8 ); 273 4 END; 274 3 1 : BEGIN 275 4 item.rel := TRUE; 276 4 n := bits ( 2 ); 277 4 CASE n OF 278 4 0 : BEGIN 279 6 item.tipe := abslute; 280 6 item.control := bits ( 4 ); 281 6 CASE item.control OF 282 6 0,1,2,3,4 : get_b_field ( item.b ); 283 7 5,6,7 : BEGIN 284 8 get_a_field ( item.a ); 285 8 get_b_field ( item.b ); 286 8 END; 287 7 8,9,10,11, 288 7 12,13,14 : get_a_field ( item.a ); 289 7 END; 290 6 IF item.control = 14 THEN cur_bit := -1; 291 6 { force to byte boundary } 292 6 END; 293 5 1 : BEGIN 294 6 item.tipe := code_rel; 295 6 n := bits ( 16 ); 296 6 item.value := SWAP ( n ); 297 6 END; 298 5 2 : BEGIN 299 6 item.tipe := data_rel; 300 6 n := bits ( 16 ); 301 6 item.value := SWAP ( n ); 302 6 END; 303 5 3 : BEGIN 304 6 item.tipe := common_rel; 305 6 n := bits ( 16 ); 306 6 item.value := SWAP ( n ); 307 6 END; 308 5 END; 309 4 END; 310 3 END; 311 2 END; 312 1 313 1 314 1 PROCEDURE insert_ext_ref ( VAR p, root, last : ptr_to_ref ); 315 1 { 316 1 Appends a new REF item to the end of a chain beginning at root. 317 1 We append at the END of the list, instead of the beginning, so 318 1 we keep the EXTERNAL items in the correct order of appearance 319 1 in the .REL file. 320 1 } 321 1 BEGIN 322 2 IF last = NIL 323 2 THEN { nothing in chain } 324 2 BEGIN Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 7 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 325 3 root := p; 326 3 root^.ptr := NIL; 327 3 last := root; 328 3 END 329 3 ELSE 330 2 BEGIN 331 3 p^.ptr := NIL; 332 3 last^.ptr := p; 333 3 last := p; 334 3 END; 335 2 END; 336 1 337 1 PROCEDURE linear_insert ( VAR p, first, last : ptr_to_ref ); 338 1 { 339 1 Assuming there is a chain of ref_type, beginning with 340 1 sentinel values first and ending with last, linearly ordered 341 1 by value, this procedure breaks the chain and inserts p^. 342 1 } 343 1 VAR 344 2 w1, w2 : ptr_to_ref; 345 2 BEGIN 346 2 w2 := first; 347 2 w1 := w2^.ptr; 348 2 last^.value := p^.value; 349 2 WHILE w1^.value < p^.value DO 350 2 BEGIN 351 3 w2 := w1; 352 3 w1 := w2^.ptr; 353 3 END; 354 2 { 355 2 Insert if the value is new, or if it is repeated 356 2 but the name is more specific. 357 2 } 358 2 IF (p^.value <> w1^.value) OR ( w1 = last ) 359 2 THEN 360 2 BEGIN 361 3 p^.ptr := w1; 362 3 w2^.ptr := p; 363 3 END 364 3 ELSE IF (p^.name <> '') THEN 365 2 BEGIN 366 3 w2^.ptr := p; 367 3 p^.ptr := w1^.ptr; 368 3 END 369 3 ELSE p := w1; 370 2 END; 371 1 372 1 PROCEDURE write_memavail; 373 1 BEGIN 374 2 IF out_f_name <> tty_name THEN 375 2 BEGIN 376 3 WRITE ( CHR (bs), CHR (bs), CHR (bs), CHR (bs) ); 377 3 WRITE_HEX ( OUTPUT, MEMAVAIL, 2 ); 378 3 END; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 8 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 379 2 END; 380 1 381 1 382 1 PROCEDURE test_for_create_error; 383 1 BEGIN 384 2 IF (MEMAVAIL < SIZEOF ( ref_type ) ) THEN 385 2 halt ( '*** HALT -- insufficient MEMORY' ); 386 2 write_memavail; 387 2 END; 388 1 389 1 PROCEDURE create_ref ( VAR p : ptr_to_ref; tipe : tipe_type; 390 1 value : INTEGER; name : name_type; 391 1 public : INTEGER { 0 for public, 1 for private } ); 392 1 BEGIN 393 2 new ( p ); 394 2 test_for_create_error; 395 2 p^.value := value; 396 2 p^.name := name; 397 2 IF tipe = code_rel 398 2 THEN 399 2 BEGIN 400 3 p^.tipe := CHR ( 2 * public ); 401 3 linear_insert ( p, first_code_ref, last_code_ref ); 402 3 END 403 3 ELSE 404 2 BEGIN 405 3 p^.tipe := CHR ( 1 + 2 * public ); 406 3 linear_insert ( p, first_data_ref, last_data_ref ); 407 3 END; 408 2 END { create_ref }; 409 1 410 1 PROCEDURE chain_external ( item : ms_item ); 411 1 VAR 412 2 p : ptr_to_ref; 413 2 q, q1 : INTEGER; { Indices into code buffer } 414 2 stop : BOOLEAN; 415 2 BEGIN 416 2 new ( p ); 417 2 test_for_create_error; 418 2 IF item.a.tipe = code_rel 419 2 THEN 420 2 p^.tipe := CHR ( 0 ) { code, public } 421 2 ELSE 422 2 p^.tipe := CHR ( 1 ); { data, public } 423 2 p^.value := item.a.value; 424 2 p^.name := item.b; 425 2 insert_ext_ref ( p, first_ext_ref, last_ext_ref ); 426 2 q := item.a.value; 427 2 REPEAT { Replace code-file REL quantities with pointers to REF } 428 3 stop := ( test_type ( q ) = 0 ) AND (code_buffer [ q ] = CHR ( 0 )) 429 3 AND (test_type ( q + 1 ) = 0) 430 3 AND (code_buffer [ q + 1 ] = CHR ( 0 )); 431 3 set_type ( q, 3 ); 432 3 set_type ( q + 1, 3 ); Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 9 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 433 3 MOVELEFT ( code_buffer [ q ], q1, 2 ); 434 3 MOVELEFT ( p, code_buffer [ q ], 2 ); 435 3 q := q1; 436 3 UNTIL stop; 437 2 END; 438 1 439 1 PROCEDURE define_entry_point ( item : ms_item ); 440 1 VAR 441 2 p : ptr_to_ref; 442 2 BEGIN 443 2 create_ref ( p, item.a.tipe, item.a.value, item.b, 0 { public } ); 444 2 END; 445 1 446 1 PROCEDURE chain_address ( item : ms_item ); 447 1 VAR 448 2 p : ptr_to_ref; 449 2 q, q1 : INTEGER; 450 2 stop : BOOLEAN; 451 2 BEGIN 452 2 create_ref ( p, code_rel, pc, '', 1 { private } ); 453 2 q := item.a.value; 454 2 REPEAT { Replace code-file REL quantities with pointers to REF } 455 3 stop := ( test_type ( q ) = 0 ) AND (code_buffer [ q ] = CHR ( 0 )) 456 3 AND (test_type ( q + 1 ) = 0) 457 3 AND (code_buffer [ q + 1 ] = CHR ( 0 )); 458 3 set_type ( q, 3 ); 459 3 set_type ( q + 1, 3 ); 460 3 MOVELEFT ( code_buffer [ q ], q1, 2 ); 461 3 MOVELEFT ( p, code_buffer [ q ], 2 ); 462 3 q := q1; 463 3 UNTIL stop; 464 2 END; 465 1 466 1 PROCEDURE program_name ( item : ms_item ); 467 1 BEGIN 468 2 pgm_name := item.b; 469 2 END; 470 1 471 1 PROCEDURE define_data_size ( item : ms_item ); 472 1 BEGIN 473 2 data_size := item.a.value; 474 2 END; 475 1 476 1 PROCEDURE set_load ( item : ms_item ); 477 1 BEGIN 478 2 IF item.a.tipe = code_rel THEN pc := item.a.value; 479 2 END; 480 1 481 1 PROCEDURE define_program_size ( item : ms_item ); 482 1 BEGIN 483 2 pgm_size := item.a.value; 484 2 END; 485 1 486 1 PROCEDURE name_for_search ( item : ms_item ); Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 10 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 487 1 BEGIN 488 2 END; 489 1 490 1 PROCEDURE offset ( item : ms_item ); 491 1 VAR 492 2 p : ^offset_type; 493 2 BEGIN 494 2 new ( p ); 495 2 test_for_create_error; 496 2 IF item.control = 8 { - offset } THEN p^.sign := -1 ELSE p^.sign := +1; 497 2 p^.loc := pc; 498 2 p^.offset := item.a.value; 499 2 p^.next := NIL; 500 2 { 501 2 Now insert the item at the END of the offset chain. Because 502 2 the pc increases, the chain will be ordered on its LOC field. 503 2 } 504 2 IF last_offset = NIL 505 2 THEN 506 2 BEGIN 507 3 first_offset := p; 508 3 last_offset := first_offset; 509 3 END 510 3 ELSE 511 2 BEGIN 512 3 last_offset^.next := p; 513 3 last_offset := p; 514 3 END; 515 2 END; 516 1 517 1 PROCEDURE end_pgm ( item : ms_item ); 518 1 BEGIN 519 2 END; 520 1 521 1 PROCEDURE end_file ( item : ms_item ); 522 1 BEGIN 523 2 END; 524 1 525 1 PROCEDURE handle_special ( item : ms_item ); 526 1 BEGIN 527 2 CASE item.control OF 528 2 0 : name_for_search ( item ); 529 3 { 1 : ignore SELECT COMMON BLOCK } 530 3 2 : program_name ( item ); 531 3 { 3 : ignore REQUEST LIBRARY SEARCH } 532 3 { 4 : ignore RESERVED FOR FUTURE EXPANSION } 533 3 { 5 : ignore DEFINE COMMON SIZE } 534 3 6 : chain_external ( item ); 535 3 7 : define_entry_point ( item ); 536 3 8, 537 3 9 : offset ( item ); 538 3 10 : define_data_size ( item ); 539 3 11 : set_load ( item ); 540 3 12 : chain_address ( item ); Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 11 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 541 3 13 : define_program_size ( item ); 542 3 14 : end_pgm ( item ); 543 3 15 : end_file ( item ); 544 3 END; 545 2 END { handle_special }; 546 1 547 1 PROCEDURE write_name ( p : ptr_to_ref ); 548 1 VAR 549 2 i : INTEGER; 550 2 BEGIN 551 2 IF p^.name <> '' 552 2 THEN 553 2 WRITE ( fout, p^.name) 554 2 ELSE 555 2 BEGIN 556 3 IF TSTBIT ( p^.tipe, 0 ) 557 3 THEN WRITE ( fout, 'D$' ) 558 3 ELSE WRITE ( fout, 'C$' ); 559 3 WRITE_HEX ( fout, p^.value, 2 ); 560 3 END; 561 2 END; 562 1 563 1 PROCEDURE write_ref_name ( pc : INTEGER ); 564 1 VAR 565 2 p : ptr_to_ref; 566 2 BEGIN 567 2 MOVELEFT ( code_buffer [ pc ], p, 2 ); 568 2 write_name ( p ); 569 2 END; 570 1 571 1 PROCEDURE write_next_label; 572 1 BEGIN 573 2 write_name ( next_label ); 574 2 WRITE( fout, ':', tab ); 575 2 END; 576 1 577 1 PROCEDURE w_hex ( n, nbytes : INTEGER ); 578 1 { 579 1 Writes the integer n (one or two bytes) to file f in hex form, 580 1 in M80-readable form; e.g., 0FFFFh. 581 1 } 582 1 BEGIN 583 2 IF ( (nbytes = 1) AND (LO ( n ) >= $a0) ) OR ( (nbytes = 2) AND 584 2 (HI ( n ) >= $a0) ) THEN WRITE ( fout, '0' ); 585 2 WRITE_HEX ( fout, n, nbytes ); 586 2 WRITE ( fout, 'H' ); 587 2 END; 588 1 589 1 PROCEDURE write_offset ( pc : INTEGER ); 590 1 BEGIN 591 2 IF next_offset <> NIL THEN WITH next_offset^ DO 592 2 BEGIN 593 3 IF loc = pc THEN 594 3 BEGIN Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 12 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 595 4 IF sign = 1 596 4 THEN 597 4 BEGIN 598 5 IF offset >= 0 599 5 THEN WRITE ( fout, '+', offset ) 600 5 ELSE WRITE ( fout, offset ); 601 5 END 602 5 ELSE IF offset >= 0 603 4 THEN WRITE ( fout, '-', offset ) 604 4 ELSE WRITE ( fout, '+', -offset ); 605 4 next_offset := next_offset^.next; 606 4 END; 607 3 END; 608 2 END; 609 1 610 1 611 1 PROCEDURE WriteDB; 612 1 BEGIN 613 2 WRITE ( fout, 'DB', TAB ); 614 2 w_hex ( ord ( code_buffer [ pc ] ), 1 ); 615 2 WRITELN ( fout ); 616 2 WRITELN ( fout, TAB, '; *** SYNC ERROR: inconsistent REL type' ); 617 2 END; (* WriteDB *) 618 1 619 1 620 1 PROCEDURE dis_asm ( VAR pc : INTEGER ); 621 1 VAR 622 2 a : a_field; 623 2 p : ptr_to_ref; 624 2 expect, 625 2 n, 626 2 t, 627 2 temp : INTEGER; 628 2 629 2 PROCEDURE WriteOpCode; 630 2 VAR 631 3 i,len: INTEGER; 632 3 ch: CHAR; 633 3 BEGIN 634 3 WITH opCodes[ codeBuffer[ pc ] ] DO BEGIN 635 4 i := 1; 636 4 len := ORD( name[0] ); (* length *) 637 4 ch := name[1]; 638 4 WHILE (i <= len) AND (ch <> argMark) DO BEGIN 639 5 IF ch = ' ' THEN 640 5 WRITE( fout, TAB ) 641 5 ELSE 642 5 WRITE ( fout, ch ); 643 5 i := i + 1; 644 5 ch := name[i]; 645 5 END; 646 4 IF follow <> 0 THEN BEGIN 647 5 IF follow = 1 THEN 648 5 Whex( ORD( codeBuffer[ pc + 1 ] ), 1 ) Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 13 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 649 5 ELSE IF follow = 2 THEN BEGIN 650 6 IF t = 0 THEN BEGIN 651 7 MOVELEFT ( codeBuffer[ pc + 1 ], temp, 2 ); 652 7 w_hex ( temp, 2 ) 653 7 END 654 7 ELSE IF t = 3 THEN BEGIN 655 7 write_ref_name ( pc + 1 ); 656 7 END; 657 6 write_offset ( pc + 1 ); 658 6 END; 659 5 i := i + 1; (* move behind % *) 660 5 WHILE i <= len DO BEGIN 661 6 IF ch = ' ' THEN 662 6 WRITE( fout, tab ) 663 6 ELSE 664 6 WRITE ( fout, name[i] ); 665 6 i := i + 1; 666 6 END; 667 5 END; (* follow # 0 *) 668 4 WRITELN ( fout ); 669 4 END; (* WITH *) 670 3 END; (* WriteOpCode *) 671 2 672 2 BEGIN 673 2 IF next_label^.ptr <> NIL 674 2 THEN 675 2 BEGIN 676 3 IF pc = next_label^.value 677 3 THEN 678 3 BEGIN 679 4 write_next_label; 680 4 next_label := next_label^.ptr; 681 4 END 682 4 ELSE 683 3 WRITE ( fout, TAB ); 684 3 END 685 3 ELSE 686 2 WRITE ( fout, TAB); 687 2 CASE test_type ( pc ) OF 688 2 0 :BEGIN 689 4 expect := op_codes [ code_buffer [ pc ] ].follow; 690 4 CASE expect OF 691 4 0 : BEGIN 692 6 IF op_codes [ code_buffer [ pc ] ].name <> '???' THEN BEGIN 693 7 WriteOpCode; 694 7 END 695 7 ELSE BEGIN 696 7 WriteDB; 697 7 END; 698 6 pc := pc + 1; 699 6 END; 700 5 1 : BEGIN 701 6 IF test_type ( pc + 1 ) <> 0 THEN BEGIN 702 7 WriteDB; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 14 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 703 7 pc := pc + 1; 704 7 END 705 7 ELSE BEGIN 706 7 WriteOpCode; 707 7 pc := pc + 2; 708 7 END; 709 6 END; 710 5 2 : BEGIN 711 6 t := test_type ( pc + 1 ); 712 6 IF t <> test_type ( pc + 2 ) THEN BEGIN 713 7 WriteDB; 714 7 pc := pc + 1; 715 7 END 716 7 ELSE BEGIN 717 7 WriteOpCode; 718 7 pc := pc + 3; 719 7 END; 720 6 END; 721 5 END; { case expect of } 722 4 END; 723 3 1,2: 724 3 BEGIN 725 4 WRITELN ( fout, TAB, '; *** WOW!! HOW DID THAT HAPPEN?!!' ); 726 4 pc := pc + 1; 727 4 END; 728 3 3 : BEGIN 729 4 MOVELEFT ( code_buffer [ pc ], p, 2 ); 730 4 WRITE ( fout, 'DW', TAB ); 731 4 write_ref_name ( pc ); 732 4 WRITELN ( fout ); 733 4 pc := pc + 2; 734 4 END; 735 3 END { case test_type of } 736 2 END; 737 1 738 1 739 1 PROCEDURE print_publics ( VAR p : ptr_to_ref ); 740 1 VAR 741 2 count : INTEGER; 742 2 BEGIN 743 2 count := 0; 744 2 WHILE p^.ptr <> NIL DO 745 2 BEGIN 746 3 IF p^.name <> '' THEN 747 3 BEGIN 748 4 IF count = 0 749 4 THEN WRITE ( fout, TAB, 'PUBLIC', TAB, p^.name ) 750 4 ELSE WRITE ( fout, ',' , p^.name ); 751 4 count := count + 1; 752 4 IF count = 6 THEN 753 4 BEGIN 754 5 WRITELN ( fout ); 755 5 count := 0; 756 5 END; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 15 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 757 4 END; 758 3 p := p^.ptr; 759 3 END; 760 2 IF count > 0 THEN WRITELN ( fout ); 761 2 END { print_publics }; 762 1 763 1 PROCEDURE print_it; 764 1 VAR 765 2 p : ptr_to_ref; 766 2 count : INTEGER; 767 2 BEGIN 768 2 IF out_f_name <> tty_name THEN 769 2 BEGIN 770 3 WRITELN; 771 3 WRITELN ( 'Disassembling ', pgm_name ); 772 3 END; 773 2 pc := 0; 774 2 p := first_ext_ref; 775 2 IF pgm_name <> '' THEN 776 2 WRITELN ( fout, TAB, 'TITLE', TAB, pgm_name ); 777 2 count := 0; 778 2 WHILE p <> NIL DO 779 2 BEGIN 780 3 IF count = 0 781 3 THEN WRITE ( fout, TAB, 'EXTRN', TAB, p^.name ) 782 3 ELSE WRITE ( fout, ',' , p^.name ); 783 3 count := count + 1; 784 3 IF count = 6 THEN 785 3 BEGIN 786 4 WRITELN ( fout ); 787 4 count := 0; 788 4 END; 789 3 p := p^.ptr; 790 3 END; 791 2 IF count > 0 THEN WRITELN ( fout ); 792 2 p := first_code_ref^.ptr; 793 2 print_publics ( p ); 794 2 p := first_data_ref^.ptr; 795 2 print_publics ( p ); 796 2 WRITELN ( fout, TAB, 'CSEG' ); 797 2 next_label := first_code_ref^.ptr; 798 2 next_offset := first_offset; 799 2 WHILE pc < final_pc DO 800 2 dis_asm ( pc ); 801 2 IF pc < pgm_size THEN 802 2 WRITELN ( fout, TAB, 'DS', TAB, pgm_size - pc ); 803 2 WHILE next_label <> last_code_ref DO 804 2 BEGIN 805 3 WRITE ( fout, TAB, 'ORG', TAB ); 806 3 w_hex ( next_label^.value, 2 ); 807 3 WRITELN ( fout ); 808 3 write_next_label; 809 3 WRITELN ( fout ); 810 3 next_label := nextlabel^.ptr; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 16 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 811 3 END; 812 2 IF data_size > 0 THEN 813 2 BEGIN 814 3 WRITELN ( fout, TAB, 'DSEG', TAB ); 815 3 next_label := first_data_ref^.ptr; 816 3 pc := 0; 817 3 WHILE next_label^.ptr <> NIL DO 818 3 BEGIN 819 4 IF pc = next_label^.value 820 4 THEN 821 4 BEGIN 822 5 write_next_label; 823 5 WRITE ( fout, 'DS', TAB ); 824 5 next_label := next_label^.ptr; 825 5 IF next_label^.ptr <> NIL 826 5 THEN 827 5 BEGIN 828 6 WRITELN ( fout, next_label^.value - pc ); 829 6 pc := next_label^.value; 830 6 END 831 6 ELSE 832 5 WRITELN ( fout, data_size - pc ); 833 5 END 834 5 ELSE 835 4 BEGIN 836 5 WRITELN ( fout, TAB, 'DS', TAB, 837 5 next_label^.value - pc ); 838 5 pc := next_label^.value; 839 5 END; 840 4 END; 841 3 END; 842 2 WRITELN ( fout, TAB, 'END' ); 843 2 END; 844 1 845 1 PROCEDURE replace_names; 846 1 VAR 847 2 p : ptr_to_ref; 848 2 found : BOOLEAN; 849 2 n, 850 2 value : INTEGER; 851 2 BEGIN 852 2 pc := 0; 853 2 WHILE pc < final_pc DO 854 2 BEGIN 855 3 n := test_type ( pc ); 856 3 CASE n OF 857 3 0 : pc := pc + 1; 858 4 3 : pc := pc + 2; 859 4 1,2 : BEGIN 860 5 MOVELEFT ( code_buffer [ pc ], value, 2 ); 861 5 IF n = 1 862 5 THEN p := first_code_ref^.ptr 863 5 ELSE p := first_data_ref^.ptr; 864 5 found := FALSE; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 17 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 865 5 WHILE (p <> last_code_ref) AND (p <> last_data_ref) 866 5 AND NOT found DO 867 5 BEGIN 868 6 found := (p^.value = value); 869 6 IF NOT found THEN p := p^.ptr; 870 6 END; 871 5 IF (p = last_code_ref) 872 5 THEN create_ref ( p, code_rel, value, '', 1 { private } ) 873 5 ELSE IF (p = last_data_ref) THEN 874 5 create_ref ( p, data_rel, value, '', 1 ); 875 5 { 876 5 Now that p points to an appropriate reference -- one already 877 5 in the chain, or one we just added -- we can push its address 878 5 into the code buffer and adjust the REL bits to POINTER. 879 5 } 880 5 MOVELEFT ( p, code_buffer [ pc ], 2 ); 881 5 set_type ( pc, 3 ); 882 5 set_type ( pc + 1, 3 ); 883 5 pc := pc + 2; 884 5 END { Case 1,2 }; 885 4 END { Case n of }; 886 3 END { While pc < final_pc }; 887 2 END { replace_names }; 888 1 889 1 PROCEDURE initialize; 890 1 BEGIN 891 2 pc := 0; 892 2 pgm_name := ''; 893 2 pgm_size := 0; 894 2 data_size := 0; 895 2 release; { free all space in the heap } 896 2 new ( first_code_ref ); 897 2 new ( last_code_ref ); 898 2 new ( first_data_ref ); 899 2 new ( last_data_ref ); 900 2 first_code_ref^.ptr := last_code_ref; 901 2 last_code_ref^.ptr := NIL; 902 2 first_data_ref^.ptr := last_data_ref; 903 2 last_data_ref^.ptr := NIL; 904 2 first_ext_ref := NIL; 905 2 last_ext_ref := NIL; 906 2 first_offset := NIL; 907 2 last_offset := NIL; 908 2 END; 909 1 910 1 911 1 PROCEDURE one_program ( VAR item : ms_item ); 912 1 BEGIN 913 2 initialize; 914 2 IF out_f_name <> tty_name THEN 915 2 WRITE ( 'Memory remaining: ' ); 916 2 REPEAT 917 3 get_ms_item ( item ); 918 3 IF (item.rel) AND (item.tipe = abslute) AND (item.control = 15) THEN EXIT; Pascal/MT+ Release 5.5 Copyright (c) 1981 MT MicroSYSTEMS, Inc. Page # 18 Compilation of: DISA-REL.PAS Stmt Nest Source Statement 919 3 { End-of-file } 920 3 IF NOT item.rel 921 3 THEN 922 3 BEGIN 923 4 MOVELEFT ( item.value, code_buffer [ pc ], 1 ); 924 4 set_type ( pc, 0 ); 925 4 pc := pc + 1; 926 4 IF pc > maxpc THEN halt ( '*** ERROR: Code file overflow.' ); 927 4 END 928 4 ELSE 929 3 CASE item.tipe OF 930 3 code_rel, 931 4 data_rel, 932 4 common_rel : BEGIN 933 5 IF pc <= maxpc - 2 934 5 THEN 935 5 MOVELEFT ( item.value, code_buffer [ pc ], 2 ) 936 5 ELSE 937 5 halt ( '*** ERROR: Code file overflow.' ); 938 5 CASE item.tipe OF 939 5 code_rel : n := 1; 940 6 data_rel : n := 2; 941 6 common_rel: n := 0; 942 6 END; 943 5 set_type ( pc, n ); 944 5 set_type ( pc+1, n ); 945 5 pc := pc + 2; 946 5 END; 947 4 abslute : handle_special ( item ); 948 4 END; 949 3 UNTIL (item.rel) AND (item.tipe=abslute) AND (item.control IN [14,15]); 950 2 final_pc := pc; { save program counter } 951 2 replace_names; 952 2 print_it; 953 2 END; 954 1 955 1 BEGIN { >>> MAIN PROGRAM <<< } 956 1 tab := CHR( tabu ); 957 1 open_files; 958 1 mark; { mark heap space } 959 1 REPEAT 960 2 one_program ( item ) 961 2 UNTIL (item.rel) AND (item.tipe = abslute) AND (item.control = 15 ); 962 1 halt ( 'End of file - Normal termination.' ); 963 1 END. 963 0 --------------------------- 963 0 Normal End of Input Reached ċċċDċ ODPDRDTDVċċċċċċċċċċċċċċċċċċċċċċċċċċċ