{$M-}
program mdep;

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

	This file consists of all of the machine dependent routines

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

include {NOLIST} 'domain:jsys.def';
include {NOLIST} 'pascal:extern.pas';		
include {NOLIST} 'domain:mdep.def';
include {NOLIST} 'domain:master.def';
include {NOLIST} 'domain:addrr.hdr';
include {NOLIST} 'domain:msub.hdr';
include {NOLIST} 'domain:lparse.def';
include {NOLIST} 'domain:iomsg.hdr';
include {NOLIST} 'domain:dump.hdr';

type	flagword=set of 0..35;

var	secfile:file of octet;
	section_number:integer;
	section_pointer:secptr;
	i:integer;
	iptr:^integer;
	jval:integer;
	master:master_block_pointer;
	slave:master_block_pointer;
	flipname,flopname:filename;
	master_jfn,slave_jfn:integer;
	m_ptr,s_ptr:master_block_pointer;
	open_flags,pmap_flags:flagword;
procedure tstamp(var x:file);

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

	TSTAMP writes a date/time string to the specified file

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

var	crs:packed array[1..18] of char;

begin
jsys(odtim;crs,-1,0);
write(x,crs)

end; { tstamp }

function getversion(jfn:integer):integer;

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

	GETVERSION gets the version number of the specified file

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

var	string:packed array[1..20] of char;
	rval,ac1,ac2:integer;

begin
jsys(jfns;string,jfn,000010b:0,0);
jsys(nin,1;string,0,10;ac1,ac2);
getversion:=ac2
end; { getversion }

function cntpage(var mymap:pagemap):integer;

{ CNTPAGE returns a count of the number of marked pages in the pagemap }

var i,sum:integer;

begin
sum:=0;
for i:=db_first_page to db_last_page
do if mymap[i] then sum:=sum+1;
cntpage:=sum
end;
procedure initmaster;

{ Set the master block pointer to NIL.
  Should be used by all programs sharing
  any portion of this software. }

begin
    master:=NIL;
    slave:=NIL;
end;
procedure up_pages(first_file_page:integer; (* file page number *)
		     count:integer);          (* count of pages to write *)

{ UP_PAGES UPDATES the specified pages of the master file }

var	rval:integer;
	myfbp:file_blk_ptr;

begin
jsys(ufpgs,-2,rval;
     master^.prijfn:first_file_page,count);
if rval<>2
then begin
	 myfbp:=ofile(fatl);
	 writeln(myfbp^.fident,'Cannot update master pages');
	 jsys_err(abort,-1,myfbp)
     end
end; { up_pages }

procedure up_all;

begin
up_pages(0,db_last_page-db_first_page+1);
end; { up_all }
function getmaster:master_block_pointer;

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

	GETMASTER returns a pointer to the master block at the start
	of the database.  Note that the database must have been set
	up, either by a call to IMASTER to initialize a new copy, or
	by a call to MAPMASTER to get an old one.

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

begin
getmaster:=master
end; { getmaster }

procedure imaster;

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

	IMASTER sets up a file and memory for a new data base

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

var	myfbp:file_blk_ptr;
	total_sections:integer;	(* include space for primary and secondary *)

begin { imaster }

{ setup files }

rewrite(secfile,'flip.dd.-1');

{ create sections }

section_number:=(db_first_page div 512);
total_sections:=((db_last_page div 512)-(db_first_page div 512)+1)*2;
getsections(total_sections,
	    section_number,
	    section_pointer);

section_number:=bshift(quotep(section_pointer),-18);

if section_number<>(db_first_page div 512)
then	begin
	    myfbp:=ofile(err);
	    writeln(myfbp^.fident, 'Section ', (db_first_page div 512):2,
		    ' requested, but section ', section_number:2,
		    ' was obtained');
	    cfile(myfbp);
	end;

modptr(section_pointer,band(db_first_page,511)*512);

{ zero memory to make it real }
cpyptr(section_pointer,iptr);
for i:=db_first_page to db_last_page
do	begin
	iptr^:=0;
	modptr(iptr,512)
	end;

cpyptr(section_pointer,master);

{ mark pages for master block }
for i:=0 to sizeof(master) div au_per_page
do	master^.used_pages[db_first_page+i]:=true;

{ initialize search block chain }
master^.sbloop:=sbptr(master^.sb_array[1]);
for i:=1 to max_sb
do with master^.sb_array[i]
   do begin
	  sbnext:=sbptr(master^.sb_array[(i mod max_sb)+1]);
	  if (i<3) or (i>4) { reserve search blocks 3 & 4 for LDO }
	  then ldores:=0
	  else ldores:=1;
	  rcomp:=intptr(master^.rcom[i])
      end;

{	initialize IAORG and STARK	}

master^.starbp:=xseto(master^.stard);
xidpb(master^.starbp,1);
xidpb(master^.starbp,ord('*'));
master^.starbp:=xseto(master^.stard);

master^.iaorg[1]:=7;
master^.iaorg[2]:=ord('I');
master^.iaorg[3]:=ord('N');
master^.iaorg[4]:=ord('-');
master^.iaorg[5]:=ord('A');
master^.iaorg[6]:=ord('D');
master^.iaorg[7]:=ord('D');
master^.iaorg[8]:=ord('R');
master^.iaorg[9]:=4;
master^.iaorg[10]:=ord('A');
master^.iaorg[11]:=ord('R');
master^.iaorg[12]:=ord('P');
master^.iaorg[13]:=ord('A');

master^.iaorg[14]:=0;

{	set database time }

jsys(gtad;;i);
if i=-1
then   begin
       myfbp:=ofile(err);
       writeln(myfbp^.fident,'System clock not set.. big trouble');
       cfile(myfbp)
       end;
master^.measure.tzero:=i;
master^.measure.mclear:=i;
master^.cupdate:=i;

ilock(master^.update_lock);
ilock(master^.alloc_lock);

ilock(master^.msg_files[fatl].flock);
ilock(master^.msg_files[err].flock);
ilock(master^.msg_files[log].flock);

end; { imaster }

procedure wmaster;

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

	WMASTER writes out a copy of the new database

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

begin
{ pmap the file out }
jsys(pmap,-2,jval;
	fhslf:section_number*512,
	secfile:0,
	540000b:((db_last_page div 512)-(db_first_page div 512)+1)*512);

if jval=3
then	analys(secfile);

close(secfile);

{ Set the file length }

jsys(chfdb,-2,jval; (* set file length *)
     12b:secfile,-1,(db_last_page-db_first_page+1)*512);
jsys(chfdb,-2,jval; (* set file bytesize to 36 *)
     11b:secfile,007700b:0,004400b:0);

end; { wmaster }
procedure logmaster;

var	myfbp:file_blk_ptr;

begin
myfbp:=ofile(log);
write(myfbp^.fident, 'Database taken from ');
d_file(myfbp^.fident,flipname);
writeln(myfbp^.fident);
pheader(log,myfbp);
if m_ptr^.cache_pointer=NIL
then writeln(myfbp^.fident,'No cache.')
else begin
     writeln(myfbp^.fident,' Includes a ',
	     cntpage(m_ptr^.cache_pointer^.zone_pages):4,
	     ' page cache');
     if master<>NIL
     then dmp_zstg(myfbp^.fident,m_ptr^.cache_pointer^)
     end;
cfile(myfbp)
end; { logmaster }
procedure jerr;

begin (* This procedure writes the most recent error to the TTY *)
write(tty,' ');
jsys(erstr,2;curjfn(tty),fhslf:-1,0);
writeln(tty)
end; { jerr }

procedure freezl(mynode:node_pointer);

(* This procedure used in mapmaster along with WALKNODE to
   free zone locks *)

var zp:zone_entry_pointer;

begin
zp:=mynode^.zone_ptr;
while zp<>NIL
do begin
       ilock(zp^.zone_lock);
       zp:=zp^.zone_chain
   end
	 
end; { freezl }
procedure fakei(var mjfn:integer; (* return master JFN *)
		  var sjfn:integer);extern; (* return slave JFNgtdom.mac
 *)

procedure fakemaster;

var	rval:integer;

begin
fakei(master_jfn,slave_jfn); (* call userdj to map in database *)
flipname:=m_ptr^.measure.prifn;
flopname:=m_ptr^.measure.secfn;

logmaster; (* goes to console since master=NIL here *)
master:=m_ptr;
end; { fakemaster }
procedure mapmaster(writable:boolean;	(* writable mapin? *)
		      warm_start:boolean; (* warm start lock code *)
		      setup_db:boolean;	(* setup database locks etc *)
		      jsys_file_select:boolean);

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

	MAPMASTER maps in the best version of the database.
	The database can be selected either by asking the JSYS context
	which files to use (JSYS_FILE_SELECT=true) or else by calling the
	user level JSYS code to emulate the selection process.

	Warm start performs special synchronization with JSYS requests,
        nad is appropriate for restarting a resolver, etc.

        If setup_db is true, then the master block gets its locks set,
	and the jfns in PRIJFN and SECJFN, etc.

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

var	i,loopct,unlocked:integer;
	block:free_block_pointer;
	rval:integer;
	myfbp:file_blk_ptr;
	slots_locked:array[1..max_sb] of boolean;

begin

if writable (* setup open and PMAP flags *)
then	 begin
	     open_flags:=[ofrd,ofwr,ofthw];
	     pmap_flags:=[pmrd+18,pmwr+18,pmcnt+18]
	 end
else	 begin
	     open_flags:=[ofrd,ofthw];
	     pmap_flags:=[pmrd+18,pmcnt+18]
	 end;

block:=aofpage(db_first_page); cpyptr(block,m_ptr); cpyptr(block,s_ptr);
modptr(s_ptr,512);

if not jsys_file_select
then fakemaster	(* execute fake mapmaster *)
else begin (* the real thing *)
	 (* Use TTY since file locks may be set *)
	 writeln(tty,' Domain initialization begun');

	 jsys(gtdom,-2,rval; (* get primary file name *)
	      gtdfus,flipname);	(* get name of primary file *)
	 if rval=3
	 then (* error in GTDOM file name query *)
	      begin
		  write(tty,'GTDOM error asking for DB file, ');
		  jerr;quit
	      end
	 else writeln(tty,'GTDOM database is ',flipname);

	 jsys(gtjfn,-2,rval;[gjsht,gjold],flipname;master_jfn);
	 if rval=3
	 then begin (* error in GTJFN *)
		  write(tty,'GTJFN error on primary, ');
		  jerr;quit
	      end;

	 jsys(openf,-2,rval;master_jfn,open_flags);
	 if rval=3
	 then begin (* error in OPENF *)
		  write(tty,'OPENF error on primary, ');
		  jerr;quit
	      end;

	 jsys(pmap,-2,rval; (* map in database *)
	      master_jfn:0,
	      fhslf:db_first_page,
	      pmap_flags:db_last_page-db_first_page+1);
	 if rval=3
	 then begin (* error in PMAP *)
		  write(tty,'PMAP error on primary, ');
		  jerr;quit
	      end;
	 master:=m_ptr;
	 flopname:=master^.measure.secfn;

	 jsys(gtjfn,-2,rval;[gjsht,gjold],flopname;slave_jfn);
	 if rval=3
	 then begin (* error in GTJFN *)
		  write(tty,'GTJFN error on secondary, ');
		  jerr;quit
	      end;

	 jsys(openf,-2,rval;slave_jfn,open_flags);
	 if rval=3
	 then begin (* error in OPENF *)
		  write(tty,'OPENF error on secondary, ');
		  jerr;quit
	      end;
	 
     end; (* the real thing *)

if setup_db
then with master^
     do begin
	     prijfn:=master_jfn;
	     secjfn:=slave_jfn;
	     resolve_job:=-1; (* signal no resolver *)
	     if warm_start (* special initialization if possible restart *)
	     then begin
		      (* This code is intended to flush all pending JSYS
		         requests and lock up all search blocks to prevent
		         any more from starting.  The assumption is that
			 setting resolve_job to -1 will make this happen *)
		      dflush:=1; (* signal flush *)
		      for i:=1 to max_sb (* mark all as unlocked *)
		      do slots_locked[i]:=false;
		      unlocked:=max_sb; (* set unlocked to max *)

		      loopct:=0; (* wait till we get all of them *)
		      while unlocked>0
		      do begin
			     loopct:=loopct+1;
			     for i:=1 to max_sb (* try to lock this one *)
			     do if not slots_locked[i]
				then if (rcom[i]<>0)
				        and tbit(sb_array[i].fcode,gtdrbk)
				     then begin
					      slots_locked[i]:=true;
					      unlocked:=unlocked-1;
					  end
				     else begin
					      slots_locked[i]:=prlock(sb_array[i].slock);
					      if slots_locked[i] then unlocked:=unlocked-1
					  end;
			     if (unlocked<>0) and (loopct>20)
         		     then writeln(tty,'Domain locks stuck after ',
					  loopct:5,' iterations');
			     mswait(1000)
			 end;
		  end; { End of warm start initialization }

	    { Continue Normal initialization }
	    dflush:=0;
	    ilock(search_zone.zone_lock);
	    if cache_pointer<>NIL
	    then if cache_pointer^.zone_lock.exclusive<>0
		 then cache_pointer:=NIL (* if write locked, toss it *)
		 else ilock(cache_pointer^.zone_lock); (* else free it *)
	    walknode(search_zone.zone_node,freezl,-1,1); (* free zone locks *)
	    for i:=1 to max_sb (* unlock and idle all search blocks *)
	    do begin
		    pulock(sb_array[i].slock);
		    rcom[i]:=0
	       end;
	    ilock(master^.update_lock);
	    ilock(master^.alloc_lock);

	    ilock(master^.msg_files[fatl].flock);
	    ilock(master^.msg_files[err].flock);
	    ilock(master^.msg_files[log].flock);

	end;

end; { mapmaster }
procedure forkmaster;

{ FORKMASTER is called when the database is mapped in by a superior
  to a subfork }

var	block:free_block_pointer;

begin
block:=aofpage(db_first_page);
cpyptr(block,master);
end; { forkmaster }
procedure gcmaster;

{ This procedure garbage collects a master file's page map,
  and initializes its locks, etc. }

var     newmap:pagemap;
	i:integer;
	same:boolean;
	oldused,newused:integer;
	myfbp:file_blk_ptr;

	procedure gczone(var myzone:zone_entry);

	{ This procedure adds all of the pages allocated to this zone to the
	  new map being calculated }

	var	  i:integer;

	begin (* gczone *)
	for i:=db_first_page to db_last_page
	do  if myzone.zone_pages[i]
	    then       if newmap[i]
		       then	   { page is used twice }
			   begin
			       myfbp:=ofile(fatl);
			       writeln(myfbp^.fident,'Page ',i:5,' multiple allocation');
			       cfile(myfbp)
			   end
		       else   newmap[i]:=true;
   
	end; (* gczone *)

	procedure gczonelist(mynode:node_pointer);


	{ This procedure marks all of the pages used by zones at the same
	  name }

	var myzone:zone_entry_pointer;

	begin { gczonelist }
	myzone:=mynode^.zone_ptr;
	while myzone<>NIL
	do    begin
		  gczone(myzone^);
		  myzone:=myzone^.zone_chain
	      end
	end; { gczonelist }
	
begin { gcmaster }

ilock(master^.update_lock);
ilock(master^.alloc_lock);

ilock(master^.msg_files[fatl].flock);
ilock(master^.msg_files[err].flock);
ilock(master^.msg_files[log].flock);

for i:=db_first_page to db_last_page (* start out with a blank map *)
do  newmap[i]:=false;

for i:=0 to sizeof(master) div au_per_page
do  newmap[db_first_page+i]:=true; (* mark master block pages *)

gczone(master^.search_zone);
if master^.cache_pointer<>NIL
then	   gczone(master^.cache_pointer^);

walknode(master^.search_zone.zone_node,gczonelist,-1,1);

same:=true; (* get ready for comparison *)
oldused:=0;
newused:=0;

for i:=db_first_page to db_last_page (* compare the old and new maps *)
do  begin
	if master^.used_pages[i]<>newmap[i]
	    then same:=false;
	if master^.used_pages[i]
	    then oldused:=oldused+1;
	if newmap[i]
	    then newused:=newused+1
    end;

myfbp:=ofile(log);
if same
then   writeln(myfbp^.fident,'Database pagemap constant at',oldused:5,
	       ' pages')
else   writeln(myfbp^.fident,'Database pagemap reduced from',oldused:5,
	       ' to new size of ',newused:5);
cfile(myfbp);

master^.used_pages:=newmap;

up_all;

end; { gcmaster }
procedure mapslave;

var  block:free_block_pointer;
     rval:integer;
     myfbp:file_blk_ptr;

begin
jsys(pmap,-2,rval;
     master^.secjfn:0,
     fhslf:backup_first_page,
     [pmcnt+18,pmrd+18,pmwr+18]:db_last_page-db_first_page+1);
if rval=3
then	 begin (* error in PMAP *)
	     myfbp:=ofile(fatl);
	     writeln(myfbp^.fident,'Cannot map backup file');
	     jsys_err(abort,-1,myfbp)
	 end;

block:=aofpage(backup_first_page);
cpyptr(block,slave); (* set up pointer to slave *)
end; { mapslave }

function getslave:master_block_pointer;

begin
getslave:=slave
end;
procedure cpymaster;

(* Cpymaster copies the primary file to the secondary file.

   WARNING: This operation must be protected by the appropriate locking
	    discipline (except as part of process initialization).

	    The caller must guarantee that the primary will never be
            DIRTY during the copy *)

var     i,rval:integer;
	myfbp:file_blk_ptr;
	block:free_block_pointer;
	from_ptr,to_ptr:free_block_pointer; (* copy pointers *)

	procedure usp;

	(* USP makes sure the slave pages are written to disk *)
        begin
	    jsys(ufpgs,-2,rval;
		 master^.secjfn:0,db_last_page-db_first_page+1);
	    if rval<>2
		then begin
			 myfbp:=ofile(fatl);
			 writeln(myfbp^.fident,'Cannot update slave copy');
			 jsys_err(abort,-1,myfbp)
		     end
        end;

	procedure pdbstat(mblock:master_block_pointer;
			 var fn:filename);

	var    i:integer;

	begin
	    write(myfbp^.fident,' last updated ');
	    d_gtad(myfbp^.fident,mblock^.cupdate);
	    write(myfbp^.fident,',dirty=',mblock^.dirty:2);
	    if mblock^.cache_pointer=NIL
	    then write(myfbp^.fident,', no cache')
	    else begin
		     i:=cntpage(mblock^.cache_pointer^.zone_pages);
		     write(myfbp^.fident,', ',i:4,' cache pages')
		 end;
	    write(myfbp^.fident,', file is ');
	    d_file(myfbp^.fident,fn);
	    writeln(myfbp^.fident)
	end;

begin (* cpymaster *)

(* Map the secondary file in *)
if slave=NIL then mapslave;

{ Log status }

myfbp:=ofile(log);
writeln(myfbp^.fident,'Backup begun to slave database');
pheader(log,myfbp);
write(myfbp^.fident,'Master');
pdbstat(master,flipname);
pheader(log,myfbp);
write(myfbp^.fident,'Slave');
pdbstat(slave,flopname);
cfile(myfbp);

{ Now mark slave as dirty }
slave^.dirty:=1;
usp; (* make sure dirty is written to disk *)

(* Copy the database *)
block:=aofpage(db_first_page);
cpyptr(block,from_ptr);
modptr(from_ptr,1); (* dont copy dirty word *)
block:=aofpage(backup_first_page);
cpyptr(block,to_ptr);
modptr(to_ptr,1);
xxblt(from_ptr,to_ptr,au_per_page-1); (* copy rest of first page *)
modptr(from_ptr,au_per_page-1);
modptr(to_ptr,au_per_page-1);

for i:=db_first_page+1 to db_last_page
do begin (* copy other pages only if marked *)
	if master^.used_pages[i]
	then xxblt(from_ptr,to_ptr,au_per_page);
	modptr(from_ptr,au_per_page);
	modptr(to_ptr,au_per_page)
   end;

(* Update file pages *)
usp;

(* Mark the secondary as not-dirty *)
slave^.dirty:=0;

(* Update file pages one more time to finish the process *)
usp;

myfbp:=ofile(log);
writeln(myfbp^.fident,'Backup completed for slave database');
cfile(myfbp)

end; (* cpymaster *)
function pib_init(var mypib:pib;
		      fn:filename):boolean;

{	PIB_INIT initializes a pib for input
}

begin
with mypib
do	begin
	reset(dfile,fn,'/O/E');
	dfilename:=fn;
	line_number:=0;
	pflag:=false;
	pib_init:=erstat(dfile)=0
	end
end. {pib_init}