mergeprl:	procedure options(main);
/* program to interactively patch a PRL file with
a CDL hex file.  Layout is assumed to be standard
PPS system track */

declare
	imptr			pointer,
	float_ptr		pointer,
	map_ptr			pointer,
	cmd_ptr			pointer,

	command			char(79) varying based(cmd_ptr),


	i				bin fixed(15),
	j				bin fixed(15),
	k				bin fixed(7),


	inp				file,
	oup				file,
	patch			file;



/*complete image of the PRL file*/

/*slightly different layout of same area of
memory*/

declare
	1 sysimg	based(imptr),
		2 pad1			bit(8),		/*place to put lxi b*/
		2 imglen		bin fixed(15),
		2 pad2(253)		bit(8),		/*normal empty page*/

		2 data(0:8063)	bit(8);		/* 7K plus bitmap max */

declare
	bitmap(0:895)		bit(8)	based(map_ptr);


declare
	image(8320)	bin fixed(7) based(imptr);


declare
	1 input_buf			static,
		2 max_buf		bin fixed(7) init(14),
		2 filename		char(14) varying;


declare
	signon_msg			char(79) static
init('^M^J^JMERGEPRL v1.0 -- Copyright (c) 1985,86 Plu*Perfect Systems$'),

	usage_msg			char(128) static
init('^M^JUsage:^M^JMERGEPRL  infile   outfile^M^J^J
Where infile and outfile are standard ORG 0 Digital Research PRL files$'),

	bad_wrt_msg			char(79) static
init('^M^JUnable to write PRL file.$'),

	bad_rd_msg			char(79) static
init('^M^JUnable to read PRL file.$'),

	prompt_msg			char(79) static
init('^M^JEnter name of CDL format REL file to merge: $'),

	no_patch_msg		char(79) static
init('^M^J               not found.$');

%include 'DIOCON.DCL';

/****************************************************/
	call wrstr(addr(signon_msg));


/*get space for the file image*/
	allocate image set (imptr);

/*zero out all the bytes that will be filled in later*/
		do i=1 to 8320;
			image(i)=0;
		end;

/* check for ? on command line */
	unspec(cmd_ptr)='0080'b4;
	if index(command,'?') ^= 0 then
	do;
		call wrstr(addr(usage_msg));
		stop;
	end;


	
	on undefinedfile(inp) begin;
		call wrstr(addr(bad_rd_msg));
		stop;
	end;

	open file(inp) record input title('$1.PRL');
	read file(inp) into (image);

/* now get length of PRL and position bitmap correctly */
	map_ptr=addr(data(imglen));
	

/* now prompt for CDL type REL file to read in and
patch PRL*/

	call wrstr(addr(prompt_msg));
	
/* get name of patch file and add REL suffix*/
	call rdbuf(addr(input_buf));

/* uppercase file name and add REL if needed */
	do i=1 to length(filename);
		substr(filename,i,1)=uppercase(substr(filename,i,1));
	end;
	if substr(filename,length(filename)-3,4) ^= '.REL' then
		filename=filename!!'.REL';

/* patch PRL image with CDL  file */
	call patchit(filename);

on undefinedfile(oup) go to badout;
on error(14) go to badout;

/*now write out the patched system*/
	open file(oup) record output
				title('$2.PRL');
	write file(oup) from (image);
	close file(oup);
	stop;

badout:
	call wrstr(addr(bad_wrt_msg));

		
patchit:	procedure(pfile);
/*procedure to read through current CDL format REL
file and patch the image and bitmap*/
declare
	inchar			char(1),
	pfile			char(14) varying,
	in_rec_length	bit(8),
	record_length	bin fixed(7),
	rel_addr		bit(16),
	rel_base		bit(8),
	record_address	bin fixed(15),
	n				bin fixed(7),
	j				bin fixed(7),
	k				bin fixed(7),
	i				bin fixed(7),
	reloc_byte		bit(8),
	this_address	bin fixed(15),
	this_bit		bin fixed(15),
	prv_bit			bit(1),
	rel_bit			bit(1);


substr(no_patch_msg,3,14)=pfile;

on undefinedfile(patch) begin;
	call wrstr(addr(no_patch_msg));
	stop;
end;


on endfile(patch) go to finish;

open file(patch) stream input
			title(pfile);

do while('1'b);
	inchar=' ';
	/*find start of record*/
	do while(inchar^=';');
		get file(patch) edit(inchar)(a(1));
	end;

	get file(patch) edit(in_rec_length)(b4(2));
	if in_rec_length = '00'b4 then
			signal endfile(patch);

	/*convert from unsigned bit string to number*/
	unspec(record_length)=in_rec_length;

	/*now get the address for this record*/
	get file(patch) edit(rel_addr,rel_base)
					(b4(4),b4(2));
	/*convert to number*/
	unspec(record_address)=rel_addr;


	/*now loop over relocation bits and data
	till record is exhausted*/
	j=0;	/*actual offset from record base*/
	k=0;	/*bit counter*/
	do	i=1 to record_length;
		if k=0 then
			get file(patch) edit(reloc_byte)(b4(2));
		else
		do;
			/*compute this data byte address*/
			this_address=j+record_address;
			j=j+1;

			/*now compute position in the bitmap*/
			this_bit=this_address/8;
			n=mod(this_address,8)+1;


			get file(patch) edit(data(this_address))
						(b4(2));

			rel_bit=substr(reloc_byte,k,1);
			if  prv_bit = '0'b then
				substr(bitmap(this_bit),n,1)='0'b;
			else
			do;
				substr(bitmap(this_bit),n,1)='1'b;
				prv_bit='0'b;
			end;

			if rel_bit ='1'b then
				prv_bit='1'b;
			else
				prv_bit='0'b;
					
		end;
		k=k+1;
		if k > 8 then
			k=0;
	end;

end;			
finish:
	close file(patch);
end patchit;

/********************************************************/

%include 'UPCASE.PLI';

end mergeprl;