home *** CD-ROM | disk | FTP | other *** search
- unit code;
-
- interface
-
- procedure print_dump(seg:byte);
-
- implementation
-
- uses globals,head,blocks,reloc,dump,util;
-
- procedure print_dump(seg:byte);
- var
- codebase,codeofs,codelimit,
- base,ofs,limit : word;
- code_block : block_ptr;
- block : byte_array_ptr;
- begin
- case seg of
- code_seg : begin
- if header^.code_size = 0 then
- exit;
- writeln;
- writeln('Emitted code');
- codebase :=header^.ofs_code_blocks;
- codelimit := header^.ofs_const_blocks-codebase;
- end;
-
- const_seg : begin
- if header^.const_size = 0 then
- exit;
- writeln;
- writeln('Emitted consts');
- codebase :=header^.ofs_const_blocks;
- codelimit := header^.ofs_var_blocks-codebase;
- end;
- end;
- base := 0;
- codeofs := 0;
- while codeofs < codelimit do
- begin
- code_block := add_offset(buffer,codebase+codeofs);
- write('---');
- case seg of
- code_seg: write_code_block_name(code_block^.owner);
- const_seg: write_const_block_name(code_block^.owner);
- end;
- write('---(block ',hexword2(codeofs),')');
- ofs := 0;
- limit := code_block^.size;
- dumpbytes(add_offset(code_buf,base)^,0,limit);
- inc(base,limit);
- inc(codeofs,sizeof(block_rec));
- end;
- end;
-
- end.