{**********************************************************************}
{*                     APMTEL Database routines                       *}
{*                  John Butler for A.Ness project                    *}
{*                                                                    *}
{*                    Version 3.2 11 Aug 1988                         *}
{**********************************************************************}

%include "CONSTS.INC"
%include "INC:UTIL.IMP"
%include "FILES.INC"
%include "inc:region.imp"


!File organisation is now an index-sequential file with a couple of linked
!lists running through it.

!A cell here is 1024 bytes. Each cell contains a PAGE or indexing information.

!A PAGE may have 0 or many SUBPAGES.
!In Teletext terms the full page number is pppssss where ppp is the pagenumber
!and ssss is the subpage number. If ssss=0 and the only subpage is the page itself.
!The index cells point at the first or only subpage of the page.
!This has pointers to the other subpages (if any). We'll call it a HEAD Cell

!The first 12 bytes in the file are:
! 0,1: Free cell queue head.
! 2,3: Used cell chain head. This chain links the cell heads
!      in chronologica; order.
! 4,5: Used chain tail. Points to the most recent cell
! 7,8: unused
! 8-11: Timestamp of last write to file.


!The first 10 cells (bar the first 12 bytes) are index cells, each being
!2 bytes, indexed by page.  This allows up to 5114 pages (we can only use 4500)

! Page is a 16-bit channel/page number. Top 4 bits channel, bottom 12 page no.
!The head cells start with BLEN (24) bytes admin information then 1000 bytes for
!the first/only subpage. (the 25th line is not used yet). The first 10 bytes are:
! 0,1: Pointer to next subpage or 0
! 2,3: Forward pointer to next head cell
! 4,5: Reverse pointer to last head cell
! 6,7: Page id
! 8-11: Timestamp (offset must equal tst offset below)

%recordformat admin fm(( %c
   (%half free head, busy head, busy tail) %c
%or %c
   (%half cell ptr, fwd link, rev link) %c
), %half page id, %integer timestamp)

%ownrecord (admin fm) junk
%constinteger blk0admin = 12, blknadmin=12, indexblks=5, pageblks = 15, {testing}
   tst offset = 6, blen=24

%constinteger true=1,false=0

%owninteger file ref=0, file size=0


%integerfn open(%string(255) cache file, %integername file size, %integer mode)
   ! Attempt to open one of the database files.   success = 1, failure = -1
   ! Note use of global FILE REF
   %on %event 0,1,2,3,4,5,6,7,8,9 %start
      %if event_event = 3 %and event_sub = 3 %start
         printstring("Catastrophic user cache error - Event ")
         write(event_event,-1); space; write(event_sub,-1); newline
         %stop
      %finish
      %result= -1
   %finish

!t!printstring("open ".cache file)
   file ref=0
   accessfile(cache file ,mode, file ref,file size)
!t!printstring(" accessed "); write(file ref,-1); space; write(file size,-1)
!t!newline
   %result= 1
%end


%externalroutine open cache(%string(255) cache file)
   ! Repeat a re-open of the database file until it succeeds
   ! Open it in write mode.
!t!printstring("Open Cache ".cache file); newline
   %cycle
   %repeatuntil open(cache file, file size, 1) #-1
%end


%externalroutine close cache
   ! Close the database file for use by other users
!t!printstring("Close cache"); newline
   deaccessfile(file ref)
%end

   
%routine read cell(%integer cell, offset, bytes, %name to)
!t! printstring("ReadCell: "); write(cell, 3);space; phex(offset)
!t! space; write(bytes, 3); space; phex(addr(to))
   read region(file ref, cell*1024+offset, bytes, to)
!t! printstring("="); phex(to); newline
%end

%integerfn read admin(%integer cell, %name admin)
   !A result code of -1 almost certainly means we're reading off end-of-file
!t!   %record (admin fm) %name adm
!t!   printstring("ReadAdm "); write(cell, 3); printstring(":")

   %if cell=0 %start
      %if cell*1024+blk0admin<=file size %then %c
      read region(file ref, cell*1024, blk0admin, admin) %else %result=-1
   %else
      %if cell*1024+blknadmin<=file size %then %c
      read region(file ref, cell*1024, blknadmin, admin) %else %result=-1
   %finish
!t!   adm == record(addr(admin))
!t!   write(adm_free head, 4); write(adm_busy head,4); write(adm_busy tail,4)
!t!   newline
   %result=0
%end

%routine write to cell(%integer cell, offset, bytes, %name from)
!t! printstring("WriteCell: "); write(cell, 3);space; phex(offset)
!t! space; write(bytes, 3); space; phex(addr(from))
!t! printstring("="); phex(from); newline
   write region(file ref, cell*1024+offset, bytes, from)
%end

%integerfn kday(%integer d,m,y)
      !Days since 1/1/1900
      %if m>2 %then m=m-3 %else m=m+9 %and y=y-1
      %result=1461*y//4+(153*m+2)//5+d+58
%end; ! of kday

%routine kdate(%integername d,m,y,%integer k)
   !Convert timestamp k to d,m,y.   k is days since 1/1/1900. 2 digit y
   %integer w
   k=k+693902; ! days since Cleopatras birthday
   w=4*k-1
   y=w//146097
   k=w-146097*y
   d=k//4
   k=(4*d+3)//1461;  d=4*d+3-1461*k;  d=(d+4)//4
   m=(5*d-3)//153;   d=5*d-3-153*m;   d=(d+5)//5
   y=k
   %if m<10 %then m=m+3 %else %start
      m=m-9
      %if y=99 %then y = 0 %else y=y+1
   %finish
%end; ! of kdate

%integerfn timestamp
   %integer dd,mm,yy,hh,nn,magic
   %string(31)t
   t = datetime
   dd=stoi(substring(t,1,2)); mm=stoi(substring(t, 4,5)); yy=stoi(substring(t, 7,8))
   hh=stoi(substring(t,11,12)); nn=stoi(substring(t,14,15))
   magic = ((kday(dd,mm,yy)-31411)*24+hh)*60+nn
   !23-bit integer (minutes since 1/1/86)
   !31411 is the day no for 1/1/86.   
   !Date part of magic won't overflow this century.
   %result = magic
%end

%routine readstamp(%record (admin fm) %name adm, %integername d,m,y, h,n)
   %integer dstamp, tstamp
   tstamp = adm_timestamp; dstamp = tstamp//(24*60)
   kdate(d,m,y, dstamp+31411)
   tstamp = tstamp - dstamp*24*60
   h = tstamp//60
   n = tstamp - h*60
%end

%externalroutine create db file(%string (255) filename, %integer indexblks, pageblks)
   %record (admin fm) b0admin
   %integer i, ch

   %routine write rec
      %integer i
      %for i=0,1,sizeof(b0admin)-1 %cycle; printsymbol(byteinteger(addr(b0admin)+i)); %repeat
      %for i=0,1,1023-sizeof(b0admin) %cycle; printsymbol(0); %repeat
   %end

   ch = outstream
   openoutput(1, filename); selectoutput(1)
   b0admin=0
   b0admin_free head = indexblks
   b0admin_timestamp = timestamp
   write rec
   
   b0admin=0
   %for i=1,1,indexblks-1 %cycle
      write rec
   %repeat
   
   %for i=indexblks,1,pageblks+indexblks-2 %cycle
      b0admin_free head=i+1
      write rec
   %repeat

   b0admin_free head = 0
   write rec

   close output
   selectoutput(ch)
   
%end

%integerfn pageno(%integer page id)
   %integer d,t,h
   d = page id&15; page id = page id>>4
   t = page id&15; page id = page id>>4
   h = page id&15
   %result = (h*10+t)*10+d
%end

%routine analyse db file(%string(255) filename)
   %integer ad, len, freecnt, busycnt, d,m,y, h,n, i,rc
   %record (admin fm) b0admin, bnadmin
   %halfinteger cno
   %halfintegerarray ind(0:512*10-1)
   open cache(filename)

   read region(file ref, 0, 1024*10, byteinteger(addr(ind(0)))) 
   %for i=0,1,blk0admin>>1-1 %cycle
      printstring("**** ")
   %repeat
   %for i=blk0admin>>1,1,511 %cycle
      phex4(ind(i))
      %if i&16=15 %then newline %else space
   %repeat
   newline
   rc=read admin(0, b0admin)
   %if rc=0 %start
   cno = b0admin_free head; freecnt=0
   printstring("Free Head ->"); write(cno, 4); newline
   %while cno#0 %cycle
      rc=read admin(cno, bnadmin)
      cno = bnadmin_free head; freecnt=freecnt+1
      printstring(" -> "); write(cno, 4); newline
   %repeat
   write(freecnt, -1); printstring(" Free cells"); newline

   cno = b0admin_busy head; busycnt=0
   printstring("Busy Tail ->"); write(b0admin_busy tail, 4)
   printstring("   Busy Head ->"); write(cno, 4)
   newline
   %while cno#0 %cycle
      rc=read admin(cno, bnadmin)
      printstring("p"); write(bnadmin_page id>>12,-1)
      printstring("."); write(pageno(bnadmin_page id),-1); printstring(": ")
      write(cno, 3)
      cno = bnadmin_fwd link; busy cnt = busy cnt+1
      
      %while bnadmin_cell ptr#0 %cycle
         printstring(","); write(bnadmin_cell ptr, -1)
         rc=read admin(bnadmin_cell ptr, bnadmin)
      %repeat
      printstring(" -> "); write(cno, -1)
      newline
   %repeat
   write(busycnt, -1); printstring(" Head cells"); newline
   readstamp(b0admin, d,m,y, h,n)
   printstring("File last altered ")
   write(d,-1); printsymbol('/'); write(m,-1); printsymbol('/'); write(y,-1);
   write(h,3); printsymbol(':'); write(n,-1); newline
   %else
     printstring("Problem with file"); newline
   %finish
   close cache
%end

%routine write admin(%integer cell, %name admin)
!t!   %record (admin fm) %name adm
!t!   printstring("Write adm"); write(cell, 3); printstring(":")
   %if cell=0 %start
      write region(file ref, cell*1024, blk0admin, admin)
   %else
      write region(file ref, cell*1024, blknadmin, admin)
   %finish
!t!   adm == record(addr(admin))
!t!   write(adm_free head, 4); write(adm_busy head, 4); write(adm_busy tail, 4)
!t!   newline
%end

%integerfn indexno(%integer page)
   %integer p
   !Page is supplied as a BCD number.
   !Top 4 bits channel, bottom 12 page as 3 nibbles.
   p = page&15; page=page>>4
   p = p + (page&15)*10; page=page>>4
   p = p + (page&15)*100;page=page>>4
   p = p-100 ;!Should now be an integer in the range 0-899
   p = p + ((page&15)-1)*900 ;!Include the channel number
   !5 channels = 4500 pages.
!t! printline("Indexno ".itos(p,-1))
   %result=p
%end

%routine find free cell(%halfname cellno)
   %integer offset,rc
   %halfinteger zero
   %record (admin fm) b0admin, bnadmin
   !Attempt to find a free cell (should be on the free list)
!t! printline("Find free cell")
   rc=read admin(0, b0admin)

   %if rc=0 %start
   %if b0admin_free head#0 %start
      !It is.  Take it off the free queue and give it to the user.
      rc=read admin(b0admin_free head, bnadmin)
      cellno = b0admin_free head; b0admin_free head = bnadmin_free head
   %else
      !Grab the first chain of pages off the busy queue, give the user the
      !first and put the rest on the free queue
      rc=read admin(b0admin_busy head, bnadmin)
      cellno = b0admin_busy head; b0admin_busy head = bnadmin_fwd link
      !Zap the index pointer to this cell head.
      zero=0
      offset = indexno(bnadmin_page id)*2 + blk0admin
      write to cell(offset>>10, offset&1023, 2, zero)
   %finish
   write admin(0, b0admin)
   %finishelse cellno=0
!t! printline("Free cell = ".itos(cellno, -1))
%end

%routine create new cell head(%integer page id, %halfname head)
   %record (admin fm) b0admin, bnadmin
   %integer offset,rc

!t! printstring("Create new cell head "); phex4(page id); newline
   !Find a free cell
   find free cell(head)
   %return %if head=0

   !Locate the busy queue tail pointer.
   rc=read admin(0, b0admin)

   %if b0admin_busy tail=0 %start
      !First cell on queue. Point head at it.
      b0admin_busy head = head
   %else
      !Add the new cell to the end of the busy queue
      rc=read admin(b0admin_busy tail, bnadmin)
      bnadmin_fwd link=head
      write admin(b0admin_busy tail, bnadmin)
   %finish

   !Point the new cell back to the previous cell and forward to NIL
   bnadmin_cell ptr=0; bnadmin_fwd link=0; bnadmin_rev link=b0admin_busy tail
   bnadmin_page id = page id
   write admin(head, bnadmin)
   !Update the busy queue tail pointer
   b0admin_busy tail = head
   b0admin_timestamp=timestamp
   b0admin_page id=page id
   write admin(0, b0admin)
   offset = indexno(page id)*2 + blk0admin
   write to cell(offset>>10, offset&1023, 2, head)
%end

%externalintegerfn record no(%integer page id)
   %halfinteger index
   %integer offset

   offset = indexno(page id)*2 + blk0admin
   read cell(0, offset, 2, index)
!t! printline("Record no(".itos(page id,-1).") = ".itos(index,-1))
   %result = index
%end

!Cache must have been OPENed first.

%routine read data(%integer cell, %name to)
!t! printstring("ReadData:"); write(cell, 3); newline
   read region(file ref, cell*1024+blen, 1000, to)
%end

%externalroutine read cached page(%integer page id, address, %integername subpages)
   %integer ptr, filesize, pg,rc
   %record (admin fm) blknadmin

   !Subpages will be 0 if the page is absent.
!t! printline("Read cached page ".itos(page id,-1))
   pg=record no(page id); ptr=address; subpages=0
   %while pg#0 %cycle
      rc=read admin(pg, blknadmin)
      %if rc=0 %start
        read data(pg, byteinteger(ptr))
        pg = blknadmin_cell ptr; ptr=ptr+1000
        subpages=subpages+1
      %finishelse pg=-1 ;!probably off end of file
   %repeat
!t! printline("Subpages = ".itos(subpages,-1))
%end


%routine move(%integer bytes, %name from, to)
   !Move BYTES bytes from FROM to TO. Pinched from IE.
   !If addr(FROM) < addr(TO) do the move from the top down to allow overlap
   %return %if Bytes = 0 %or  From == To

   %if Addr (To) < Addr (From) %start
      *Subq.l #1, d0
   f loop:
      *move.b (a0)+, (a1)+
      *dbra   d0, f loop
   %else
      *add.l  d0, a0
      *add.l  d0, a1
      *subq.l #1, d0
   b loop:
      *move.b -(a0), -(a1)
      *dbra   d0, b loop
   %finish
%end

%routine write complete cell(%integer cell, %record (admin fm) %name admin,
%integer fromaddr)
   !This is directly equivalent to write admin followed by write data
   !but putting it like this saves filestore read/writes
   !(though at the expense of a block copy)
   %bytearray buff(0:1023)
   move(blen, admin, buff(0))
   move(1000, byteinteger(fromaddr), buff(blen))
   write region(file ref, cell*1024, 1024, buff(0))
%end

%externalroutine write cached page(%integer page id, address, subpages)
    %integer ptr,tt,rc
    %half pg, newpg, headcell
    %record (admin fm) bnadmin
!t!  printline("Write cached page ".itos(page id, -1).", ".itos(subpages,-1)." subpages")
    pg=0; newpg = record no(page id); ptr=0
    create new cell head(page id, newpg) %if newpg=0
    headcell=newpg
    tt=timestamp
    %while newpg#0 %and ptr # subpages*1000 %cycle
       !Overwrite what's there (if it's there) as far as we can
       !Read the admin info
       pg = newpg
       rc=read admin(pg, bnadmin)
       !Change the time stamp
       bnadmin_timestamp=tt %and tt=0 %if tt#0
       write complete cell(pg, bnadmin, address+ptr)
       !overwrite the page
  
       ptr=ptr+1000
       newpg = bnadmin_cell ptr
    %repeat
  
!t!  printline("adding to end") %if ptr # subpages*1000
    %while ptr # subpages * 1000 %cycle ;!We have data left to write
       !Get an unused page (or the oldest used one)
       find free cell(newpg)
       !Chain it onto the subpage list
       rc=read admin(pg, bnadmin)
       bnadmin_cell ptr = newpg
       write admin(pg, bnadmin)
       !Write the new page admin with a null pointer to the next page
       bnadmin_cell ptr = 0
       !For subpage cells we point the forward link to the head cell
       !and the reverse link to the previous subpage cell
       bnadmin_rev link = pg
       bnadmin_fwd link = headcell
       pg = newpg
       write complete cell(pg, bnadmin, address+ptr)
       ptr=ptr+1000
    %repeat
!t!  printline("Cached")
%end
     

%begin
%if cli param="" %then analyse db file("db.dat") %else %c
analyse db file(cli param)
%endofprogram