{$M-,X+}
program eutil;

include {NOLIST} 'domain:mdep.def';
include {NOLIST} 'domain:master.def';
include {NOLIST} 'domain:addrr.hdr';
include {NOLIST} 'domain:msub.hdr';
include {NOLIST} 'domain:iomsg.hdr';

{	**********************************************************

	This file contains procedures for manipulating expanded
	domain data structures and other general utility functions.

	********************************************************** }

function rrsquash(var x:exp_rr):boolean;

{ By convention, consecutive lit_chunks are combined
  this routine does it.  Return false if there wasn't
  enough room for everything. }

var	i, j, tobyte, frombyte:integer;
	overflow:boolean;

begin
with x
do	begin
	overflow:=false;
	i:=chunk_count;
	while (i>=2) and not overflow
	do	begin	
		if (chunks[i].ckind=lit_chunk) and
	    	    (chunks[i-1].ckind=lit_chunk)
		then	if (chunks[i-1].lit_data_count+
				chunks[i].lit_data_count) >
				max_binary_octets
	     		then overflow:=true
	     		else	begin  {combine chunks}
		      		tobyte:=chunks[i-1].lit_data_count;
		      		for frombyte:=1 to chunks[i].lit_data_count do
			  	       chunks[i-1].lit_data[tobyte+frombyte]:=
					chunks[i].lit_data[frombyte];
		      		chunks[i-1].lit_data_count:=
					chunks[i-1].lit_data_count+
					chunks[i].lit_data_count;
		      		chunk_count:=chunk_count-1;
		      		for j:=i to chunk_count do
			  	chunks[j]:=chunks[j+1]
		  		end;
	     	i:=i-1;
    		end;
	rrsquash:=not overflow;
	end;  {with}
end; { rrsquash }
function chcomp(var echunk:exp_chunk;
		cchunk:rdchunk_pointer;
		exact:boolean
		):boolean;

{	CHCOMP compares an expanded and compressed chunk for equality
	EXACT controls whether case is important.

}

var	i:integer;
	result:boolean;
	spoint:dname_pointer;
	myfbp:file_blk_ptr;

begin
if echunk.ckind<>cchunk^.ckind
then	chcomp:=false	{ if not of the same type, they are not equal }
else	case echunk.ckind of

	lit_chunk:	if echunk.lit_data_count<>cchunk^.litdata^.lcount
			then	chcomp:=false	{ not the same size }
			else	begin	{ compare the data }
				i:=0;
				result:=true;
				while	result and (i<echunk.lit_data_count)
				do	begin
					i:=i+1;
					result:=echunk.lit_data[i]=
						cchunk^.litdata^.ldata[i]
					end;
				chcomp:=result
				end;

	name_chunk:	begin	{ compare a domain name }
			i:=1;
			result:=true;
			spoint:=cchunk^.rrname;
			while result and (i<=echunk.rrname.count)
			do	{ compare labels }
				begin
				if exact
				then	result:=elcomp(echunk.rrname.dlabels[i],
							spoint)
				else	result:=lcomp(echunk.rrname.dlabels[i].labinfo,
							spoint^.dlabel.labptr^.text)=0;
				spoint:=spoint^.more;
				i:=i+1
				end;
			chcomp:=result
			end;

	others: begin
		    myfbp:=ofile(fatl);
		    writeln(myfbp^.fident, 'ADDRR internal error');
		    cfile(myfbp);
		end;
	
	end {case}
end; { chcomp }


procedure dlcase(var x:exp_label);

{	DLCASE sets up the modifier bits in its argument label, assuming
	the input contains a mixture of upper and lower case  }

var	i,j:integer;

begin
with x
do	for j:=1 to labinfo[0]
	do	if (chr(labinfo[j])>='a')
			 and
		   (chr(labinfo[j])<='z')
		then	begin
			case_mod[j]:=true;
			labinfo[j]:=labinfo[j]-ord('a')+ord('A')
			end
		else	case_mod[j]:=false

end;	{ DNCASE }


function casechar( ch:char ):char;

begin
if (ch<'a') or (ch>'z')
then	casechar:=ch
else	casechar:=chr(ord(ch)+ord('A')-ord('a'))
end; { casechar }

function compchar( x,y:char ):boolean;

begin
if x=y
then	compchar:=true
else	compchar:= casechar(x)=casechar(y)
end; { compchar }

procedure caseatom( var inarg:atom;
		    var outarg:atom );

var	i:integer;
	chr:char;

begin
for i:=1 to max_atom_chars
do	outarg[i]:=casechar(inarg[i])

end; { caseatom }

function compatom( var arg1:atom;
		       arg2:atom):boolean;

var	i:integer;
	ch1,ch2:char;
	flag:boolean;
begin
flag:=true;
i:=1;
repeat	if arg1[i]<>arg2[i]
	then	begin
		ch1:=casechar(arg1[i]);
		ch2:=casechar(arg2[i]);
		if ch1<>ch2
		then	flag:=false
		end;

	i:=i+1

until	(i=(max_atom_chars+1)) or not(flag);

compatom:=flag;

end. { compatom }