h60893
s 00795/00000/00000
d D 1.1 83/03/22 19:54:10 bog 1 0
c date and time created 83/03/22 19:54:10 by bog
e
u
4
U
t
T
I 1
omf: proc options (main);

/*
    Dump intel object module format  2/24/83

    To use, enter a command of the form:

        OMF filename                   dumps filename.OBJ to the console
        OMF filename filename2         dumps filename.OBJ to filename2
*/

%replace
	false by '0'b,
	true by '1'b;

declare
	typ (31) entry variable;

declare
	record_type (31) bit (8) static initial (
		'6E'b4,   /*   1: r-module header  */
		'70'b4,   /*   2: register initialization  */
		'72'b4,   /*   3: relocatable enumerated data  */
		'74'b4,   /*   4: relocatable iterated data  */
		'76'b4,   /*   5: overlay definition  */
		'78'b4,   /*   6: end  */
		'7A'b4,   /*   7: block definition  */
		'7C'b4,   /*   8: block end  */
		'7E'b4,   /*   9: debug symbols  */
		'80'b4,   /*  10: t-module header  */
		'82'b4,   /*  11: l-module header  */
		'84'b4,   /*  12: physical enumerated data  */
		'86'b4,   /*  13: physical iterated data  */
		'88'b4,   /*  14: comment  */
		'8A'b4,   /*  15: module end  */
		'8C'b4,   /*  16: external names definition  */
		'8E'b4,   /*  17: type definition  */
		'90'b4,   /*  18: public names definition  */
		'92'b4,   /*  19: local symbols  */
		'94'b4,   /*  20: line numbers  */
		'96'b4,   /*  21: list of names  */
		'98'b4,   /*  22: segment definition  */
		'9A'b4,   /*  23: group definition  */
		'9C'b4,   /*  24: fixup  */
		'9E'b4,   /*  25: (unused)  */
		'A0'b4,   /*  26: logical enumerated data  */
		'A2'b4,   /*  27: logical iterated data  */
		'A4'b4,   /*  28: library header  */
		'A6'b4,   /*  29: library module names  */
		'A8'b4,   /*  30: library module locations  */
		'AA'b4);  /*  31: library dictionary  */

declare
	record_name (31) char (6) static initial (
		'RHEADR',   /*   1: r-module header  */
		'REGINT',   /*   2: register initialization  */
		'REDATA',   /*   3: relocatable enumerated data  */
		'RIDATA',   /*   4: relocatable iterated data  */
		'OVLDEF',   /*   5: overlay definition  */
		'ENDREC',   /*   6: end  */
		'BLKDEF',   /*   7: block definition  */
		'BLKEND',   /*   8: block end  */
		'DEBSYM',   /*   9: debug symbols  */
		'THEADR',   /*  10: t-module header  */
		'LHEADR',   /*  11: l-module header  */
		'PEDATA',   /*  12: physical enumerated data  */
		'PIDATA',   /*  13: physical iterated data  */
		'COMENT',   /*  14: comment  */
		'MODEND',   /*  15: module end  */
		'EXTDEF',   /*  16: external names definition  */
		'TYPDEF',   /*  17: type definition  */
		'PUBDEF',   /*  18: public names definition  */
		'LOCSYM',   /*  19: local symbols  */
		'LINNUM',   /*  20: line numbers  */
		'LNAMES',   /*  21: list of names  */
		'SEGDEF',   /*  22: segment definition  */
		'GRPDEF',   /*  23: group definition  */
		'FIXUPP',   /*  24: fixup  */
		'(NONE)',   /*  25: (unused)  */
		'LEDATA',   /*  26: logical enumerated data  */
		'LIDATA',   /*  27: logical iterated data  */
		'LIBHED',   /*  28: library header  */
		'LIBNAM',   /*  29: library module names  */
		'LIBLOC',   /*  30: library module locations  */
		'LIBDIC');  /*  31: library dictionary  */

declare
	leaf_type (99:127) char (17) static initial (
		'interrupt',
		'file',
		'packed',
		'unpacked',
		'set',
		'<reserved>',
		'chameleon',
		'boolean',
		'true',
		'false',
		'char',
		'integer',
		'const',
		'<reserved>',
		'label',
		'long',
		'short',
		'procedure',
		'parameter',
		'dimension',
		'array',
		'<reserved>',
		'structure',
		'pointer',
		'scalar',
		'unsigned integer',
		'signed integer',
		'real',
		'list');

declare
	source file,
	outfile file,
	library bit (1),
	eof bit (1),
	b bit (8),
	b8 bit (8),
	b16 bit (16),
	i fixed (7),
	group_type bit (8),
	offset fixed (15),
	group_index fixed (15),
	segment_index fixed (15),
	external_index fixed (15),
	lnames_number fixed (15),
	segdef_number fixed (15),
	grpdef_number fixed (15),
	typdef_number fixed (15),
	blkdef_number fixed (15),
	buff (1024) bit (8),
	bufptr fixed (15),
	record_number fixed (15),
	checksum fixed (8),
	name_length fixed (7),
	record_length fixed (15);

declare
	loc_type (0:4) char (7) static initial (
		'lobyte', 'offset', 'base', 'pointer', 'hibyte');

declare
	fix_type (0:1) char (8) static initial ('self rel', 'segm rel');

declare
	target_method (0:2) char (3) static initial ('SI(', 'GI(', 'EI('),
	frame_method (4:6) char (8) static initial ('location', 'target',
	 'none');

declare
	p pointer,
        type char (3) based (p),
	ch char based (p);

put skip list ('INTEL OBJECT FILE DUMP UTILITY  2/24/83');
put skip;

on endfile (source) begin; end;
unspec (p) = '0065'b4;
if type = '   ' then type = 'OBJ';
open file (source) input record title ('$1.$1') env(b(1024));
unspec (p) = '006d'b4;
if ch ^= ' ' then open file (outfile) output stream title ('$2.$2');
else open file (outfile) output stream title ('$CON');
bufptr = hbound (buff, 1);

typ (1) = put_rheadr;
typ (2) = put_record;
typ (3) = put_record;
typ (4) = put_record;
typ (5) = put_record;
typ (6) = put_record;
typ (7) = put_block_def;
typ (8) = put_record;
typ (9) = put_debug_symbols;
typ (10) = put_name;
typ (11) = put_name;
typ (12) = put_pedata;
typ (13) = put_record;
typ (14) = put_comment;
typ (15) = put_module_end;
typ (16) = put_external_names;
typ (17) = put_type_def;
typ (18) = put_public_names;
typ (19) = put_public_names;
typ (20) = put_line_numbers;
typ (21) = put_name_list;
typ (22) = put_seg_def;
typ (23) = put_group_def;
typ (24) = put_fixup;
typ (25) = put_record;
typ (26) = put_ledata;
typ (27) = put_lidata;
typ (28) = put_libhed;
typ (29) = put_libnam;
typ (30) = put_libloc;
typ (31) = put_libdic;

call reset_indexes;
library = false;
eof = false;
record_number = 0;
do while (true);
	checksum = 0;
	record_length = 3;
	b = get_bit8 ();
	i = get_index ();
	if i = 0 then
		put skip file (outfile) list ('undefined record type', b);
	else call process_record;
end;

process_record: procedure;
	record_number = record_number + 1;
	put file (outfile) skip edit (deblank (record_number)) (a);
	put file (outfile) skip edit (record_name (i), '   ') (a, a);
	record_length = get_word ();
	call typ (i);
	b8 = get_bit8 ();
	if mod (checksum, 256) ^= 0 then
		put skip file (outfile) list ('checksum error');
	if (b = '8a'b4) & (library = false) then stop;
end process_record;

reset_indexes: procedure;
	external_index = 1;
	segdef_number = 1;
	grpdef_number = 1;
	typdef_number = 1;
	blkdef_number = 1;
	lnames_number = 1;
	end reset_indexes;

get_index: procedure returns (fixed (7));
	declare i fixed (7);
	do i = 1 to hbound (record_type, 1);
		if b = record_type (i) then return (i);
	end;
	return (0);
	end get_index;

get_bit8: procedure returns (bit (8));
	bufptr = bufptr + 1;
	if bufptr > hbound (buff, 1) then
		do;
			read file (source) into (buff);
			bufptr = 1;
		end;
	record_length = record_length - 1;
	if record_length = -1 then
		put skip file (outfile) list ('*** record length error ***');
	checksum = checksum + binary (buff (bufptr));
	return (buff (bufptr));
	end get_bit8;

get_bit16: procedure returns (bit (16));
	declare x bit (8);
	x = get_bit8 ();
	return (get_bit8 () || x);
	end get_bit16;

get_byte: procedure returns (fixed (7));
	return (binary (get_bit8 ()));
	end get_byte;

get_word: procedure returns (fixed (15));
	declare x bit (16);
	x = get_bit16 ();
	return (binary (x));
	end get_word;

getbw: procedure returns (fixed (15));
	declare t bit (8);
	t = get_bit8 ();
	if (t & '80'b4) = 0 then return (binary (t));
	return (binary ((t & '7f'b4) || get_bit8 ()));
	end getbw;

get_f8: procedure returns (fixed (8));
	return (binary (get_bit8 ()));
	end get_f8;

get_char: procedure returns (char);
	return (ascii (get_byte ()));
	end get_char;

put_name: procedure;
	declare c fixed (7);
	c = get_byte ();
	name_length = c;
	if c = 0 then put file (outfile) edit ('<null>') (a);
	else
		do i = 1 to c;
			put file (outfile) edit (get_char ()) (a);
		end;
	end put_name;

put_rheadr: procedure;
	call put_name;
	put file (outfile) edit (' ') (col (9), a);
	call put_record;
	end put_rheadr;

put_base: procedure;
	group_index = getbw ();
	segment_index = getbw ();
	put file (outfile) edit ('group index = ', deblank (group_index),
	  ' segment index = ', deblank (segment_index))
	  (4(a));
	if segment_index = 0 & group_index = 0 then
		put file (outfile) edit (' frame number = ', get_bit16 ()) (a, b4);
	end put_base;

put_block_def: procedure;
	declare
		p bit (1),
		l bit (1);
	put file (outfile) edit (deblank (blkdef_number), ' ') (a, a);
	call put_base;
	put file (outfile) edit (' ') (skip, col(9), a);
	call put_name;
	put file (outfile) edit (' block offset = ', get_bit16 (),
	  ' block length = ', get_bit16 ())
	  (a, b4, a, b4);
	b8 = get_bit8 ();
	p = substr (b8, 1, 1);
	l = substr (b8, 2, 1);
	put file (outfile) edit ('p = ', p, ' l = ', l) (col(10), a, b, a, b);
	if p = '1'b then
		put file (outfile) edit (' return address offset = ', get_bit16 ()) (a, b4);
	if name_length > 0 then
		put file (outfile) edit (' type index = ', deblank (getbw ())) (a, a);
	blkdef_number = blkdef_number + 1;
	end put_block_def;

put_debug_symbols: procedure;
	declare
		frame_info bit (8),
		b bit (1),
		l bit (1),
		frame_method bit (3);
	frame_info = get_bit8 ();
	b = substr (frame_info, 1, 1);
	l = substr (frame_info, 2, 1);
	frame_method = substr (frame_info, 6, 3);
	put file (outfile) edit ('b = ', b, ' l = ', l, ' frame method = ', frame_method, ' ')
	  (a, b, a, b, a, b3, a);
	if frame_method = '0'b then call put_base;
	else if frame_method = '001'b then
		put file (outfile) edit ('external index = ', deblank (getbw ()))
		  (a, a);
	else if frame_method = '010'b then
		put file (outfile) edit ('block index = ', deblank (getbw ()))
		  (a, a);
	else put skip file (outfile) list ('*** FRAME METHOD ERROR ***');
	do while (record_length > 1);
		put file (outfile) edit (' ') (skip, col(9), a);
		call put_name;
		put file (outfile) edit (' offset = ', get_bit16 ()) (a, b4);
		put file (outfile) edit (' type index = ', deblank (getbw ())) (a, a);
	end;
	end put_debug_symbols;

put_pedata: procedure;
	put file (outfile) edit ('frame number = ', get_bit16 (),
	  ' offset = ', get_bit8 (), ' ')
	  (a, b4, a, b4, col(9), a);
	call put_record;
	end put_pedata;

put_comment: procedure;
	put file (outfile) edit ('type = ', get_bit16(), ' ') (a,b4,a);
	do while (record_length > 1);
		put file (outfile) edit (get_char ()) (a);
	end;
	end put_comment;

put_module_end: procedure;
	declare
		mattr bit (2),
		l bit (1);
	b8 = get_bit8 ();
	mattr = substr (b8, 1, 2);
	l = substr (b8, 8, 1);
	put file (outfile) edit ('mattr = ', mattr, ' l = ', l) (a, b2, a, b2);
	if (mattr & '01'b) = '01'b then
		do;
			if l = '0'b then
				put file (outfile) edit (' frame number = ', get_bit16 (),
				  ' offset = ', get_bit16 ())
				  (a, b4, a, b4);
			else call fix_or_end_dat;
		end;
	call reset_indexes;
	put file (outfile) skip;
	end put_module_end;

put_external_names: procedure;
	do while (record_length > 1);
		put file (outfile) edit (deblank (external_index), ' ') (col(10), a, a);
		call put_name;
		put file (outfile) edit (' type index = ', deblank (getbw ())) (a, a);
		external_index = external_index + 1;
	end;
	end put_external_names;

do_leaf: procedure;
	declare f8 fixed (8);
	declare f7 fixed (7);
	f8 = get_f8 ();
	if f8 < 128 then
		do;
			if (mod (f8,8) = 0) | (f8 < 99) then do;
				f7 = f8;
				put file (outfile) edit (bit (f7), ' ') (b4, a);
				end;
			else put file (outfile) edit (deblank_char (leaf_type (f8))) (a);
		end;
	else if f8 = 128 then put file (outfile) edit ('null ') (a);
	else if f8 = 129 then
		put file (outfile) edit (get_bit16 (), ' ') (b4, a);
	else if f8 = 130 then
		do;
			put file (outfile) edit ('string = ') (a);
			call put_name;
		end;
	else if f8 = 131 then
		put file (outfile) edit ('index = ', deblank (getbw ()), ' ')
		  (a, a, a);
	else if f8 = 132 then
		do;
			b16 = get_bit16 ();
			put file (outfile) edit (get_bit8 (), b16, ' ')
			  (b4, b4, a);
		end;
	else if f8 = 133 then
		put file (outfile) edit ('repeat ') (a);
	else if f8 = 134 then
		put file (outfile) edit ('signed numeric = ', get_byte (), ' ')
		  (a, f(4), a);
	else if f8 = 135 then
		put file (outfile) edit ('signed numeric = ', get_word (), ' ')
		  (a, f(6), a);
	else if f8 = 136 then
		put file (outfile) edit ('signed numeric = ', get_word (), get_word (), ' ')
		  (a, b4, b4, a);
	else put skip file (outfile) list ('*** LEAF ERROR ***');
	end do_leaf;

put_type_def: procedure;
	declare en bit (8);
	declare f8 fixed (8);
	declare leaf_count fixed (7);
	put file (outfile) edit (deblank (typdef_number), ' ') (a, a);
	call put_name;
	do while (record_length > 1);
		en = get_bit8 ();
		put file (outfile) edit (' en = ', en, ' ') (a, b4, a);
		leaf_count = 0;
		do while (record_length > 1 & leaf_count < 8);
			call do_leaf;
			leaf_count = leaf_count + 1;
		end;
	end;
	typdef_number = typdef_number + 1;
	end put_type_def;

put_public_names: procedure;
	group_index = getbw ();
	segment_index = getbw ();
	put file (outfile) edit ('group index = ', deblank (group_index),
	          ' segment index = ', deblank (segment_index))
	          (a, a, a, a);
	if segment_index = 0 & group_index = 0 then
		put file (outfile) edit (' frame number = ', get_bit16 ()) (a, b4);
	do while (record_length > 1);
		put file (outfile) edit (' ') (col(9), a);
		call put_name;
		put file (outfile) edit (' offset = ', get_bit16 (),
		          ' type index = ', deblank (getbw ()))
		          (a, b4, a, a);
	end;
	end put_public_names;

put_line_numbers: procedure;
	call put_base;
	do while (record_length > 1);
		put file (outfile) edit ('line number = ', get_bit16 ())
		  (skip, col(10), a, b4);
		put file (outfile) edit (' offset = ', get_bit16 ()) (a, b4);
	end;
	end put_line_numbers;

put_name_list: procedure;
	do while (record_length > 1);
		put file (outfile) edit (deblank (lnames_number), ' ') (col(10), a, a);
		call put_name;
		lnames_number = lnames_number + 1;
	end;
	end put_name_list;

put_seg_def: procedure;
	declare
		a bit (3),
		c bit (3),
		b bit (1),
		p bit (1);
	put file (outfile) edit (deblank (segdef_number), ' ') (a, a);
	b8 = get_bit8 ();
	a = substr (b8, 1, 3);
	c = substr (b8, 4, 3);
	b = substr (b8, 7, 1);
	p = substr (b8, 8, 1);
	put file (outfile) edit ('a = ', a, ' c = ', c, ' b = ', b, ' p = ', p)
	  (a, b3, a, b3, a, b1, a, b1);
	if a = '0'b | a = '101'b then
		put file (outfile) edit ('frame number = ', get_bit16 (),
		  ' offset = ', get_bit8 ())
		  (skip, col(10), a, b4, a, b4);
	if a = '110'b then
		put file (outfile) edit ('ltl dat = ', get_bit8 (),
		  ' max seg len = ', get_bit16 (),
		  ' group offset = ', get_bit16 ())
		  (skip, col(10), a, b4, a, b4, a, b4);
	put file (outfile) edit (' segment length = ', get_bit16 ()) (a, b4);
	if a ^= '101'b then
		put file (outfile) edit ('segment name index = ', deblank (getbw ()),
		  ' class name index = ', deblank (getbw ()),
		  ' overlay name index = ', deblank (getbw ()))
		  (skip, col(10), 3(a, a));
	segdef_number = segdef_number + 1;
	end put_seg_def;

put_group_def: procedure;
	put file (outfile) edit (deblank (grpdef_number), ' ') (a, a);
	put file (outfile) edit ('group name index = ', deblank (getbw ())) (a, a);
	do while (record_length > 1);
	group_type = get_bit8 ();
	if group_type = 'ff'b4 then
		do;
			put file (outfile) edit ('segment index = ', deblank (getbw ()))
			  (col(10), a, a);
		end;
	else if group_type = 'fe'b4 then
		do;
			put file (outfile) edit ('external index = ', deblank (getbw ()))
			  (col(10), a, a);
		end;
	else if group_type = 'fd'b4 then
		do;
			put file (outfile) edit ('segment name index = ', deblank (getbw ()),
			  'class name index = ', deblank (getbw ()),
			  'overlay name index = ', deblank (getbw ()))
			  (col(10), a, a, a, a, a, a);
		end;
	else if group_type = 'fb'b4 then
		do;
			put file (outfile) edit ('ltl dat = ', get_bit8 (),
			  'max group length = ', get_bit16 (),
			  'group length = ', get_bit16 ())
			  (col(10), a, b4, a, b4, a, b4);
		end;
	else if group_type = 'fa'b4 then
		do;
			put file (outfile) edit ('frame number = ', get_bit16 (),
			  ' offset = ', get_bit8 ())
			  (col(10), a, b4, a, b4);
		end;
	else put skip file (outfile) list ('*** error ***');
	end;
	grpdef_number = grpdef_number + 1;
	end put_group_def;

put_fixup: procedure;
	declare
		d bit (1),
		method bit (3),
		thred bit (2),
		bmethod fixed (7),
		m bit (1),
		s bit (1),
		loc bit (3),
		offset bit (10);
	do while (record_length > 1);
		b8 = get_bit8 ();
		if (b8 & '80'b4) = 0 then
			do;   /* thread */
				d = substr (b8, 2, 1);
				method = substr (b8, 4, 3);
				thred = substr (b8, 7, 2);
				if d = '0'b then put file (outfile) edit ('target ') (col(10), a);
				else put file (outfile) edit ('frame  ') (col(10), a);
				put file (outfile) edit ('thread ', thred) (a, b2);
				put file (outfile) edit (' method = ', method) (a, b3);
				bmethod = binary (method);
				if bmethod < 4 | bmethod > 6 then
					put file (outfile) edit (' index or frame # = ', deblank (getbw ()))
					  (a, a);
			end;
		else   /* fixup */
			do;
				b16 = b8 || get_bit8 ();
				m = substr (b16, 2, 1);
				s = substr (b16, 3, 1);
				loc = substr (b16, 4, 3);
				offset = substr (b16, 7, 10);
				put file (outfile) edit (fix_type (binary (m)), loc_type (binary (loc)), ' at ', offset)
				  (col(10), a, x(1), a, a, b4);
				call fix_or_end_dat;
			end;
	end;
	end put_fixup;

put_ledata: procedure;
	put file (outfile) edit ('segment index = ', deblank (getbw ()),
	  ' data offset = ', get_bit16 (), ' ')
	  (a, a, a, b4, col(9), a);
	call put_record;
	end put_ledata;

put_iterated_data_block: procedure recursive;
	declare
		repeat_count bit (16),
		block_count bit (16),
		byte_count bit (8),
		i fixed (8),
		c fixed (7);
	repeat_count = get_bit16 ();
	block_count = get_bit16 ();
	put file (outfile) skip edit ('repeat count = ', repeat_count,
		' block count = ', block_count) (col (10), a, b4, a, b4);
	if block_count = '0'b4 then
		do;
			byte_count = get_bit8 ();
			put file (outfile) skip edit ('byte count = ', byte_count, ' ') (col (10), a, b4, col (9), a);
			c = 0;
			do i = 1 to fixed (byte_count);
				if c = 16 then
					do;
						c = 0;
						put file (outfile) edit (' ') (col (9), a);
					end;
				put file (outfile) edit (get_bit8 (), ' ') (b4, a);
				c = c + 1;
			end;
		end;
	else call put_iterated_data_block;
	end put_iterated_data_block;

put_lidata: procedure;
	put file (outfile) edit ('segment index = ', deblank (getbw ()),
	  ' data offset = ', get_bit16 ())
	  (a, a, a, b4);
	do while (record_length > 1);
		call put_iterated_data_block;
	end;
	end put_lidata;

put_libhed: procedure;
	library = true;
	put file (outfile) edit ('module count = ', get_bit16 (),
		' block number = ', get_bit16 (),
		' byte number = ', get_bit16 ()) (a,b4);
	end put_libhed;

put_libnam: procedure;
	call put_name_list;
	end put_libnam;

put_libloc: procedure;
	lnames_number = 1;
	do while (record_length > 1);
		put file (outfile) edit (deblank (lnames_number), ' ')
			(col (10), a, a);
		put file (outfile) edit ('block number = ', get_bit16 (),
			' byte number = ', get_bit16 ()) (a,b4,a,b4);
		lnames_number = lnames_number + 1;
	end;
	end put_libloc;

put_libdic: procedure;
	lnames_number = 1;
	name_length = 0;
	do while (record_length > 1);
		if name_length = 0 then put file (outfile) edit (deblank (lnames_number)) (col (10), a);
		name_length = get_byte ();
		if name_length = 0 then lnames_number = lnames_number + 1;
		else
			do;
				put file (outfile) edit (' ') (col (11), a);
				do i = 1 to name_length;
					put file (outfile) edit (get_char ()) (a);
				end;
			end;
	end;
	stop;
	end put_libdic;

fix_or_end_dat: procedure;
	declare
		f bit (1),
		frame bit (3),
		t bit (1),
		p bit (1),
		targt bit (2),
		frame_datum fixed (15),
		target_datum fixed (15),
		target_disp bit (16);
	b8 = get_bit8 ();
	f = substr (b8, 1, 1);
	frame = substr (b8, 2, 3);
	t = substr (b8, 5, 1);
	p = substr (b8, 6, 1);
	targt = substr (b8, 7, 2);
	if f = '0'b & (binary (frame) < 4 | binary (frame) > 6) then
		do;
			if (frame & '011'b) = '011'b then
				frame_datum = get_bit16 ();
			else
				frame_datum = getbw ();
		end;
	if t = '0'b then
		do;
			if targt = '11'b then target_datum = get_bit16 ();
			else target_datum = getbw ();
		end;
	if p = '0'b then target_disp = get_bit16 ();
	put file (outfile) edit ('  target: ') (a);
	if t = '0'b then
		do;
			if targt = '11'b then
				put file (outfile) edit (bit (target_datum)) (b4);
			else put file (outfile) edit (target_method (binary (targt)), deblank (target_datum), ')' ) (a,a,a);
		end;
	else
		do;
			put file (outfile) edit ('thread ') (a);
			put file (outfile) edit (deblank (binary (targt))) (a);
		end;
	if p = '0'b then
		put file (outfile) edit (',', target_disp) (a, b4);
	put file (outfile) edit ('  frame: ') (col(56), a);
	if f = '0'b then
		do;
			if frame = '011'b then
				put file (outfile) edit (bit (frame_datum)) (b4);
			else if binary (frame) < 3 then
				put file (outfile) edit (target_method (binary (frame)), deblank (frame_datum), ')' ) (a,a,a);
			else put file (outfile) edit (frame_method (binary (frame))) (a);
		end;
	else
		do;
			put file (outfile) edit ('thread ') (a);
			put file (outfile) edit (deblank (binary (frame))) (a);
		end;
	end fix_or_end_dat;

put_record: procedure;
	declare c fixed (7);
	c = 0;
	do while (record_length > 1);
		if c = 16 then
			do;
				c = 0;
				put file (outfile) edit (' ') (col (9), a);
			end;
		put file (outfile) edit (get_bit8 (), ' ') (b4, a);
		c = c + 1;
	end;
	end put_record;

deblank: procedure (x) returns (char (20) varying);
	declare x fixed (15);
	declare c char (20) varying;
	declare i fixed (7);
	c = char (x);
	i = verify (c, ' ');
	return (substr (c, i));
	end deblank;

deblank_char: procedure (c) returns (char (20) varying);
	declare c char (17);
	declare i fixed (7);
	i = index (c, ' ');
	return (substr (c, 1, i));
	end deblank_char;

end omf;
E 1
