{$W-}
program demo_randomtempfile ;


(*	Copyright (C) 1979 1980 1981   Brian Nelson	*)

(*
	in  order  to  clearly show how the temp file manager in the
	editor works, the following is a new PASCAL version  of  all
	the  routines  used  to  control  and find lines in the work
	file. It is felt that doing this  in  PASCAL  will  allow  a
	clear  understanding of the linkages involved in maintaining
	the work file. To include it as  comments  in  the  macro-11
	source,  either use a conditional assembly to skip the text,
	or insert ';' in column one thoughout. 
*)

(*	the following (inf,i,j,l) are used only by the main  program
	so we can actually test this thing out.
*)
  const	debug = false ;

  var inf: text ;
      i,j,k,l:integer ;


  const nolines = 1;
  const temperr = 2;



(*	var		use

	bucket_fill	max # lines in the temp file buffer, also
			is number of lines in the file edit window.

	bucket_size	number of characters of text that will fit
			in a temp file buffer (512-bucket_fill*2)
*)

  const tempblocksize = 512 ;
  const bucket_fill = 15 ;
  const bucket_size = tempblocksize - ( bucket_fill * 2 ) ;

  type tempblock = record				 
 		    rsize : array [1..bucket_fill] of integer ;
 		    txt   : array [1..bucket_size] of char 
 		   end ;				 


(*	var		usage

	maxlinesize	max number of characters in a line (const)
			used to define the window of lines from the
			temp file buffer.

	inline		a useful scratch line

	tempindex	record definition for a element of the temp
			file index.

	index		array of tempindex, used to retrieve lines
			from the work file. Each element contains
			the character count for the temp file bucket,
			the line count for that bucket and the link
			to the next bucket of lines.
*)

  const maxlinesize = 140 ;
  type textline  = record				 
 		    len   : integer ;			 
 		    c     : array [1..maxlinesize] of char 
 		   end ;				 

  var  inline : textline ;

  type tempindex = record				 
 		    link   : integer;			 
 		    lcount : integer;			 
 		    chcount: integer			 
 		   end ;				 


  const indexsize = 100 ;
  var tempbuffer : tempblock ; 
  var index : array [1..indexsize] of tempindex ;

  type textwindow = record
		     botlin : integer ;
		     toplin : integer ;
		     lines  : array [1..bucket_fill] of textline
		    end ;

  var window : textwindow ;

  type cachestats = record
		     writes : integer ;
		     reads  : integer ;
		     accesses:integer ;
		     faults : integer
		    end ;

  var tempstat : cachestats ;

  var
	currentbucket	: integer ;
	lastbucket	: integer ;
	firstbucket	: integer ;	
	maximumbucket	: integer ;
	linecount	: integer ;
	block_offset	: integer ;
	maximum_line	: integer ;
	lowlimit	: integer ;
	highlimit	: integer ;


(*	the following controls the actions taken in FINDLINE
	and in INSERT_LINE.

	normal_mode:	   do not update disk copy of text window
	initial_fileload:  build index sequentially since the index
			   will not be completed yet.
	force_update:	   update the text window to the work file.
			   this must be set  for any  module  which
			   wants to alter text in a line.
	inserting_lines:   when adding lines.
*)

  type	states = (normal_mode,initial_fileload,inserting_lines,
		  force_update,special_mode) ;
  var	currentmode : states ;


  const
	pagecount = 8 ;
  type
	pagecontrol = record
			buffermod : integer ;
			hitcount  : integer ;
			bufferres : integer
		      end ;

  var
	temppages: array [1..pagecount] of tempblock ;
	pagectl  : array [1..pagecount] of pagecontrol ;
	lastpage : integer ;
	totalhits: integer ;

  const templun = 10 ;

  procedure error(i:integer) ;
   begin writeln; writeln('errcode ',i)
  end ;


  Procedure Getblk(var buff:tempblock; bufsiz,lun,bnum:integer;
                    var reterr:integer ) ; external ;
   
   
  Procedure Putblk(var buff:tempblock; bufsiz,lun,bnum:integer;
                    var reterr:integer ) ; external ;
  

  Procedure Fcreat(var filename:array [1..30] of char; lun:integer;
                   var status:integer; var reterr:integer ); external;
  

  procedure init_pages ;

     var
	i,j: integer ;

     begin
	for i := 1 to pagecount do
	 with pagectl[i] do begin
	  buffermod := 0 ;
	  bufferres := 0 ;
	  hitcount  := 0
	 end ;
	totalhits := 0 ;
	lastpage := 0
  end ;



  function bufctl( rnum:integer; writing:boolean) : integer ;


{	control  the internal  cacheing of temp file buckets
	uses a least recently used algorithm to control page
	residency.
}
     var
	leastaccessed : integer ;
	i , loc ,er   : integer ;

     begin
	er := 0 ;
	loc := 0 ;
	for i := 1 to pagecount do
	 if rnum = pagectl[i].bufferres then loc := i ;
	if loc = 0 then
	 begin
	  tempstat.faults := succ( tempstat.faults ) ;
	  leastaccessed := maxint ;
	  loc  := 0  ;
	  for i := 1 to pagecount do
	    if pagectl[i].hitcount < leastaccessed
	     then begin
	      leastaccessed := pagectl[i].hitcount ;
	      loc  := i
	     end ;

{	  we have now found a page that can be dumped to disk.
	  if it has been modified then write it out. Note that
	  we are not using write-thru but are deferring writes
	  until a page must be dumped.
	  also, since the pages are written in 1-page clusters
	  we can avoid doing a read of the desired page  after
	  the write, unlike in the editor where pages are kept
	  with a clustersize of 2
}
	  with pagectl[loc] do
	   begin
	    if buffermod <> 0
	     then
	      if bufferres <> 0
	       then begin
	        if bufferres > lastpage then lastpage := bufferres ;
	        putblk(temppages[loc],tempblocksize,templun,bufferres,er);
	        if er <> 0 then error(er) ;
	       end ;
	    if (rnum <= lastpage) and not writing 
	      then getblk(temppages[loc],tempblocksize,templun,rnum,er);	
	    if er <> 0 then error(er) ;
	    bufferres := rnum ;
	    buffermod := 0 ;
	   end { with pagectl[loc] } ;

	end { if loc = 0 (page non-resident) } ;

	totalhits := succ( totalhits ) ;
	if totalhits = maxint then
	 begin
	  totalhits := 0 ;
	  for i := 1 to pagecount do pagectl[i].hitcount := 0
	 end ;
	pagectl[loc].hitcount := totalhits ;
	if writing then pagectl[loc].buffermod := -1 ;
	bufctl := loc
    end ;



	    
  procedure puttemp( var buff:tempblock; rnum:integer );
    var i:integer ;
     begin
	i := bufctl(rnum,true);
	if debug then writeln('puttemp - ',i);
	temppages[ i ] := buff
     end ;

  procedure gettemp( var buff:tempblock; rnum:integer );
    var i:integer ;
     begin
	i := bufctl(rnum,false);
	if debug then writeln('gettemp - ',i);
	buff := temppages[ i ]
     end ;

procedure readstring(var f:text; var s:textline);

begin
	s.len := 0 ;
	with s do
	   while (not eoln(f)) and (len<maxlinesize) do begin
	      len := len + 1 ;
	      read(f,c[len])
	      end;
	readln(f);
	s.c[s.len+1] := chr(13) ;
	s.c[s.len+2] := chr(10) ;
	s.len := s.len + 2
end;

	


 procedure insert_lineblock ; forward ;
 procedure insert_links     ; forward ;
 procedure putback	    ; forward ;


 procedure checkindexsize ;
  begin end ;

 procedure checkscreentmo( i:integer ) ;
  begin end ;



 procedure insert_line( var line: textline ) ;

   var
     current_offset : integer ;
     i : integer ;
     more : boolean ;

   begin
	repeat
	  currentbucket := lastbucket ;
	  if linecount = 0 then block_offset := 1 ;
	  if   ( linecount = bucket_fill )
	    or ( block_offset + line.len > bucket_size )
	    then begin
	     insert_lineblock ;
	     insert_links ;
	     linecount := 0 ;
	     more := true
	    end
	    else more := false
	until not more ;

	if line.len <> 0 then
	 begin
	  linecount := succ( linecount ) ;
	  tempbuffer.rsize[linecount] := line.len
	 end ;
	current_offset := block_offset ;
	block_offset := block_offset + line.len ;
	for i := 1 to line.len do
	 begin
	  tempbuffer.txt[current_offset] := line.c[i] ;
	  current_offset := succ(current_offset)
	 end 
   end  { inscom } ;


  procedure putlast( var line: textline ) ;

    begin
	insert_lineblock ;
	insert_links ;
	linecount := 0 ;
	insert_line( line )
    end ;


  procedure insert_lineblock ;

    var
       nextbucket   : integer ;
       done,foundlink : boolean ;

    begin

	lastbucket := 0 ;
	if currentmode = initial_fileload
	 then
	  begin
	   currentbucket := succ( currentbucket ) ;
	   lastbucket  := currentbucket ;
	   index[ lastbucket ].link := succ( lastbucket )
	  end
	 else begin
	   nextbucket := 1 ;
	   done := nextbucket > maximumbucket ;
	   while not done do			{find an empty link }
	    begin
	     lastbucket := nextbucket ;
	     if index[nextbucket].lcount  <> 0
	      then begin
		nextbucket := succ(nextbucket) ;{ not empty, try next 1}
		foundlink := false ;		{ say not found }
		done := nextbucket>maximumbucket
	       end
	      else begin			{ found an empty bucket }
		done := true ;			{ to exit the loop }
		foundlink := true		{ flag success }
	      end
	   end { while } ;

	   if not foundlink then
	    begin
	     maximumbucket := nextbucket ;
	     lastbucket := nextbucket
	    end ;

	   index[nextbucket].link:= index[currentbucket].link ;
	   index[currentbucket].link := nextbucket ;
	   index[nextbucket].lcount := -1 ;
	end 

    end ;




  procedure insert_links ;

     var
      i,nchars: integer ;

     begin

	index[currentbucket].lcount := linecount ;
	nchars := 0 ;
	for i := 1 to linecount do nchars := tempbuffer.rsize[i]+nchars ;
	index[currentbucket].chcount := nchars ;
	checkindexsize ;
	puttemp( tempbuffer,currentbucket ) ;
	tempstat.writes := succ( tempstat.writes ) ;
	window.toplin := 0 ;
	if linecount = 0 then
	 begin
	   if currentbucket = firstbucket
	    then firstbucket := index[currentbucket].link
	    else
	     begin
	      i := 1 ;
	      while index[i].link <> currentbucket do i := i + 1 ;
	      index[i].link := index[currentbucket].link
	     end ;
	   index[currentbucket].link := 0 ;
	 end { if linecount = 0 } ;
    end ;



   function findline( desiredline: integer ) : integer ;

     var
      i,wl,finalresult : integer ;
      buffoffset : integer ;


      function line_in_window : boolean ;
        begin
	 line_in_window :=    ( desiredline >= window.botlin )
			  and ( desiredline <= window.toplin )
      end ;


	begin
	  if maximum_line < 2 then error( nolines ) ;
	  if line_in_window
	    then findline := desiredline - window.botlin + 1
	    else begin
	      if currentmode = force_update then putback ;
	      currentbucket  := firstbucket ;
	      window.botlin := 1 ;
	      window.toplin := index[currentbucket].lcount ;

	      while not line_in_window do
	       begin
		window.botlin := window.toplin + 1 ;
{		writeln(currentbucket:6,index[currentbucket].link:6);}
		currentbucket := index[currentbucket].link ;
		window.toplin := index[currentbucket].lcount
			       + window.toplin ;
	       end ;

	      gettemp( tempbuffer,currentbucket ) ;
	      tempstat.reads := succ( tempstat.reads ) ;
	      checkscreentmo( tempstat.reads ) ;
	      lastbucket := currentbucket ;

	      { got it, now load text window up with lines }

	      buffoffset := 0 ;
	      for wl := 1 to index[currentbucket].lcount do
	       begin
		for i := 1 to tempbuffer.rsize[wl] do
		  window.lines[wl].c[i] := tempbuffer.txt[buffoffset+i];
		window.lines[wl].len := tempbuffer.rsize[wl] ;
		buffoffset := buffoffset + window.lines[wl].len ;
	       end ;
	     finalresult := findline( desiredline ) ;
	     findline := finalresult
	    end
	end ;


  procedure putback ;

     var
       nlines,i : integer ;

     begin

	lastbucket := currentbucket ;
	linecount := 0 ;
	nlines := index[currentbucket].lcount ;
	for i := 1 to nlines do insert_line( window.lines[i] ) ;
	insert_links ;
	if currentmode <> special_mode then currentmode := normal_mode
   end ;


  procedure init_tempsys ;

     const tempname = "SY:TEMPXX.TMP                " ;
     var devicestatus,er:integer ;

     begin
	with tempstat do
	 begin
	  writes := 0 ; reads := 0 ;
	  faults := 0 ; accesses := 0
	 end ;
	init_pages ;
	lastbucket := 0 ;
	linecount  := 0 ;
	currentmode:= initial_fileload ;
	firstbucket:= 1 ;
	fcreat(tempname,templun,devicestatus,er);
	if er <> 0 then writeln('fcreate err - ',er)
     end ;


  procedure ifl( var f:text ) ;

     begin
	while not eof(f) do begin
	 readstring(f,inline);
	 if inline.len <> 0
	   then maximum_line := succ( maximum_line ) ;
	 insert_line( inline ) ;
	end ;
	inline.len := 1 ;
	inline.c[1]:= '@' ;
	insert_line( inline ) ;
	putlast( inline ) ;
	maximumbucket := lastbucket ;
	index[lastbucket].link := 0 ;
	maximum_line := succ( maximum_line ) ;
	linecount := 0 ;
	window.toplin := 0 ;

  end { initial file load (ifl) } ;



   begin
	write('file ');break(output);
	readstring(input,inline);
	reset(inf,inline.c,2);
	init_tempsys ;
	ifl(inf) ;
	readstring(input,inline) ;
	for i := 1 to (maximum_line-1) do
	 begin
	  j := findline(i) ;
	  l := window.lines[j].len ;
	  write(window.lines[j].c:l);
	  break(output)
	 end ;
	repeat
	 write('line ? ');break(output);
	 read(i);
	 if (i>0) and (i<maximum_line) then
	  begin
	   j := findline(i);
	   l := window.lines[j].len ;
	   write(i:3,'  ',window.lines[j].c:l)
	  end 
	until i = 0 ;
	
end.