chgdisk:	procedure options(main);
/* Program to allow dynamic reconfiguration of the
Advent Ramdisk when used in conjunction with the
TurboROM.  The procedure is to 

a) check for presence of TurboROM
b) check for presence of Ramdisk
c) verify that Ramdisk is totally empty
d) modify the DPB to reflect new parameters
e) modify DPH to point to new ALV if needed
f) relocate bad track tables and safety code if needed
g) erase directory area

*/

%replace
	true			by		'1'b,
	false			by		'0'b,
	up				by		'1'b,
	down			by		'0'b,
	loc_hiptr		by		'FFEA'b4;

declare
	1 himem					based(hiptr),
		2 safptr			pointer,
		2 hrdptr			pointer,
		2 extptr			pointer,
		2 intptr			pointer,
		2 hstptr			pointer,
		2 dpbptr			pointer,
		2 dphptr			pointer,
		2 signat(3)			char(1),
		2 romver			bit(8),
		2 jump				bit(8),
		2 roment			pointer,
		2 chksum			bin fixed(7);


declare
	1 dph_table		based(dphptr),
		2 number_dph		bin fixed(7),
		2 dph_array(1:16),
			3 phy_log		bit(8),
			3 drv_byt		bit(8),
			3 xltptr		pointer,
			3 scratch(3)	pointer,
			3 dirbuf		pointer,
			3 dpb_ptr		pointer,
			3 csvptr		pointer,
			3 alvptr		pointer;

declare
	1 dpb_table				based(dpbptr),
		2 number_dpb		bin fixed(7),
		2 dpb_array(1:16),
			3 body(1:18)	bit(8);

declare
	1 dpb					based(rmdpbp),
		2 transtab			pointer,
		2 media_byte		bit(8),
		2 spt				bin fixed(15),
		2 bsh				bin fixed(7),
		2 blm				bin fixed(7),
		2 exm				bin fixed(7),
		2 dsm				bin fixed(15),
		2 drm				bin fixed(15),
		2 al0				bit(8),
		2 al1				bit(8),
		2 cks				bin fixed(15),
		2 off				bin fixed(15);

declare
	hstbuf(0:1023)			bit(8) based(hstptr),
	1 dsk_param				based(hrdptr),
		2 hard_drive(0:1),
			3 badtrk		pointer,
			3 maxcyl		bin fixed(15),
			3 hstep_rate	bin fixed(7),
			3 precomp_cyl	bin fixed(7),

		2 select_mask		bit(8),
		2 wd_flag			bit(8),
		2 floppy_status		bit(8),
		2 multiplex_flag	bit(8),
		2 floppy_drive(0:3),
			3 step_rate		bin fixed(7),
			3 head_load		bin fixed(7),
			3 head_settle	bin fixed(7),
		2 current_drive,
			3 fstprt		bin fixed(7),
			3 hldly			bin fixed(7),
			3 stldly		bin fixed(7),
		2 small_flag		bit(8),
		2 blking_flag		bit(8);

declare
	dbuf(0:127)				bit(8) based(dbufptr);		

declare
	rmdpbp					pointer,
	ram_alv_ptr				pointer,
	hiptr					pointer,
	srce_ptr				pointer,
	dest_ptr				pointer,
	limit_ptr				pointer,
	dbufptr					pointer,
	cmdptr					pointer;

declare
	SREPRT					entry,
	ROMCHK					entry returns(bin fixed(7));

declare
	i						bin fixed(7),
	logical					bin fixed(7),
	sector					bin fixed(15),
	track					bin fixed(15),
	sector_count			bin fixed(15),
	j						bin fixed(15),
	ram_dpb					bin fixed(7),
	ram_drive				bin fixed(7),
	cmd_line				char(80) varying based(cmdptr),
	alloc(0:255)			bit(8) based(ram_alv_ptr),
	total_tracks			bin fixed(15),
	min_bsh					bin fixed(7),
	new_bsh					bin fixed(15),
	new_off					bin fixed(15),
	new_drm					bin fixed(15),
	new_dsm					bin fixed(15),
	entries_per_block		bin fixed(15),
	reserved_blocks			bin fixed(7),
	new_alv_space			bin fixed(15),
	old_alv_space			bin fixed(15),
	space_adjustment		bin fixed(15),
	inchar					char(1),
	ialloc					bit(16),
	erase_direct			bit(1),
	found					bit(1);

declare
	1 chgtxt				external,
		2 number_pointers	bin fixed(7),
		2 fixed_pointers,
			3 title				pointer,
			3 usage_msg			pointer,
			3 bad_rom_msg		pointer,
			3 no_rdisk_msg		pointer,
			3 nempty_msg		pointer,
			3 bad_parm_msg		pointer,
			3 bad_bsh_msg		pointer,
			3 bad_drm_msg		pointer,
			3 bad_off_msg		pointer,
			3 bad_dir_msg		pointer,
			3 space_wrn_msg		pointer,

		2 msg_space(2048)		char(1);


%include 'DIOCON.DCL';
%include 'BIOSCALL.DCL';

/* sign on message */
	call wrstr(title);

/* check for usage message */
	unspec(cmdptr)='0080'b4;
	if length(cmd_line)=0 ! index(cmd_line,'?') ^= 0 then
		call errx(usage_msg);

/* check for presence of TurboROM */
	if romchk() = 0 then
		call errx(bad_rom_msg);

/* set up pointer to array of himemory pointers */
	unspec(hiptr)=loc_hiptr;

/* check for presence of RAMDISK */

	found=false;
	do i=1 to dphptr->number_dph while(^found);
		if substr(dphptr->phy_log(i),2,3) = '000'b then
		do;
			found=true;
			ram_drive=i;
			logical=substr(dphptr->phy_log(i),5,4);
			/* force reset for skip map */
			substr(dphptr->phy_log(i),1,1)='0'b;
		end;
	end;
	if ^found then
		call errx(no_rdisk_msg);

/* set up ALVPTR */
	ram_alv_ptr=dphptr->alvptr(ram_drive);	

/* set up pointer to RAM DPB in Array */
	ram_dpb=substr(dphptr->drv_byt(ram_drive),5,4);
	ram_dpb=dpbptr->number_dpb-ram_dpb;
	rmdpbp=addr(dpbptr->body(ram_dpb,1));

/* check for empty ram drive */
	erase_direct=true;
	found=false;
	do i=2 to dsm/8;
		if alloc(i) then
			found=true;
	end;


	if al0 ^= alloc(0) ! al1 ^= alloc(1) ! found then
	do;
		if index(cmd_line,'Y') =0 then
		do;
			call wrstr(nempty_msg);
			inchar=coninp();
			if inchar='Y' ! inchar='y' then
				erase_direct=false;
			else
				stop;
		end;
		else
			erase_direct=false;
	end;	

/* init to old values */
	new_bsh=bsh;
	new_off=off;
	new_drm=drm;

/* now get new parameters from command line */
	on error(1)
		call errx(bad_parm_msg);
	call getparm('BSH',new_bsh);
	call getparm('OFF',new_off);
	call getparm('DRM',new_drm);
	revert error(1);


/* now measure size of current drive */
	total_tracks=(dsm+1)*2**(bsh-6) + off;

	if total_tracks > 32 then
		min_bsh=4;
	else
		min_bsh=3;

/* check parameters for reasonableness */
	if new_bsh < min_bsh  ! new_bsh > 7 then
		call errx(bad_bsh_msg);

	if new_off+2 > total_tracks  ! new_off < 1 then
		call errx(bad_off_msg);

/* round directory entries up to nearest whole block */
	entries_per_block= 2**(new_bsh+2);
	do while(mod(new_drm+1,entries_per_block) ^= 0);
		new_drm=new_drm+1;
	end;

	reserved_blocks=divide(new_drm+1,entries_per_block,15);
	if reserved_blocks > 16 then
		call errx(bad_drm_msg);


/* compute ALV space requirements */
	new_dsm=(total_tracks - new_off)*2**(6-new_bsh)-1;
	old_alv_space=ceil(divide(dsm,8,15));
	new_alv_space=ceil(divide(new_dsm,8,15));
	space_adjustment=old_alv_space-new_alv_space;

/* assign new values to DPB */

	dsm=new_dsm;
	off=new_off;
	bsh=new_bsh;
	blm=2**bsh -1;
	if dsm < 256 then
		exm=2**(bsh-3)-1;
	else
		exm=2**(bsh-4)-1;

	drm=new_drm;

/* now must adjust AL0,1 for reserved directory blocks*/

	do i=1 to 16;
		if i <= reserved_blocks then
			substr(ialloc,i,1)='1'b;
		else
			substr(ialloc,i,1)='0'b;
	end;
	al0=substr(ialloc,1,8);
	al1=substr(ialloc,9,8);

/* must move any safety code, bad track maps 
to adjust for new ALV space */

	if space_adjustment < 0 then
	do;		/* move down in memory */
	
	/*find current top of host buffer */
		if hrdptr->small_flag then
			srce_ptr=addr(hstptr->hstbuf(512));
		else
			srce_ptr=addr(hstptr->hstbuf(1024));

	/* now adjust host buffer */
		hstptr=adjust_ptr(hstptr,space_adjustment);
		if hrdptr->small_flag then
			dest_ptr=addr(hstptr->hstbuf(512));
		else
			dest_ptr=addr(hstptr->hstbuf(1024));

		limit_ptr=dphptr->alvptr(ram_drive);
		call movit(down,limit_ptr);
	
		dphptr->alvptr(ram_drive)=adjust_ptr(
				dphptr->alvptr(ram_drive),space_adjustment);

	end;
	else
	do;		/* move up in memory */
		srce_ptr=adjust_ptr(dphptr->alvptr(ram_drive),-1);

		dphptr->alvptr(ram_drive)=adjust_ptr(
				dphptr->alvptr(ram_drive),space_adjustment);

		dest_ptr=adjust_ptr(dphptr->alvptr(ram_drive),-1);

		if hrdptr->small_flag then
			limit_ptr=addr(hstptr->hstbuf(511));
		else
			limit_ptr=addr(hstptr->hstbuf(1023));

		call movit(up,limit_ptr);
		hstptr=adjust_ptr(hstptr,space_adjustment);
	end;

/* adjust pointers to for new memory layout */

	safptr=adjust_ptr(safptr,space_adjustment);
	hrdptr->badtrk(0)=adjust_ptr(
				hrdptr->badtrk(0),space_adjustment);
	hrdptr->badtrk(1)=adjust_ptr(
				hrdptr->badtrk(1),space_adjustment);

/* erase new directory area */

	if erase_direct then
	do;
		/* select ramdisk */
		dbufptr=seldsk(0,logical);	/*dummy ptr*/
	
		/* create erased buffer area */
		allocate dbuf set(dbufptr);
		call setdma(dbufptr);
		do j=0 to 127;
			dbuf(j)='E5'b4;
		end;
	
		/* loop over all directory sectors */
		sector=0;
		track=off;
		do sector_count=1 to (drm+1)/4;
			call settrk(track);
			call setsec(sector);
			if write(1) ^=0 then
				call errx(bad_dir_msg);
			sector=sector+1;
			if sector > spt then
			do;
				track=track+1;
				sector=0;
			end;
		end;
	end;

/* completed, now print space warning message */
	call wrstr(space_wrn_msg);


/* print size information */
	call sreprt;

/*****************************************************/
errx:	procedure(msgptr);
declare
	msgptr			pointer;

	call wrstr(msgptr);
	stop;

end errx;
/*****************************************************/
getparm:	procedure(match,word);
declare
	match			char(3),
	word			bin fixed(15),
	j				bin fixed(7),
	start			bin fixed(7),
	argument		char(15) varying,
	numeric			char(10) static init('0123456789');

	start=index(cmd_line,match);
	if start = 0 then
		return;		/* no change */
	else
	do;
		start=start+3;
		do j=start to length(cmd_line)
			while(substr(cmd_line,j,1)=' ' !
				substr(cmd_line,j,1)='=');
		end;

		start=j;	/* first non divider */
		do j=start to length(cmd_line)
			while(index(numeric,substr(cmd_line,j,1)) ^= 0);
		end;
		argument=substr(cmd_line,start,j-start);
		word=binary(argument,15);
	end;

end getparm;
/****************************************************/
adjust_ptr:	procedure(ptrval,adjustment) returns(pointer);
/* procedure to create new pointer from old plus/minus
adjustment */

declare
	temp0				bin fixed(15),
	temp1				pointer,
	ptrval				pointer,
	adjustment			bin fixed(15);

	unspec(temp0)=unspec(ptrval);
	temp0=temp0+adjustment;
	unspec(temp1)=unspec(temp0);
	return(temp1);

end adjust_ptr;
/*****************************************************/
movit:	procedure(direction,limit);

declare
	direction				bit(1),
	limit					pointer,
	s						bit(8) based(srce_ptr),
	d						bit(8) based(dest_ptr);


	do while(srce_ptr ^= limit);
		d=s;
		if direction=down then
		do;
			call inc_ptr(srce_ptr);
			call inc_ptr(dest_ptr);
		end;
		else
		do;
			call dec_ptr(srce_ptr);
			call dec_ptr(dest_ptr);
		end;

	end;
end movit;
/*****************************************************/
inc_ptr:	procedure(ptr0);
declare
	ptr0			pointer,
	temp			bin fixed(15) based(p0),
	p0				pointer;

	p0=addr(ptr0);
	temp=temp+1;


end inc_ptr;
/*****************************************************/
dec_ptr:	procedure(ptr0);
declare
	ptr0			pointer,
	temp			bin fixed(15) based(p0),
	p0				pointer;

	p0=addr(ptr0);
	temp=temp-1;

end dec_ptr;
/*****************************************************/
end chgdisk;